192 lines
6.2 KiB
Scheme
192 lines
6.2 KiB
Scheme
(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))
|