GIMP Script-fu

; Example file for script-fu-sg-goobie.scm
; The script should be invoked from an image
; that contains layers with the following names

( athlete-name club-name athlete-number uniform-color )

; Next comes the data entries for each of the athletes.
;
 ("Kyle" "Manchester United" "21" "red")
 ("Kenny" "Chelsea" "4" "red")
 ; date entries can be spread across lines (white space is ignored)
 ("Stan"  
   "Arsenal" 
   "15" 
   "blue" )
 ("Token" ; comments can be interspersed with data
   "Liverpool" ; following Scheme syntax.
   "11" 
   "black" )

; 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"
  )