; 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.
; Change these to reasonable values
;
(define STW-default-basename "brochure-")
(define STW-default-output-dir "/home/saul/stw-test/output")
(define STW-default-banner-dir "/home/saul/stw-test/banner images")
(define STW-default-left-dir "/home/saul/stw-test/left_images")
(define STW-default-right-dir "/home/saul/stw-test/right_images")
(define STW-default-left-file "/home/saul/stw-test/Left_text/left_text.txt")
(define STW-default-right-file "/home/saul/stw-test/right_text/right_text.txt")
(define (script-fu-sg-STW-brochures orig-image output-dir output-basename banner-dir
left-dir right-dir left-file right-file)
; The dynamic layers are identified by the following names:
(define banner-pic-layername "banner_image")
(define left-pic-layername "image_left")
(define right-pic-layername "image_right")
(define left-text-layername "text_left")
(define right-text-layername "text_right")
; Get all the picture files in the specified folder.
;
(define (get-pictures directory)
(append
(cadr (file-glob (string-append directory DIR-SEPARATOR "*.png") 1))
(cadr (file-glob (string-append directory DIR-SEPARATOR "*.PNG") 1))
(cadr (file-glob (string-append directory DIR-SEPARATOR "*.jpg") 1))
(cadr (file-glob (string-append directory DIR-SEPARATOR "*.JPG") 1)) ))
; returns an output filename that is sequentially incremented
;
(define create-output-filename
(let ((index 0)) ; change to -1 if indexing should start with 0000
(lambda (basename)
(let ((suffix (number->string index)))
(set! index (succ index))
(string-append output-dir
DIR-SEPARATOR
basename
(make-string (- 4 (string-length suffix)) #\0)
suffix
".xcf" )))))
; A layermask is used to define the size of the layer; this allows for
; later repositioning of the layer within the mask frame.
; If no mask is present then the layer defines the boundaries of the frame.
;
(define (load-random-pic layer pictures)
(let* ((image (car (gimp-item-get-image layer)))
(picture (list-ref pictures (random (length pictures))))
(pic-layer (car (gimp-file-load-layer RUN-NONINTERACTIVE image picture)))
(mask (car (gimp-layer-get-mask layer)))
(x (car (gimp-drawable-offsets layer)))
(y (cadr (gimp-drawable-offsets layer)))
(w (car (gimp-drawable-width layer)))
(h (car (gimp-drawable-height layer)))
(orig-name (car (gimp-item-get-name layer)))
(group (car (gimp-item-get-parent layer)))
)
(if (= group -1)
(set! group 0) )
(gimp-selection-none image)
(gimp-image-insert-layer image pic-layer group (car (gimp-image-get-layer-position image layer)))
(unless (= mask -1)
(gimp-image-select-item image CHANNEL-OP-REPLACE mask)
(let ((bounds (cdr (gimp-selection-bounds image))))
(set! x (car bounds))
(set! y (cadr bounds))
(set! w (- (caddr bounds) x))
(set! h (- (cadddr bounds) y)) ))
(gimp-layer-set-offsets pic-layer
(- (+ x (/ w 2)) (/ (car (gimp-drawable-width pic-layer)) 2))
(- (+ y (/ h 2)) (/ (car (gimp-drawable-height pic-layer)) 2)) )
; guarantee that pic-layer is large enough for the mask frame
(when (zero? (car (gimp-drawable-has-alpha pic-layer)))
(gimp-layer-add-alpha pic-layer) )
(let ((lx (car (gimp-drawable-offsets pic-layer)))
(lw (car (gimp-drawable-width pic-layer)))
(lh (car (gimp-drawable-height pic-layer))) )
(if (> lx x) ; expand the top
(gimp-layer-resize pic-layer (+ lw (- lx x)) lh (- lx x) 0) ))
(let ((ly (cadr (gimp-drawable-offsets pic-layer)))
(lw (car (gimp-drawable-width pic-layer)))
(lh (car (gimp-drawable-height pic-layer))) )
(if (> ly y) ; expand the left side
(gimp-layer-resize pic-layer lw (+ lh (- ly y)) 0 (- ly y)) ))
(let ((lx (car (gimp-drawable-offsets pic-layer)))
(lw (car (gimp-drawable-width pic-layer)))
(lh (car (gimp-drawable-height pic-layer))) )
(if (< (+ lx lw) (+ x w)) ; expand the bottom
(gimp-layer-resize pic-layer (+ lw (- (+ x w) (+ lx lw))) lh 0 0) ))
(let ((ly (cadr (gimp-drawable-offsets pic-layer)))
(lw (car (gimp-drawable-width pic-layer)))
(lh (car (gimp-drawable-height pic-layer))) )
(if (< (+ ly lh) (+ y h)) ; expand the right side
(gimp-layer-resize pic-layer lw (+ lh (- (+ y h) (+ ly lh))) 0 0) ))
(gimp-image-select-rectangle image CHANNEL-OP-REPLACE x y w h)
(gimp-layer-add-mask pic-layer (car (gimp-layer-create-mask pic-layer ADD-SELECTION-MASK)))
(gimp-image-remove-layer image layer)
(gimp-item-set-name pic-layer orig-name)
(gimp-selection-none image)
(gimp-layer-set-edit-mask pic-layer FALSE)
pic-layer ))
; Read characters until end-of-line
; Note: the optional 'port' argument is only used during
; interactive debugging.
;
(define (readln . port)
(let ((getch (if (pair? port)
(lambda () (read-char (car port)))
read-char )))
(let loop ((char (getch))
(result "") )
(if (eof-object? char)
#f
(if (eqv? char #\newline)
result
(loop (getch) (string-append result (make-string 1 char))) )))))
; MAIN PROCEDURE
; Retrieve the dynamic layers from the template
(srand (realtime))
(let ((banner-pic-layer (car (gimp-image-get-layer-by-name orig-image banner-pic-layername)))
(left-pic-layer (car (gimp-image-get-layer-by-name orig-image left-pic-layername)))
(right-pic-layer (car (gimp-image-get-layer-by-name orig-image right-pic-layername)))
(left-text-layer (car (gimp-image-get-layer-by-name orig-image left-text-layername)))
(right-text-layer (car (gimp-image-get-layer-by-name orig-image right-text-layername)))
; (left-file (string-append left-dir DIR-SEPARATOR "left_text.txt" ))
; (right-file (string-append right-dir DIR-SEPARATOR "right_text.txt"))
(banner-pics (get-pictures banner-dir))
(left-pics (get-pictures left-dir))
(right-pics (get-pictures right-dir))
)
(cond
((member -1 (list banner-pic-layer left-pic-layer right-pic-layer left-text-layer right-text-layer))
(gimp-message "Image is not a brochure template") )
((not (equal? (car (gimp-text-layer-get-markup left-text-layer)) ""))
(gimp-message "Left text layer contains markup") )
((not (equal? (car (gimp-text-layer-get-markup right-text-layer)) ""))
(gimp-message "Right text layer contains markup") )
((not (and (file-exists? left-file) (= (file-type left-file) 1)))
(gimp-message "Left text file not found") )
((not (and (file-exists? right-file) (= (file-type right-file) 1)))
(gimp-message "Right text file not found") )
(else ; Image is a valid template
(with-input-from-file left-file
(lambda ()
(let loop-left ((left-text (readln)))
(when left-text
(with-input-from-file right-file
(lambda ()
(let loop-right ((right-text (readln))
(image (car (gimp-image-duplicate orig-image))) )
(if (not right-text)
(gimp-image-delete image)
(begin
(let* ((banner-pic-layer (car (gimp-image-get-layer-by-name image banner-pic-layername)))
(left-pic-layer (car (gimp-image-get-layer-by-name image left-pic-layername)))
(right-pic-layer (car (gimp-image-get-layer-by-name image right-pic-layername)))
(left-text-layer (car (gimp-image-get-layer-by-name image left-text-layername)))
(right-text-layer (car (gimp-image-get-layer-by-name image right-text-layername)))
)
(gimp-text-layer-set-text left-text-layer left-text)
(gimp-text-layer-set-text right-text-layer right-text)
(set! banner-pic-layer (load-random-pic banner-pic-layer banner-pics))
(set! left-pic-layer (load-random-pic left-pic-layer left-pics))
(set! right-pic-layer (load-random-pic right-pic-layer right-pics))
(let ((filename (create-output-filename output-basename)))
(if (catch #f (gimp-file-save RUN-NONINTERACTIVE image banner-pic-layer
filename filename ))
(gimp-image-delete image)
(begin
(gimp-display-new image)
(gimp-image-undo-disable image)
(gimp-image-undo-enable image)
(gimp-image-clean-all image) )))
(loop-right (readln)
(car (gimp-image-duplicate orig-image)) )))))
(let loop ((obj (read))) ; work-around for a GIMP bug
(unless (eof-object? obj)
(loop (read)) ))))
(loop-left (readln)) ))))))))
(script-fu-register "script-fu-sg-STW-brochures"
"Create Brochures..."
"Create STW brochures from template image"
"Saul Goode"
"Saul Goode"
"April 2014"
"RGB*,GRAY*"
SF-IMAGE "Image" 0
SF-DIRNAME "Output Folder" STW-default-output-dir
SF-STRING "Output Basename" STW-default-basename
SF-DIRNAME "Banner Images Folder" STW-default-banner-dir
SF-DIRNAME "Left Images Folder" STW-default-left-dir
SF-DIRNAME "Right Images Folder" STW-default-right-dir
SF-FILENAME "Left Text File" STW-default-left-file
SF-FILENAME "Right Text File" STW-default-right-file
)
(script-fu-menu-register "script-fu-sg-STW-brochures"
"<Image>/Filters/STW"
)
(define (script-fu-sg-STW-float-dynamic-layer image layer)
(gimp-image-undo-group-start image)
(gimp-selection-none image)
(when (zero? (car (gimp-drawable-has-alpha layer)))
(gimp-layer-add-alpha layer) )
(let ((buffer (car (gimp-edit-named-copy layer "dynamic layer"))))
(gimp-edit-clear layer)
(gimp-edit-named-paste layer buffer FALSE)
(gimp-buffer-delete buffer) )
(gimp-image-undo-group-end image) )
(script-fu-register "script-fu-sg-STW-float-dynamic-layer"
"STW Float Layer"
"Float the dynamic layer so it can be moved"
"Saul Goode"
"Saul Goode"
"April 2014"
"RGB*,GRAY*"
SF-IMAGE "Image" 0
SF-DRAWABLE "Drawable" 0
)
(script-fu-menu-register "script-fu-sg-STW-float-dynamic-layer"
"<Image>/Filters/STW"
)
(script-fu-menu-register "script-fu-sg-STW-float-dynamic-layer"
"<Layers>"
)