; ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

(define (rndvec)
    (vadd (vector (flxrnd) (flxrnd) (flxrnd)) (vector -0.5 -0.5 -0.5)))

(define (make-particle-system pos)
    (define (init-particles n pos)
        (pdata-set "s" n (vector 1 1 1))
        (pdata-set "p" n pos)
        (pdata-set "age" n (vector (flxrnd) 0 0))
        (pdata-set "c" n (vector 1 1 1))
        (pdata-set "vel" n (vmul (rndvec) 2))
        (if (zero? n)
            0
            (init-particles (- n 1) pos)))
    (let ((p (build-particles 500)))
    (grab p)
    (hint-solid)
    (pdata-add "vel" "v")
    (pdata-add "age" "v")
    (init-particles (pdata-size) pos)
    (ungrab)
    p))

(define (particle-system-mod ps dir)
    (grab ps)
    (pdata-op "+" "vel" dir)
    (ungrab))
    

(define (particle-system-update ps dir)
    (define (update-particles n)
        (cond 
            ((< (vector-ref (pdata-get "age" n) 0) 0.01)
                (pdata-set "p" n (vector 0 0 0))
                (pdata-set "vel" n (vadd (vmul (rndvec) 0.1) dir))
                (pdata-set "age" n (vector (flxrnd) 0 0))))
        (if (zero? n)
            0
            (update-particles (- n 1))))
    (grab ps)
    (update-particles (pdata-size))
    (pdata-op "+" "vel" (vector 0 -0.001 0))
    (pdata-op "+" "p" "vel")
    (pdata-op "*" "age" 0.99)
    (ungrab))

(clear)

(blur 0.1)
(hint-none)
(hint-wire)
(wire-colour (vector 1 1 1))
(line-width 5)

(define ps (make-particle-system (vector 0 0 0)))

(define dir (vector 0 0 0))

(define (render n)
    (when (key-pressed "s") (set! dir (vadd dir (vmul (rndvec) 1))))
    (when (key-pressed "q") (particle-system-mod ps (vector 0 0.01 0)))
    (when (key-pressed "e") (particle-system-mod ps (vector 0 -0.01 0)))
    (when (key-pressed "z") (particle-system-mod ps (vector 0 0 0.01)))
    (when (key-pressed "c") (particle-system-mod ps (vector 0 0 -0.01)))
    (when (key-special-pressed 100) (set! dir (vadd dir (vector -0.5 0 0))))
    (when (key-special-pressed 102) (set! dir (vadd dir (vector 0.5 0 0))))
    (when (key-special-pressed 101) (set! dir (vadd dir (vector 0 0.5 0))))
    (when (key-special-pressed 103) (set! dir (vadd dir (vector 0 -0.5 0))))

    (particle-system-update ps dir)
    (set! dir (vmul dir 0.9)))

(every-frame (render 10))