groworld/plant-eyes/test-scripts/fin-test.scm
2009-09-28 09:57:29 +01:00

96 lines
2.9 KiB
Scheme

; an example of the fluxus extrusion tool
(require scheme/class)
(define min-fin-len 3)
(define fin-length-var 6)
(define fin-grow-prob 2)
(define max-fins-per-twig 5)
(define fin%
(class object%
(init-field
(fin-size 1)
(twig-ob #f)
(col (vector 0 0 0))
(path-len 0)
(profile-len 0))
(field
(fin-len (min path-len (+ min-fin-len (random fin-length-var))))
(root (build-polygons (* fin-len 2) 'triangle-strip))
(pos (random profile-len))
(start (* (random (- path-len fin-len)) profile-len))
(grow-t 0)
(grow-speed (* (rndf) 0.1)))
(define/public (build)
(with-primitive root
(parent twig-ob)
(texture (load-texture "textures/fin-roots.png"))
(hint-unlit)
(hint-depth-sort)
(colour col)
(backfacecull 0)
(pdata-index-map!
(lambda (i t)
(vector (/ (+ (quotient i 2) 1) (/ (pdata-size) 2)) (if (odd? i) 1 0) 0))
"t")))
(define/public (update t d)
(when (< grow-t 1)
(with-primitive root
(pdata-index-map!
(lambda (i p)
(let* ((ti (+ start pos (* (quotient i 2) profile-len)))
(tp (with-primitive twig-ob (pdata-ref "p" ti)))
(tn (with-primitive twig-ob (pdata-ref "n" ti))))
(if (even? i)
tp
(vadd tp (vmul tn (* grow-t fin-size))))))
"p"))
(set! grow-t (+ grow-t (* d grow-speed)))))
(super-new)))
(clear)
(clear-colour 0.5)
(define profile (build-circle-profile 12 0.5))
(define width (build-list 20
(lambda (n) (* n 0.01 (+ 1.5 (cos (* 0.5 n)))))))
(define path (build-list 20
(lambda (n) (vadd (vector 1 0 0) (vmul (vector (sin (* 0.2 n)) 0 (cos (* 0.2 n))) (* 0.05 n))))))
(define p (with-state
(wire-colour 0)
(colour (vector 1 1 1))
(specular (vector 1 1 1))
(shinyness 20)
(hint-wire)
; (hint-normal)
(build-extrusion profile path width 10 (vector 0 1 0))))
(define fins (build-list 10
(lambda (_)
(let ((f (make-object fin% 0.5 p (vector 1 1 1) (length path) (length profile))))
(send f build)
f))))
(every-frame (for-each
(lambda (f)
(send f update (time) (delta)))
fins))
#;(define (animate)
(with-primitive p
(partial-extrude
(* (* 0.5 (+ 1 (sin (* 1 (time))))) (+ (length path) 5))
profile path width (vector 0 1 0) 0.05)))
#;(every-frame (animate))