; This program is free software; you can redistribute it and/or modify
; it under the terms of the GNU General Public License as published by
; the Free Software Foundation; either version 2 of the License, or
; (at your option) any later version.
;
; This program is distributed in the hope that it will be useful,
; but WITHOUT ANY WARRANTY; without even the implied warranty of
; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
; GNU General Public License for more details.
(define (script-fu-sg-ornament-simple image)
(gimp-image-undo-group-start image)
(let ((bulb-angle 0) ; SF-ADJUSTMENT "Top angle" '(-45 -90 90 15 15 1 0 0)
(lighted? #f) ; SF-TOGGLE "Lighted?" TRUE
(light-x -0.5) ; SF-ADJUSTMENT "Light location X" '(-0.5 -1 1 0.25 0.5 1 0 1)
(light-y -0.5) ; SF-ADJUSTMENT "Light location Y" '(-0.5 -1 1 0.25 0.5 1 0 1)
(drawable (car (gimp-image-get-active-layer image)))
(orig-sel (car (gimp-selection-save image))) )
(let ((bounds (gimp-drawable-mask-intersect drawable)))
(unless (zero? (car bounds))
(set! bounds (cdr bounds))
(gimp-layer-resize drawable
(caddr bounds)
(cadddr bounds)
(- (car bounds))
(- (cadr bounds)) )))
(gimp-selection-none image)
(let ((width (car (gimp-drawable-width drawable)))
(height (car (gimp-drawable-height drawable))) )
; square off layer
(cond
((> width height)
(gimp-layer-resize drawable
width
width
0
(/ (- width height) 2) ))
((< width height)
(gimp-layer-resize drawable
height
height
(/ (- height width) 2)
0 ))))
(gimp-layer-flatten drawable)
(gimp-layer-add-alpha drawable)
(let ((width (car (gimp-drawable-width drawable)))
(height (car (gimp-drawable-height drawable))) )
; enlarge image if necessary
(if (or (> width (car (gimp-image-width image)))
(> height (car (gimp-image-height image))) )
(gimp-image-resize image
width
height
(- (car (gimp-drawable-offsets drawable)))
(- (cadr (gimp-drawable-offsets drawable))) )))
(let ((width (car (gimp-drawable-width drawable)))
(height (car (gimp-drawable-height drawable))) )
; compensate for Map Object's lack of supersampling by working at 3X
(gimp-layer-scale-full drawable
(* 3 width)
(* 3 height)
TRUE INTERPOLATION-CUBIC ))
(let ((width (car (gimp-drawable-width drawable)))
(height (car (gimp-drawable-height drawable))) )
; create empty region that will be wrapped onto hidden backside of bulb
(gimp-layer-resize drawable
(* 3 width)
(* height 1.5)
width
(/ (* height 1) 4) )
(gimp-layer-scale-full drawable width height TRUE INTERPOLATION-CUBIC)
(plug-in-map-object RUN-NONINTERACTIVE
image
drawable
1 ; maptype (0=plane,1=sphere,2=box,3=cylinder)
0.5 0.5 1.25 ; viewpoint xyz (0.5 0.5 2)
0.5 0.5 0.5 ; position xyz
1 0 0 ; first axis of object
0 1 0 ; second axis of object
(- bulb-angle) 0 0 ; rotation angles z y x
(if lighted? 0 2) ; lighttype (0=point,1=directional,2=none)
'(255 255 255) ; light color
light-x light-y 2 ; light position xyz
-1.0 -1.0 1.0 ; light direction xyz
0.3 ; ambient-intensity
1.0 ; diffuse-intensity
0.5 ; diffuse-reflectivity
0.5 ; specular-reflectivity
27.0 ; highlight
TRUE ; antialiasing
FALSE ; tiled
FALSE ; newimage
TRUE ; transparentbackground
0.25 ; radius (sphere or cylinder)
0.5 0.5 0.5 ; scale xyz (box)
1 ; cylinder-length
drawable ; box-front-drawable
drawable ; box-back-drawable
drawable ; box-top-drawable
drawable ; box-bottom-drawable
drawable ; box-left-drawable
drawable ; box-right-drawable
drawable ; cyl-top-drawable
drawable ; cyl-bottom-drawable
)
; undo the simulated oversampling scaling
(gimp-layer-scale-full drawable
(/ width 3)
(/ height 3)
TRUE
INTERPOLATION-CUBIC ))
; correct for fact that Map Object doesn't produce a perfect sphere
(gimp-selection-layer-alpha drawable)
(let ((bounds (cdr (gimp-drawable-mask-intersect drawable))))
(gimp-ellipse-select image
(+ (car (gimp-drawable-offsets drawable)) (car bounds))
(+ (cadr (gimp-drawable-offsets drawable)) (cadr bounds))
(caddr bounds)
(cadddr bounds)
CHANNEL-OP-REPLACE TRUE FALSE 0 ))
(gimp-selection-invert image)
(gimp-edit-clear drawable)
(gimp-selection-load orig-sel)
(gimp-image-remove-channel image orig-sel)
(gimp-image-set-active-layer image drawable) )
(gimp-displays-flush)
(gimp-image-undo-group-end image)
)
(script-fu-register "script-fu-sg-ornament-simple"
"Christmas Ornament"
"Map squared region to a Christmas Tree bulb"
"Saul Goode"
"Saul Goode"
"Sept 2011"
"RGB*, GRAY*"
SF-IMAGE "Image" 0
)
(script-fu-menu-register "script-fu-sg-ornament-simple"
"<Image>/Filters/Map"
)