; rollout-anim.scm   version 1.00   23.10.2002
;
; A Gimp Script-Fu Scheme script to create an animation of an
; downward roll out/unrolling of an image
;
; CHANGE-LOG:
; 1.00 - initial release	23.10.2002
;
; Prerequisites: The Gimp (http://www.gimp.org/)
;		(tested with version 1.2)
;
; License:	The program is distributed under the GNU General Public License (GPL)
;		(see http://www.gnu.org/copyleft/gpl.html)
;
; Installation:	Copy this file in your local or global Gimp scripts directory
;               (e.g. ~/.gimp-1.2/scripts)
;
; Copyright (C) 2002 Martin Bernreuther <martin@bernreuther.net>
;

;

; Define the function:
(define (
	script-fu-rollout-anim img
				drawable
				diameter
				num-frames
				replace
				flatten)
(let*
	(
		(image (car (gimp-channel-ops-duplicate img)))
		(diameter (max 0 diameter))
		(num-frames (max 2 num-frames))
		(source-layer (car (if (= flatten TRUE) (gimp-image-flatten image) (gimp-image-get-active-layer image))))
		(layer-height (car (gimp-drawable-height source-layer)))
		(layer-width (car (gimp-drawable-width source-layer)))
		(layer-type (car (gimp-drawable-type source-layer)))
		(frame-type "(combine)")
		(stepsize (/ layer-height (- num-frames 1)))
		(radius (/ diameter 2))
		(numframe 1)
	)

	(set! num-frames (min layer-height num-frames))
	(if (= replace TRUE) (set! frame-type "(replace)"))

	(gimp-image-undo-disable image)

	(while (< numframe num-frames)
	; draw frame
	(let*
		(
			(layer-name (string-append "Frame " (number->string numframe 10) " " frame-type))
			(new-layer (car (gimp-layer-new image layer-width layer-height layer-type layer-name 100 0)))
			;(pos-top (round (* (- numframe 1) stepsize)))
			(pos-top (* (- numframe 1) stepsize))
			(pos2 (- pos-top stepsize))
		)

		(gimp-layer-add-alpha new-layer)
		(gimp-image-add-layer image new-layer 0)
		(gimp-edit-clear new-layer)

		(if (> pos-top 0)
		(begin
			(if (or (< pos2 0) (= replace TRUE)) (set! pos2 0))
			(gimp-rect-select image 0 pos2 layer-width (- pos-top pos2) REPLACE 0 0)
			(gimp-edit-copy source-layer)
			(let ((floating-sel (car (gimp-edit-paste new-layer FALSE)))) (gimp-floating-sel-anchor floating-sel))
			(gimp-selection-none image)
		)
		)

		(if (< pos-top layer-height)
		; draw role
		(begin
			(set! pos2 0)
			(while (and (< pos2 diameter) (< pos2 (- layer-height pos-top)))
			(let*
				(
					(pos-dst (+ pos-top pos2))
					(beta (acos (- 1. (/ pos2 radius))))
					;                         1.+1.5*pi
					(pos-src (+ pos-top (* (- 5.7123889798 beta) radius)))
				)

				(if (> pos-src layer-height)
					(if (> pos2 radius)
					;                                          1.-.5*pi
						(set! pos-src (+ pos-top (*(- beta 0.5707963266) radius)))
						(set! pos-src pos-dst)
					)
				)

				(if (< pos-src layer-height)
				(begin
					(gimp-rect-select image 0 pos-src layer-width 1 REPLACE 0 0)
					(gimp-edit-copy source-layer)
					(gimp-selection-none image)
					(gimp-rect-select image 0 pos-dst layer-width 1 REPLACE 0 0)
					(let ((floating-sel (car (gimp-edit-paste new-layer FALSE)))) (gimp-floating-sel-anchor floating-sel))
					(gimp-selection-none image)
				)
				)

			)
				(set! pos2 (+ pos2 1))
			)
		)
		)

	)
		(set! numframe (+ numframe 1))
	)

	(if (= replace TRUE)
		(gimp-layer-set-name source-layer (string-append "Frame " (number->string num-frames 10) " " frame-type))
		(gimp-image-remove-layer image source-layer)
	)

	(gimp-image-undo-enable image)
	(gimp-display-new image)
)
)

; Gimp Registration:
(script-fu-register "script-fu-rollout-anim"
		    _"<Image>/Script-Fu/Animators/Roll out..."
		    "Animation of rolling out/unrolling an image downward"
		    "Martin Bernreuther <martin@bernreuther.net>"
		    "Martin Bernreuther"
		    "23.10.2002"
		    ""
		    SF-IMAGE "Image" 0
		    SF-DRAWABLE "Drawable" 0
		    SF-ADJUSTMENT _"Diameter of role"     '(20  2  1024 1 10 0 1)
		    SF-ADJUSTMENT _"Number of frames"     (list 24  2  1024 1 10 0 1)	; maximum number of frames should be height of image
		    SF-TOGGLE _"Replace mode for frames?" FALSE
		    SF-TOGGLE _"Flatten image?"           TRUE
)