[gimp] Bug 748270 - ripply-anim.scm does not handle transparent backgrounds

[Michael Natterer <mitch src gnome org>]

commit cc042b35d2844675152cda3512283c2d22dff199
Author: Saul Goode <saul crazyauntgail com>
Date:   Sun Apr 26 22:19:38 2015 -0400

    Bug 748270 - ripply-anim.scm does not handle transparent backgrounds
    
    Replace the script by a modernized re-write, which also handles layers
    with alpha.

 plug-ins/script-fu/scripts/ripply-anim.scm |  168 ++++++++++------------------
 1 files changed, 58 insertions(+), 110 deletions(-)
---
diff --git a/plug-ins/script-fu/scripts/ripply-anim.scm b/plug-ins/script-fu/scripts/ripply-anim.scm
index b2a1605..a593258 100644
--- a/plug-ins/script-fu/scripts/ripply-anim.scm
+++ b/plug-ins/script-fu/scripts/ripply-anim.scm
@@ -1,133 +1,81 @@
 ; "Rippling Image" animation generator (ripply-anim.scm)
 ; Adam D. Moss (adam foxbox org)
 ; 97/05/18
+; Revised by Saul Goode April 2015.
 ;
 ; Designed to be used in conjunction with a plugin capable
 ; of saving animations (i.e. the GIF plugin).
 ;
 
-(define (script-fu-ripply-anim img drawable displacement num-frames edge-type)
-
-  (define (copy-layer-ripple dest-image dest-drawable source-image source-drawable)
-    (gimp-selection-all dest-image)
-    (gimp-edit-clear dest-drawable)
-    (gimp-selection-none dest-image)
-    (gimp-selection-all source-image)
-    (gimp-edit-copy source-drawable)
-    (gimp-selection-none source-image)
-    (let ((floating-sel (car (gimp-edit-paste dest-drawable FALSE))))
-      (gimp-floating-sel-anchor (car (gimp-edit-paste dest-drawable FALSE)))
-    )
-  )
-
-  (let* (
-        (width (car (gimp-drawable-width drawable)))
-        (height (car (gimp-drawable-height drawable)))
-        (ripple-image (car (gimp-image-new width height GRAY)))
-        (ripple-layer (car (gimp-layer-new ripple-image width height GRAY-IMAGE "Ripple Texture" 100 
NORMAL-MODE)))
-        (rippletiled-ret 0)
-        (rippletiled-image 0)
-        (rippletiled-layer 0)
-        (remaining-frames 0)
-        (xpos 0)
-        (ypos 0)
-        (xoffset 0)
-        (yoffset 0)
-        (dup-image 0)
-        (layer-name 0)
-        (this-image 0)
-        (this-layer 0)
-        (dup-layer 0)
-        )
-
+(define (script-fu-ripply-anim image drawable displacement num-frames edge-type)
+  (let* ((width (car (gimp-drawable-width drawable)))
+         (height (car (gimp-drawable-height drawable)))
+         (work-image (car (gimp-image-new width
+                                          height
+                                          (quotient (car (gimp-drawable-type drawable))
+                                                    2))))
+         (map-layer (car (gimp-layer-new work-image
+                                         width
+                                         height
+                                         (car (gimp-drawable-type drawable))
+                                         "Ripple Map"
+                                         100
+                                         NORMAL-MODE))))
     (gimp-context-push)
+    (gimp-image-undo-disable work-image)
 
-    ; this script generates its own displacement map
-
-    (gimp-image-undo-disable ripple-image)
+    ; Create a tile-able displacement map in the first layer
     (gimp-context-set-background '(127 127 127))
-    (gimp-image-insert-layer ripple-image ripple-layer 0 0)
-    (gimp-edit-fill ripple-layer BACKGROUND-FILL)
-    (plug-in-noisify RUN-NONINTERACTIVE ripple-image ripple-layer FALSE 1.0 1.0 1.0 0.0)
-    ; tile noise
-    (set! rippletiled-ret (plug-in-tile RUN-NONINTERACTIVE ripple-image ripple-layer (* width 3) (* height 
3) TRUE))
-    (gimp-image-undo-enable ripple-image)
-    (gimp-image-delete ripple-image)
-
-    (set! rippletiled-image (car rippletiled-ret))
-    (set! rippletiled-layer (cadr rippletiled-ret))
-    (gimp-image-undo-disable rippletiled-image)
-
-    ; process tiled noise into usable displacement map
-    (plug-in-gauss-iir RUN-NONINTERACTIVE rippletiled-image rippletiled-layer 35 TRUE TRUE)
-    (gimp-equalize rippletiled-layer TRUE)
-    (plug-in-gauss-rle RUN-NONINTERACTIVE rippletiled-image rippletiled-layer 5 TRUE TRUE)
-    (gimp-equalize rippletiled-layer TRUE)
-
-    ; displacement map is now in rippletiled-layer of rippletiled-image
-
-    ; loop through the desired frames
-
-    (set! remaining-frames num-frames)
-    (set! xpos (/ width 2))
-    (set! ypos (/ height 2))
-    (set! xoffset (/ width num-frames))
-    (set! yoffset (/ height num-frames))
-
-    (let* ((out-imagestack (car (gimp-image-new width height RGB))))
-
-    (gimp-image-undo-disable out-imagestack)
-
-    (while (> remaining-frames 0)
-      (set! dup-image (car (gimp-image-duplicate rippletiled-image)))
-      (gimp-image-undo-disable dup-image)
-      (gimp-image-crop dup-image width height xpos ypos)
-
-      (set! layer-name (string-append "Frame "
-                 (number->string (- num-frames remaining-frames) 10)
-                 " (replace)"))
-      (set! this-layer (car (gimp-layer-new out-imagestack
-                                            width height RGB
-                                            layer-name 100 NORMAL-MODE)))
-      (gimp-image-insert-layer out-imagestack this-layer 0 0)
-
-      (copy-layer-ripple out-imagestack this-layer img drawable)
-
-      (set! dup-layer (car (gimp-image-get-active-layer dup-image)))
-      (plug-in-displace RUN-NONINTERACTIVE out-imagestack this-layer
-                        displacement displacement
-                        TRUE TRUE dup-layer dup-layer edge-type)
-
-      (gimp-image-undo-enable dup-image)
-      (gimp-image-delete dup-image)
-
-      (set! remaining-frames (- remaining-frames 1))
-      (set! xpos (+ xoffset xpos))
-      (set! ypos (+ yoffset ypos))
-    )
-
-    (gimp-image-undo-enable rippletiled-image)
-    (gimp-image-delete rippletiled-image)
-    (gimp-image-undo-enable out-imagestack)
-    (gimp-display-new out-imagestack))
-
-    (gimp-context-pop)
-  )
-)
+    (gimp-image-insert-layer work-image map-layer 0 0)
+    (gimp-edit-fill map-layer BACKGROUND-FILL)
+    (plug-in-noisify RUN-NONINTERACTIVE work-image map-layer FALSE 1.0 1.0 1.0 0.0)
+    (plug-in-tile RUN-NONINTERACTIVE work-image map-layer (* width 3) (* height 3) FALSE)
+    (plug-in-gauss-iir RUN-NONINTERACTIVE work-image map-layer 35 TRUE TRUE)
+    (gimp-drawable-equalize map-layer TRUE)
+    (plug-in-gauss-rle RUN-NONINTERACTIVE work-image map-layer 5 TRUE TRUE)
+    (gimp-drawable-equalize map-layer TRUE)
+    (gimp-image-crop work-image width height width height)
+
+    ; Create the frame layers
+    (let loop ((remaining-frames num-frames))
+      (unless (zero? remaining-frames)
+        (let ((frame-layer (car (gimp-layer-new-from-drawable drawable work-image))))
+          (gimp-image-insert-layer work-image frame-layer 0 0)
+          (gimp-item-set-name frame-layer
+                              (string-append "Frame "
+                                             (number->string (+ 1 (- num-frames
+                                                                     remaining-frames)))
+                                             " (replace)"))
+          (plug-in-displace RUN-NONINTERACTIVE work-image frame-layer
+                            displacement displacement
+                            TRUE TRUE map-layer map-layer edge-type)
+          (gimp-item-set-visible frame-layer TRUE))
+        (gimp-drawable-offset map-layer
+                              TRUE
+                              OFFSET-BACKGROUND
+                              (/ width num-frames)
+                              (/ height num-frames))
+        (loop (- remaining-frames 1))))
+
+    (gimp-image-remove-layer work-image map-layer)
+    (gimp-image-undo-enable work-image)
+    (gimp-display-new work-image)
+
+    (gimp-context-pop)))
 
 (script-fu-register "script-fu-ripply-anim"
   _"_Rippling..."
-  _"Create a multi-layer image by adding a ripple effect to the current image"
-  "Adam D. Moss (adam foxbox org)"
-  "Adam D. Moss"
-  "1997"
+  _"Create a multi-layer image by adding a ripple effect to the current layer"
+  "Adam D. Moss (adam foxbox org), Saul Goode"
+  "Adam D. Moss, Saul Goode"
+  "1997, 2015"
   "RGB* GRAY*"
   SF-IMAGE      "Image to animage"    0
   SF-DRAWABLE   "Drawable to animate" 0
   SF-ADJUSTMENT _"Rippling strength"  '(3 0 256 1 10 1 0)
   SF-ADJUSTMENT _"Number of frames"   '(15 0 256 1 10 0 1)
   SF-OPTION     _"Edge behavior"      '(_"Wrap" _"Smear" _"Black")
-)
+  )
 
 (script-fu-menu-register "script-fu-ripply-anim"
                          "<Image>/Filters/Animation/Animators")