(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))