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
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
|
;; 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>
;;
;; Modified June 24, 2005 by Kevin Cozens
;; Incorporated changes made by Daniel P. Stasinski in his text-circle3.scm
;; script. The letters are now placed properly for both positive and negative
;; fill angles.
(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))
(start-angle-rad (* (/ (modulo start-angle 360) 360) 2 *pi*))
(angle-list #f)
(letter "")
(new-layer #f)
(index 0)
(ndx 0)
(ndx-start 0)
(ndx-step 1)
(ccw 0)
(rot-op))
(gimp-image-undo-disable img)
(gimp-image-add-layer img BG-layer 0)
(gimp-edit-fill BG-layer BACKGROUND-FILL)
;; change units
(if (< fill-angle 0)
(begin
(set! ccw 1)
(set! fill-angle (abs fill-angle))
(set! start-angle-rad (* (/ (modulo (+ (- start-angle fill-angle) 360) 360) 360) 2 *pi*))
(set! ndx-start (- char-num 1))
(set! ndx-step -1)))
(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! ndx ndx-start)
(set! index 0)
(while (< index char-num)
(set! temp-str (substring text ndx (+ ndx 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! ndx (+ ndx ndx-step))
(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! ndx ndx-start)
(set! index 0)
(while (< index char-num)
(set! letter (substring text ndx (+ ndx 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
(if (= ccw 0)
(set! rot-op (if (< 0 fill-angle-rad) + -))
(set! rot-op (if (> 0 fill-angle-rad) + -)))
(gimp-drawable-transform-rotate-default new-layer
(rot-op 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! ndx (+ ndx ndx-step))
(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 C_ircle..."
"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")
|
