;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; ;;;
;;; GIMP - The GNU Image Manipulation Program ;;;
;;; Copyright (C) 1995 Spencer Kimball and Peter Mattis ;;;
;;; ;;;
;;; 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 3 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. ;;;
;;; ;;;
;;; You should have received a copy of the GNU General Public License ;;;
;;; along with this program. If not, see . ;;;
;;; ;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; ;;;
;;; Identify Image Objects ;;;
;;; ;;;
;;; identify-image-objects.scm - version 1.02 ;;;
;;; Copyright (C) 2011-2013 Gino D ;;;
;;; https://sites.google.com/site/ginodonig/gimp-scripts ;;;
;;; ;;;
;;; This script adapts the name of each object (layer, channel or path) of ;;;
;;; an open image by replacing or extending it with a string containing ;;;
;;; mainly the object's ID. ;;;
;;; ;;;
;;; ....................................................................... ;;;
;;; ;;;
;;; VERSION HISTORY ;;;
;;; ;;;
;;; 1.00 - January 2011 ;;;
;;; * First release. ;;;
;;; ;;;
;;; 1.01 - August 2011 ;;;
;;; * Fixed a small flaw in the display of the progress bar. ;;;
;;; * Corrected the year in my copyright notice. ;;;
;;; * Improved and cleaned up the code. ;;;
;;; ;;;
;;; 1.02 - October 2013 ;;;
;;; * Made the script fully compatible with GIMP 2.8, while maintaining ;;;
;;; the backward compatibility with the previous versions beginning from ;;;
;;; GIMP 2.6.10. ;;;
;;; * Now the script is also capable to rename the layers contained within ;;;
;;; any layer group. ;;;
;;; * Lots of improvements, cleanups and minor bug fixes. ;;;
;;; ;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(define *identify-image-objects-2.8.0* 1)
(let* ((gimp-version-comparison
(lambda (predicate version-a version-b)
(letrec ((func
(lambda (string1 p q)
(cond ((= (string-length string1) p)
(* (expt 100 q) (string->atom string1)))
((eqv? (string-ref string1 p)
(integer->char 46))
(+ (* (expt 100 q)
(string->atom (substring string1 0 p)))
(func (substring string1
(+ p 1)
(string-length string1))
0
(- q 1))))
(else (func string1 (+ p 1) q))))))
(predicate (func version-a 0 2)
(func version-b 0 2))))))
(cond ((gimp-version-comparison < (car (gimp-version)) "2.6.10")
(quit))
((gimp-version-comparison < (car (gimp-version)) "2.8.0")
(set! *identify-image-objects-2.8.0* 0))))
(define (script-fu-identify-image-objects image1
processed-images
obj-ren-method
rename-quick-mask)
(cond ((= *identify-image-objects-2.8.0* 0)
(define (gimp-item-get-name item)
(if (= (car (gimp-vectors-is-valid item)) TRUE)
(gimp-vectors-get-name item)
(gimp-drawable-get-name item)))
(define (gimp-item-set-name item name)
(if (= (car (gimp-vectors-is-valid item)) TRUE)
(gimp-vectors-set-name item name)
(gimp-drawable-set-name item name)))
(define (gimp-item-is-group item)
(cons FALSE ()))
(define (gimp-item-get-children item))
(define (gimp-context-get-antialias))
(define (gimp-context-set-antialias antialias)
(set! gimp-context-get-antialias
(lambda () (cons antialias ()))))
(define (gimp-context-get-feather))
(define (gimp-context-set-feather feather)
(set! gimp-context-get-feather
(lambda () (cons feather ()))))
(define (gimp-context-get-feather-radius))
(define (gimp-context-set-feather-radius feather-radius-x
feather-radius-y)
(set! gimp-context-get-feather-radius
(lambda ()
(cons feather-radius-x
(cons feather-radius-y
())))))
(define (gimp-item-set-visible item visible)
(if (= (car (gimp-vectors-is-valid item)) TRUE)
(gimp-vectors-set-visible item visible)
(gimp-drawable-set-visible item visible)))
(define (gimp-image-select-item image operation item)
(cond ((= (car (gimp-drawable-is-layer item)) TRUE)
(gimp-selection-layer-alpha item))
((= (car (gimp-drawable-is-channel item)) TRUE)
(gimp-selection-combine item operation))
((= (car (gimp-vectors-is-valid item)) TRUE)
(gimp-vectors-to-selection
item
operation
(car (gimp-context-get-antialias))
(car (gimp-context-get-feather))
(car (gimp-context-get-feather-radius))
(car (cdr (gimp-context-get-feather-radius)))))))
(define (gimp-item-is-layer-mask item)
(gimp-drawable-is-layer-mask item))
(define (gimp-item-is-layer item)
(gimp-drawable-is-layer item))))
(define (gimp-image-get-nested-layers image)
(letrec ((find-children
(lambda (layer-ids k n)
(if (< k n)
(let* ((layer-k (vector-ref layer-ids k)))
(append
(cons layer-k
(if (= (car (gimp-item-is-group layer-k)) TRUE)
(find-children
(car (cdr
(gimp-item-get-children layer-k)))
0
(car (gimp-item-get-children layer-k)))
()))
(find-children layer-ids (+ k 1) n)))
()))))
(let* ((all-layers
(apply vector
(find-children (car (cdr (gimp-image-get-layers image)))
0
(car (gimp-image-get-layers image))))))
(cons (vector-length all-layers)
(cons all-layers
())))))
(case obj-ren-method
((0) (define (rename-item item id-string)
(string-append id-string " ")))
((1) (define (rename-item item id-string)
(let* ((string1 (car (gimp-item-get-name item)))
(n1 (string-length string1))
(string2 (string-append " [" id-string "] "))
(n2 (string-length string2))
(string3 (if (< n1 n2)
""
(substring string1 (- n1 n2) n1))))
(if (eqv? (string->symbol string2)
(string->symbol string3))
string1
(string-append string1 string2))))))
(define (rename-objects image
ren-mode
ren-qmask)
(let* ((num-layers (car (gimp-image-get-nested-layers image)))
(layer-ids (car (cdr (gimp-image-get-nested-layers image))))
(num-channels (car (gimp-image-get-channels image)))
(channel-ids (car (cdr (gimp-image-get-channels image))))
(num-vectors (car (gimp-image-get-vectors image)))
(vector-ids (car (cdr (gimp-image-get-vectors image))))
(drawable (car (gimp-image-floating-sel-attached-to image)))
(floating-sel (car (gimp-image-get-floating-sel image)))
(qmask -1)
(drawable-i-l-m)
(drawable-i-l)
(drawable-mask))
(gimp-context-push)
(gimp-context-set-antialias FALSE)
(gimp-context-set-feather FALSE)
(gimp-context-set-feather-radius 0 0)
(gimp-image-undo-group-start image)
(gimp-progress-init " " 0)
(gimp-progress-set-text " ")
(let f-loop ((f (if (= drawable -1) 0 1))
(f-layer ())
(f-layer-mask ()))
(cond ((< f num-layers)
(gimp-progress-pulse)
(set! f-layer (vector-ref layer-ids f))
(set! f-layer-mask (car (gimp-layer-get-mask f-layer)))
(gimp-item-set-name
f-layer
(rename-item f-layer
(string-append (atom->string f-layer)
(if (> f-layer-mask -1)
(string-append
"-"
(atom->string f-layer-mask))
""))))
(f-loop (+ f 1) f-layer f-layer-mask))))
(let g-loop ((g 0)
(g-channel ()))
(cond ((< g num-channels)
(gimp-progress-pulse)
(set! g-channel (vector-ref channel-ids g))
(cond ((not (eqv? (string->symbol
(car (gimp-item-get-name g-channel)))
'Qmask))
(gimp-item-set-name
g-channel
(rename-item g-channel (atom->string g-channel))))
((= ren-qmask TRUE)
(set! qmask g-channel)
(gimp-item-set-name
qmask
(rename-item qmask (atom->string qmask)))
(gimp-item-set-visible qmask FALSE)
(gimp-channel-set-color qmask '(0 0 0))
(gimp-image-select-item image
CHANNEL-OP-REPLACE
qmask)))
(g-loop (+ g 1) g-channel))))
(let h-loop ((h 0)
(h-vectors ()))
(cond ((< h num-vectors)
(gimp-progress-pulse)
(set! h-vectors (vector-ref vector-ids h))
(gimp-item-set-name
h-vectors
(rename-item h-vectors (atom->string h-vectors)))
(h-loop (+ h 1) h-vectors))))
(cond ((and (> drawable -1)
(or (= ren-qmask TRUE)
(not (= drawable qmask))))
(set! drawable-i-l-m (car (gimp-item-is-layer-mask drawable)))
(set! drawable-i-l (car (gimp-item-is-layer drawable)))
(set! drawable-mask
(cond ((= drawable-i-l TRUE)
(car (gimp-layer-get-mask drawable)))
((= drawable-i-l-m TRUE) drawable)
(else -1)))
(if (= drawable-i-l-m TRUE)
(set! drawable (car (gimp-layer-from-mask drawable))))
(case ren-mode
((1) (gimp-progress-pulse)
(let* ((drawable-name
(car (gimp-item-get-name drawable)))
(int1 (+ (string-length
(string-append
(atom->string drawable)
(atom->string drawable-mask)))
(if (= drawable-mask -1) 2 5))))
(gimp-item-set-name
drawable
(substring drawable-name
0
(- (string-length drawable-name) int1))))))
(gimp-item-set-name
drawable
(rename-item drawable
(string-append (atom->string drawable)
(if (= drawable-i-l-m FALSE)
(string-append
"("
(atom->string floating-sel)
")")
"")
(if (> drawable-mask -1)
(string-append
"-"
(atom->string drawable-mask)
(if (= drawable-i-l-m TRUE)
(string-append
"("
(atom->string floating-sel)
")")
""))
""))))))
(gimp-image-undo-group-end image)
(gimp-displays-flush)
(gimp-context-pop)))
(case processed-images
((0) (rename-objects image1
obj-ren-method
rename-quick-mask))
((1) (let* ((num-images (car (gimp-image-list)))
(image-ids (car (cdr (gimp-image-list)))))
(let i-loop ((i 0))
(cond ((< i num-images)
(rename-objects (vector-ref image-ids i)
obj-ren-method
rename-quick-mask)
(i-loop (+ i 1)))))))))
(let* ((widget-a '("Active one only"
"All those currently open"))
(widget-b '("Replace original name with ID"
"Append ID to original name")))
;;
(script-fu-register
"script-fu-identify-image-objects"
_"Identify Image Objects..."
_"Fit the name of every image object with the relevant ID"
"Gino D "
"Gino D"
"2011-2013"
"*"
SF-IMAGE "Image" 0
SF-OPTION _"Images to process" widget-a
SF-OPTION _"Method of renaming objects" widget-b
SF-TOGGLE _"Rename Quick Mask as well (if any)" FALSE))
(script-fu-menu-register "script-fu-identify-image-objects"
"/BestFilters/Image")