142 lines
4 KiB
Scheme
142 lines
4 KiB
Scheme
|
(clear)
|
||
|
|
|
||
|
|
(define-struct vg (v w h))
|
||
|
|
|
||
|
|
(define (build-vg x y)
|
||
|
|
(make-vg
|
||
|
|
(build-vector (* x y) (lambda (n)
|
||
|
|
(srndvec))) x y))
|
||
|
|
|
||
|
|
(define (vg-ref vg x y)
|
||
|
|
(if (and (>= x 0) (>= y 0) (< x (vg-w vg)) (< y (vg-h vg)))
|
||
|
|
(vector-ref (vg-v vg) (+ (* y (vg-w vg)) x))
|
||
|
|
(vector 0 0 0)))
|
||
|
|
|
||
|
|
(define (vg-lerp vg x y)
|
||
|
|
(let* ((ix (inexact->exact (floor x))) (iy (inexact->exact (floor y)))
|
||
|
|
(fx (- x ix)) (fy (- y iy)))
|
||
|
|
(if (and (>= ix 0) (>= iy 0) (< (+ ix 1) (vg-w vg)) (< (+ iy 1) (vg-h vg)))
|
||
|
|
(let ((a (vector-ref (vg-v vg) (+ (* iy (vg-w vg)) ix)))
|
||
|
|
(b (vector-ref (vg-v vg) (+ (* (+ iy 1) (vg-w vg)) (+ ix 1)))))
|
||
|
|
(vector (+ (* (vx b) fx) (* (vx a) (- 1 fx)))
|
||
|
|
(+ (* (vy b) fy) (* (vy a) (- 1 fy))) 0))
|
||
|
|
(vector 0 0 0))))
|
||
|
|
|
||
|
|
|
||
|
|
(define (vg-set! vg x y s)
|
||
|
|
(when (and (>= x 0) (>= y 0) (< x (vg-w vg)) (< y (vg-h vg)))
|
||
|
|
(vector-set! (vg-v vg) (+ (* y (vg-w vg)) x) s)))
|
||
|
|
|
||
|
|
(define (vg-blend! vg)
|
||
|
|
(for ((x (in-range 0 (vg-w vg))))
|
||
|
|
(for ((y (in-range 0 (vg-h vg))))
|
||
|
|
(vg-set! vg x y
|
||
|
|
(vadd
|
||
|
|
(vmul (vadd
|
||
|
|
(vadd (vg-ref vg (- x 1) y) (vg-ref vg x (- y 1)))
|
||
|
|
(vadd (vg-ref vg (+ x 1) y) (vg-ref vg x (+ y 1))))
|
||
|
|
(/ 1 5))
|
||
|
|
(vmul (vg-ref vg x y) (/ 1 5)))))))
|
||
|
|
|
||
|
|
(define (vg-turbulate! vg s)
|
||
|
|
(for ((x (in-range 0 (vg-w vg))))
|
||
|
|
(for ((y (in-range 0 (vg-h vg))))
|
||
|
|
(vg-set! vg x y
|
||
|
|
(vmul
|
||
|
|
(let ((x (* x 0.3)) (y (* y 0.3)))
|
||
|
|
(vector (- (noise (+ x (time)) y) 0.5)
|
||
|
|
(- (noise (+ x (time)) (+ y 100)) 0.5) 0)) s)))))
|
||
|
|
|
||
|
|
(define (vg-jitter! vg s)
|
||
|
|
(for ((x (in-range 0 (vg-w vg))))
|
||
|
|
(for ((y (in-range 0 (vg-h vg))))
|
||
|
|
(vg-set! vg x y
|
||
|
|
(vadd
|
||
|
|
(vmul
|
||
|
|
(vector (crndf) (crndf) 0) s)
|
||
|
|
(vmul (vg-ref vg x y) (- 1 s)))))))
|
||
|
|
|
||
|
|
|
||
|
|
|
||
|
|
(define (render-vg root vg)
|
||
|
|
(with-state
|
||
|
|
(wire-colour (vector 1 1 1))
|
||
|
|
(hint-none)
|
||
|
|
(hint-wire)
|
||
|
|
(line-width 1)
|
||
|
|
(hint-unlit)
|
||
|
|
(parent root)
|
||
|
|
(for ((x (in-range 0 (vg-w vg))))
|
||
|
|
(for ((y (in-range 0 (vg-h vg))))
|
||
|
|
(let ((p (build-ribbon 2)))
|
||
|
|
(with-primitive p
|
||
|
|
(pdata-set! "p" 0 (vector x y 0))
|
||
|
|
(pdata-set! "p" 1 (vadd (vector x y 0)
|
||
|
|
(vmul (vg-ref vg x y) 1)))))))))
|
||
|
|
|
||
|
|
|
||
|
|
;----------------------------------------------------------------
|
||
|
|
|
||
|
|
|
||
|
|
(define (vg-push-particles vg c)
|
||
|
|
(pdata-map!
|
||
|
|
(lambda (p)
|
||
|
|
(let ((v (vg-lerp vg (vx p) (vy p))))0
|
||
|
|
(if (and (zero? (vx v)) (zero? (vy v)))
|
||
|
|
(vadd c
|
||
|
|
(vmul (vector (crndf) (crndf) 0) 1))
|
||
|
|
(vadd (vadd p (vmul v 0.5))
|
||
|
|
(vmul (vector (crndf) (crndf) 0) 0.1)))))
|
||
|
|
"p"))
|
||
|
|
|
||
|
|
|
||
|
|
(clear)
|
||
|
|
|
||
|
|
(define p (with-state
|
||
|
|
(hint-none)
|
||
|
|
(hint-points)
|
||
|
|
(build-particles 2000)))
|
||
|
|
|
||
|
|
(define rp (with-state
|
||
|
|
(hint-none)
|
||
|
|
(hint-points)
|
||
|
|
(build-particles 2000)))
|
||
|
|
|
||
|
|
|
||
|
|
(with-primitive p
|
||
|
|
(pdata-map!
|
||
|
|
(lambda (p)
|
||
|
|
(vadd (vector 15 15 0) (vmul (vector (crndf) (crndf) 0) 1)))
|
||
|
|
"p")
|
||
|
|
(pdata-map!
|
||
|
|
(lambda (c)
|
||
|
|
(vector 1 1 1))
|
||
|
|
"c"))
|
||
|
|
|
||
|
|
(with-primitive rp
|
||
|
|
(pdata-map!
|
||
|
|
(lambda (p)
|
||
|
|
(vadd (vector 10 15 0) (vmul (vector (crndf) (crndf) 0) 1)))
|
||
|
|
"p")
|
||
|
|
(pdata-map!
|
||
|
|
(lambda (c)
|
||
|
|
(vector 1 0.5 0.5))
|
||
|
|
"c"))
|
||
|
|
|
||
|
|
|
||
|
|
(define r (build-locator))
|
||
|
|
|
||
|
|
(define v (build-vg 30 30))
|
||
|
|
|
||
|
|
(define (animate)
|
||
|
|
|
||
|
|
(with-primitive p
|
||
|
|
(vg-push-particles v (vector 5 15 0)))
|
||
|
|
|
||
|
|
(with-primitive rp
|
||
|
|
(vg-push-particles v (vector 15 15 0)))
|
||
|
|
|
||
|
|
(vg-turbulate! v 5))
|
||
|
|
|
||
|
|
(every-frame (animate))
|