(require fluxus-016/fluxa)
(clear)

(define texture-loc "/home/dave/flotsam/groworld/game-prototypes/mingle/textures/")

;----------------------------------------------------------------

(define t 0)

(define (vg-npush-particles)
    (set! t (+ t 0.04))
    (pdata-map! 
        (lambda (p)
            (let* ((pp (vmul p 0.1))
                    (v (vector (- (noise (vx pp) (vy pp) (time)) 0.5)
                            (- (noise (vx pp) (+ (vy pp) 112.3) t) 0.5) 0)))
                (vadd (vadd p (vmul v 1))
                    (vmul (vector (crndf) (crndf) 0) 0.05))))
        "p"))

(define (cirndvec)
    (let ((o (srndvec)))
        (vector (vx o) (vy o) 0)))

(define (puff pos col size np)
    (for ((i (in-range 0 np)))
        (let ((c (random (pdata-size))))
            (pdata-set! "p" c (vadd (vmul (cirndvec) size) pos))
            (pdata-set! "c" c (vadd col (vmul (grndvec) 0.2))))))


;-------------

(define-struct flower (pos tex col root rot 
        (sc #:mutable) (power #:mutable) (r #:mutable)))

(define (build-flower pos tex col)
    (let ((pos (vadd pos (vmul (cirndvec) 1))))
        (make-flower pos tex col (with-state
                (translate pos)
                (hint-unlit)
                (scale 3)
                ;            (colour col)    
                (texture (load-texture tex))
                (build-plane))
            (* (crndf) 0.5)
            1
            100
            0)))

(define (flower-puff flower particles)
    (set-flower-sc! flower 2)
    (with-primitive particles
        (puff (flower-pos flower) (flower-col flower) 1 (flower-power flower))
        (when (> (flower-power flower) 0)
            (set-flower-power! flower (- (flower-power flower) 5)))))

(define (flower-update flower particles do-puff)
    (with-primitive (flower-root flower)
        (identity)
        (translate (flower-pos flower))
        (scale 3)
        (when (> (flower-sc flower) 1)
            (set-flower-sc! flower (* (flower-sc flower) 0.9))
            (scale (* (flower-sc flower) 1))
            (colour (flower-sc flower)))
        
        (set-flower-r! flower (+ (flower-r flower) (flower-rot flower)))
        (rotate (vector 0 0 (flower-r flower))))
    (when (< (flower-power flower) 100) 
        (set-flower-power! flower (+ (flower-power flower) 1))))

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

(define debounce-vec (build-vector 10 (lambda (_) #f)))

(define (debounce n)
    (vector-ref debounce-vec n))

(define (debounce! n s)
    (vector-set! debounce-vec n s))

(define (on-key p n proc)
    (if p
        (when (debounce n)
            (proc)
            (debounce! n #f))
        (debounce! n #t)))

;--------------

(clear)

(define f (list
        (build-flower (vector -5 5 0) (string-append texture-loc "wflower1.png") (vector 1 0.5 0.6))
        (build-flower (vector 0 5 0) (string-append texture-loc "wflower2.png") (vector 0.6 0 0.6))
        (build-flower (vector 5 5 0) (string-append texture-loc "wflower3.png") (vector 1 1 0))
        
        (build-flower (vector -5 0 0) (string-append texture-loc "wflower4.png") (vector 1 1 0.9))
        (build-flower (vector 0 0 0) (string-append texture-loc "wflower5.png") (vector 0.6 0.6 1))
        (build-flower (vector 5 0 0) (string-append texture-loc "wflower6.png") (vector 0.5 0.5 0.5))
        
        (build-flower (vector -5 -5 0) (string-append texture-loc "wflower7.png") (vector 0.5 0.2 0.1))
        (build-flower (vector 0 -5 0) (string-append texture-loc "wflower8.png") (vector 0.5 0.5 1))
        (build-flower (vector 5 -5 0) (string-append texture-loc "wflower9.png") (vector 1 1 1))))


(define p (with-state
        (texture (load-texture (string-append texture-loc "particle.png")))
        (build-particles 3000)))

(with-primitive p
    (opacity 0.5)
    (hint-ignore-depth)
    (pdata-map!
        (lambda (p)
            (vmul (vector (crndf) (crndf) 0) 100))
        "p")
    (pdata-map!
        (lambda (c)
            (vector 1 1 1 0.5))
        "c")
    (pdata-map!
        (lambda (c)
            (let ((s (* 0.5 (grndf))))
                (vector s s 1)))
        "s"))


;-------------


(define (animate)
    (on-key (key-pressed "q") 0 
        (lambda () 
            (play-now (mul (adsr 0 0.1 0.1 1) 
                    (mul (sine (add 20 (mul (adsr 0 0.05 0 0) 3))) 4)))
            (flower-puff (list-ref f 0) p)))
    (on-key (key-special-pressed 101) 1
        (lambda () 
            (play-now (mul (adsr 0 0.1 0.1 1) (sine (add 100 (mul (sine 10) 3000)))))
            (flower-puff (list-ref f 1) p)))
    (on-key (key-pressed "e") 2
        (lambda () 
            (play-now (mul (adsr 0 0.1 0.1 1) (mooglp (add (saw 41) (saw 40)) (adsr 0.1 0 0 0) 0.4)))
            (flower-puff (list-ref f 2) p)))
    
    (on-key (key-special-pressed 100) 3
        (lambda () 
            (play-now (mul (adsr 0 0.1 0.1 1) 
                    (sine (add 100 (mul (sine 100) (mul (adsr 0.2 0.2 0 0) 3000))))))
            (flower-puff (list-ref f 3) p)))
    (on-key (key-pressed "s") 4
        (lambda () 
            (play-now (mul (adsr 0 0.05 0 0) (pink 4)))
            (flower-puff (list-ref f 4) p)))
    (on-key (key-special-pressed 102) 5
        (lambda () 
            (play-now (mul (adsr 0 0.1 0.1 1) (moogbp (add (saw 81) (saw 81.1)) (adsr 0.1 0 0 0) 0.4)))
            (flower-puff (list-ref f 5) p)))
    
    (on-key (key-pressed "z") 6
        (lambda () 
            (play-now (mul (adsr 0 0.1 0.1 1) 
                    (sine (+ (random 100) 100))))
            (flower-puff (list-ref f 6) p)))
    (on-key (key-special-pressed 103) 7
        (lambda () 
            (play-now (mul (adsr 0.2 0.1 0.1 1) 
                (sine (add 100 (mul (sine 100) (mul (sine 5) 300))))))

            (flower-puff (list-ref f 7) p)))
    (on-key (key-pressed "c") 8
        (lambda () 
            (let ((n (+ (random 100) 50)))
            (play-now (echo 
                (mul (adsr 0 0.05 0.1 1) 
                    (mul (add (squ (+ n 0.1)) (squ n)) 0.3))
                0.1 0.6)))

            (flower-puff (list-ref f 8) p)))
    
    (for-each 
        (lambda (flower)
            (flower-update flower p (mouse-button 1)))
        f)
    
    (with-primitive p 
        (vg-npush-particles)))

(every-frame (animate))