; 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-align-down image drawable)
;; Search for the first layer that is visible below the active layer
;; return #f on failure (no such layer)
;
(define (get-base-layer layer)
(let
loop ((layers (cdr (memv layer (vector->list (cadr (gimp-image-get-layers image)))))))
(if (null? layers)
#f
(if (= (car (gimp-drawable-get-visible (car layers))) TRUE)
(car layers)
(loop (cdr layers))))))
(if (or (= (car (gimp-drawable-is-layer drawable)) TRUE)
(= (car (gimp-drawable-is-layer-mask drawable)) TRUE) )
(let* ((layer (car (gimp-image-get-active-layer image)))
(width (car (gimp-drawable-width layer)))
(height (car (gimp-drawable-height layer)))
(bounds (gimp-selection-bounds image))
(base-layer (get-base-layer layer))
(base-x 0)
(base-y 0)
(base-width (car (gimp-image-width image)))
(base-height (car (gimp-image-height image))))
(if (= (car bounds) TRUE)
(begin
(set! bounds (cdr bounds))
(set! base-x (car bounds))
(set! base-y (cadr bounds))
(set! base-width (- (caddr bounds) base-x))
(set! base-height (- (cadddr bounds) base-y))
)
(when base-layer
(set! base-x (car (gimp-drawable-offsets base-layer)))
(set! base-y (cadr (gimp-drawable-offsets base-layer)))
(set! base-width (car (gimp-drawable-width base-layer)))
(set! base-height (car (gimp-drawable-height base-layer)))
)
)
(gimp-image-undo-group-start image)
(gimp-layer-set-offsets layer
(- (+ base-x (/ base-width 2)) (/ width 2))
(- (+ base-y (/ base-height 2)) (/ height 2)))
(gimp-image-undo-group-end image)
(gimp-displays-flush)
)
(begin ;; ELSE active drawable is a channel, center selection on image
(gimp-image-undo-group-start image)
(let ((orig-sel (if (zero? (car (gimp-selection-is-empty image)))
(car (gimp-selection-save image))
#f ))
(channel 0) )
(if orig-sel
(set! channel (car (gimp-selection-save image)))
(begin
(set! channel (car (gimp-channel-copy drawable)))
(gimp-image-add-channel image channel -1) ))
(gimp-selection-load channel) ;; !!! BUG = unable to load from quickmask
(let* ((bounds (gimp-selection-bounds image))
(x (cadr bounds))
(y (caddr bounds))
(width (- (cadddr bounds) x))
(height (- (car (cddddr bounds)) y))
(image-width (car (gimp-image-width image)))
(image-height (car (gimp-image-height image))) )
(gimp-selection-none image)
(unless (zero? (car bounds)) ;; do nothing if channel is empty
(gimp-drawable-offset channel
TRUE
OFFSET-BACKGROUND
(- (/ (- image-width width) 2) x)
(- (/ (- image-height height) 2) y) )))
(if orig-sel
(begin
(gimp-selection-load channel)
(gimp-image-remove-channel image orig-sel) )
(let ((buffer (car (gimp-edit-named-copy channel "temp"))))
(gimp-floating-sel-anchor (car (gimp-edit-named-paste drawable buffer FALSE)))
(gimp-buffer-delete buffer) ))
(gimp-image-remove-channel image channel)
)
(gimp-image-undo-group-end image)
(gimp-displays-flush)
)
)
)
(script-fu-register "script-fu-sg-align-down"
"Align Down"
"Align this layer centered with the (visible) layer below it"
"Saul Goode"
"Saul Goode"
"4/9/2010"
"*"
SF-IMAGE "Image" 0
SF-DRAWABLE "Layer" 0
)
(script-fu-menu-register "script-fu-sg-align-down"
"<Image>/Layer"
)
(script-fu-menu-register "script-fu-sg-align-down"
"<Layers>"
)