; 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 script reads in a data file containing a list of
; team members' names and associated information. For each person listed
; in the data file, an XCF file is produced incorporating the data
; into a master template image.
; The data file uses Lisp/Scheme style lists and commenting (comments
; start with a semi-colon and extend to the end of the line).
; The first non-comment line of the data file should be a list containing
; the field names of the player information wrapped in parentheses.
; For example:
;
; ; THIS IS A COMMENT AND IGNORED
; ( athlete-name club-name athlete-number uniform-color )
;
; This "header" list should be followed by the lists containing the
; actual data to be substituted into the template file. The data should
; be text strings and appear in the same order as the fields specified in
; the header list.
;
; ("Kyle" "Manchester United" "21" "red")
; ("Stan" "Arsenal" "15" "blue")
; ("Kenny" "Chelsea" "4" "red")
; ("Token" "Liverpool" "11" "black")
;
;
; The currently open image is used as a template with the upper layers having
; names that match the field names. These field layers are used to determine
; the location and size of the text (this layer is otherwise ignored).
; The name text is centered within the bounds of this field template layer.
;
;
(define (script-fu-sg-goobie image
datafilename
save-xcf
save-jpeg
save-png
save-dir
vert-justification
size-handling)
;; Perform a search for the largest font that will fit within
;; the cell.
;
(define (calc-fontsize text font width height)
(let loop ((fontsize 6) ;; minimum possible fontsize
(last-extents nil)
(last-fontsize 3)
(adjust 2)
)
(let ((extents (gimp-text-get-extents-fontname text fontsize PIXELS font)))
(if (or (= last-fontsize fontsize) (equal? extents last-extents))
(max fontsize 6)
(if (or (> (car extents) width) (> (cadr extents) height))
(loop (truncate (* last-fontsize (+ (* (- adjust 1) 0.5) 1)))
last-extents
last-fontsize
(+ (* (- adjust 1) 0.5) 1) )
(loop (truncate (* fontsize adjust))
extents
fontsize
adjust ))))))
(define (create-data-layer image field-name field-data)
(let ((frame-layer
(let loop ((layers (vector->list (cadr (gimp-image-get-layers image)))))
(if (null? layers)
#f
(if (string=? field-name (car (gimp-drawable-get-name (car layers))))
(car layers)
(loop (cdr layers)) )))))
(if frame-layer
(if (= (car (gimp-drawable-is-text-layer frame-layer)) 1)
(let ((x (car (gimp-drawable-offsets frame-layer)))
(y (cadr (gimp-drawable-offsets frame-layer)))
(w (car (gimp-drawable-width frame-layer)))
(h (car (gimp-drawable-height frame-layer)))
(font (car (gimp-text-layer-get-font frame-layer)))
(size (car (gimp-text-layer-get-font-size frame-layer)))
)
(gimp-image-set-active-layer image frame-layer)
(gimp-text-layer-set-text frame-layer field-data)
(let ((extents (gimp-text-get-extents-fontname field-data
size
PIXELS
font )))
(when (and (zero? size-handling)
(or (> (car extents) w)
(> (cadr extents) h) ))
(gimp-text-layer-set-font-size frame-layer (calc-fontsize field-data font w h) PIXELS) )
(case vert-justification
((0) ; center
(gimp-layer-set-offsets frame-layer
x
(+ y (/ (- h (cadr extents)) 2)) ))
((1) ; top
(gimp-layer-set-offsets frame-layer
x
y ))
((2) ; bottom
(gimp-layer-set-offsets frame-layer
x
(- (+ y h) (cadr extents)) )))))
(gimp-message "Field layer is not a text layer")
)
(begin
(gimp-message (string-append "Field layer not found: " field-name)) ))
frame-layer ))
;; ----------------------------------------------------------------------
;; Main processing start here
;
(let* ((inport (open-input-file datafilename))
(field-names (map symbol->string (read inport)))
(filetag (car field-names)) )
(gimp-image-undo-freeze image)
(gimp-context-push)
(let entry-loop ((fields (read inport)))
(unless (eof-object? fields)
(let ((temp-image (car (gimp-image-duplicate image)))
(filename #f) )
(let field-loop ((field-names field-names)
(field-values fields) )
(unless (null? field-values)
(when (string=? (car field-names) filetag)
(set! filename (car field-values)) )
(create-data-layer temp-image (car field-names) (car field-values))
(field-loop (cdr field-names) (cdr field-values)) ))
(if filename
(let ((fullname (string-append save-dir
DIR-SEPARATOR
filename )))
(unless (zero? save-xcf)
(let ((filename (string-append fullname ".xcf")))
(gimp-xcf-save TRUE
temp-image
(car (gimp-image-get-active-layer image))
filename
filename )))
(unless (zero? save-png)
(let ((layer (car (gimp-image-merge-visible-layers temp-image
CLIP-TO-IMAGE )))
(filename (string-append fullname ".png")) )
(file-png-save2 RUN-NONINTERACTIVE
temp-image
layer
filename
filename
FALSE ; interlace
9
FALSE ; bkgd
(car (gimp-drawable-has-alpha layer))
FALSE ; offs
FALSE ; phys
FALSE ; time
TRUE ; comment
FALSE ; svtrans
)))
(unless (zero? save-jpeg)
(let ((layer (car (gimp-image-flatten temp-image)))
(filename (string-append fullname ".jpg")) )
(file-jpeg-save RUN-NONINTERACTIVE
temp-image
layer
filename
filename
0.93
0 ; smoothing
1 ; optimize
1 ; progressive
"" ; comment
0 ; subsmp (0-4)
1 ; baseline
0 ; restart
0 ;dct
))))
(gimp-message "Error encountered") )
; (gimp-image-delete temp-image)
)
(entry-loop (read inport)) ))
(close-input-port inport)
(gimp-context-pop)
(gimp-image-undo-thaw image)
)
)
(script-fu-register "script-fu-sg-goobie"
"Goobie (uniforms)..."
"Create uniform files based on template image"
"Saul Goode"
"Saul Goode"
"June 2012"
"*"
SF-IMAGE "Image" 0
SF-FILENAME "Data file" "example.data"
SF-TOGGLE "Save as XCF" FALSE
SF-TOGGLE "Save as JPEG" TRUE
SF-TOGGLE "Save as PNG" FALSE
SF-DIRNAME "Save directory" ""
SF-OPTION "Vertical justification" '("Center" "Top" "Bottom")
SF-OPTION "Font sizing (if too large)" '("Fit" "Crop" "Overflow")
)
(script-fu-menu-register "script-fu-sg-goobie"
"<Image>/File"
)