summaryrefslogtreecommitdiffstats
path: root/plug-ins/script-fu/scripts/spyrogimp.scm
diff options
context:
space:
mode:
Diffstat (limited to '')
-rw-r--r--plug-ins/script-fu/scripts/spyrogimp.scm352
1 files changed, 352 insertions, 0 deletions
diff --git a/plug-ins/script-fu/scripts/spyrogimp.scm b/plug-ins/script-fu/scripts/spyrogimp.scm
new file mode 100644
index 0000000..0a1e40c
--- /dev/null
+++ b/plug-ins/script-fu/scripts/spyrogimp.scm
@@ -0,0 +1,352 @@
+; spyrogimp.scm -*-scheme-*-
+; Draws Spirographs, Epitrochoids and Lissajous Curves.
+; More info at http://www.wisdom.weizmann.ac.il/~elad/spyrogimp/
+; Version 1.2
+;
+; Copyright (C) 2003 by Elad Shahar <elad@wisdom.weizmann.ac.il>
+;
+; This program is free software: you can redistribute it and/or modify
+; it under the terms of the GNU General Public License as published by
+; the Free Software Foundation; either version 3 of the License, or
+; (at your option) any later version.
+;
+; This program is distributed in the hope that it will be useful,
+; but WITHOUT ANY WARRANTY; without even the implied warranty of
+; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+; GNU General Public License for more details.
+;
+; You should have received a copy of the GNU General Public License
+; along with this program. If not, see <https://www.gnu.org/licenses/>.
+
+
+; This routine is invoked by a dialog.
+; It is the main routine in this file.
+(define (script-fu-spyrogimp img drw
+ type shape
+ oteeth iteeth
+ margin hole-ratio start-angle
+ tool brush
+ color-method color grad)
+
+ ; Internal function to draw the spyro.
+ (define (script-fu-spyrogimp-internal img drw
+ x1 y1 x2 y2 ; Bounding box.
+ type ; = 0 (Spirograph), 1 (Epitrochoid), 2(Lissajous) .
+ shape ; = 0 (Circle), 1 (Frame), >2 (Polygons) .
+ oteeth iteeth ; Outer and inner teeth.
+ margin hole-ratio
+ start-angle ; 0 <= start-angle < 360 .
+ tool ; = 0 (Pencil), 1 (Brush), 2 (Airbrush) .
+ brush
+ color-method ; = 0 (Single color), 1 (Grad. Loop Sawtooth),
+ ; 2 (Grad. Loop triangle) .
+ color ; Used when color-method = Single color .
+ grad ; Gradient used in Gradient color methods.
+ )
+
+
+ ; This function returns a list of samples according to the gradient.
+ (define (get-gradient steps color-method grad)
+ (if (= color-method 1)
+ ; option 1
+ ; Just return the gradient
+ (gimp-gradient-get-uniform-samples grad (min steps 50) FALSE)
+
+ ; option 2
+ ; The returned list is such that the gradient appears two times, once
+ ; in the normal order and once in reverse. This way there are no color
+ ; jumps if we go beyond the edge
+ (let* (
+ ; Sample the gradient into array "gr".
+ (gr (gimp-gradient-get-uniform-samples grad
+ (/ (min steps 50) 2)
+ FALSE))
+
+ (grn (car gr)) ; length of sample array.
+ (gra (cadr gr)) ; array of color samples (R1,G1,B1,A1, R2,....)
+
+ ; Allocate array gra-new of size (2 * grn) - 8,
+ ; but since each 4 items is actually one (RGBA) tuple,
+ ; it contains 2x - 2 entries.
+ (grn-new (+ grn grn -8))
+ (gra-new (cons-array grn-new 'double))
+
+ (gr-index 0)
+ (gr-index2 0)
+ )
+
+ ; Copy original array gra to gra_new.
+ (while (< gr-index grn)
+ (aset gra-new gr-index (aref gra gr-index))
+ (set! gr-index (+ 1 gr-index))
+ )
+
+ ; Copy second time, but in reverse
+ (set! gr-index2 (- gr-index 8))
+ (while (< gr-index grn-new)
+ (aset gra-new gr-index (aref gra gr-index2))
+ (set! gr-index (+ 1 gr-index))
+ (set! gr-index2 (+ 1 gr-index2))
+
+ (if (= (fmod gr-index 4) 0)
+ (set! gr-index2 (- gr-index2 8))
+ )
+ )
+
+ ; Return list.
+ (list grn-new gra-new)
+ )
+ )
+ )
+
+
+ (let* (
+ (steps (+ 1 (lcm oteeth iteeth)))
+ (*points* (cons-array (* steps 2) 'double))
+
+ (ot 0) ; current outer tooth
+ (cx 0) ; Current x,y
+ (cy 0)
+
+ ; If its a polygon or frame, how many sides does it have.
+ (poly (if (= shape 1) 4 ; A frame has four sides.
+ (if (> shape 1) (+ shape 1) 0)))
+
+ (2pi (* 2 *pi*))
+
+ (drw-width (- x2 x1))
+ (drw-height (- y2 y1))
+ (half-width (/ drw-width 2))
+ (half-height (/ drw-height 2))
+ (midx (+ x1 half-width))
+ (midy (+ y1 half-height))
+
+ (hole (* hole-ratio
+ (- (/ (min drw-width drw-height) 2) margin)
+ )
+ )
+ (irad (+ hole margin))
+
+ (radx (- half-width irad)) ;
+ (rady (- half-height irad)) ;
+
+ (gradt (get-gradient steps color-method grad))
+ (grada (cadr gradt)) ; Gradient array.
+ (gradn (car gradt)) ; Number of entries of gradients.
+
+ ; Indexes
+ (grad-index 0) ; for array: grada
+ (point-index 0) ; for array: *points*
+ (index 0)
+ )
+
+ ; Do one step of the loop.
+ (define (calc-and-step!)
+ (let* (
+ (oangle (* 2pi (/ ot oteeth)) )
+ (shifted-oangle (+ oangle (* 2pi (/ start-angle 360))) )
+ (xfactor (cos shifted-oangle))
+ (yfactor (sin shifted-oangle))
+ (lenfactor 1)
+ (ofactor (/ (+ oteeth iteeth) iteeth))
+
+ ; The direction of the factor changes according
+ ; to whether the type is a sypro or an epitcorhoid.
+ (mfactor (if (= type 0) (- ofactor) ofactor))
+ )
+
+ ; If we are drawing a polygon then compute a contortion
+ ; factor "lenfactor" which deforms the standard circle.
+ (if (> poly 2)
+ (let* (
+ (pi4 (/ *pi* poly))
+ (pi2 (* pi4 2))
+
+ (oanglemodpi2 (fmod (+ oangle
+ (if (= 1 (fmod poly 2))
+ 0 ;(/ pi4 2)
+ 0
+ )
+ )
+ pi2))
+ )
+
+ (set! lenfactor (/ ( if (= shape 1) 1 (cos pi4) )
+ (cos
+ (if (< oanglemodpi2 pi4)
+ oanglemodpi2
+ (- pi2 oanglemodpi2)
+ )
+ )
+ )
+ )
+ )
+ )
+
+ (if (= type 2)
+ (begin ; Lissajous
+ (set! cx (+ midx
+ (* half-width (cos shifted-oangle)) ))
+ (set! cy (+ midy
+ (* half-height (cos (* mfactor oangle))) ))
+ )
+ (begin ; Spyrograph or Epitrochoid
+ (set! cx (+ midx
+ (* radx xfactor lenfactor)
+ (* hole (cos (* mfactor oangle) ) ) ))
+ (set! cy (+ midy
+ (* rady yfactor lenfactor)
+ (* hole (sin (* mfactor oangle) ) ) ))
+ )
+ )
+
+ ;; Advance teeth
+ (set! ot (+ ot 1))
+ )
+ )
+
+
+ ;; Draw all the points in *points* with appropriate tool.
+ (define (flush-points len)
+ (if (= tool 0)
+ (gimp-pencil drw len *points*) ; Use pencil
+ (if (= tool 1)
+ (gimp-paintbrush-default drw len *points*); use paintbrush
+ (gimp-airbrush-default drw len *points*) ; use airbrush
+ )
+ )
+
+ ; Reset points array, but copy last point to first
+ ; position so it will connect the next time.
+ (aset *points* 0 (aref *points* (- point-index 2)))
+ (aset *points* 1 (aref *points* (- point-index 1)))
+ (set! point-index 2)
+ )
+
+ ;;
+ ;; Execution starts here.
+ ;;
+
+ (gimp-context-push)
+
+ (gimp-image-undo-group-start img)
+
+ ; Set new color, brush, opacity, paint mode.
+ (gimp-context-set-foreground color)
+ (gimp-context-set-brush (car brush))
+ (gimp-context-set-opacity (car (cdr brush)))
+ (gimp-context-set-paint-mode (car (cdr (cdr (cdr brush)))))
+
+ (gimp-progress-set-text _"Rendering Spyro")
+
+ (while (< index steps)
+
+ (calc-and-step!)
+
+ (aset *points* point-index cx)
+ (aset *points* (+ point-index 1) cy)
+ (set! point-index (+ point-index 2))
+
+ ; Change color and draw points if using gradient.
+ (if (< 0 color-method) ; use gradient.
+ (if (< (/ (+ grad-index 4) gradn) (/ index steps))
+ (begin
+ (gimp-context-set-foreground
+ (list
+ (* 255 (aref grada grad-index))
+ (* 255 (aref grada (+ 1 grad-index)) )
+ (* 255 (aref grada (+ 2 grad-index)) )
+ )
+ )
+ (gimp-context-set-opacity (* 100 (aref grada (+ 3 grad-index) ) ) )
+ (set! grad-index (+ 4 grad-index))
+
+ ; Draw points
+ (flush-points point-index)
+ )
+ )
+ )
+
+ (set! index (+ index 1))
+
+ (if (= 0 (modulo index 16))
+ (gimp-progress-update (/ index steps))
+ )
+ )
+
+ ; Draw remaining points.
+ (flush-points point-index)
+
+ (gimp-progress-update 1.0)
+
+ (gimp-image-undo-group-end img)
+ (gimp-displays-flush)
+
+ (gimp-context-pop)
+ )
+ )
+
+ (let* (
+ ; Get current selection to determine where to draw.
+ (bounds (cdr (gimp-selection-bounds img)))
+ (x1 (car bounds))
+ (y1 (cadr bounds))
+ (x2 (caddr bounds))
+ (y2 (car (cdddr bounds)))
+ )
+
+ (set! oteeth (trunc (+ oteeth 0.5)))
+ (set! iteeth (trunc (+ iteeth 0.5)))
+
+ (script-fu-spyrogimp-internal img drw
+ x1 y1 x2 y2
+ type shape
+ oteeth iteeth
+ margin hole-ratio start-angle
+ tool brush
+ color-method color grad)
+ )
+)
+
+
+
+(script-fu-register "script-fu-spyrogimp"
+ _"_Spyrogimp (older script-fu version)..."
+ _"This procedure is deprecated! Use 'plug-in-spyrogimp' instead."
+ "Elad Shahar <elad@wisdom.weizmann.ac.il>"
+ "Elad Shahar"
+ "June 2003"
+ "RGB*, INDEXED*, GRAY*"
+ SF-IMAGE "Image" 0
+ SF-DRAWABLE "Drawable" 0
+
+ SF-OPTION _"Type" '(_"Spyrograph"
+ _"Epitrochoid"
+ _"Lissajous")
+ SF-OPTION _"Shape" '(_"Circle"
+ _"Frame"
+ _"Triangle"
+ _"Square"
+ _"Pentagon"
+ _"Hexagon"
+ _"Polygon: 7 sides"
+ _"Polygon: 8 sides"
+ _"Polygon: 9 sides"
+ _"Polygon: 10 sides")
+ SF-ADJUSTMENT _"Outer teeth" '(86 1 120 1 10 0 0)
+ SF-ADJUSTMENT _"Inner teeth" '(70 1 120 1 10 0 0)
+ SF-ADJUSTMENT _"Margin (pixels)" '(0 -10000 10000 1 10 0 1)
+ SF-ADJUSTMENT _"Hole ratio" '(0.4 0.0 1.0 0.01 0.1 2 0)
+ SF-ADJUSTMENT _"Start angle" '(0 0 359 1 10 0 0)
+
+ SF-OPTION _"Tool" '(_"Pencil"
+ _"Brush"
+ _"Airbrush")
+ SF-BRUSH _"Brush" '("Circle (01)" 100 -1 0)
+
+ SF-OPTION _"Color method" '(_"Solid Color"
+ _"Gradient: Loop Sawtooth"
+ _"Gradient: Loop Triangle")
+ SF-COLOR _"Color" "black"
+ SF-GRADIENT _"Gradient" "Deep Sea"
+)
generated by cgit v1.2.3 (git 2.39.1) at 2024-11-06 09:38:17 +0000