; fractalize_path.scm
; by Rob Antonishen
; http://ffaat.pointclark.net
; Version 1.0 (20090728)
; Description
;
; Fractalizes a path using a midpoint desplace algorithm
; with either uniform or gaussian distributions.
;
; License:
;
; 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.
;
; The GNU Public License is available at
; http://www.gnu.org/copyleft/gpl.html
(define (fractalize_path img inPath inSubs inMode inSmoothness inInterp inPixels inNew)
; helper functions:
; TinyScheme lacks pi.
(define pi (acos -1))
; TinyScheme lacks a floating-point random number generator.
(define (urandom) (/ (rand 32768) 32768))
; Gaussian random variables are generated by a Box-Muller transform:
; http://en.wikipedia.org/wiki/Box-Muller_transform
; code here from "isomage" of the cartographersguild.com forums
; and his cavegen script
; return of (gauss) is in range of -2pi...2pi
(define gauss-buffer '())
(define (gauss)
(if (null? gauss-buffer)
(let ((r (sqrt (* -2 (log (urandom)))))
(t (* 2 pi (urandom))))
(set! gauss-buffer (list (* r (cos t))
(* r (sin t))))))
(let ((z (car gauss-buffer)))
(set! gauss-buffer (cdr gauss-buffer))
z))
; returns a gaussian distributed value between -range and +range
(define (grandom range) (* range (/ (gauss) (* 2 pi))))
; returns a uniform distributed value between -range and + range
(define (rrandom range) (* range (- (* (urandom) 2) 1.0)))
; calcSubdivide returns a point on the line perpendicular to the line connecting
; p1 and p2 with a deviation proportionate to smoothness
; method is uniform (0) or gaussian (1)
(define (calcSubdivide p1 p2 smoothness mode)
(let*
((x1 (car p1))
(y1 (cadr p1))
(x2 (car p2))
(y2 (cadr p2))
(x3 (- x2 x1))
(y3 (- y2 y1))
(hx (+ x1 (/ x3 2)))
(hy (+ y1 (/ y3 2)))
(len (sqrt (+ (* x3 x3) (* y3 y3))))
(nx 1)
(ny 0)
(r 0))
(when (> len 0)
(set! nx (/ (- y3) len))
(set! ny (/ x3 len)))
(set! r
(cond
((equal? mode 1) (grandom (/ len (+ 1 smoothness))))
((equal? mode 0) (rrandom (/ len (+ 1 smoothness))))
))
(set! nx (* nx r))
(set! ny (* ny r))
(list (+ hx nx) (+ hy ny))
)
)
;main script
;-----------------------------------------------------------------------------
(let*
((width (car (gimp-image-width img)))
(height (car (gimp-image-height img)))
(varVector inPath)
(varName (car (gimp-vectors-get-name varVector)))
(newVector 0)
(temp 0))
(gimp-image-undo-group-start img)
(gimp-progress-set-text "Fractalizing Path...")
(set! newVector (car (gimp-vectors-new img (string-append (car (gimp-vectors-get-name varVector)) " fractalized"))))
;there is an active vector/path
(unless (equal? varVector -1)
(let
((strokelist (cadr (gimp-vectors-get-strokes varVector)))
(numstrokes (vector-length (cadr (gimp-vectors-get-strokes varVector))))
(points ())
(numpoints 0)
(counter 0)
(isclosed FALSE))
(while (< counter numstrokes) ; for each stroke in the path
(gimp-progress-set-text (string-append "Analyzing Segment " (number->string (+ counter 1)) " of " (number->string numstrokes)))
(if (equal? inInterp FALSE)
(begin
(set! points (caddr (gimp-vectors-stroke-get-points varVector (vector-ref strokelist counter))))
(set! numpoints (/ (cadr (gimp-vectors-stroke-get-points varVector (vector-ref strokelist counter))) 6)))
(let*
((varPathLength (car (gimp-vectors-stroke-get-length varVector (vector-ref strokelist counter) 1)))
(varCheck (list-ref (gimp-vectors-stroke-get-point-at-dist varVector (vector-ref strokelist counter) varPathLength 1) 3))
(varPos 0)
(x 0)
(y 0))
;backtrack to get last good length
(while (= varCheck FALSE)
(set! varPathLength (- varPathLength 0.001))
(set! varCheck (list-ref (gimp-vectors-stroke-get-point-at-dist varVector (vector-ref strokelist counter) varPathLength 1) 3))
)
(gimp-progress-set-text (string-append "Refactoring " (number->string (+ counter 1)) " of " (number->string numstrokes)))
(while (< varPos varPathLength)
(set! x (car (gimp-vectors-stroke-get-point-at-dist varVector (vector-ref strokelist counter) varPos 1)))
(set! y (cadr (gimp-vectors-stroke-get-point-at-dist varVector (vector-ref strokelist counter) varPos 1)))
; no idea why but appending all of this in one line would cause some to get dropped
(set! points (append points (list x y)))
(set! points (append points (list x y)))
(set! points (append points (list x y)))
(set! varPos (+ varPos inPixels)))
(set! x (car (gimp-vectors-stroke-get-point-at-dist varVector (vector-ref strokelist counter) varPathLength 1)))
(set! y (cadr (gimp-vectors-stroke-get-point-at-dist varVector (vector-ref strokelist counter) varPathLength 1)))
; no idea why but appending all of this in one line would cause some to get dropped
(set! points (append points (list x y)))
(set! points (append points (list x y)))
(set! points (append points (list x y)))
(set! numpoints (/ (length points) 6))
(set! points (list->vector points))
))
(set! isclosed (cadddr (gimp-vectors-stroke-get-points varVector (vector-ref strokelist counter))))
(let
((pcount 0)
(pointlist ())
(newpointlist ())
(divcounter 0))
(while (< pcount numpoints)
(set! pointlist (append pointlist (list (list (vector-ref points (+ (* pcount 6) 2))
(vector-ref points (+ (* pcount 6) 3))))))
(set! pcount (+ pcount 1))
)
;add start point to end if closed path
(if (equal? isclosed TRUE)
(set! pointlist (append pointlist (list (car pointlist)))))
;pointlist is now a list like ((x1 y1) (x2 y2) ... (xn yn)) use list-ref to get each pair
;todo:
; repeat for "subdivisions"
; build a new list like so ((x1 y1) (calcsubdivide (x1 y1) (x2 y2)) (x2 y2) (calc...) )
(gimp-progress-set-text (string-append "Fractalizing " (number->string (+ counter 1)) " of " (number->string numstrokes)))
(while (< divcounter inSubs)
(set! pcount 0)
(set! numpoints (length pointlist))
(while (< pcount (- numpoints 1))
(if (= (modulo pcount 10) 0) (gimp-progress-update (/ (+ pcount (* divcounter numpoints) (* counter inSubs numpoints)) (* numstrokes inSubs numpoints))))
(set! newpointlist (append newpointlist (list (list-ref pointlist pcount)
(calcSubdivide (list-ref pointlist pcount) (list-ref pointlist (+ pcount 1)) inSmoothness inMode))))
(set! pcount (+ pcount 1))
)
(set! newpointlist (append newpointlist (list (list-ref pointlist (- numpoints 1)))))
(set! pointlist newpointlist)
(set! newpointlist ())
(set! divcounter (+ divcounter 1))
)
;should be a list with the intermediate points
;turn this new list into a set of points and replace the stoke in the array.
(set! pcount 0)
(set! numpoints (- (length pointlist) 1))
(set! newpointlist ())
(gimp-progress-set-text (string-append "Remapping " (number->string (+ counter 1)) " of " (number->string numstrokes)))
(while (< pcount numpoints)
(if (= (modulo pcount 10) 0) (gimp-progress-pulse))
(set! temp (list-ref pointlist pcount))
; no idea why but appending all of this in one line would cause some to get dropped
(set! newpointlist (append newpointlist temp))
(set! newpointlist (append newpointlist temp))
(set! newpointlist (append newpointlist temp))
(set! pcount (+ pcount 1))
)
(when (equal? isclosed FALSE)
(set! temp (list-ref pointlist pcount))
; no idea why but appending all of this in one line would cause some to get dropped
(set! newpointlist (append newpointlist temp))
(set! newpointlist (append newpointlist temp))
(set! newpointlist (append newpointlist temp)))
(gimp-vectors-stroke-new-from-points newVector 0 (length newpointlist)
(list->vector newpointlist) isclosed)
)
(set! counter (+ counter 1))
)
)
)
(gimp-progress-set-text " ")
(gimp-progress-end)
(gimp-image-add-vectors img newVector (car (gimp-image-get-vectors-position img varVector)))
(when (equal? inNew FALSE)
(gimp-image-remove-vectors img varVector)
(gimp-vectors-set-name newVector varName)
)
(gimp-vectors-set-visible newVector TRUE)
(gimp-displays-flush)
(gimp-image-undo-group-end img)
)
)
(script-fu-register "fractalize_path"
"Fractalize Path..."
"Fractalize the path."
"Rob Antonishen"
"Rob Antonishen"
"July 2009"
""
SF-IMAGE "image" 0
SF-VECTORS "path" 0
SF-ADJUSTMENT "Subdivisions" (list 3 1 5 1 2 0 SF-SLIDER)
SF-OPTION "Method" (list "Uniform" "Gaussian")
SF-ADJUSTMENT "Smoothness" (list 5 0 20 0.1 1 1 SF-SLIDER)
SF-TOGGLE "Interpolate First" FALSE
SF-ADJUSTMENT "Interpolate Pixel Spacing" (list 50 15 100 1 10 0 SF-SLIDER)
SF-TOGGLE "Create New Path" FALSE
)
(script-fu-menu-register "fractalize_path"
"")