summaryrefslogtreecommitdiff
path: root/chickadee/audio.scm
diff options
context:
space:
mode:
Diffstat (limited to 'chickadee/audio.scm')
-rw-r--r--chickadee/audio.scm763
1 files changed, 763 insertions, 0 deletions
diff --git a/chickadee/audio.scm b/chickadee/audio.scm
new file mode 100644
index 0000000..aa56dac
--- /dev/null
+++ b/chickadee/audio.scm
@@ -0,0 +1,763 @@
+;;; Chickadee Game Toolkit
+;;; Copyright © 2020, 2019 David Thompson <davet@gnu.org>
+;;;
+;;; Chickadee is free software: you can redistribute it and/or modify
+;;; it under the terms of the GNU General Public License as published
+;;; by the Free Software Foundation, either version 3 of the License,
+;;; or (at your option) any later version.
+;;;
+;;; Chickadee is distributed in the hope that it will be useful, but
+;;; WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+;;; General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU General Public License
+;;; along with this program. If not, see
+;;; <http://www.gnu.org/licenses/>.
+
+;;; Commentary:
+;;
+;; Audio API.
+;;
+;;; Code:
+
+(define-module (chickadee audio)
+ #:use-module (chickadee array-list)
+ #:use-module (chickadee audio mpg123)
+ #:use-module ((chickadee audio openal) #:prefix openal:)
+ #:use-module (chickadee audio vorbis)
+ #:use-module (chickadee audio wav)
+ #:use-module (chickadee math)
+ #:use-module (chickadee math vector)
+ #:use-module (ice-9 format)
+ #:use-module (ice-9 match)
+ #:use-module (rnrs bytevectors)
+ #:use-module (srfi srfi-1)
+ #:use-module (srfi srfi-9)
+ #:use-module (srfi srfi-9 gnu)
+ #:export (init-audio
+ quit-audio
+ update-audio
+ load-audio
+ audio?
+ streaming-audio?
+ static-audio?
+ audio-mode
+ audio-duration
+ audio-bits-per-sample
+ audio-channels
+ audio-sample-rate
+ audio-play
+ make-source
+ source?
+ streaming-source?
+ static-source?
+ source-playing?
+ source-paused?
+ source-stopped?
+ source-pitch
+ source-volume
+ source-min-volume
+ source-max-volume
+ source-max-distance
+ source-reference-distance
+ source-rolloff-factor
+ source-cone-outer-volume
+ source-cone-inner-angle
+ source-cone-outer-angle
+ source-position
+ source-velocity
+ source-direction
+ source-relative?
+ source-play
+ source-pause
+ source-toggle
+ source-stop
+ source-rewind
+ set-source-audio!
+ set-source-loop!
+ set-source-pitch!
+ set-source-volume!
+ set-source-min-volume!
+ set-source-max-volume!
+ set-source-max-distance!
+ set-source-reference-distance!
+ set-source-rolloff-factor!
+ set-source-cone-outer-volume!
+ set-source-cone-inner-angle!
+ set-source-cone-outer-angle!
+ set-source-position!
+ set-source-velocity!
+ set-source-direction!
+ set-source-relative!)
+ #:re-export ((openal:listener-volume . listener-volume)
+ (openal:listener-position . listener-position)
+ (openal:listener-velocity . listener-velocity)
+ (openal:listener-orientation . listener-orientation)
+ (openal:set-listener-volume! . set-listener-volume!)
+ (openal:set-listener-position! . set-listener-position!)
+ (openal:set-listener-velocity! . set-listener-velocity!)
+ (openal:set-listener-orientation! . set-listener-orientation!)
+ (openal:doppler-factor . doppler-factor)
+ (openal:speed-of-sound . speed-of-sound)
+ (openal:distance-model . distance-model)
+ (openal:set-doppler-factor! . set-doppler-factor!)
+ (openal:set-speed-of-sound! . set-speed-of-sound!)
+ (openal:set-distance-model! . set-distance-model!)))
+
+(define %default-cone-outer-angle (* 2.0 pi))
+(define %default-max-distance (expt 2 31))
+
+(define-record-type <audio>
+ (%make-audio mode bv duration bits-per-sample channels sample-rate
+ decode-proc seek-proc close-proc)
+ audio?
+ (mode audio-mode)
+ (bv audio-bv)
+ (static-length audio-static-length set-audio-static-length!)
+ (duration audio-duration)
+ (bits-per-sample audio-bits-per-sample)
+ (channels audio-channels)
+ (sample-rate audio-sample-rate)
+ (decode-proc audio-decode-proc)
+ (seek-proc audio-seek-proc)
+ (close-proc audio-close-proc))
+
+(define-record-type <source>
+ (%make-source audio openal-source)
+ source?
+ (audio source-audio %set-source-audio!)
+ (openal-source source-openal-source)
+ (loop? source-loop? %set-source-loop!)
+ (pitch source-pitch %set-source-pitch!)
+ (volume source-volume %set-source-volume!)
+ (min-volume source-min-volume %set-source-min-volume!)
+ (max-volume source-max-volume %set-source-max-volume!)
+ (max-distance source-max-distance %set-source-max-distance!)
+ (reference-distance source-reference-distance %set-source-reference-distance!)
+ (rolloff-factor source-rolloff-factor %set-source-rolloff-factor!)
+ (cone-outer-volume source-cone-outer-volume %set-source-cone-outer-volume!)
+ (cone-inner-angle source-cone-inner-angle %set-source-cone-inner-angle!)
+ (cone-outer-angle source-cone-outer-angle %set-source-cone-outer-angle!)
+ (position source-position %set-source-position!)
+ (velocity source-velocity %set-source-velocity!)
+ (direction source-direction %set-source-direction!)
+ (relative? source-relative? %set-source-relative!))
+
+(define-record-type <sound-system> ; gonna bring me back home
+ (%make-sound-system openal-context free-buffers used-buffers
+ sources streaming-sources free-sources used-sources
+ guardian)
+ sound-system?
+ (openal-context sound-system-openal-context)
+ (free-buffers sound-system-free-buffers)
+ (used-buffers sound-system-used-buffers)
+ (sources sound-system-sources)
+ (streaming-sources sound-system-streaming-sources)
+ ;; free/used temp sources for audio-play procedure.
+ (free-sources sound-system-free-sources)
+ (used-sources sound-system-used-sources)
+ (guardian sound-system-guardian))
+
+(define (make-sound-system)
+ (%make-sound-system (openal:make-context (openal:open-device))
+ (make-array-list)
+ (make-hash-table)
+ (make-weak-key-hash-table)
+ (make-hash-table)
+ (make-array-list)
+ (make-hash-table)
+ (make-guardian)))
+
+(define (register-source sound-system source)
+ (hashq-set! (sound-system-sources sound-system) source source)
+ ((sound-system-guardian sound-system) source))
+
+(define (borrow-buffer sound-system)
+ (let* ((free (sound-system-free-buffers sound-system))
+ (used (sound-system-used-buffers sound-system))
+ (buffer (if (array-list-empty? free)
+ (openal:make-buffer)
+ (array-list-pop! free))))
+ (hashv-set! used (openal:buffer-id buffer) buffer)))
+
+(define (return-buffer sound-system buffer-id)
+ (let* ((free (sound-system-free-buffers sound-system))
+ (used (sound-system-used-buffers sound-system))
+ (buffer (hashv-ref used buffer-id)))
+ (hashv-remove! used buffer-id)
+ (array-list-push! free buffer)))
+
+(define (borrow-source sound-system)
+ (let* ((free (sound-system-free-sources sound-system))
+ (used (sound-system-used-sources sound-system))
+ (source (if (array-list-empty? free)
+ (make-source)
+ (array-list-pop! free))))
+ (hashq-set! used source source)))
+
+(define (return-source sound-system source)
+ (let ((free (sound-system-free-sources sound-system))
+ (used (sound-system-used-sources sound-system)))
+ (when (hashq-remove! used source)
+ (array-list-push! free source))))
+
+(define (start-sound-system sound-system)
+ (openal:set-current-context! (sound-system-openal-context sound-system))
+ (mpg123-init))
+
+(define (stop-sound-system sound-system)
+ (let ((context (sound-system-openal-context sound-system)))
+ ;; Delete sources.
+ (hash-for-each (lambda (key source)
+ (openal:delete-source (source-openal-source source)))
+ (sound-system-sources sound-system))
+ ;; Delete buffers.
+ (array-list-for-each (lambda (i buffer)
+ (openal:delete-buffer buffer))
+ (sound-system-free-buffers sound-system))
+ (hash-for-each (lambda (id buffer)
+ (openal:delete-buffer buffer))
+ (sound-system-used-buffers sound-system))
+ ;; Delete context.
+ (openal:set-current-context! #f)
+ (openal:destroy-context context)
+ (openal:close-device (openal:context-device context))))
+
+(define (update-sound-system sound-system)
+ ;; TODO: Audio should really be handled on a dedicated thread, but
+ ;; that's a task for another day/year.
+ ;;
+ ;; Feed chunks of audio data to streaming sources that need more
+ ;; data.
+ (let ((streaming-sources (sound-system-streaming-sources sound-system)))
+ (hash-for-each (lambda (key source)
+ (let loop ()
+ ;; Unqueue a buffer that has been played, if
+ ;; there is one.
+ (when (source-flush-buffer source)
+ ;; Replace the unqueued buffer with the next
+ ;; chunk of audio. If there is nothing left
+ ;; to decode, remove the source from the list
+ ;; of actively streaming sources.
+ (if (source-buffer/stream source)
+ (loop)
+ (hashq-remove! streaming-sources source)))))
+ streaming-sources))
+ ;; Check if any borrowed sources (used for audio-play procedure) are
+ ;; stopped and return them to the queue for reuse.
+ (hash-for-each (lambda (key source)
+ (when (source-stopped? source)
+ (return-source sound-system source)))
+ (sound-system-used-sources sound-system))
+ ;; Delete OpenAL sources associated with sounds that are ready to be
+ ;; GC'd.
+ (let ((guardian (sound-system-guardian sound-system)))
+ (let loop ((source (guardian)))
+ (when source
+ (when (streaming-source? source)
+ ;; Clean up audio resources, like open file handles.
+ (audio-close (source-audio source))
+ ;; Ensuring that the source is stopped means that we can
+ ;; reliably reclaim all buffers still attached to the source
+ ;; before we delete it, otherwise we could leak memory
+ ;; because the buffers never make it back into the buffer
+ ;; pool.
+ (openal:source-stop (source-openal-source source))
+ (let loop ()
+ (and (source-flush-buffer source) (loop))))
+ (openal:delete-source (source-openal-source source))
+ (loop (guardian))))))
+
+(define (stop-all-sources sound-system)
+ (hash-for-each (lambda (key source)
+ (source-stop source))
+ (sound-system-sources sound-system)))
+
+(define (add-streaming-source sound-system source)
+ (hashq-set! (sound-system-streaming-sources sound-system) source source)
+ ;; Initialize the source's queue with a bunch of buffers, enough to
+ ;; keep OpenAL busy until the next sound system update.
+ ;; update-audio-system will add new buffers as they are unqueued
+ ;; later.
+ (let loop ((i 0))
+ (when (< i 8) ; TODO: allow variable number of buffers?
+ (source-buffer/stream source)
+ (loop (+ i 1)))))
+
+(define (remove-streaming-source sound-system source)
+ ;; Flush buffers.
+ (let loop ()
+ (and (source-flush-buffer source) (loop)))
+ ;; Remove from actively playing sources.
+ (hashq-remove! (sound-system-streaming-sources sound-system) source))
+
+(define current-sound-system (make-parameter #f))
+
+(define (init-audio)
+ "Initialize audio system."
+ (let ((sound-system (make-sound-system)))
+ (start-sound-system sound-system)
+ (current-sound-system sound-system)))
+
+(define (quit-audio)
+ "Stop audio system."
+ (let ((sound-system (current-sound-system)))
+ (when sound-system
+ (stop-sound-system sound-system)
+ (current-sound-system #f))))
+
+(define (update-audio)
+ "Update audio system."
+ (update-sound-system (current-sound-system)))
+
+(define* (make-source #:key
+ audio
+ loop?
+ (pitch 1.0)
+ (volume 1.0)
+ (min-volume 0.0)
+ (max-volume 1.0)
+ (max-distance %default-max-distance)
+ (reference-distance 0.0)
+ (rolloff-factor 1.0)
+ (cone-outer-volume 0.0)
+ (cone-inner-angle 0.0)
+ (cone-outer-angle %default-cone-outer-angle)
+ (position (vec3 0.0 0.0 0.0))
+ (velocity (vec3 0.0 0.0 0.0))
+ (direction (vec3 0.0 0.0 0.0))
+ relative?)
+ "Return a new audio source. AUDIO is the audio data to use when
+playing. LOOP? specifies whether or not to loop the audio during
+playback. PITCH is a scalar that modifies the pitch of the audio
+data. VOLUME is a scalar that modifies the volume of the audio data.
+
+For 3D audio representation, many other arguments are available.
+POSITION is a 3D vector. VELOCITY is a 3D vector. DIRECTION is a 3D
+vector. RELATIVE? specifies whether or not to consider the source
+position as relative to the listener or as an absolute value."
+ (let ((source (%make-source audio (openal:make-source))))
+ (register-source (current-sound-system) source)
+ (set-source-loop! source loop?)
+ (set-source-pitch! source pitch)
+ (set-source-volume! source volume)
+ (set-source-min-volume! source min-volume)
+ (set-source-max-volume! source max-volume)
+ (set-source-max-distance! source max-distance)
+ (set-source-reference-distance! source reference-distance)
+ (set-source-rolloff-factor! source rolloff-factor)
+ (set-source-cone-outer-volume! source cone-outer-volume)
+ (set-source-cone-inner-angle! source cone-inner-angle)
+ (set-source-cone-outer-angle! source cone-outer-angle)
+ (set-source-position! source position)
+ (set-source-velocity! source velocity)
+ (set-source-direction! source direction)
+ (set-source-relative! source relative?)
+ source))
+
+(define (streaming-source? source)
+ "Return #t if SOURCE is currently configured with streaming audio
+data."
+ (let ((audio (source-audio source)))
+ (and audio (streaming-audio? audio))))
+
+(define (static-source? source)
+ "Return #t if SOURCE is currently configured with static audio data"
+ (let ((audio (source-audio source)))
+ (and audio (static-audio? audio))))
+
+(define (set-source-audio! source audio)
+ "Set the playback stream for SOURCE to AUDIO."
+ (%set-source-audio! source audio)
+ (when (static-audio? audio)
+ (source-buffer/static source)))
+
+(define (source-play source)
+ "Begin/resume playback of SOURCE."
+ (unless (source-playing? source)
+ (openal:source-play (source-openal-source source))
+ (when (streaming-source? source)
+ (add-streaming-source (current-sound-system) source))))
+
+(define (source-pause source)
+ "Pause playback of SOURCE."
+ (openal:source-pause (source-openal-source source)))
+
+(define (source-toggle source)
+ "Play SOURCE if it is currently paused or pause SOURCE if it is
+currently playing."
+ (if (source-playing? source)
+ (source-pause source)
+ (source-play source)))
+
+(define* (source-stop #:optional source)
+ "Stop playing SOURCE or, if no source is specified, stop playing *all*
+sources."
+ (cond
+ ((not source)
+ (stop-all-sources (current-sound-system)))
+ ((streaming-source? source)
+ (openal:source-stop (source-openal-source source))
+ (audio-seek (source-audio source) 0)
+ (remove-streaming-source (current-sound-system) source))
+ (else
+ (openal:source-stop (source-openal-source source)))))
+
+(define (source-rewind source)
+ "Rewind SOURCE back to the beginning."
+ (if (streaming-source? source)
+ (audio-seek (source-audio source) 0)
+ (openal:source-rewind (source-openal-source source))))
+
+(define (source-playing? source)
+ "Return #t if SOURCE is currently playing."
+ (eq? (openal:source-state (source-openal-source source)) 'playing))
+
+(define (source-paused? source)
+ "Return #t if SOURCE is currently paused."
+ (eq? (openal:source-state (source-openal-source source)) 'paused))
+
+(define (source-stopped? source)
+ "Return #t if SOURCE is currently stopped."
+ (eq? (openal:source-state (source-openal-source source)) 'stopped))
+
+(define (set-source-loop! source loop?)
+ "Configure whether or not SOURCE should loop the audio stream."
+ (%set-source-pitch! source loop?)
+ (openal:set-source-looping! (source-openal-source source) loop?))
+
+(define (set-source-pitch! source pitch)
+ "Set the pitch multiplier for SOURCE to PITCH."
+ (unless (>= pitch 0.0)
+ (error "pitch must be a positive number" pitch))
+ (%set-source-pitch! source pitch)
+ (openal:set-source-property! (source-openal-source source) 'pitch pitch))
+
+(define (set-source-volume! source volume)
+ "Set the volume of SOURCE to VOLUME. A value of 1.0 is 100% volume."
+ (unless (>= volume 0.0)
+ (error "volume must be a positive number" volume))
+ (%set-source-volume! source volume)
+ (openal:set-source-property! (source-openal-source source) 'gain volume))
+
+(define (set-source-min-volume! source volume)
+ "Set the minimum volume of SOURCE to VOLUME."
+ (unless (>= volume 0.0)
+ (error "minimum volume must be a positive number" volume))
+ (%set-source-min-volume! source volume)
+ (openal:set-source-property! (source-openal-source source) 'min-gain volume))
+
+(define (set-source-max-volume! source volume)
+ "Set the maximum volume of SOURCE to VOLUME."
+ (unless (>= volume 0.0)
+ (error "maximum volume must be a positive number" volume))
+ (%set-source-max-volume! source volume)
+ (openal:set-source-property! (source-openal-source source) 'max-gain volume))
+
+(define (set-source-max-distance! source distance)
+ "Set the distance where there will no longer be any attenuation of
+SOURCE to DISTANCE."
+ (%set-source-max-distance! source distance)
+ (openal:set-source-property! (source-openal-source source) 'max-distance distance))
+
+(define (set-source-reference-distance! source distance)
+ "Set the reference distance of SOURCE to DISTANCE."
+ (%set-source-reference-distance! source distance)
+ (openal:set-source-property! (source-openal-source source) 'reference-distance distance))
+
+(define (set-source-rolloff-factor! source factor)
+ "Set the rolloff factor of SOURCE to FACTOR."
+ (%set-source-rolloff-factor! source factor)
+ (openal:set-source-property! (source-openal-source source) 'rolloff-factor factor))
+
+(define (set-source-cone-outer-volume! source volume)
+ "Set the volume of SOURCE when outside the sound cone to VOLUME."
+ (unless (>= volume 0.0)
+ (error "cone outer volume must be a positive number" volume))
+ (%set-source-cone-outer-volume! source volume)
+ (openal:set-source-property! (source-openal-source source) 'cone-outer-gain volume))
+
+(define (set-source-cone-inner-angle! source angle)
+ "Set the inner angle of the source cone of SOURCE to ANGLE radians."
+ (%set-source-cone-inner-angle! source angle)
+ (openal:set-source-property! (source-openal-source source)
+ 'cone-inner-angle
+ (radians->degrees angle)))
+
+(define (set-source-cone-outer-angle! source angle)
+ "Set the outer angle of the source cone of SOURCE to ANGLE radians."
+ (%set-source-cone-outer-angle! source angle)
+ (openal:set-source-property! (source-openal-source source)
+ 'cone-outer-angle
+ (radians->degrees angle)))
+
+(define (set-source-position! source position)
+ "Set the position of SOURCE to the 3D vector POSITION."
+ (%set-source-position! source position)
+ (openal:set-source-property! (source-openal-source source) 'position position))
+
+(define (set-source-velocity! source velocity)
+ "Set the velocity of SOURCE to the 3D vector VELOCITY."
+ (%set-source-velocity! source velocity)
+ (openal:set-source-property! (source-openal-source source) 'velocity velocity))
+
+(define (set-source-direction! source direction)
+ "Set the direction of SOURCE to the 3D vector DIRECTION."
+ (%set-source-direction! source direction)
+ (openal:set-source-property! (source-openal-source source) 'direction direction))
+
+(define (set-source-relative! source relative?)
+ "If RELATIVE? is #t, set the position of SOURCE to be relative to the
+listener. Otherwise, the position is in absolute coordinates."
+ (%set-source-relative! source relative?)
+ (openal:set-source-property! (source-openal-source source) 'relative relative?))
+
+(define (source-flush-buffer source)
+ (let* ((openal-source (source-openal-source source))
+ (processed (openal:source-buffers-processed openal-source)))
+ (if (> processed 0)
+ (let* ((buffer-id (openal:source-unqueue-buffer openal-source)))
+ (return-buffer (current-sound-system) buffer-id)
+ #t)
+ #f)))
+
+(define (source-buffer/static source)
+ (let* ((audio (source-audio source))
+ (buffer (borrow-buffer (current-sound-system)))
+ (bv (audio-bv audio))
+ (length (audio-static-length audio))
+ (format (audio-format audio))
+ (sample-rate (audio-sample-rate audio)))
+ (openal:set-buffer-data! buffer bv length format sample-rate)
+ (openal:set-source-buffer! (source-openal-source source) buffer)))
+
+(define (source-buffer/stream source)
+ (let* ((audio (source-audio source)))
+ (define (next)
+ (call-with-values (lambda () (audio-decode audio))
+ (lambda (chunk length)
+ (cond
+ ((> length 0)
+ (let ((format (audio-format audio))
+ (sample-rate (audio-sample-rate audio))
+ (buffer (borrow-buffer (current-sound-system))))
+ (openal:set-buffer-data! buffer chunk length format sample-rate)
+ (openal:source-queue-buffer (source-openal-source source) buffer)
+ (when (source-stopped? source)
+ (source-play source))
+ #t))
+ ((source-loop? source)
+ ;; Reset back to the beginning and try again.
+ (audio-seek audio 0)
+ (next))
+ ;; ight imma head out (if the git history is lost,
+ ;; researchers will be able to accurately date the code
+ ;; based upon this meme)
+ (else #f)))))
+ (next)))
+
+(define* (make-audio #:key
+ mode
+ (buffer-size 4096)
+ bits-per-sample
+ channels
+ duration
+ sample-rate
+ decode
+ seek
+ close)
+ (let* ((bv-size (if (eq? mode 'stream)
+ buffer-size
+ ;; Make a buffer big enough to hold the entire
+ ;; decoded audio stream.
+ (inexact->exact
+ (ceiling
+ (* duration
+ (/ bits-per-sample 8)
+ channels
+ sample-rate
+ ;; XXX: Adding extra padding because vorbis files
+ ;; seem to lie about how many audio samples there
+ ;; are.
+ 1.1)))))
+ (audio (%make-audio mode
+ (make-bytevector bv-size)
+ duration
+ bits-per-sample
+ channels
+ sample-rate
+ decode
+ seek
+ close)))
+ (when (eq? mode 'static)
+ (call-with-values (lambda () (audio-decode audio))
+ (lambda (bv length)
+ (set-audio-static-length! audio length)))
+ (audio-close audio))
+ audio))
+
+(define (display-audio audio port)
+ (format port "#<audio mode: ~a duration: ~f bits-per-sample: ~d sample-rate: ~d>"
+ (audio-mode audio)
+ (audio-duration audio)
+ (audio-bits-per-sample audio)
+ (audio-sample-rate audio)))
+
+(set-record-type-printer! <audio> display-audio)
+
+(define (streaming-audio? audio)
+ "Return #t if AUDIO is in streaming mode."
+ (eq? (audio-mode audio) 'stream))
+
+(define (static-audio? audio)
+ "Return #t if AUDIO is in static mode."
+ (eq? (audio-mode audio) 'static))
+
+(define (audio-format audio)
+ (let ((channels (audio-channels audio))
+ (bits-per-sample (audio-bits-per-sample audio)))
+ (cond
+ ((and (= channels 1)
+ (= bits-per-sample 16))
+ 'mono-16)
+ ((and (= channels 1)
+ (= bits-per-sample 8))
+ 'mono-8)
+ ((and (= channels 2)
+ (= bits-per-sample 16))
+ 'stereo-16)
+ ((and (= channels 2)
+ (= bits-per-sample 8))
+ 'stereo-8)
+ (else
+ (error "unsupported audio format" channels bits-per-sample)))))
+
+(define (audio-decode audio)
+ (define (nearest-multiple-of-4 x)
+ (let ((remainder (modulo x 4)))
+ (if (zero? remainder)
+ x
+ (+ x (- 4 remainder)))))
+ (let* ((bv (audio-bv audio))
+ (length ((audio-decode-proc audio) bv)))
+ (values bv (nearest-multiple-of-4 length))))
+
+(define (audio-close audio)
+ ((audio-close-proc audio)))
+
+(define (audio-seek audio t)
+ ((audio-seek-proc audio) t))
+
+(define* (audio-play audio #:key
+ (pitch 1.0)
+ (volume 1.0)
+ (min-volume 0.0)
+ (max-volume 1.0)
+ (max-distance %default-max-distance)
+ (reference-distance 0.0)
+ (rolloff-factor 1.0)
+ (cone-outer-volume 0.0)
+ (cone-inner-angle 0.0)
+ (cone-outer-angle %default-cone-outer-angle)
+ (position (vec3 0.0 0.0 0.0))
+ (velocity (vec3 0.0 0.0 0.0))
+ (direction (vec3 0.0 0.0 0.0))
+ relative?)
+ (let ((source (borrow-source (current-sound-system))))
+ (set-source-audio! source audio)
+ (set-source-pitch! source pitch)
+ (set-source-volume! source volume)
+ (set-source-min-volume! source min-volume)
+ (set-source-max-volume! source max-volume)
+ (set-source-max-distance! source max-distance)
+ (set-source-reference-distance! source reference-distance)
+ (set-source-rolloff-factor! source rolloff-factor)
+ (set-source-cone-outer-volume! source cone-outer-volume)
+ (set-source-cone-inner-angle! source cone-inner-angle)
+ (set-source-cone-outer-angle! source cone-outer-angle)
+ (set-source-position! source position)
+ (set-source-velocity! source velocity)
+ (set-source-direction! source direction)
+ (set-source-relative! source relative?)
+ (source-play source)))
+
+(define (make-wav-audio file-name mode)
+ (let ((wav (open-wav file-name)))
+ (make-audio #:mode mode
+ #:duration (/ (exact->inexact (wav-length wav))
+ (wav-sample-rate wav))
+ #:bits-per-sample (wav-bits-per-sample wav)
+ #:sample-rate (wav-sample-rate wav)
+ #:channels (wav-num-channels wav)
+ #:decode
+ (lambda (bv)
+ (wav-read wav bv))
+ #:seek
+ (lambda (t)
+ (wav-time-seek wav t))
+ #:close
+ (lambda ()
+ (close-wav wav)))))
+
+(define (make-vorbis-audio file-name mode)
+ (let* ((vf (vorbis-open file-name))
+ (info (vorbis-info vf)))
+ (make-audio #:mode mode
+ #:duration (vorbis-time-total vf)
+ #:bits-per-sample 16
+ #:sample-rate (vorbis-info-sample-rate info)
+ #:channels (vorbis-info-channels info)
+ #:decode
+ (lambda (bv)
+ (vorbis-fill-buffer vf bv))
+ #:seek
+ (lambda (t)
+ (vorbis-time-seek vf t))
+ #:close
+ (lambda ()
+ (vorbis-clear vf)))))
+
+(define (make-mp3-audio file-name mode)
+ (let ((handle (mpg123-open file-name)))
+ (call-with-values (lambda () (mpg123-format handle))
+ (lambda (sample-rate channels bits-per-sample)
+ (make-audio #:mode mode
+ #:bits-per-sample bits-per-sample
+ #:channels channels
+ #:duration (exact->inexact
+ (/ (mpg123-length handle) sample-rate))
+ #:sample-rate sample-rate
+ #:decode
+ (lambda (bv)
+ (mpg123-read handle bv))
+ #:seek
+ (lambda (t)
+ (mpg123-time-seek handle t))
+ #:close
+ (lambda ()
+ (mpg123-close handle)))))))
+
+(define* (load-audio file-name #:key (mode 'static))
+ "Load audio source in FILE-NAME. The following audio formats are
+supported:
+
+- WAV
+- Ogg Vorbis
+- MP3
+
+MODE determines the algorithm used for reading audio from the file.
+If MODE is 'static' then the entire file will be read into memory
+immediately. If MODE is 'stream', audio data will be need in small
+pieces as needed from the file. The default mode is 'static'. For
+short sound effects, 'static' is recommended. For music and other
+lengthy audio files, 'stream' is recommended."
+ (unless (file-exists? file-name)
+ (error "file not found" file-name))
+ (let* ((make (match (last (string-split file-name #\.))
+ ("wav" make-wav-audio)
+ ("ogg" make-vorbis-audio)
+ ("mp3" make-mp3-audio)
+ (ext
+ (error "unsupported audio file format:" ext)))))
+ (make file-name mode)))