(define (head l) (car l)) (define (tail l) (cdr l)) (define (ifsnow a b c d) (let ((p (+ (* a a) (* b b) (* c c) (* d d) 3)) (s60 0.866025403) (c60 0.5)) (ifs-iterate 0 (list (list (/ (* a a) p) (vector a 0 0) (vector 0 a 0)) (list (/ (* b b) p) (vector b 0 0) (vector 0 b a)) (list (/ (* c c) p) (vector (* c60 c) (* s60 c) 0) (vector (* (- 0 s60) c) (* c60 c) a)) (list (/ (* d d) p) (vector (* (- 0 c60) d) (* s60 d) 0) (vector (* (- 0 s60) d) (* (- 0 c60) c) a)) (list (/ 1 p) (vector 1 0 0) (vector 0 -1 0)) (list (/ 1 p) (vector -1 0 0) (vector 0 1 0)) (list (/ 1 p) (vector c60 s60 0) (vector (- 0 s60) c60 0)) )) )) (define (ifs-iterate n t) (cond ((= n 0) (begin (pdata-set "p" n (vector 0 0 1)) (ifs-iterate (+ n 1) t)) ) ((< n (pdata-size)) (let ((z (pdata-get "p" (- n 1)))) (let ((tr (pickprob t (flxrnd)))) (let ((x (car tr)) (y (cadr tr))) (begin (pdata-set "p" n (vector (vdot x z) (vdot y z) 1)) (ifs-iterate (+ n 1) t) ))))) )) (define (pickprob l r) (if (<= r (head (head l))) (tail (head l)) (pickprob (tail l) (- r (head (head l)))) )) (backfacecull 0) (clear-colour (vector 0.2 0.5 0.6)) (clear) (hint-points) ;(hint-unlit) ;(hint-anti-alias) ;(hint-wire) ;(line-width 1) (wire-colour (vector 1 1 1)) (define count 10000) (define l0 0.5) (define l1 0.5) (define l2 0.33) (define l3 0.33) (define pi 3.1415926) (define t 0) (colour (vector 1 1 1)) (define obj (build-particles count)) (define (ifsnow-init n) (if (< n (pdata-size)) (begin (pdata-set "s" n (vector 0.01 0.01 0.01)) ; (pdata-set "c" n (vector 1 1 1)) ;; this line fails an assert (ifsnow-init (+ n 1)) )) ) (grab obj) (ifsnow-init 0) (ungrab) (define (render) (grab obj) (ifsnow l0 l1 l2 l3) (ungrab) (set! t (+ t 0.040)) (set! l0 (+ (* 0.3 (cos (* t 0.5 pi))) 0.5)) (set! l1 (- 1 l0)) (set! l2 (+ (* -0.25 (cos (/ (* t 3 2 pi) 217))) 0.4)) (set! l3 (+ (* -0.25 (cos (/ (* t 4 2 pi) 217))) 0.4)) ) (every-frame (render)) ;(start-framedump "out" "png")