mirror of
https://gitlab.gnome.org/GNOME/gimp.git
synced 2025-07-03 17:33:25 +00:00
e125c30cfd
The libgimp wrapper was just calling the PDB procedure. Get rid of the wrapper and make the PDB proc public. Also reorder the name argument to be in the second place, just like it was for the wrapper.
182 lines
6.2 KiB
Scheme
182 lines
6.2 KiB
Scheme
;; font-map
|
|
;; Spencer Kimball
|
|
|
|
;; To test, open the Font tool dialog,
|
|
;; press right mouse button in the list of fonts, choose "Render Font Map"
|
|
|
|
;; Test cases for font filter regex
|
|
;; ".*" expect render all installed fonts
|
|
;; "foo" expect render blank image (no matching fonts)
|
|
;; "Sans" expect render subset of installed fonts
|
|
|
|
(define (script-fu-font-map text
|
|
use-name
|
|
labels
|
|
font-filter
|
|
font-size
|
|
border
|
|
colors)
|
|
|
|
(define (max-font-width text use-name list-cnt list font-size)
|
|
(let* ((count 0)
|
|
(width 0)
|
|
(maxwidth 0)
|
|
(font "")
|
|
(font-object '())
|
|
(extents '()))
|
|
(while (< count list-cnt)
|
|
(set! font (car list))
|
|
(set! font-object (car (gimp-font-get-by-name font)))
|
|
|
|
(if (= use-name TRUE)
|
|
(set! text font))
|
|
(set! extents (gimp-text-get-extents-font text
|
|
font-size
|
|
font-object))
|
|
(set! width (car extents))
|
|
(if (> width maxwidth)
|
|
(set! maxwidth width))
|
|
|
|
(set! list (cdr list))
|
|
(set! count (+ count 1))
|
|
)
|
|
|
|
maxwidth
|
|
)
|
|
)
|
|
|
|
(define (max-font-height text use-name list-cnt list font-size)
|
|
(let* ((count 0)
|
|
(height 0)
|
|
(maxheight 0)
|
|
(font "")
|
|
(font-object '())
|
|
(extents '()))
|
|
(while (< count list-cnt)
|
|
(set! font (car list))
|
|
(set! font-object (car (gimp-font-get-by-name font)))
|
|
|
|
(if (= use-name TRUE)
|
|
(set! text font)
|
|
)
|
|
(set! extents (gimp-text-get-extents-font text
|
|
font-size
|
|
font-object))
|
|
(set! height (cadr extents))
|
|
(if (> height maxheight)
|
|
(set! maxheight height)
|
|
)
|
|
|
|
(set! list (cdr list))
|
|
(set! count (+ count 1))
|
|
)
|
|
|
|
maxheight
|
|
)
|
|
)
|
|
|
|
(let* (
|
|
; gimp-fonts-get-list returns a one element list of results,
|
|
; the only element is itself a list of fonts, possibly empty.
|
|
(font-list (car (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 num-fonts font-list font-size))
|
|
(maxwidth (max-font-width text use-name num-fonts 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 "Background"
|
|
width height (if (= colors 0)
|
|
GRAY-IMAGE RGB-IMAGE)
|
|
100 LAYER-MODE-NORMAL)))
|
|
(count 0)
|
|
(font "")
|
|
(font-object '())
|
|
)
|
|
|
|
(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-insert-layer img drawable 0 0)
|
|
(gimp-drawable-edit-clear drawable)
|
|
|
|
(if (= labels TRUE)
|
|
(begin
|
|
(set! drawable (car (gimp-layer-new img "Labels" width height
|
|
(if (= colors 0)
|
|
GRAYA-IMAGE RGBA-IMAGE)
|
|
100 LAYER-MODE-NORMAL)))
|
|
(gimp-image-insert-layer img drawable 0 -1)))
|
|
(gimp-drawable-edit-clear drawable)
|
|
|
|
(while (< count num-fonts)
|
|
(set! font (car font-list))
|
|
(set! font-object (car (gimp-font-get-by-name font)))
|
|
|
|
(if (= use-name TRUE)
|
|
(set! text font))
|
|
|
|
(gimp-text-font img -1
|
|
border
|
|
y
|
|
text
|
|
0 TRUE font-size
|
|
font-object)
|
|
|
|
(set! y (+ y maxheight))
|
|
|
|
(if (= labels TRUE)
|
|
(begin
|
|
(gimp-floating-sel-anchor (car (gimp-text-font img drawable
|
|
(- border
|
|
(/ label-size 2))
|
|
(- y
|
|
(/ label-size 2))
|
|
font
|
|
0 TRUE
|
|
label-size
|
|
font-object)))
|
|
(set! y (+ y label-size))
|
|
)
|
|
)
|
|
|
|
(set! font-list (cdr font-list))
|
|
(set! count (+ count 1))
|
|
)
|
|
|
|
(gimp-image-set-selected-layers img (vector drawable))
|
|
|
|
(gimp-image-undo-enable img)
|
|
(gimp-display-new img)
|
|
|
|
(gimp-context-pop)
|
|
)
|
|
)
|
|
|
|
(script-fu-register-procedure "script-fu-font-map"
|
|
_"Render _Font Map..."
|
|
_"Create an image filled with previews of fonts matching a fontname filter"
|
|
"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")
|
|
)
|
|
|
|
(script-fu-menu-register "script-fu-font-map"
|
|
"<Fonts>/Fonts Menu")
|