GIMP Script-fu

Artifact [ddee22d338]
Login

Artifact ddee22d3383ee5985120be835bf05552a8f29d34:


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

;; This file provides two commands: 
;;   "Group Linked Layers" - will create a new layer group and move
;;                           all linked layers into it.
;;   "Ungroup Layer" - will move a layer out of its containing group,
;;                     placing it directly above the group's fundament 
;;                     in the layer stack. If the active layer is a 
;;                     fundament, then all of the layers in the group 
;;                     are spliced into the parent and the fundament 
;;                     removed.

(define (script-fu-sg-group-linked-layers image layer)

  ; if 'mode' is either 0 or omitted altogether return just the 
  ;   top-level layers and fundaments
  ; If 'mode' is 1 then a nested list of all real layers (no
  ;   fundaments) is returned.
  ; If 'mode' is 2 then a nested list is returned, where the first
  ;   item in each sub-list is the fundament of the group.
  ;
  (define (get-layers image . mode)
    (let ((top-layers (vector->list (cadr (gimp-image-get-layers image)))))
      (if (or (null? mode) (zero? (car mode)))
        top-layers
        (let loop ((top-layers top-layers)
                   (layers '()))
          (if (null? top-layers)
            (reverse layers)
            (loop (cdr top-layers)
                  (cons (if (zero? (car (gimp-item-is-group (car top-layers))))
                          (car top-layers)
                          (if (= (car mode) 2)
                            (cons (car top-layers)
                                  (get-children (car top-layers) (car mode)))
                            (get-children (car top-layers) (car mode))))
                        layers)))))))

  ; similar to 'get-layers' but for a group fundament
  ;
  (define (get-children fundament . mode)
    (let ((top-layers (vector->list (cadr (gimp-item-get-children fundament)))))
      (if (or (null? mode) (zero? (car mode)))
        top-layers
        (let loop ((top-layers top-layers)
                   (layers '()))
          (if (null? top-layers)
            (reverse layers)
            (loop (cdr top-layers)
                  (cons (if (zero? (car (gimp-item-is-group (car top-layers))))
                          (car top-layers)
                          (if (= (car mode) 2)
                            (cons (car top-layers)
                                  (get-children (car top-layers) (car mode)))
                            (get-children (car top-layers) (car mode))))
                        layers)))))))

  (define (flatten x)
    (cond 
      ((null? x) '())
      ((not (pair? x)) (list x))
      (else (append (flatten (car x))
                    (flatten (cdr x))))))

  (define (get-parent item)
    (let ((parent (car (gimp-item-get-parent item))))
      (if (= parent -1) #f parent)))

  (let ((linkeds (let loop ((layers (flatten (get-layers image 2)))
                                    (linkeds '()))
                   (if (null? layers)
                     (reverse linkeds)
                     (loop (cdr layers)
                           (if (or (zero? (car (gimp-item-get-linked (car layers))))
                                   (and (get-parent (car layers))
                                        (member (get-parent (car layers)) linkeds)))
                             linkeds
                             (cons (car layers) linkeds)))))))
    (unless (null? linkeds)
      (let ((parent (or (get-parent layer) 0))
            (safe? (let loop ((parent (get-parent layer)))
                     (if parent
                       (if (member parent linkeds)
                         #f
                         (loop (get-parent parent)))
                       #t))))
        (if (not safe?)
          (gimp-message "Moving a layer group into itself")
          (begin
            (gimp-image-undo-group-start image)
            (let ((fundament (car (gimp-layer-group-new image))))
              (gimp-image-insert-layer image 
                                       fundament 
                                       (if safe? parent 0)
                                       (if safe? -1 0))
              (map (lambda (x) (gimp-image-reorder-item image x fundament 0))
                   (reverse linkeds)))
              (gimp-image-undo-group-end image)
              (gimp-displays-flush)))))))

(script-fu-register "script-fu-sg-group-linked-layers"
  "Group Linked Layers"
  "Move linked layers into a new layer group"
  "Saul Goode"
  "saulgoode"
  "March 2015"
  "*"
  SF-IMAGE    "Image"    0
  SF-DRAWABLE "Drawable" 0
  )
(script-fu-menu-register "script-fu-sg-group-linked-layers"
  "<Image>/Layer/Stack/"
  )

( script-fu-menu-register "script-fu-sg-group-linked-layers"
  "<Layers>"
  )  

(define (script-fu-sg-ungroup-layer image item)
  (gimp-image-undo-group-start image)
  (if (= (car (gimp-item-is-group item)) 1)
    (let ((parent (car (gimp-item-get-parent item)))
          (position (car (gimp-image-get-item-position image item))))
      (if (= parent -1)
        (set! parent 0))
      (let loop ((layers (reverse (vector->list (cadr  (gimp-item-get-children item))))))
        (unless (null? layers)
          (gimp-image-reorder-item image (car layers) parent position)
          (loop (cdr layers))))
      (gimp-image-remove-layer image item))
    (begin 
      (when (= (car (gimp-item-is-layer-mask item)) 1)
        (set! item (car (gimp-layer-from-mask item))))
      (let ((parent (car (gimp-item-get-parent item))))
        (unless (= parent -1) 
          (let ((grandparent (car (gimp-item-get-parent parent)))
                (position ( car (gimp-image-get-item-position image parent))))
            (if (= grandparent -1)
              (set! grandparent 0)) 
            (gimp-image-reorder-item image item grandparent position))))))
  (gimp-image-undo-group-end image)
  (gimp-displays-flush)
  )

  
(script-fu-register "script-fu-sg-ungroup-layer"
  "Ungroup Layer"
  "Move a layer (or members of a group) out of its group"
  "Saul Goode"
  "saulgoode"
  "February 2015"
  "*"
  SF-IMAGE    "Image"    0
  SF-DRAWABLE "Drawable" 0
  )
(script-fu-menu-register "script-fu-sg-ungroup-layer"
  "<Image>/Layer/Stack/"
  )

( script-fu-menu-register "script-fu-sg-ungroup-layer"
  "<Layers>"
  )