From bcb235bd82e567d3e591515b75017ab6c760a998 Mon Sep 17 00:00:00 2001 From: David Thompson Date: Wed, 22 May 2024 21:30:06 -0400 Subject: [PATCH] Allow the same sound effect to be played many times simultaneously. --- game.scm | 21 ++++++++++----------- modules/game/audio.scm | 40 ++++++++++++++++++++++++++++++++++++++++ 2 files changed, 50 insertions(+), 11 deletions(-) create mode 100644 modules/game/audio.scm diff --git a/game.scm b/game.scm index 444a9bc..6155e35 100644 --- a/game.scm +++ b/game.scm @@ -26,6 +26,7 @@ (dom media) (dom window) (game actors) + (game audio) (game level) (game levels level-1) (game levels level-2) @@ -58,9 +59,7 @@ (inexact->exact tile-width) (inexact->exact tile-height))) (define* (load-sound-effect name #:key (volume 0.25)) - (let ((audio (make-audio (string-append "assets/sounds/" name ".wav")))) - (set-media-volume! audio volume) - audio)) + (make-sound-effect (string-append "assets/sounds/" name ".wav"))) (define audio:bump (load-sound-effect "bump")) (define audio:push (load-sound-effect "push")) (define audio:undo (load-sound-effect "undo")) @@ -97,11 +96,11 @@ (set! *snapshots* (cons (copy-whactormap *actormap*) *snapshots*))) (define (rollback-snapshot!) (match *snapshots* - (() (media-play audio:no)) + (() (play-sound-effect audio:no)) ((snapshot . older-snapshots) (set! *actormap* snapshot) (set! *snapshots* older-snapshots) - (media-play audio:undo)))) + (play-sound-effect audio:undo)))) (define (sort lst compare) (match lst @@ -210,19 +209,19 @@ (let ((result (match ($ player 'event) (('bump) - (media-play audio:bump) + (play-sound-effect audio:bump) #f) (('push) - (media-play audio:push) + (play-sound-effect audio:push) #f) (('exit) - (media-play audio:exit) + (play-sound-effect audio:exit) 'next-level) (('die) - (media-play audio:die) + (play-sound-effect audio:die) #f) (('gem) - (media-play audio:pickup) + (play-sound-effect audio:pickup) ;; TODO: Maybe show a little achievement popup when all gems ;; are collected? (set! *gems* (cons *level-idx* *gems*)) @@ -232,7 +231,7 @@ (save-snapshot!) result)) (begin - (media-play audio:no) + (play-sound-effect audio:no) #f))))) (when (eq? (do-move) 'next-level) (next-level!))) diff --git a/modules/game/audio.scm b/modules/game/audio.scm new file mode 100644 index 0000000..59f9be7 --- /dev/null +++ b/modules/game/audio.scm @@ -0,0 +1,40 @@ +(define-module (game audio) + #:use-module (dom element) + #:use-module (dom media) + #:use-module (ice-9 match) + #:use-module (srfi srfi-9) + #:export (make-sound-effect + sound-effect? + sound-effect-src + play-sound-effect)) + +(define-record-type + (%make-sound-effect src elems) + sound-effect? + (src sound-effect-src) + (elems sound-effect-elems)) + +(define max-simultaneous 8) + +(define (make-sound-effect src) + (let ((elems (make-vector max-simultaneous #f))) + (vector-set! elems 0 (make-audio src)) + (%make-sound-effect src elems))) + +(define* (play-sound-effect sound #:optional (volume 0.5)) + (define (play elem) + (set-media-volume! elem volume) + (media-play elem)) + (match sound + (($ src elems) + (let lp ((i 0)) + (when (< i max-simultaneous) + (match (vector-ref elems i) + (#f + (let ((elem (clone-element (vector-ref elems 0)))) + (vector-set! elems i elem) + (play elem))) + (elem + (if (media-ended? elem) + (play elem) + (lp (1+ i))))))))))