; 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
parent
(if (zero? (car (gimp-item-is-group layer)))
-1
(car (gimp-image-get-item-position image layer))))
(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>"
)