1
;; spyrogimp.scm -*-scheme-*-
2
;; Draws Spirographs, Epitrochoids and Lissajous Curves.
3
;; More info at http://netword.com/*spyrogimp
6
;; Copyright (C) 2003 by Elad Shahar <elad@wisdom.weizmann.ac.il>
8
;; This program is free software; you can redistribute it and/or
9
;; modify it under the terms of the GNU General Public License
10
;; as published by the Free Software Foundation; either version 2
11
;; of the License, or (at your option) any later version.
13
;; This program is distributed in the hope that it will be useful,
14
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
15
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
16
;; GNU General Public License for more details.
18
;; You should have received a copy of the GNU General Public License
19
;; along with this program; if not, write to the Free Software
20
;; Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
22
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
24
; Internal function to draw the spyro.
25
(define (script-fu-spyrogimp-internal img drw
26
x1 y1 x2 y2 ; Bounding box.
27
type ; = 0 (Spirograph), 1 (Epitrochoid), 2(Lissajous) .
28
shape ; = 0 (Circle), 1 (Frame), >2 (Polygons) .
29
oteeth iteeth ; Outer and inner teeth.
31
start-angle ; 0 <= start-angle < 360 .
32
tool ; = 0 (Pencil), 1 (Brush), 2 (Airbrush) .
34
color-method ; = 0 (Single color), 1 (Grad. Loop Sawtooth), 2 (Grad. Loop triangle) .
35
color ; Used when color-method = Single color .
36
grad ; Gradient used in Gradient color methods.
39
; Find minimum number n such that it is divisible by both a and b.
40
; (least common multiplier)
41
(define (calc-min-mult a b)
42
(let* ((c 1) (fac 2) (diva 0) (divb 0))
43
(while ( <= fac (max a b) )
44
(set! diva ( = 0 (fmod (/ a fac) 1) ) )
45
(set! divb ( = 0 (fmod (/ b fac) 1) ) )
47
(if diva (set! a (/ a fac)))
48
(if divb (set! b (/ b fac)))
52
(set! fac (+ 1 fac)) )
59
; This function returns a list of samples according to the gradient.
60
(define (get-gradient steps color-method grad)
61
(if (= color-method 1)
63
; Just return the gradient
64
(gimp-gradient-get-uniform-samples grad (min steps 50) FALSE)
67
; The returned list is such that the gradient appears two times, once
68
; in the normal order and once in reverse. This way there are no color
69
; jumps if we go beyond the edge
71
; Sample the gradient into array "gr".
72
(gr (gimp-gradient-get-uniform-samples grad (/ (min steps 50) 2) FALSE))
74
(grn (car gr)) ; length of sample array.
75
(gra (cadr gr)) ; array of color samples (R1,G1,B1,A1, R2,....)
77
; Allocate array gra-new of size (2 * grn) - 8,
78
; but since each 4 items is actually one (RGBA) tuple,
79
; it contains 2x - 2 entries.
80
(grn-new (+ grn grn -8))
81
(gra-new (cons-array grn-new 'double))
87
; Copy original array gra to gra_new.
88
(while (< gr-index grn)
89
(aset gra-new gr-index (aref gra gr-index))
90
(set! gr-index (+ 1 gr-index))
93
; Copy second time, but in reverse
94
(set! gr-index2 (- gr-index 8))
95
(while (< gr-index grn-new)
96
(aset gra-new gr-index (aref gra gr-index2))
97
(set! gr-index (+ 1 gr-index))
98
(set! gr-index2 (+ 1 gr-index2))
100
(if (= (fmod gr-index 4) 0)
101
(set! gr-index2 (- gr-index2 8))
106
(list grn-new gra-new)
112
(let* ((steps (+ 1 (calc-min-mult oteeth iteeth)))
113
(*points* (cons-array (* steps 2) 'double))
115
(ot 0) ; current outer tooth
119
; If its a polygon or frame, how many sides does it have.
120
(poly (if (= shape 1) 4 ; A frame has four sides.
121
(if (> shape 1) (+ shape 1) 0)))
125
(drw-width (- x2 x1))
126
(drw-height (- y2 y1))
127
(half-width (/ drw-width 2))
128
(half-height (/ drw-height 2))
129
(midx (+ x1 half-width))
130
(midy (+ y1 half-height))
133
(- (/ (min drw-width drw-height) 2) margin)
136
(irad (+ hole margin))
138
(radx (- half-width irad)) ;
139
(rady (- half-height irad)) ;
141
(gradt (get-gradient steps color-method grad))
142
(grada (cadr gradt)) ; Gradient array.
143
(gradn (car gradt)) ; Number of entries of gradients.
146
(grad-index 0) ; for array: grada
147
(point-index 0) ; for array: *points*
152
; Do one step of the loop.
153
(define (calc-and-step!)
155
(oangle (* 2pi (/ ot oteeth)) )
156
(shifted-oangle (+ oangle (* 2pi (/ start-angle 360))) )
157
(xfactor (cos shifted-oangle))
158
(yfactor (sin shifted-oangle))
160
(ofactor (/ (+ oteeth iteeth) iteeth))
162
; The direction of the factor changes according
163
; to whether the type is a sypro or an epitcorhoid.
164
(mfactor (if (= type 0) (- ofactor) ofactor))
167
; If we are drawing a polygon then compute a contortion
168
; factor "lenfactor" which deforms the standard circle.
174
(oanglemodpi2 (fmod (+ oangle
175
(if (= 1 (fmod poly 2))
183
(set! lenfactor (/ ( if (= shape 1) 1 (cos pi4) )
185
(if (< oanglemodpi2 pi4)
198
(* half-width (cos shifted-oangle)) ))
200
(* half-height (cos (* mfactor oangle))) ))
202
(begin ; Spyrograph or Epitrochoid
204
(* radx xfactor lenfactor)
205
(* hole (cos (* mfactor oangle) ) ) ))
207
(* rady yfactor lenfactor)
208
(* hole (sin (* mfactor oangle) ) ) ))
217
;; Draw all the points in *points* with appropriate tool.
218
(define (flush-points len)
221
(gimp-pencil drw len *points*) ; Use pencil
223
(gimp-paintbrush-default drw len *points*); use paintbrush
224
(gimp-airbrush-default drw len *points*) ; use airbrush
228
; Reset points array, but copy last point to first
229
; position so it will connect the next time.
230
(aset *points* 0 (aref *points* (- point-index 2)))
231
(aset *points* 1 (aref *points* (- point-index 1)))
236
;; Execution starts here.
241
(gimp-image-undo-group-start img)
243
; Set new color, brush, opacity, paint mode.
244
(gimp-context-set-foreground color)
245
(gimp-context-set-brush (car brush))
246
(gimp-context-set-opacity (* 100 (car (cdr brush))))
247
(gimp-context-set-paint-mode (car (cdr (cdr (cdr brush)))))
249
(while (< index steps)
253
(aset *points* point-index cx)
254
(aset *points* (+ point-index 1) cy)
255
(set! point-index (+ point-index 2))
257
; Change color and draw points if using gradient.
258
(if (< 0 color-method) ; use gradient.
259
(if (< (/ (+ grad-index 4) gradn) (/ index steps))
261
(gimp-context-set-foreground
263
(* 255 (aref grada grad-index))
264
(* 255 (aref grada (+ 1 grad-index)) )
265
(* 255 (aref grada (+ 2 grad-index)) )
268
(gimp-context-set-opacity (* 100 (aref grada (+ 3 grad-index) ) ) )
269
(set! grad-index (+ 4 grad-index))
272
(flush-points point-index)
277
(set! index (+ index 1))
281
; Draw remaining points.
282
(flush-points point-index)
284
(gimp-image-undo-group-end img)
285
(gimp-displays-flush)
290
; This routine is invoked by a dialog.
291
; It is the main routine in this file.
292
(define (script-fu-spyrogimp img drw
295
margin hole-ratio start-angle
297
color-method color grad)
300
; Get current selection to determine where to draw.
302
(bounds (cdr (gimp-selection-bounds img)))
306
(y2 (car (cdddr bounds)))
309
(set! oteeth (trunc (+ oteeth 0.5)))
310
(set! iteeth (trunc (+ iteeth 0.5)))
312
(script-fu-spyrogimp-internal img drw
316
margin hole-ratio start-angle
318
color-method color grad)
323
(script-fu-register "script-fu-spyrogimp"
325
_"Draws Spirographs, Epitrochoids and Lissajous Curves. More info at http://netword.com/*spyrogimp"
326
"Elad Shahar <elad@wisdom.weizmann.ac.il>"
329
"RGB*, INDEXED*, GRAY*"
331
SF-DRAWABLE "Drawable" 0
333
SF-OPTION _"Type" '(_"Spyrograph"
336
SF-OPTION _"Shape" '(_"Circle"
345
_"Polygon: 10 sides")
346
SF-ADJUSTMENT _"Outer teeth" '(86 1 120 1 10 0 0)
347
SF-ADJUSTMENT _"Inner teeth" '(70 1 120 1 10 0 0)
348
SF-ADJUSTMENT _"Margin (pixels)" '(0 -10000 10000 1 10 0 1)
349
SF-ADJUSTMENT _"Hole ratio" '(0.4 0.0 1.0 0.01 0.1 2 0)
350
SF-ADJUSTMENT _"Start angle" '(0 0 359 1 10 0 0)
352
SF-OPTION _"Tool" '(_"Pencil"
355
SF-BRUSH _"Brush" '("Circle (01)" 1.0 -1 0)
357
SF-OPTION _"Color method" '(_"Solid Color"
358
_"Gradient: Loop Sawtooth"
359
_"Gradient: Loop Triangle")
360
SF-COLOR _"Color" '(0 0 0)
361
SF-GRADIENT _"Gradient" "Deep Sea")
363
(script-fu-menu-register "script-fu-spyrogimp"
364
_"<Image>/Script-Fu/Render")
1
;; spyrogimp.scm -*-scheme-*-
2
;; Draws Spirographs, Epitrochoids and Lissajous Curves.
3
;; More info at http://www.wisdom.weizmann.ac.il/~elad/spyrogimp/
6
;; Copyright (C) 2003 by Elad Shahar <elad@wisdom.weizmann.ac.il>
8
;; This program is free software; you can redistribute it and/or
9
;; modify it under the terms of the GNU General Public License
10
;; as published by the Free Software Foundation; either version 2
11
;; of the License, or (at your option) any later version.
13
;; This program is distributed in the hope that it will be useful,
14
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
15
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
16
;; GNU General Public License for more details.
18
;; You should have received a copy of the GNU General Public License
19
;; along with this program; if not, write to the Free Software
20
;; Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
22
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
25
; This routine is invoked by a dialog.
26
; It is the main routine in this file.
27
(define (script-fu-spyrogimp img drw
30
margin hole-ratio start-angle
32
color-method color grad)
34
; Internal function to draw the spyro.
35
(define (script-fu-spyrogimp-internal img drw
36
x1 y1 x2 y2 ; Bounding box.
37
type ; = 0 (Spirograph), 1 (Epitrochoid), 2(Lissajous) .
38
shape ; = 0 (Circle), 1 (Frame), >2 (Polygons) .
39
oteeth iteeth ; Outer and inner teeth.
41
start-angle ; 0 <= start-angle < 360 .
42
tool ; = 0 (Pencil), 1 (Brush), 2 (Airbrush) .
44
color-method ; = 0 (Single color), 1 (Grad. Loop Sawtooth),
45
; 2 (Grad. Loop triangle) .
46
color ; Used when color-method = Single color .
47
grad ; Gradient used in Gradient color methods.
51
; This function returns a list of samples according to the gradient.
52
(define (get-gradient steps color-method grad)
53
(if (= color-method 1)
55
; Just return the gradient
56
(gimp-gradient-get-uniform-samples grad (min steps 50) FALSE)
59
; The returned list is such that the gradient appears two times, once
60
; in the normal order and once in reverse. This way there are no color
61
; jumps if we go beyond the edge
63
; Sample the gradient into array "gr".
64
(gr (gimp-gradient-get-uniform-samples grad
68
(grn (car gr)) ; length of sample array.
69
(gra (cadr gr)) ; array of color samples (R1,G1,B1,A1, R2,....)
71
; Allocate array gra-new of size (2 * grn) - 8,
72
; but since each 4 items is actually one (RGBA) tuple,
73
; it contains 2x - 2 entries.
74
(grn-new (+ grn grn -8))
75
(gra-new (cons-array grn-new 'double))
81
; Copy original array gra to gra_new.
82
(while (< gr-index grn)
83
(aset gra-new gr-index (aref gra gr-index))
84
(set! gr-index (+ 1 gr-index))
87
; Copy second time, but in reverse
88
(set! gr-index2 (- gr-index 8))
89
(while (< gr-index grn-new)
90
(aset gra-new gr-index (aref gra gr-index2))
91
(set! gr-index (+ 1 gr-index))
92
(set! gr-index2 (+ 1 gr-index2))
94
(if (= (fmod gr-index 4) 0)
95
(set! gr-index2 (- gr-index2 8))
100
(list grn-new gra-new)
107
(steps (+ 1 (lcm oteeth iteeth)))
108
(*points* (cons-array (* steps 2) 'double))
110
(ot 0) ; current outer tooth
114
; If its a polygon or frame, how many sides does it have.
115
(poly (if (= shape 1) 4 ; A frame has four sides.
116
(if (> shape 1) (+ shape 1) 0)))
120
(drw-width (- x2 x1))
121
(drw-height (- y2 y1))
122
(half-width (/ drw-width 2))
123
(half-height (/ drw-height 2))
124
(midx (+ x1 half-width))
125
(midy (+ y1 half-height))
128
(- (/ (min drw-width drw-height) 2) margin)
131
(irad (+ hole margin))
133
(radx (- half-width irad)) ;
134
(rady (- half-height irad)) ;
136
(gradt (get-gradient steps color-method grad))
137
(grada (cadr gradt)) ; Gradient array.
138
(gradn (car gradt)) ; Number of entries of gradients.
141
(grad-index 0) ; for array: grada
142
(point-index 0) ; for array: *points*
146
; Do one step of the loop.
147
(define (calc-and-step!)
149
(oangle (* 2pi (/ ot oteeth)) )
150
(shifted-oangle (+ oangle (* 2pi (/ start-angle 360))) )
151
(xfactor (cos shifted-oangle))
152
(yfactor (sin shifted-oangle))
154
(ofactor (/ (+ oteeth iteeth) iteeth))
156
; The direction of the factor changes according
157
; to whether the type is a sypro or an epitcorhoid.
158
(mfactor (if (= type 0) (- ofactor) ofactor))
161
; If we are drawing a polygon then compute a contortion
162
; factor "lenfactor" which deforms the standard circle.
168
(oanglemodpi2 (fmod (+ oangle
169
(if (= 1 (fmod poly 2))
177
(set! lenfactor (/ ( if (= shape 1) 1 (cos pi4) )
179
(if (< oanglemodpi2 pi4)
192
(* half-width (cos shifted-oangle)) ))
194
(* half-height (cos (* mfactor oangle))) ))
196
(begin ; Spyrograph or Epitrochoid
198
(* radx xfactor lenfactor)
199
(* hole (cos (* mfactor oangle) ) ) ))
201
(* rady yfactor lenfactor)
202
(* hole (sin (* mfactor oangle) ) ) ))
212
;; Draw all the points in *points* with appropriate tool.
213
(define (flush-points len)
215
(gimp-pencil drw len *points*) ; Use pencil
217
(gimp-paintbrush-default drw len *points*); use paintbrush
218
(gimp-airbrush-default drw len *points*) ; use airbrush
222
; Reset points array, but copy last point to first
223
; position so it will connect the next time.
224
(aset *points* 0 (aref *points* (- point-index 2)))
225
(aset *points* 1 (aref *points* (- point-index 1)))
230
;; Execution starts here.
235
(gimp-image-undo-group-start img)
237
; Set new color, brush, opacity, paint mode.
238
(gimp-context-set-foreground color)
239
(gimp-context-set-brush (car brush))
240
(gimp-context-set-opacity (* 100 (car (cdr brush))))
241
(gimp-context-set-paint-mode (car (cdr (cdr (cdr brush)))))
243
(gimp-progress-set-text _"Rendering Spyro")
245
(while (< index steps)
249
(aset *points* point-index cx)
250
(aset *points* (+ point-index 1) cy)
251
(set! point-index (+ point-index 2))
253
; Change color and draw points if using gradient.
254
(if (< 0 color-method) ; use gradient.
255
(if (< (/ (+ grad-index 4) gradn) (/ index steps))
257
(gimp-context-set-foreground
259
(* 255 (aref grada grad-index))
260
(* 255 (aref grada (+ 1 grad-index)) )
261
(* 255 (aref grada (+ 2 grad-index)) )
264
(gimp-context-set-opacity (* 100 (aref grada (+ 3 grad-index) ) ) )
265
(set! grad-index (+ 4 grad-index))
268
(flush-points point-index)
273
(set! index (+ index 1))
275
(if (= 0 (modulo index 16))
276
(gimp-progress-update (/ index steps))
280
; Draw remaining points.
281
(flush-points point-index)
283
(gimp-progress-update 1.0)
285
(gimp-image-undo-group-end img)
286
(gimp-displays-flush)
293
; Get current selection to determine where to draw.
294
(bounds (cdr (gimp-selection-bounds img)))
298
(y2 (car (cdddr bounds)))
301
(set! oteeth (trunc (+ oteeth 0.5)))
302
(set! iteeth (trunc (+ iteeth 0.5)))
304
(script-fu-spyrogimp-internal img drw
308
margin hole-ratio start-angle
310
color-method color grad)
316
(script-fu-register "script-fu-spyrogimp"
318
_"Add Spirographs, Epitrochoids, and Lissajous Curves to the current layer"
319
"Elad Shahar <elad@wisdom.weizmann.ac.il>"
322
"RGB*, INDEXED*, GRAY*"
324
SF-DRAWABLE "Drawable" 0
326
SF-OPTION _"Type" '(_"Spyrograph"
329
SF-OPTION _"Shape" '(_"Circle"
338
_"Polygon: 10 sides")
339
SF-ADJUSTMENT _"Outer teeth" '(86 1 120 1 10 0 0)
340
SF-ADJUSTMENT _"Inner teeth" '(70 1 120 1 10 0 0)
341
SF-ADJUSTMENT _"Margin (pixels)" '(0 -10000 10000 1 10 0 1)
342
SF-ADJUSTMENT _"Hole ratio" '(0.4 0.0 1.0 0.01 0.1 2 0)
343
SF-ADJUSTMENT _"Start angle" '(0 0 359 1 10 0 0)
345
SF-OPTION _"Tool" '(_"Pencil"
348
SF-BRUSH _"Brush" '("Circle (01)" 1.0 -1 0)
350
SF-OPTION _"Color method" '(_"Solid Color"
351
_"Gradient: Loop Sawtooth"
352
_"Gradient: Loop Triangle")
353
SF-COLOR _"Color" "black"
354
SF-GRADIENT _"Gradient" "Deep Sea"
357
(script-fu-menu-register "script-fu-spyrogimp"
358
"<Image>/Filters/Render")
added
removed
plug-ins/script-fu/scripts/spyrogimp.scm
