GIMP Script-fu

Artifact [d9552c30ea]
Login

Artifact [d9552c30ea]

Artifact d9552c30eaea6e8d9f7dcec928795373e09f488b:


; 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.

; Revision history:
;   June 2013 - support for layer groups

; pre-2.8 COMPATIBILITY
  (when (not (defined? 'gimp-item-get-parent))
    (define (gimp-item-get-parent ignored) -1) ; always top-level
    (define gimp-item-get-visible gimp-drawable-get-visible)
    (define gimp-item-is-layer gimp-drawable-is-layer)
    (define gimp-item-is-layer-mask gimp-drawable-is-layer-mask) )

(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* ((parent (car (gimp-item-get-parent layer)))
           (siblings (if (= -1 parent)
                         (vector->list (cadr (gimp-image-get-layers image)))
                         (vector->list (cadr (gimp-item-get-children parent))) )))
      (let 
        loop ((layers (cdr (memv layer siblings))))
         (if (null? layers)
           #f
           (if (= (car (gimp-item-get-visible (car layers))) TRUE)
             (car layers)
             (loop (cdr layers)))))))
  (if (or (= (car (gimp-item-is-layer drawable)) TRUE)
          (= (car (gimp-item-is-layer-mask drawable)) TRUE) )
    (let* ((layer (if (= (car (gimp-item-is-layer drawable)) TRUE)
                    drawable
                    (car (gimp-layer-from-mask drawable)) ))
           (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)) )
        (if base-layer
          (begin
            (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))) )
          (let ((parent (car (gimp-item-get-parent layer))))
            (unless (= -1 parent)
              (set! base-x (car  (gimp-drawable-offsets parent)))
              (set! base-y (cadr (gimp-drawable-offsets parent)))
              (set! base-width  (car (gimp-drawable-width  parent)))
              (set! base-height (car (gimp-drawable-height parent))) ))))
      (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>"
 )