(require scheme/class) (define (build-ring n sr er) (let ((p (build-polygons (+ (* n 2) 2) 'triangle-strip))) (with-primitive p (pdata-index-map! (lambda (i p) (let ((a (* (/ (quotient i 2) n) (* 2 3.141))) (s (if (odd? i) sr er))) (vector (* (cos a) s) (* (sin a) s) (if (odd? i) 0 1)))) "p") (recalc-normals 1)) p)) (define twig% (class object% (init-field (size 10) (radius 1) (speed 0.2)) (field (root (build-locator)) (child-twigs '()) (age 0) (tx (mident)) (next-ring-time 0)) (define/public (build pos dir) (with-primitive root (translate pos) (if dir (concat (maim (vector 0 0 1) dir)) (rotate (vmul (crndvec) 20))))) (define/public (update) (when (and (< age size) (< next-ring-time (time))) (set! next-ring-time (+ (time) speed)) (with-state (parent root) ;(hint-none) ; (hint-wire) (backfacecull 0) (let* ((s (- size age)) (sr (* radius (/ s size))) (er (* radius (/ (+ s 1) size)))) (translate (vector 0 0 age)) (when (zero? (random 20)) (with-state (identity) (set! child-twigs (cons (make-object twig% (/ size 2) sr speed) child-twigs)) (send (car child-twigs) build (vector 0 0 age) #f))) (build-ring 5 sr er))) (set! age (+ age 1))) (for-each (lambda (child) (send child update)) child-twigs)) (super-new))) (define seed% (class object% (field (twigs '()) (debounce #t) (debounce-time 0)) (define/public (add-twig dir) (let ((t (make-object twig% 100 1 0.01))) (set! twigs (cons (with-state (colour (vector 0.3 0.8 0.4)) (send t build (vector 0 0 0) dir) t) twigs)))) (define/public (update) (when (and debounce (key-pressed " ")) (add-twig (vtransform-rot (vector 0 0 1) (minverse (get-camera-transform)))) (set! debounce #f) (set! debounce-time (+ (time) 1))) (when (> (time) debounce-time) (set! debounce #t)) (for-each (lambda (twig) (send twig update)) twigs)) (super-new))) (clear) (show-axis 1) (clear-colour (vector 0.2 0.5 0.3)) (define s (make-object seed%)) (every-frame (send s update))