Commit 7ecebde9 authored by Sven Neumann's avatar Sven Neumann Committed by Sven Neumann

plug-ins/script-fu/scripts/Makefile.am

2003-06-24  Sven Neumann  <sven@gimp.org>

	* plug-ins/script-fu/scripts/Makefile.am
	* plug-ins/script-fu/scripts/spyrogimp.scm
	* plug-ins/script-fu/scripts/trochoid.scm: replaced Trochoid
	script with the more advanced Spyrogimp (bug #115290).

	* plug-ins/script-fu/scripts/grid-system.scm: renamed menu entry.
parent 4b07d5cb
2003-06-24 Sven Neumann <sven@gimp.org>
* plug-ins/script-fu/scripts/Makefile.am
* plug-ins/script-fu/scripts/spyrogimp.scm
* plug-ins/script-fu/scripts/trochoid.scm: replaced Trochoid
script with the more advanced Spyrogimp (bug #115290).
* plug-ins/script-fu/scripts/grid-system.scm: renamed menu entry.
2003-06-24 Sven Neumann <sven@gimp.org>
* tools/pdbgen/pdb/image.pdb: changed the maximum preview
......@@ -82,6 +82,7 @@ scriptdata_DATA = \
speed-text.scm \
sphere.scm \
spinning-globe.scm \
spyrogimp.scm \
starburst-logo.scm \
starscape-logo.scm \
swirltile.scm \
......@@ -95,7 +96,6 @@ scriptdata_DATA = \
textured-logo.scm \
title-header.scm \
tileblur.scm \
trochoid.scm \
truchet.scm \
unsharp-mask.scm \
waves-anim.scm \
......
......@@ -72,7 +72,7 @@
(gimp-displays-flush)))
(script-fu-register "script-fu-grid-system"
_"<Image>/Script-Fu/Render/Make Grid System..."
_"<Image>/Script-Fu/Render/Grid..."
"Draw grid as specified by X-DIVIDES (list of propotions relative to the drawable) and Y-DIVIDES. The color and width of grid is detemined by the current settings of brush."
"Shuji Narazaki <narazaki@InetQ.or.jp>"
"Shuji Narazaki"
......@@ -80,8 +80,8 @@
"RGB*, INDEXED*, GRAY*"
SF-IMAGE "Image to use" 0
SF-DRAWABLE "Drawable to draw grid" 0
SF-VALUE _"Grids X" script-fu-grid-system-x-divides
SF-VALUE _"Grids Y" script-fu-grid-system-y-divides
SF-VALUE _"X Divisions" script-fu-grid-system-x-divides
SF-VALUE _"Y Divisions" script-fu-grid-system-y-divides
)
;;; grid-system.scm ends here
;; 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 <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 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)))
; 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))))
(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-undo-push-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-undo-push-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 <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" '(90 1 120 1 10 0 0)
SF-ADJUSTMENT _"Inner Teeth" '(70 1 120 1 10 0 0)
SF-ADJUSTMENT _"Margin (pixels)" '(5 0 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
;;; trochoid.scm -*-scheme-*-
;;; Time-stamp: <1997/06/13 23:15:23 narazaki@InetQ.or.jp>
;;; This file is a part of:
;;; The GIMP (Copyright (C) 1995 Spencer Kimball and Peter Mattis)
;;; Author: Shuji Narazaki (narazaki@InetQ.or.jp)
;;; Version 1.0
;;; Code:
(define (script-fu-trochoid base-radius-f wheel-radius-f pen-pos hue-rate
erase-before-draw brush-details)
(if 'not-guile (define modulo fmod))
(define (floor x) (- x (fmod x 1)))
(define *prime-table*
'(2 3 5 7 11 13 17 19 23 29 31 37 41 43 47 53 59 61 67 71 73 79 83 89 97))
(define (LCM x y) ; Least Common Multiple
(define (divide? x y) (= 0 (modulo x y)))
(define (factorize x)
(define (f-aux x p-list result)
(cond ((= x 1)
(nreverse result))
((null? p-list)
(nreverse (cons (list x 1) result)))
((divide? x (car p-list))
(let ((times 1)
(p (car p-list)))
(set! x (/ x p))
(while (divide? x p)
(set! times (+ times 1))
(set! x (/ x p)))
(f-aux x (cdr p-list) (cons (list p times) result))))
('else (f-aux x (cdr p-list) result))))
(f-aux x *prime-table* '()))
(define (extend-prime-table limit)
(let ((index (+ (car *prime-table*) 1)))
(while (< index limit)
(let ((prime? #t)
(table *prime-table*))
(while (and (not (null? table)) prime?)
(if (divide? index (car table))
(set! prime? #f)
(set! table (cdr table))))
(if prime?
(set! *prime-table*
(nreverse (cons index (nreverse *prime-table*))))))
(set! index (+ index 1)))))
(define (aux l1 l2 result)
(cond ((and (null? l1) (null? l2)) result)
((null? l1) (append l2 result))
((null? l2) (append l1 result))
((= (car (car l1)) (car (car l2)))
(aux (cdr l1) (cdr l2) (cons (list (car (car l1))
(max (cadr (car l1))
(cadr (car l2))))
result)))
((< (car (car l1)) (car (car l2)))
(aux (cdr l1) l2 (cons (car l1) result)))
('else
(aux l1 (cdr l2) (cons (car l2) result)))))
(if (< (pow (car (reverse *prime-table*)) 2) (max x y))
(extend-prime-table (sqrt (max x y))))
(let ((f-list (aux (factorize x) (factorize y) '()))
(result 1))
(while (not (null? f-list))
(set! result (* (pow (car (car f-list)) (cadr (car f-list))) result))
(set! f-list (cdr f-list)))
result))
(define (rgb-to-hsv rgb hsv)
(let* ((red (floor (nth 0 rgb)))
(green (floor (nth 1 rgb)))
(blue (floor (nth 2 rgb)))
(h 0.0)
(s 0.0)
(minv (min red (min green blue)))
(maxv (max red (max green blue)))
(v maxv)
(delta 0))
(if (not (= 0 maxv))
(set! s (/ (* (- maxv minv) 255.0) maxv))
(set! s 0.0))
(if (= 0.0 s)
(set! h 0.0)
(begin
(set! delta (- maxv minv))
(cond ((= maxv red)
(set! h (/ (- green blue) delta)))
((= maxv green)
(set! h (+ 2.0 (/ (- blue red) delta))))
((= maxv blue)
(set! h (+ 4.0 (/ (- red green) delta)))))
(set! h (* 42.5 h))
(if (< h 0.0)
(set! h (+ h 255.0)))
(if (< 255 h)
(set! h (- h 255.0)))))
(set-car! hsv (floor h))
(set-car! (cdr hsv) (floor s))
(set-car! (cddr hsv) (floor v))))
;;; hsv-to-rgb that does not consume new cons cell
(define (hsv-to-rgb hsv rgb)
(let ((h (nth 0 hsv))
(s (nth 1 hsv))
(v (nth 2 hsv))
(hue 0)
(saturation 0)
(value 0))
(if (= s 0)
(begin
(set! h v)
(set! s v))
(let ((f 0)
(p 0)
(q 0)
(t 0))
(set! hue (/ (* 6 h) 255))
(if (= hue 6.0)
(set! hue 0.0))
(set! saturation (/ s 255.0))
(set! value (/ v 255.0))
(set! f (- hue (floor hue)))
(set! p (* value (- 1.0 saturation)))
(set! q (* value (- 1.0 (* saturation f))))
(set! t (* value (- 1.0 (* saturation (- 1.0 f)))))
(let ((tmp (floor hue)))
(cond ((= 0 tmp)
(set! h (* value 255))
(set! s (* t 255))
(set! v (* p 255)))
((= 1 tmp)
(set! h (* q 255))
(set! s (* value 255))
(set! v (* p 255)))
((= 2 tmp)
(set! h (* p 255))
(set! s (* value 255))
(set! v (* t 255)))
((= 3 tmp)
(set! h (* p 255))
(set! s (* q 255))
(set! v (* value 255)))
((= 4 tmp)
(set! h (* t 255))
(set! s (* p 255))
(set! v (* value 255)))
((= 5 tmp)
(set! h (* value 255))
(set! s (* p 255))
(set! v (* q 255)))))))
(set-car! rgb h)
(set-car! (cdr rgb) s)
(set-car! (cddr rgb) v)))
;; segment is
;; filled-index (integer)
;; size as number of points (integer)
;; vector (which size is 2 * size)
(define (make-segment length x y)
(if (< 64 length)
(set! length 64))
(if (< length 5)
(set! length 5))
(let ((vec (cons-array (* 2 length) 'double)))
(aset vec 0 x)
(aset vec 1 y)
(list 1 length vec)))
;; accessors
(define (segment-filled-size segment) (car segment))
(define (segment-max-size segment) (cadr segment))
(define (segment-strokes segment) (caddr segment))
(define (update-segment! center-x center-y angle1 rad1 angle2 rad2 segment)
(define (fill-segment! new-x new-y segment)
(define (shift-segment! segment)
(let ((base 0)
(size (cadr segment))
(vec (caddr segment))
(offset 2))
(while (< base offset)
(aset vec (* 2 base)
(aref vec (* 2 (- size (- offset base)))))
(aset vec (+ (* 2 base) 1)
(aref vec (+ (* 2 (- size (- offset base))) 1)))
(set! base (+ base 1)))
(set-car! segment base)))
(let ((base (car segment))
(size (cadr segment))
(vec (caddr segment)))
(if (= base 0)
(begin
(shift-segment! segment)
(set! base (segment-filled-size segment))))
(if (and (= new-x (aref vec (* 2 (- base 1))))
(= new-y (aref vec (+ (* 2 (- base 1)) 1))))
#f
(begin
(aset vec (* 2 base) new-x)
(aset vec (+ (* 2 base) 1) new-y)
(set! base (+ base 1))
(if (= base size)
(begin
(set-car! segment 0)
#t)
(begin
(set-car! segment base)
#f))))))
(set! angel1 (fmod angle1 (* 2 *pi*)))
(set! angel2 (fmod angle2 (* 2 *pi*)))
(fill-segment! (+ center-x
(* rad1 (sin angle1))
(* rad2 (- (sin angle2))))
(+ center-y
(* rad1 (cos angle1))
(* rad2 (cos angle2)))
segment))
; (set-brush-color! index total-step hue-rate rgb hsv)
; (set! drawable-to-erase drawable)
(define (draw-segment img drawable drawable-to-erase single-drawable?
segment limit rgb background-color
stroke-overwrite keep-opacity paint-mode)
(if (not stroke-overwrite)
(begin ; erase crossover region
(if (< keep-opacity 100) (gimp-brushes-set-opacity 100))
(if single-drawable?
(begin
(gimp-brushes-set-paint-mode NORMAL)
(gimp-palette-set-foreground background-color)
(gimp-airbrush drawable-to-erase 100
(* 2 limit) (segment-strokes segment))
(gimp-brushes-set-paint-mode paint-mode))
(gimp-eraser drawable-to-erase (* 2 limit)
(segment-strokes segment)))
(if (< keep-opacity 100) (gimp-brushes-set-opacity keep-opacity))))
(gimp-palette-set-foreground rgb)
(gimp-airbrush drawable 100 (* 2 limit) (segment-strokes segment)))
(define (set-brush-color! index max-index hue-rate rgb hsv)
(if (= 0 hue-rate)
rgb
(let* ((max-hue 254)
(hue (* max-hue (fmod (/ (* index (abs hue-rate)) max-index) 1))))
(if (< hue-rate 0)
(set! hue (- max-hue hue)))
(set-car! hsv hue)
(hsv-to-rgb hsv rgb)
rgb)))
(define (trochoid-rotate-gear total-distance img use-this-drawable center-x
center-y base-radius wheel-radius pen-pos hue-rate
layer-paint-mode stroke-overwrite brush-details)
(let* ((rad-of-wheel 0)
(steps-for-circle 100.0)
(wheel-spin (/ total-distance (abs wheel-radius)))
(total-step (* wheel-spin steps-for-circle))
(loop-num (max (* 2 (/ total-distance base-radius))
(/ total-distance (abs wheel-radius))))
(steps-for-a-loop (/ total-step loop-num))
(w2r (/ (abs wheel-radius) base-radius))
(rad-of-step (/ (* 2.0 *pi*) steps-for-circle))
(brush-opacity (car (gimp-brushes-get-opacity)))
(rgb (car (gimp-palette-get-foreground)))
(drawable use-this-drawable)
(drawable-to-erase use-this-drawable)
(paint-mode (car (gimp-brushes-get-paint-mode)))
(background-color (car (gimp-palette-get-background)))
(hsv '(0 255 255))
(index 0)
(iindex 0)
(center2wheel (+ base-radius wheel-radius))
(wheel2pen (* (abs wheel-radius) pen-pos))
(segment (make-segment
(if (= 0 hue-rate)
32
(max 4 (floor (/ (/ total-step (abs hue-rate)) 255.0))))
center-x (+ center-y center2wheel wheel2pen))))
(while (< 0 loop-num)
(set! iindex 0)
(if (null? use-this-drawable)
(begin
(if drawable (set! drawable-to-erase drawable))
(set! drawable (car (gimp-layer-copy