1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
|
;; text-circle.scm -- a script for The GIMP
;; Author: Shuji Narazaki <narazaki@gimp.org>
;; Time-stamp: <1998/11/25 13:26:51 narazaki@gimp.org>
;; Version 2.5
;; Thanks:
;; jseymour@jimsun.LinxNet.com (Jim Seymour)
;; Sven Neumann <neumanns@uni-duesseldorf.de>
(if (not (symbol-bound? 'script-fu-text-circle-debug? (the-environment)))
(define script-fu-text-circle-debug? #f))
(define (script-fu-text-circle text radius start-angle fill-angle
font-size antialias font-name)
;;(set! script-fu-text-circle-debug? #t)
(define modulo fmod) ; in R4RS way
(define (wrap-string str) (string-append "\"" str "\""))
(define (white-space-string? str)
(or (equal? " " str) (equal? " " str)))
(let* ((drawable-size (* 2.0 (+ radius (* 2 font-size))))
(img (car (gimp-image-new drawable-size drawable-size RGB)))
(BG-layer (car (gimp-layer-new img drawable-size drawable-size
RGBA-IMAGE "background" 100 NORMAL-MODE)))
(merged-layer #f)
(char-num (string-length text))
(radian-step 0)
(rad-90 (/ *pi* 2))
(center-x (/ drawable-size 2))
(center-y center-x)
(font-infos (gimp-text-get-extents-fontname "lAgy" font-size
PIXELS font-name))
(desc (nth 3 font-infos))
(angle-list #f)
(letter "")
(new-layer #f)
(index 0))
(gimp-image-undo-disable img)
(gimp-image-add-layer img BG-layer 0)
(gimp-edit-fill BG-layer BACKGROUND-FILL)
;; change units
(set! start-angle-rad (* (/ (modulo start-angle 360) 360) 2 *pi*))
(set! fill-angle-rad (* (/ fill-angle 360) 2 *pi*))
(set! radian-step (/ fill-angle-rad char-num))
;; make width-list
;; In a situation,
;; (car (gimp-drawable-width (car (gimp-text ...)))
;; != (car (gimp-text-get_extent ...))
;; Thus, I changed to gimp-text from gimp-text-get-extent at 2.2 !!
(let ((temp-list '())
(temp-str #f)
(temp-layer #f)
(scale 0)
(temp #f))
(set! index 0)
(while (< index char-num)
(set! temp-str (substring text index (+ index 1)))
(if (white-space-string? temp-str)
(set! temp-str "x"))
(set! temp-layer (car (gimp-text-fontname img -1 0 0
temp-str
1 antialias
font-size PIXELS
font-name)))
(set! temp-list (cons (car (gimp-drawable-width temp-layer)) temp-list))
(gimp-image-remove-layer img temp-layer)
(set! index (+ index 1)))
(set! angle-list (nreverse temp-list))
(set! temp 0)
(set! angle-list
(mapcar (lambda (angle)
(let ((tmp temp))
(set! temp (+ angle temp))
(+ tmp (/ angle 2))))
angle-list))
(set! scale (/ fill-angle-rad temp))
(set! angle-list (mapcar (lambda (angle) (* scale angle)) angle-list)))
(set! index 0)
(while (< index char-num)
(set! letter (substring text index (+ index 1)))
(if (not (white-space-string? letter))
;; Running gimp-text with " " causes an error!
(let* ((new-layer
(car (gimp-text-fontname img -1 0 0
letter
1 antialias
font-size PIXELS
font-name)))
(width (car (gimp-drawable-width new-layer)))
(height (car (gimp-drawable-height new-layer)))
(rotate-radius (- (/ height 2) desc))
(angle (+ start-angle-rad (- (nth index angle-list) rad-90))))
(gimp-layer-resize new-layer width height 0 0)
(set! width (car (gimp-drawable-width new-layer)))
(if (not script-fu-text-circle-debug?)
(begin
(gimp-drawable-transform-rotate-default new-layer
((if (< 0 fill-angle-rad)
+ -) angle rad-90)
TRUE 0 0
TRUE FALSE)
(gimp-layer-translate new-layer
(+ center-x
(* radius (cos angle))
(* rotate-radius
(cos (if (< 0 fill-angle-rad)
angle
(+ angle *pi*))))
(- (/ width 2)))
(+ center-y
(* radius (sin angle))
(* rotate-radius
(sin (if (< 0 fill-angle-rad)
angle
(+ angle *pi*))))
(- (/ height 2))))
))))
(set! index (+ index 1)))
(gimp-drawable-set-visible BG-layer 0)
(if (not script-fu-text-circle-debug?)
(begin
(set! merged-layer
(car (gimp-image-merge-visible-layers img CLIP-TO-IMAGE)))
(gimp-drawable-set-name merged-layer
(if (< (length text) 16)
(wrap-string text)
"Text Circle"))))
(gimp-drawable-set-visible BG-layer 1)
(gimp-image-undo-enable img)
(gimp-image-clean-all img)
(gimp-display-new img)
(gimp-displays-flush)))
(script-fu-register "script-fu-text-circle"
_"Text Circle..."
"Render the specified text along the perimeter of a circle"
"Shuji Narazaki <narazaki@gimp.org>"
"Shuji Narazaki"
"1997-1998"
""
SF-STRING _"Text" "The GNU Image Manipulation Program Version 2.2 "
SF-ADJUSTMENT _"Radius" '(80 1 8000 1 1 0 1)
SF-ADJUSTMENT _"Start angle" '(0 -180 180 1 1 0 1)
SF-ADJUSTMENT _"Fill angle" '(360 -360 360 1 1 0 1)
SF-ADJUSTMENT _"Font size (pixels)" '(18 1 1000 1 1 0 1)
SF-TOGGLE _"Antialias" TRUE
SF-FONT _"Font" "Sans")
(script-fu-menu-register "script-fu-text-circle"
_"<Toolbox>/Xtns/Script-Fu/Logos")
|
