FoAM/groworld
12
0
Fork 0
Code Issues Pull requests Packages Projects Releases Wiki Activity

added sound hooks

Browse source
This commit is contained in:
Dave Griffiths 2009-10-22 14:13:09 +01:00
parent 990736cd5c
commit 1fea628cdf
4 changed files with 58 additions and 16 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

13
plant-eyes/scripts/controller.ss
View file

@ -4,7 +4,8 @@
(require scheme/class
fluxus-016/fluxus
"logic.ss"
"view.ss")
"view.ss"
"sound.ss")
(provide (all-defined-out))
@ -127,13 +128,15 @@
(when (and (key-pressed " ") current-twig-growing)
(let ((vel (vmul fwd (* d -3))))
(when
(not (collide? (list pos (vadd pos vel)) (send game-view get-stones)))
(cond ((not (collide? (list pos (vadd pos vel)) (send game-view get-stones)))
(set! pos (vadd pos vel))
(when (> (vdist last-pos pos) (send current-twig get-dist))
(set! last-pos pos)
(send game-view scrub-marker)
(send player-plant grow (vsub pos player-pos))))))
(send player-plant grow (vsub pos player-pos))))
(else
(play-sound 'growth-collide-with-stone pos)))))
(when (and (not current-twig-growing) (not (key-pressed " ")))
(set! debounce-space #t))
@ -156,6 +159,7 @@
(cond ((< current-point 2)
(cond ((null? twig-stack)
(play-sound 'back-in-seed pos)
(set! current-twig #f)
(set! pos player-pos)
(send (send game-view get-plant (send player-plant get-id)) hide-twigs 1)
@ -193,6 +197,7 @@
; if we are on a twig not growing
(when (and current-twig-growing (not (send current-twig growing?)))
(play-sound 'finished-growing-twig pos)
(send game-view set-grow-mode-off)
(set! current-twig-growing #f)
(set! seed-return #t)

4
plant-eyes/scripts/logic.ss
View file

@ -656,7 +656,7 @@
this
twig
point-index)))))))
(printf "plant ~a has ~a twigs~n" id (length twigs))
;(printf "plant ~a has ~a twigs~n" id (length twigs))
(map
(lambda (twig)
(send (cadr twig) update t d))
@ -777,7 +777,7 @@
; to distribute the cpu load
(define/augment (update t d)
(printf "num pickups ~a~n" (length pickups))
;(printf "num pickups ~a~n" (length pickups))
(run-auto-pilot t d)

26
plant-eyes/scripts/sound.ss
View file

@ -7,9 +7,25 @@
(define audio-on #t)
(when audio-on (oa-start)) ;; start openAL audio
(oa-set-acoustics 1 10000 1 5)
(oa-set-cull-dist 100)
(oa-set-acoustics 1 10000 1 5) ; args: unused, max distance, reference distance, rolloff
(oa-set-cull-dist 100) ; sounds further away than this won't be played
(define (play-sound sound pos freq vol)
(when audio-on (let ((noise (oa-load-sample (fullpath sound))))
(oa-play noise pos freq vol))))
(define (make-noise sound pos freq vol)
(oa-play (oa-load-sample (fullpath sound)) pos freq vol))
(define (play-sound type pos)
;(printf "playing ~a at ~a~n" type pos)
(cond
((eq? type 'worm-idle) (make-noise "snd/event01.wav" pos 1 1))
((eq? type 'spider-idle) (make-noise "snd/event01.wav" pos 1 1))
((eq? type 'butterfly-idle) (make-noise "snd/event01.wav" pos 1 1))
((eq? type 'place-marker) (make-noise "snd/event01.wav" pos 1 1))
((eq? type 'twig-start-growing) (make-noise "snd/event01.wav" pos 1 1))
((eq? type 'twig-start-decay) (make-noise "snd/event01.wav" pos 1 1))
((eq? type 'twig-new-ornament) (make-noise "snd/event01.wav" pos 1 1))
((eq? type 'going-above-ground) (make-noise "snd/event01.wav" pos 1 1))
((eq? type 'going-below-ground) (make-noise "snd/event01.wav" pos 1 1))
((eq? type 'growth-collide-with-stone) (make-noise "snd/event01.wav" pos 1 1))
((eq? type 'back-in-seed) (make-noise "snd/event01.wav" pos 1 1))
((eq? type 'finished-growing-twig) (make-noise "snd/event01.wav" pos 1 1))
))

31
plant-eyes/scripts/view.ss
View file

@ -135,7 +135,8 @@
(to-dir (vector 0 0 0))
(time 0)
(tick 1)
(speed 0))
(speed 0)
(idle-sound-time (+ 2 (* (rndf) 10))))
(define/public (move pos dur)
(set! from to)
@ -145,6 +146,12 @@
(set! time 0)
(set! tick dur))
(define/public (play-idle-sound pos)
(cond
((eq? type 'worm) (play-sound 'worm-idle pos))
((eq? type 'butterfly) (play-sound 'butterfly-idle pos))
((eq? type 'spider) (play-sound 'spider-idle pos))))
(define/public (update t d)
(set! time (+ time d)))
@ -152,10 +159,14 @@
(let* ((t (min (/ time tick) 1))
(h (hermite-tangent from to (vmul from-dir 2) (vmul to-dir 2) t)))
(translate (car h))
(when (< idle-sound-time 0)
(set! idle-sound-time (+ 2 (* (rndf) 10)))
(play-idle-sound (car h)))
(set! speed (vmag (cadr h)))
(concat (maim (vector 0 1 0) (vnormalise (cadr h)))))
(set! time (+ time d)))
(set! time (+ time d))
(set! idle-sound-time (- idle-sound-time d)))
(super-new)))
@ -464,10 +475,14 @@
(< grow-t (+ num-points grow-overshoot)))
(define/public (start-growing)
(play-sound 'twig-start-growing
(with-primitive (get-root) (vtransform (vector 0 0 0) (get-global-transform))))
(set! grow-t 0)
(set! markers (cons (build-locator) markers)))
(define/pubment (start-shrinking)
(play-sound 'twig-start-decay
(with-primitive (get-root) (vtransform (vector 0 0 0) (get-global-transform))))
(set! shrink-t (if (growing?) grow-t (+ num-points grow-overshoot)))
(for-each
(lambda (o)
@ -477,7 +492,8 @@
(define/pubment (add-point point width make-marker)
(when make-marker
(play-sound "snd/event01.wav" point (+ 0.1 (rndf)) 0.3)
(play-sound 'place-marker (vadd point (with-primitive (get-root)
(vtransform (vector 0 0 0) (get-global-transform)))))
(set! markers (append markers (list (let ((p (with-state
(parent (get-root))
(translate point)
@ -498,7 +514,9 @@
(define/public (add-ornament point-index property)
(when (< point-index grow-t)
(play-sound "snd/nix.00203.wav" (get-point point-index) (+ 0.1 (rndf)) 0.3)
(play-sound 'twig-new-ornament
(vadd (get-point point-index)
(with-primitive (get-root) (vtransform (vector 0 0 0) (get-global-transform)))))
(with-state
(parent (get-root))
(let ((ornament (property->ornament property
@ -528,7 +546,8 @@
(when (and (not (eq? grow-t -1)) (< grow-t (+ num-points grow-overshoot)))
(set! grow-t (+ grow-t (* d grow-speed)))
(when (and (not (null? markers)) (> 0 (- marker-destroy-t grow-t)))
; soundtodo: marker gobble
#;(play-sound 'twig-eat-marker
(with-primitive (car markers) (vtransform (vector 0 0 0) (get-global-transform))))
(set! marker-destroy-t (+ 1 marker-destroy-t))
(destroy (car markers))
(set! markers (cdr markers))))
@ -1108,9 +1127,11 @@
"p" "twig" "point" "offset" "speed"))))
(define/public (above-ground)
(play-sound 'going-above-ground pos)
(when dust (send dust set-above-ground #t)))
(define/public (below-ground)
(play-sound 'going-below-ground pos)
(when dust (send dust set-above-ground #f)))
(define/public (update t d)