diff options
author | David Thompson <dthompson2@worcester.edu> | 2019-01-09 20:26:28 -0500 |
---|---|---|
committer | David Thompson <dthompson2@worcester.edu> | 2020-04-07 16:17:02 -0400 |
commit | 159c35f706de14f3e3c6942934532011a1d77277 (patch) | |
tree | c2a8ec4cc93a2ca7c823579244fe63052d77d031 /chickadee/audio.scm | |
parent | b5a93156dfc743aec69987e03e89d27735b615dd (diff) |
audio: Add public audio API.
* chickadee/audio.scm: New file.
* Makefile.am (SOURCES): Add it.
* api.texi (Audio): Add docs.
Diffstat (limited to 'chickadee/audio.scm')
-rw-r--r-- | chickadee/audio.scm | 763 |
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))) |