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