/usr/share/gimp/2.0/scripts/lasm-gm-channel-extract.scm is in gimp-plugin-registry 7.20140602ubuntu2.
This file is owned by root:root, with mode 0o644.
The actual contents of the file can be viewed below.
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191 192 193 194 195 196 197 198 199 200 201 202 203 204 205 206 207 208 209 210 211 212 213 214 215 216 217 218 219 220 221 222 223 224 225 226 227 228 229 230 231 232 233 234 235 236 237 238 239 240 241 242 243 244 245 246 247 248 249 250 251 252 253 254 255 256 257 258 259 260 261 262 263 264 265 266 267 268 269 270 271 272 273 274 275 276 277 278 279 280 281 282 283 284 285 286 287 288 289 290 291 292 293 294 295 296 297 298 299 300 301 302 303 304 305 306 307 308 309 310 311 312 313 314 315 316 317 318 319 320 321 | ; The GIMP -- an image manipulation program
; Copyright (C) 1995 Spencer Kimball and Peter Mattis
;
; Advanced Channel Extraction script for GIMP 2.3.4
; Copyright (C) 2005 Lasm <lasm@rocketmail.com>
; http://www.godsimmediatecontact.com
; http://www.godsdirectcontact.org
; http://www.raindesigninc.com
;
; Tags: tool, color
;
; Latest scripts/packages available at
; http://sourceforge.net/projects/lasmz/
; http://groups.yahoo.com/group/script-fu/
;
; Welcome to the Line Art Coffee House
; This Channel Extract script is for coffee-connisseurs only
; If it doesn't work for your images, perhaps you prefer the Bubble Tea House next door ?
; gm-channel-extract.scm - lasm's famous Channel Extract script a.k.a. 18 scholar script
;
; --------------------------------------------------------------------
; version 1.0 by Lasm 2005/07/12 <lasm@rocketmail.com>
; - Initial release
; version 1.1 by Lasm 2005/29/12 <lasm@rocketmail.com>
; - Added "All" option to select all 17 channels
;
; --------------------------------------------------------------------
; You are free to use/distribute this program provided the
; comments are left intact.
;
; 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.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;
; Instructions on using this script
;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
; 1. Copy this script in the script directory.
; 2. Open up your favourite color photo in Gimp.
; 4. Look for it under Script-Fu->Lasm's FX Effects and fire away !
;
; That's all folks. Have fun with this script !
; Another Grandmother Coffee House production.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;
; Channel Extractor function:
;
; Requires:
; plug-in-decompose
;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(define (script-fu-gm-channel-extract img inLayer All? Red? Green? Blue? L? A? B? C? M? Y? H? S? V? Cyan? Magenta? Yellow? Black? Alpha?)
; below is replacement for (lref-default list index default-fcn) on platforms greater or equal to 2.4
;Returns the index element of the list or the result of calling the default-fcn if the list is not long enough.
;David M. W. Martin (occamsrazor) 02/11/07
(if (>= (string->number (substring (car(gimp-version)) 0 3)) 2.4)
(define (lref-default ls index default-fn)
(if not(list-ref ls index) default-fn)))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;
; Helper function to make a stack
;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(define make-stack ;; generic stack template code
(lambda ()
(let ((ls '()) (p '()) (c 'a))
(lambda (msg . args)
(cond
((eqv? msg 'empty?) (null? ls))
((eqv? msg 'push!)
(set! ls (cons (car args) ls)))
((eqv? msg 'top) (car ls))
((eqv? msg 'pop!)
(set! c (car ls)) (set! ls (cdr ls)) c)
((eqv? msg 'print) (set! p ls) (set! ls '()) p) ;for printing the value
(else "oops"))))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;
; Helper function to process two lists as stacks and return a stack.
;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
; It parses user input options and ouput 1 or 0 in the return stack for the
; corresponding image type (RGB, HSV, etc) requested
; List-L1 control stack indicates how many channels make up one image type (rgb, cmy etc)
; List-L2 actual parameters list
; Return Stack : 1 - user want to create this image type, 0 - skip this image type
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(define (get-channel-stats List-L1 List-L2)
(let* ((count 0)
(return-val 0)
)
(define (create-stack List-l stack-name) ; populates a stack with contents of a list
(if (null? List-l)
()
(begin
(stack-name 'push! (car List-l))
(create-stack (cdr List-l) stack-name)))
)
(define stck-ctl (make-stack)) ; create control stack
(create-stack List-L1 stck-ctl) ; populate it
(define stck-chl (make-stack)) ; create channel stack
(create-stack List-L2 stck-chl) ; populate it
(define stck-return (make-stack)) ; create return stack
(while (not (stck-ctl 'empty?)) ; populate it
(set! count (stck-ctl 'pop!))
(set! return-val 0)
(while (> count 0)
(if (> (stck-chl 'pop!) 0) ; predicate TRUE?
(set! return-val 1))
(set! count (- count 1))
)
(stck-return 'push! return-val)
)
stck-return
)
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;
; Thatagatha - Worker function to process requests
;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
; parameters-ls is actual options
; template-ls is unique image type signature template (rgb-i, cmy-i etc)
; 1. Order of image layers list in template-ls correspond to order of parameters-ls
; 2. The car of the list is the first image layer returned by plug-in-decompose
; 3. A new layer will be created when the corresponding option in parameters-ls is TRUE
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(define (thatagatha parameters-ls template-ls)
(define (add-layer fr-layer to-img layer-name)
(let* (
(new-layer (car (gimp-layer-new-from-drawable fr-layer to-img))))
(gimp-image-add-layer to-img new-layer -1)
(gimp-drawable-set-name new-layer layer-name)
)
)
(define (iter1 a top curr parenti grayi lpre img-ls parms-ls)
(if (<= a top)
(begin
(if (= a 1) ;; top most layer id from plug-in-decompose
(set! curr (car (gimp-image-get-active-layer grayi)))
(set! curr (- curr 1)) ;; else current and subsequent layer id is below top layer
)
(if (eqv? (lref-default parms-ls (- a 1) ()) TRUE) ; parms predicate
(add-layer curr parenti (string-append ; create this layer
lpre
(lref-default img-ls (- a 1) ())
))
)
(iter1 (+ a 1) top curr parenti grayi lpre img-ls parms-ls)
)
)
)
(define inImg (car template-ls)) ; parent Image
(define inLyr (cadr template-ls)) ; parent Layer
(define inLyrname (caddr template-ls)) ; new layer name prefix "GM"
(define imgType (caar (cdddr template-ls))) ; list of list
(define imgLyrs-ls (cdar (cdddr template-ls))) ; list of image layers template
(define imgLen (length imgLyrs-ls)) ; length of image layers template = length of parameters-ls
(define gray-img (car (plug-in-decompose RUN-NONINTERACTIVE inImg inLyr imgType TRUE)))
(iter1 1 imgLen 0 inImg gray-img inLyrname imgLyrs-ls parameters-ls)
;; we're done creating layers, now remove grayscale
(gimp-image-delete gray-img)
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;
; Helper functions to create image template curry functions
;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(define parent-img (list inLayer img))
(define layername-prefix "GM ")
(define (curry f args) ;; generic curry function takes 2 args
(lambda x
(f x args)))
(define curry-parent (curry append parent-img))
(define curry-p (curry-parent layername-prefix))
(define curry-a (curry append curry-p)) ;; append curry function
(define rgb-i (curry-a (list "RGB" _"Blue" _"Green" _"Red")))
(define rgb-i (reverse rgb-i)) ;; more logical ordering of arguments
(define lab-i (curry-a (list "LAB" "B" "A" "L")))
(define lab-i (reverse lab-i))
(define hsv-i (curry-a (list "HSV" _"Value" _"Saturation" _"Hue")))
(define hsv-i (reverse hsv-i))
(define cmy-i (curry-a (list "CMY" _"Yellow" _"Magenta" _"Cyan")))
(define cmy-i (reverse cmy-i))
(define cmyk-i (curry-a (list "CMYK" _"Black" _"Yellow-K" _"Magenta-K" _"Cyan-K")))
(define cmyk-i (reverse cmyk-i))
(define alpha-i (curry-a (list _"Alpha" _"Alpha")))
(define alpha-i (reverse alpha-i))
(define rgb-f (curry thatagatha rgb-i)) ;; worker curry functions for rgb type image
(define lab-f (curry thatagatha lab-i)) ;; lab image
(define cmy-f (curry thatagatha cmy-i)) ;; cmy image
(define hsv-f (curry thatagatha hsv-i)) ;; hsv image
(define cmyk-f (curry thatagatha cmyk-i)) ;; cmyk image
(define alpha-f (curry thatagatha alpha-i)) ;; alpha image
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;
; Main function
;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(let*
((stck-ret 0)
(stat-RGB 0)
(stat-LAB 0)
(stat-CMY 0)
(stat-HSV 0)
(stat-CMYK 0)
(stat-Alpha 0)
)
(gimp-image-undo-group-start img)
;; Real work goes in here
(gimp-image-set-active-layer img inLayer)
(if (eqv? All? TRUE) ;; select All options
(begin
(rgb-f TRUE TRUE TRUE)
(lab-f TRUE TRUE TRUE)
(cmy-f TRUE TRUE TRUE)
(hsv-f TRUE TRUE TRUE)
(cmyk-f TRUE TRUE TRUE TRUE)
(if (> (car (gimp-drawable-has-alpha inLayer)) 0)
(alpha-f TRUE))
)
(begin
; process options
; control stack indicates how many channels make up one image type
(set! stck-ret (get-channel-stats '(3 3 3 3 4 1) (list Red? Green? Blue? L? A? B? C? M? Y?
H? S? V?
Cyan? Magenta? Yellow? Black?
Alpha?)))
(set! stat-RGB (stck-ret 'pop!))
(set! stat-LAB (stck-ret 'pop!))
(set! stat-CMY (stck-ret 'pop!))
(set! stat-HSV (stck-ret 'pop!))
(set! stat-CMYK (stck-ret 'pop!))
(set! stat-Alpha (stck-ret 'pop!))
(if (= stat-RGB 1)
(rgb-f Blue? Green? Red?))
(if (= stat-LAB 1)
(lab-f B? A? L?))
(if (= stat-CMY 1)
(cmy-f Y? M? C?))
(if (= stat-HSV 1)
(hsv-f V? S? H?))
(if (= stat-CMYK 1)
(cmyk-f Black? Yellow? Magenta? Cyan?))
(if (= stat-Alpha 1)
(if (> (car (gimp-drawable-has-alpha inLayer)) 0)
(alpha-f Alpha?)))
)) ;; end of All options
;; clean up before exit
(gimp-image-undo-group-end img)
(gimp-displays-flush)
)
)
(script-fu-register
"script-fu-gm-channel-extract"
_"Lasm's Channel Extract"
_"Version 1.1 \nThis utility works on any RGBA image and let you extract all or any one of the 17 greyscale channels of the image for photo-retouch, black and white conversion, creating masks and many other image processing purposes. Caution: it may run slowly on large images."
"lasm"
"Copyright 2005, lasm"
"Dec 7, 2005"
"RGB*"
SF-IMAGE "The Image" 0
SF-DRAWABLE "The Layer" 0
SF-TOGGLE _"All Channels" TRUE
SF-TOGGLE _"Red" FALSE
SF-TOGGLE _"Green" FALSE
SF-TOGGLE _"Blue" FALSE
SF-TOGGLE _"L" FALSE
SF-TOGGLE _"A" FALSE
SF-TOGGLE _"B" FALSE
SF-TOGGLE _"Cyan" FALSE
SF-TOGGLE _"Magenta" FALSE
SF-TOGGLE _"Yellow" FALSE
SF-TOGGLE _"Hue" FALSE
SF-TOGGLE _"Saturation" FALSE
SF-TOGGLE _"Value" FALSE
SF-TOGGLE _"Cyan-K" FALSE
SF-TOGGLE _"Magenta-K" FALSE
SF-TOGGLE _"Yellow-K" FALSE
SF-TOGGLE _"Black" FALSE
SF-TOGGLE _"Alpha" FALSE
)
(script-fu-menu-register "script-fu-gm-channel-extract"
"<Image>/FX-Foundry/Toolbox")
|