5f2ca28c69
2004-11-11 Michael Natterer <mitch@gimp.org> * plug-ins/script-fu/scripts/add-bevel.scm * plug-ins/script-fu/scripts/addborder.scm * plug-ins/script-fu/scripts/carve-it.scm * plug-ins/script-fu/scripts/carved-logo.scm * plug-ins/script-fu/scripts/chip-away.scm * plug-ins/script-fu/scripts/clothify.scm * plug-ins/script-fu/scripts/font-map.scm * plug-ins/script-fu/scripts/slide.scm * plug-ins/script-fu/scripts/swirltile.scm: don't call gimp-edit-* functions on drawables which are not added to an image because this will be forbidden soon (because it can trash the image's undo stack).
144 lines
3.8 KiB
Scheme
144 lines
3.8 KiB
Scheme
;; font-select
|
|
;; Spencer Kimball
|
|
|
|
(define (max-font-width text use-name font-list font-size)
|
|
(let* ((list font-list)
|
|
(width 0)
|
|
(maxwidth 0)
|
|
(font "")
|
|
(extents '()))
|
|
(while list
|
|
(set! font (car list))
|
|
(set! list (cdr list))
|
|
(if (= use-name TRUE)
|
|
(set! text font))
|
|
(set! extents (gimp-text-get-extents-fontname text
|
|
font-size PIXELS
|
|
font))
|
|
(set! width (nth 0 extents))
|
|
(if (> width maxwidth)
|
|
(set! maxwidth width)))
|
|
maxwidth))
|
|
|
|
|
|
(define (max-font-height text use-name font-list font-size)
|
|
(let* ((list font-list)
|
|
(height 0)
|
|
(maxheight 0)
|
|
(font "")
|
|
(extents '()))
|
|
(while list
|
|
(set! font (car list))
|
|
(set! list (cdr list))
|
|
(if (= use-name TRUE)
|
|
(set! text font))
|
|
(set! extents (gimp-text-get-extents-fontname text
|
|
font-size PIXELS
|
|
font))
|
|
(set! height (nth 1 extents))
|
|
(if (> height maxheight)
|
|
(set! maxheight height)))
|
|
maxheight))
|
|
|
|
|
|
(define (script-fu-font-map text
|
|
use-name
|
|
labels
|
|
font-filter
|
|
font-size
|
|
border
|
|
colors)
|
|
(let* ((font "")
|
|
(count 0)
|
|
(font-list (cadr (gimp-fonts-get-list font-filter)))
|
|
(num-fonts (length font-list))
|
|
(label-size (/ font-size 2))
|
|
(border (+ border (* labels (/ label-size 2))))
|
|
(y border)
|
|
(maxheight (max-font-height text use-name font-list font-size))
|
|
(maxwidth (max-font-width text use-name font-list font-size))
|
|
(width (+ maxwidth (* 2 border)))
|
|
(height (+ (+ (* maxheight num-fonts) (* 2 border))
|
|
(* labels (* label-size num-fonts))))
|
|
(img (car (gimp-image-new width height (if (= colors 0)
|
|
GRAY RGB))))
|
|
(drawable (car (gimp-layer-new img width height (if (= colors 0)
|
|
GRAY-IMAGE RGB-IMAGE)
|
|
"Background" 100 NORMAL-MODE))))
|
|
|
|
(gimp-context-push)
|
|
|
|
(gimp-image-undo-disable img)
|
|
|
|
(if (= colors 0)
|
|
(begin
|
|
(gimp-context-set-background '(255 255 255))
|
|
(gimp-context-set-foreground '(0 0 0))))
|
|
|
|
(gimp-image-add-layer img drawable 0)
|
|
(gimp-edit-clear drawable)
|
|
|
|
(if (= labels TRUE)
|
|
(begin
|
|
(set! drawable (car (gimp-layer-new img width height
|
|
(if (= colors 0)
|
|
GRAYA-IMAGE RGBA-IMAGE)
|
|
"Labels" 100 NORMAL-MODE)))
|
|
(gimp-image-add-layer img drawable -1)))
|
|
(gimp-edit-clear drawable)
|
|
|
|
(while font-list
|
|
(set! font (car font-list))
|
|
(set! font-list (cdr font-list))
|
|
|
|
(if (= use-name TRUE)
|
|
(set! text font))
|
|
|
|
(gimp-text-fontname img -1
|
|
border
|
|
y
|
|
text
|
|
0 TRUE font-size PIXELS
|
|
font)
|
|
|
|
(set! y (+ y maxheight))
|
|
|
|
(if (= labels TRUE)
|
|
(begin
|
|
(gimp-floating-sel-anchor (car (gimp-text-fontname img drawable
|
|
(- border
|
|
(/ label-size 2))
|
|
(- y
|
|
(/ label-size 2))
|
|
font
|
|
0 TRUE
|
|
label-size PIXELS
|
|
"Sans")))
|
|
(set! y (+ y label-size))))
|
|
|
|
|
|
(set! count (+ count 1)))
|
|
|
|
(gimp-image-set-active-layer img drawable)
|
|
|
|
(gimp-image-undo-enable img)
|
|
(gimp-display-new img)
|
|
|
|
(gimp-context-pop)))
|
|
|
|
(script-fu-register "script-fu-font-map"
|
|
_"<Toolbox>/Xtns/Script-Fu/Utils/_Font Map..."
|
|
"Generate a listing of fonts matching a filter"
|
|
"Spencer Kimball"
|
|
"Spencer Kimball"
|
|
"1997"
|
|
""
|
|
SF-STRING _"_Text" "How quickly daft jumping zebras vex."
|
|
SF-TOGGLE _"Use font _name as text" FALSE
|
|
SF-TOGGLE _"_Labels" TRUE
|
|
SF-STRING _"_Filter (regexp)" "Sans"
|
|
SF-ADJUSTMENT _"Font _size (pixels)" '(32 2 1000 1 10 0 1)
|
|
SF-ADJUSTMENT _"_Border (pixels)" '(10 0 200 1 10 0 1)
|
|
SF-OPTION _"_Color scheme" '(_"Black on white"
|
|
_"Active colors"))
|