GIMP Script-fu
Artifact Content
Not logged in

Artifact f70d2a746189916d32e3abc113761eda304e8121:


; 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 
; badge styles and people's names. For each person listed
; in the file, a PNG file is produced incorporating the 
; specified style.

; Each line of the data file either defines a style:
;   STYLE # "/full/path/to/stylefile.xcf"
; or a person's name in quotes (preceded by the style #):
;   # "Fred Flintstone"
;
; The style files should preferably be in XCF format because the topmost
; layer (typically transparent, but can contain a template for the text)
; of the image is used to determine the location and size of the text
; of the person's name (this layer is otherwise ignored). The name text
; is centered within the bounds of this topmost layer.
;
; Comments may be placed in the style file using the typical Scheme
; convention (ie, starting with a semi-colon and extending to the end of
; the line.
;
(define (sg-create-badges filename font fontsize% color)
  ;; Perform a crude search for the largest font that will fit within
  ;; the cell (this algorithm could be better!)
  ;
  (define (calc-fontsize text font fontsize% width height)
    (let* (
        (fontsize 6) ;; minimum possible fontsize
        (extents nil)
        (last-extents nil)
        (last-fontsize 3)
        (adjust 2)        
        )
      (set! extents (gimp-text-get-extents-fontname text fontsize PIXELS font))
      (set! width (* width fontsize% 0.01))
      (set! height (* height fontsize% 0.01))
      (while (and (<> last-fontsize fontsize) (not (equal? extents last-extents)))
        (if (or (> (car extents) width) (> (cadr extents) height))
          (begin 
            (set! fontsize last-fontsize)
            (set! adjust (+ (* (- adjust 1) 0.5) 1))
            )
          (begin
            (set! last-extents extents)
            (set! last-fontsize fontsize)
            )
          )
        (set! fontsize (truncate (* fontsize adjust)))
        (set! extents (gimp-text-get-extents-fontname text fontsize PIXELS font))
        )
      (max fontsize 6)
      )
    )
    
  ;; center-align layer with a base-layer
  (define (center-align base-layer layer)
    (let* (
        (anchor-x (car (gimp-drawable-offsets base-layer)))
        (anchor-y (cadr (gimp-drawable-offsets base-layer)))
        (width (car (gimp-drawable-width base-layer)))
        (height (car (gimp-drawable-height base-layer)))
        )
      (set! anchor-x (+ anchor-x (/ width 2)))
      (set! anchor-y (+ anchor-y (/ height 2)))
      (let* (
            (ref-x (car (gimp-drawable-offsets layer)))
            (ref-y (cadr (gimp-drawable-offsets layer)))
            (orig-x ref-x)
            (orig-y ref-y)
            (offset-x 0)
            (offset-y 0)
            )
        (set! width (car (gimp-drawable-width layer)))
        (set! height (car (gimp-drawable-height layer)))
        (set! ref-x (+ ref-x (/ width 2)))
        (set! ref-y (+ ref-y (/ height 2)))
        (set! offset-x (+ orig-x (- anchor-x ref-x)))
        (set! offset-y (+ orig-y (- anchor-y ref-y)))
        (gimp-layer-set-offsets layer offset-x offset-y)
        )
      )
    )
  ;; return a list of visible layers
  ;
  (define (visible-layers image)
    (let* (
        (layer's (vector->list (cadr (gimp-image-get-layers image))))
        (viewable's nil)
        )
      (while (pair? layer's)
        (when (= (car (gimp-drawable-get-visible (car layer's))) TRUE)
          (set! viewable's (cons (car layer's) viewable's))
          )
        (set! layer's (cdr layer's))
        )
      (unless (null? viewable's)
        (reverse viewable's)
        )
      )
    )
  (define (create-badge-layer image stylefile name font fontsize%)
    (let* (
        (visible's (visible-layers image))
        (layer's (vector->list (cadr (gimp-file-load-layers RUN-NONINTERACTIVE image stylefile))))
        (frame-layer (car layer's))
        (layer 0)
        (fontsize 0)
        (name-layer 0)
        )
      (set! layer's (reverse (cdr layer's)))
      (map (lambda (x) (gimp-drawable-set-visible x FALSE)) visible's)
      (map (lambda (x) (gimp-image-add-layer image x 0)) layer's)
      (set! layer (car (gimp-image-merge-visible-layers image EXPAND-AS-NECESSARY)))
      (gimp-image-add-layer image frame-layer 0)
      (set! fontsize (calc-fontsize name 
                                    font 
                                    fontsize% 
                                    (car (gimp-drawable-width frame-layer))
                                    (car (gimp-drawable-height frame-layer))
                                    ))
      (set! name-layer (car (gimp-text-fontname image -1 0 0 name 0 TRUE fontsize PIXELS font)))
      (center-align frame-layer name-layer)
      (gimp-image-remove-layer image frame-layer)
      (set! layer (car (gimp-image-merge-visible-layers image EXPAND-AS-NECESSARY)))
      (map (lambda (x) (gimp-drawable-set-visible x TRUE)) visible's)
      )
    )
    
  ;; ----------------------------------------------------------------------
  ;; Main processing start here
  ;
  (let* (
      (image (car (gimp-image-new 10 10 RGB)))
      (STYLE 0) ; "Keyword" indicating that line specifies a style # and stylefile
      (style-files (make-vector 0)) ; vector to store styles
      (inport (open-input-file filename))
      (object (read inport))
      (style-num 0)
      (name "")
      (tmp-vector 0)
      )
    (gimp-image-undo-disable image)
    (gimp-context-push)
    (gimp-context-set-foreground color)
    (while (not (eof-object? object))
      (set! style-num (eval object))
      (if (> style-num 0)
        (begin
          (set! name (read inport))
          (unless (eof-object? name)
            (create-badge-layer image 
                                (vector-ref style-files (- style-num 1))
                                name 
                                font 
                                fontsize%)
            (gimp-image-resize-to-layers image)
            )
          )
        (begin
          (set! style-num (read inport))
          (set! name (read inport))
          (if (> style-num (vector-length style-files))
            (begin
              (set! tmp-vector (make-vector style-num))
              (set! style-num (- style-num 1))
              (vector-set! tmp-vector style-num name)
              (set! style-num (vector-length style-files))
              (while (> style-num 0)
                (set! style-num (- style-num 1))
                (vector-set! tmp-vector  style-num (vector-ref style-files style-num))
                )
              (set! style-files tmp-vector)
              )
            (vector-set! style-files (- style-num 1) name)
            )
          )
        )
      (set! object (read inport))
      )
    (sg-mosaicize image (car (gimp-image-get-active-layer image)))
    (gimp-image-undo-enable image)
    (gimp-context-pop)
    (close-input-port inport)
    (gimp-display-new image)
    )
  )
                
        
(script-fu-register "sg-create-badges"
 "Create badges..."
 "Create badges based on file of names"
 "Saul Goode"
 "Saul Goode"
 "12/6/2009"
 ""
 SF-FILENAME    "Data file" "Badges/example.data"
 SF-FONT "Font" "Sans Bold"
 SF-ADJUSTMENT "Font Size (% of maximum)" '( 80 0 100 1 10 0 1)
 SF-COLOR "Color" '(0 0 0)
 )
(script-fu-menu-register "sg-create-badges"
  "<Image>/File"
  )