97 lines
2.9 KiB
Scheme
97 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))
|
||
|
|
|