; 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.
(define (script-fu-sg-process-tga-files dirname)
(define pattern "*.tga")
(define (process-file filename)
(let ((image (catch #f (car (gimp-file-open 1 filename filename)))))
(when image
(let ((layer (car (gimp-image-get-active-layer image))))
(if (zero? (car (gimp-drawable-has-alpha layer)))
(gimp-layer-add-alpha layer) )
(plug-in-colortoalpha RUN-NONINTERACTIVE image layer '(0 0 0))
(gimp-file-save RUN-NONINTERACTIVE image layer filename filename)
)
(gimp-image-delete image) )))
(define (get-tga-files dirname)
(gimp-progress-update 0)
(gimp-progress-set-text (string-append "Searching: " dirname))
(cadr (file-glob (string-append dirname DIR-SEPARATOR pattern) 1)) )
(define (get-subdirs dirname)
(let ((dirstream (dir-open-stream dirname)))
(let loop ((name (dir-read-entry dirstream))
(subdirs '()) )
(if (or (not name) (eof-object? name))
(begin
(dir-close-stream dirstream)
(reverse subdirs) )
(loop (dir-read-entry dirstream)
(if (= (file-type (string-append dirname DIR-SEPARATOR name)) 2)
(let ((subdir-name (string-append dirname DIR-SEPARATOR name)))
(cons subdir-name
(append (get-subdirs subdir-name) subdirs) ))
subdirs ))))))
(let* ((filenames (foldr append
(get-tga-files dirname)
(map get-tga-files (get-subdirs dirname) )))
(nb-files (length filenames)) )
(let loop ((files filenames)
(nb-processed 0) )
(if (null? files)
(gimp-progress-end)
(begin
(gimp-progress-set-text (string-append "Processing..."))
(gimp-progress-update (/ nb-processed nb-files))
(process-file (car files))
(loop (cdr files) (succ nb-processed)) )))))
(script-fu-register "script-fu-sg-process-tga-files"
"Process TGA Files..."
"Perform Color To Alpha on every TGA file in the directory tree"
"Saul Goode"
"Saul Goode"
"March 2014"
""
SF-DIRNAME "Directory" "."
)
(script-fu-menu-register "script-fu-sg-process-tga-files"
"<Image>/Filters/Misc"
)