From bcb235bd82e567d3e591515b75017ab6c760a998 Mon Sep 17 00:00:00 2001
From: David Thompson <dthompson2@worcester.edu>
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 <sound-effect>
+  (%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
+    (($ <sound-effect> 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))))))))))