Enter 2004 August/ENTER.ISO/files/gimp-2.0.5-i586-setup.exe/{app}/share/gimp/2.0/scripts/spyrogimp.scm

GIMP Script-Fu Script | 2004-09-26 | 12.6 KB | 373 lines

;; spyrogimp.scm -*-scheme-*-
;; Draws Spirographs, Epitrochoids and Lissajous Curves.
;; More info at http://netword.com/*spyrogimp
;; Version 1.2
;;
;; Copyright (C) 2003 by Elad Shahar <[e-mail]>
;;
;; 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 2
;; 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, write to the Free Software
;; Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA  02111-1307, USA.

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

; 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.
             )

    ; Find minimum number n such that it is divisible by both a and b.
    ; (least common multiplier)
    (define (calc-min-mult a b)
      (let* ((c 1) (fac 2) (diva 0) (divb 0))
        (while ( <= fac (max a b) )
          (set! diva ( = 0 (fmod (/ a fac) 1) ) )
          (set! divb ( = 0 (fmod (/ b fac) 1) ) )

          (if diva (set! a (/ a fac)))
          (if divb (set! b (/ b fac)))

          (if (or diva divb)
                (set! c (* c fac))
                (set! fac (+ 1 fac)) )
        )
        c
      )
    )


  ; 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
        (cdr (gimp-gradients-get-gradient-data 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 (cdr (gimp-gradients-get-gradient-data 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 (calc-min-mult oteeth iteeth)))
         (*points* (cons-array (* steps 2) 'double))

         (ot 0)                         ; current outer tooth
         (cx 0)                         ; Current x,y
         (cy 0)

         ; Save old foreground color, brush, opacity and paint mode
         (old-fg-color (car (gimp-palette-get-foreground)))
         (old-brush (car (gimp-brushes-get-brush)))
         (old-opacity (car (gimp-brushes-get-opacity)))
         (old-paint-mode (car (gimp-brushes-get-paint-mode)))

         ; 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-image-undo-group-start img)

    ; Set new color, brush, opacity, paint mode.
    (gimp-palette-set-foreground color)
    (gimp-brushes-set-brush (car brush))
    (gimp-brushes-set-opacity (* 100 (car (cdr brush))))
    (gimp-brushes-set-paint-mode (car (cdr (cdr (cdr brush)))))

    (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-palette-set-foreground
                (list
                  (* 255 (aref grada grad-index))
                  (* 255 (aref grada (+ 1 grad-index)) )
                  (* 255 (aref grada (+ 2 grad-index)) )
                )
              )
              (gimp-brushes-set-opacity (* 100 (aref grada (+ 3 grad-index) ) )  )
              (set! grad-index (+ 4 grad-index))

              ; Draw points
              (flush-points point-index)
             )
           )
        )

        (set! index (+ index 1))
    )


    ; Draw remaining points.
    (flush-points point-index)

    ; Restore foreground color, brush and opacity
    (gimp-palette-set-foreground old-fg-color)
    (gimp-brushes-set-brush old-brush)
    (gimp-brushes-set-opacity old-opacity)
    (gimp-brushes-set-paint-mode old-paint-mode)

    (gimp-image-undo-group-end img)
    (gimp-displays-flush)
  )
)


; 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)
  (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)))
       )

    (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"
 _"<Image>/Script-Fu/Render/_Spyrogimp..."
 _"Draws Spirographs, Epitrochoids and Lissajous Curves. More info at http://netword.com/*spyrogimp"
 "Elad Shahar <[e-mail]>"
 "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"   '(90 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)" 1.0 -1 0)

 SF-OPTION     _"Color Method"  '(_"Solid Color"
                  _"Gradient: Loop Sawtooth"
                                  _"Gradient: Loop Triangle")
 SF-COLOR      _"Color"         '(0 0 0)
 SF-GRADIENT   _"Gradient"       "Deep Sea"
)

;; End of syprogimp.scm