summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorDavid Thompson <dthompson2@worcester.edu>2019-01-09 17:44:26 -0500
committerDavid Thompson <dthompson2@worcester.edu>2020-04-07 16:10:23 -0400
commit8bba92a619b00277e31f14276d78e8cd531d426f (patch)
tree0beaf021ef5b68437101f3a88bf8f85d01e15c0c
parenta8db2705551f1db80a072bf0bf8e21ffcce9c73e (diff)
audio: Add OpenAL bindings.
-rw-r--r--Makefile.am1
-rw-r--r--chickadee/audio/openal.scm888
-rw-r--r--chickadee/config.scm.in2
-rw-r--r--configure.ac10
4 files changed, 901 insertions, 0 deletions
diff --git a/Makefile.am b/Makefile.am
index 32c747d..f9776f8 100644
--- a/Makefile.am
+++ b/Makefile.am
@@ -55,6 +55,7 @@ SOURCES = \
chickadee/math/grid.scm \
chickadee/math/easings.scm \
chickadee/math/path-finding.scm \
+ chickadee/audio/openal.scm \
chickadee/render/color.scm \
chickadee/render/gl.scm \
chickadee/render/gpu.scm \
diff --git a/chickadee/audio/openal.scm b/chickadee/audio/openal.scm
new file mode 100644
index 0000000..acffe6a
--- /dev/null
+++ b/chickadee/audio/openal.scm
@@ -0,0 +1,888 @@
+;;; Chickadee Game Toolkit
+;;; Copyright © 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:
+;;
+;; OpenAL bindings.
+;;
+;;; Code:
+
+(define-module (chickadee audio openal)
+ #:use-module (chickadee config)
+ #:use-module (chickadee math vector)
+ #:use-module (ice-9 format)
+ #:use-module (ice-9 match)
+ #:use-module (rnrs bytevectors)
+ #:use-module (srfi srfi-9)
+ #:use-module (srfi srfi-9 gnu)
+ #:use-module (system foreign)
+ #:export (open-device
+ close-device
+ device?
+ openal-major-version
+ openal-minor-version
+ default-device-specifier
+ capture-default-device-specifier
+ device-specifier
+ capture-device-specifier
+ device-extensions
+
+ make-context
+ destroy-context
+ context?
+ set-current-context!
+ current-context
+ with-context
+ context-device
+
+ make-buffer
+ delete-buffer
+ buffer?
+ buffer-id
+ set-buffer-data!
+
+ make-source
+ delete-source
+ source?
+ source-id
+ source-buffer
+ source-state
+ set-source-buffer!
+ set-source-looping!
+ set-source-property!
+ source-play
+ source-pause
+ source-stop
+ source-rewind
+ source-queue-buffer
+ source-unqueue-buffer
+ source-buffers-processed
+
+ listener-volume
+ listener-position
+ listener-velocity
+ listener-orientation
+ set-listener-volume!
+ set-listener-position!
+ set-listener-velocity!
+ set-listener-orientation!
+
+ doppler-factor
+ speed-of-sound
+ distance-model
+ set-doppler-factor!
+ set-speed-of-sound!
+ set-distance-model!)
+ #:replace (set-source-property!))
+
+
+;;;
+;;; Low-level Bindings
+;;;
+
+(define openal-func
+ (let ((lib (dynamic-link %libopenal)))
+ (lambda (return-type function-name arg-types)
+ (pointer->procedure return-type
+ (dynamic-func function-name lib)
+ arg-types))))
+
+(define-syntax-rule (define-foreign name return-type func-name arg-types)
+ (define name
+ (openal-func return-type func-name arg-types)))
+
+
+;;;
+;;; AL
+;;;
+
+;; al.h constants
+(define AL_FALSE 0)
+(define AL_TRUE 1)
+(define AL_NONE 0)
+(define AL_NO_ERROR 0)
+(define AL_INVALID_NAME #xA001)
+(define AL_INVALID_ENUM #xA002)
+(define AL_INVALID_VALUE #xA003)
+(define AL_INVALID_OPERATION #xA004)
+(define AL_OUT_OF_MEMORY #xA005)
+(define AL_SOURCE_RELATIVE #x202)
+(define AL_CONE_INNER_ANGLE #x1001)
+(define AL_CONE_OUTER_ANGLE #x1002)
+(define AL_PITCH #x1003)
+(define AL_POSITION #x1004)
+(define AL_DIRECTION #x1005)
+(define AL_VELOCITY #x1006)
+(define AL_LOOPING #x1007)
+(define AL_BUFFER #x1009)
+(define AL_GAIN #x100A)
+(define AL_MIN_GAIN #x100D)
+(define AL_MAX_GAIN #x100E)
+(define AL_ORIENTATION #x100F)
+(define AL_SOURCE_STATE #x1010)
+(define AL_INITIAL #x1011)
+(define AL_PLAYING #x1012)
+(define AL_PAUSED #x1013)
+(define AL_STOPPED #x1014)
+(define AL_BUFFERS_QUEUED #x1015)
+(define AL_BUFFERS_PROCESSED #x1016)
+(define AL_REFERENCE_DISTANCE #x1020)
+(define AL_ROLLOFF_FACTOR #x1021)
+(define AL_CONE_OUTER_GAIN #x1022)
+(define AL_MAX_DISTANCE #x1023)
+(define AL_SEC_OFFSET #x1024)
+(define AL_SAMPLE_OFFSET #x1025)
+(define AL_BYTE_OFFSET #x1026)
+(define AL_SOURCE_TYPE #x1027)
+(define AL_STATIC #x1028)
+(define AL_STREAMING #x1029)
+(define AL_UNDETERMINED #x1030)
+(define AL_FORMAT_MONO8 #x1100)
+(define AL_FORMAT_MONO16 #x1101)
+(define AL_FORMAT_STEREO8 #x1102)
+(define AL_FORMAT_STEREO16 #x1103)
+(define AL_FREQUENCY #x2001)
+(define AL_BITS #x2002)
+(define AL_CHANNELS #x2003)
+(define AL_SIZE #x2004)
+(define AL_DOPPLER_FACTOR #xC000)
+(define AL_DOPPLER_VELOCITY #xC001)
+(define AL_SPEED_OF_SOUND #xC003)
+(define AL_DISTANCE_MODEL #xD000)
+(define AL_INVERSE_DISTANCE #xD001)
+(define AL_INVERSE_DISTANCE_CLAMPED #xD002)
+(define AL_LINEAR_DISTANCE #xD003)
+(define AL_LINEAR_DISTANCE_CLAMPED #xD004)
+(define AL_EXPONENT_DISTANCE #xD005)
+(define AL_EXPONENT_DISTANCE_CLAMPED #xD006)
+
+(define-foreign al-get-error
+ int "alGetError" '())
+
+(define-foreign al-gen-buffers
+ void "alGenBuffers" (list int '*))
+
+(define-foreign al-delete-buffers
+ void "alDeleteBuffers" (list int '*))
+
+(define-foreign al-is-buffer
+ uint8 "alIsBuffer" (list unsigned-int))
+
+(define-foreign al-buffer-data
+ void "alBufferData" (list unsigned-int int '* int int))
+
+(define-foreign al-gen-sources
+ void "alGenSources" (list int '*))
+
+(define-foreign al-delete-sources
+ void "alDeleteSources" (list int '*))
+
+(define-foreign al-is-source
+ uint8 "alIsSource" (list unsigned-int))
+
+(define-foreign al-source-f
+ void "alSourcef" (list unsigned-int int float))
+
+(define-foreign al-source-3f
+ void "alSource3f" (list unsigned-int int float float float))
+
+(define-foreign al-source-fv
+ void "alSourcefv" (list unsigned-int int '*))
+
+(define-foreign al-source-i
+ void "alSourcei" (list unsigned-int int int))
+
+(define-foreign al-source-3i
+ void "alSource3i" (list unsigned-int int int int int))
+
+(define-foreign al-source-iv
+ void "alSourceiv" (list unsigned-int int '*))
+
+(define-foreign al-get-source-f
+ void "alGetSourcef" (list unsigned-int int '*))
+
+(define-foreign al-get-source-3f
+ void "alGetSource3f" (list unsigned-int int '* '* '*))
+
+(define-foreign al-get-source-fv
+ void "alGetSourcefv" (list unsigned-int int '*))
+
+(define-foreign al-get-source-i
+ void "alGetSourcei" (list unsigned-int int '*))
+
+(define-foreign al-get-source-3i
+ void "alGetSource3i" (list unsigned-int int '* '* '*))
+
+(define-foreign al-get-source-iv
+ void "alGetSourceiv" (list unsigned-int int '*))
+
+(define-foreign al-source-play
+ void "alSourcePlay" (list unsigned-int))
+
+(define-foreign al-source-pause
+ void "alSourcePause" (list unsigned-int))
+
+(define-foreign al-source-stop
+ void "alSourceStop" (list unsigned-int))
+
+(define-foreign al-source-rewind
+ void "alSourceRewind" (list unsigned-int))
+
+(define-foreign al-source-queue-buffers
+ void "alSourceQueueBuffers" (list unsigned-int int '*))
+
+(define-foreign al-source-unqueue-buffers
+ void "alSourceUnqueueBuffers" (list unsigned-int int '*))
+
+(define-foreign al-listener-f
+ void "alListenerf" (list int float))
+
+(define-foreign al-listener-3f
+ void "alListener3f" (list int float float float))
+
+(define-foreign al-listener-fv
+ void "alListenerfv" (list int '*))
+
+(define-foreign al-listener-i
+ void "alListeneri" (list int int))
+
+(define-foreign al-listener-3i
+ void "alListener3i" (list int int int int))
+
+(define-foreign al-listener-iv
+ void "alListeneriv" (list int '*))
+
+(define-foreign al-get-listener-f
+ void "alGetListenerf" (list int '*))
+
+(define-foreign al-get-listener-3f
+ void "alGetListener3f" (list int '* '* '*))
+
+(define-foreign al-get-listener-fv
+ void "alGetListenerfv" (list int '*))
+
+(define-foreign al-get-listener-i
+ void "alGetListeneri" (list int '*))
+
+(define-foreign al-get-listener-3i
+ void "alGetListener3i" (list int '* '* '*))
+
+(define-foreign al-get-listener-iv
+ void "alGetListeneriv" (list int '*))
+
+(define-foreign al-enable
+ void "alEnable" (list int))
+
+(define-foreign al-disable
+ void "alDisable" (list int))
+
+(define-foreign al-is-enabled
+ uint8 "alIsEnabled" (list int))
+
+(define-foreign al-get-boolean
+ uint8 "alGetBoolean" (list int))
+
+(define-foreign al-get-double
+ double "alGetDouble" (list int))
+
+(define-foreign al-get-float
+ float "alGetFloat" (list int))
+
+(define-foreign al-get-integer
+ int "alGetInteger" (list int))
+
+(define-foreign al-get-booleanv
+ void "alGetBooleanv" (list int '*))
+
+(define-foreign al-get-doublev
+ void "alGetDoublev" (list int '*))
+
+(define-foreign al-get-floatv
+ void "alGetFloatv" (list int '*))
+
+(define-foreign al-get-integerv
+ void "alGetIntegerv" (list int '*))
+
+(define-foreign al-get-string
+ '* "alGetString" (list int))
+
+(define-foreign al-distance-model
+ void "alDistanceModel" (list int))
+
+(define-foreign al-doppler-factor
+ void "alDopplerFactor" (list float))
+
+(define-foreign al-speed-of-sound
+ void "alSpeedOfSound" (list float))
+
+
+;;;
+;;; ALC
+;;;
+
+;; alc.h constants
+(define ALC_FREQUENCY #x1007)
+(define ALC_REFRESH #x1008)
+(define ALC_SYNC #x1009)
+(define ALC_MONO_SOURCES #x1010)
+(define ALC_STEREO_SOURCES #x1011)
+(define ALC_NO_ERROR 0)
+(define ALC_INVALID_DEVICE #xA001)
+(define ALC_INVALID_CONTEXT #xA002)
+(define ALC_INVALID_ENUM #xA003)
+(define ALC_INVALID_VALUE #xA004)
+(define ALC_OUT_OF_MEMORY #xA005)
+(define ALC_MAJOR_VERSION #x1000)
+(define ALC_MINOR_VERSION #x1001)
+(define ALC_ATTRIBUTES_SIZE #x1002)
+(define ALC_ALL_ATTRIBUTES #x1003)
+(define ALC_DEFAULT_DEVICE_SPECIFIER #x1004)
+(define ALC_DEVICE_SPECIFIER #x1005)
+(define ALC_EXTENSIONS #x1006)
+(define ALC_EXT_CAPTURE 1)
+(define ALC_CAPTURE_DEVICE_SPECIFIER #x310)
+(define ALC_CAPTURE_DEFAULT_DEVICE_SPECIFIER #x311)
+(define ALC_CAPTURE_SAMPLES #x312)
+
+(define-foreign alc-get-error
+ int "alcGetError" '(*))
+
+(define-foreign alc-open-device
+ '* "alcOpenDevice" '(*))
+
+(define-foreign alc-close-device
+ uint8 "alcCloseDevice" '(*))
+
+(define-foreign alc-create-context
+ '* "alcCreateContext" '(* *))
+
+(define-foreign alc-process-context
+ void "alcProcessContext" '(*))
+
+(define-foreign alc-suspend-context
+ void "alcSuspendContext" '(*))
+
+(define-foreign alc-destroy-context
+ void "alcDestroyContext" '(*))
+
+(define-foreign alc-make-context-current
+ uint8 "alcMakeContextCurrent" '(*))
+
+(define-foreign alc-get-current-context
+ '* "alcGetCurrentContext" '())
+
+(define-foreign alc-get-contexts-device
+ '* "alcGetContextsDevice" '(*))
+
+(define-foreign alc-get-string
+ '* "alcGetString" (list '* int))
+
+(define-foreign alc-get-integer-v
+ void "alcGetIntegerv" (list '* int int '*))
+
+(define-foreign alc-capture-open-device
+ '* "alcCaptureOpenDevice" (list '* unsigned-int int int))
+
+(define-foreign alc-capture-close-device
+ uint8 "alcCaptureCloseDevice" '(*))
+
+(define-foreign alc-capture-start
+ void "alcCaptureStart" '(*))
+
+(define-foreign alc-capture-stop
+ void "alcCaptureStop" '(*))
+
+(define-foreign alc-capture-samples
+ void "alcCaptureSamples" (list '* '* int))
+
+
+;;;
+;;; High-level public API
+;;;
+
+(define (al-check-error func message . args)
+ (let* ((error-id (al-get-error))
+ (error-string (cond
+ ((= error-id AL_NO_ERROR)
+ "no error")
+ ((= error-id AL_INVALID_NAME)
+ "invalid name parameter passed to an AL call")
+ ((= error-id AL_INVALID_ENUM)
+ "invalid enum parameter passed to an AL call")
+ ((= error-id AL_INVALID_VALUE)
+ "invalid value parameter passed to an AL call")
+ ((= error-id AL_INVALID_OPERATION)
+ "illegal AL call")
+ ((= error-id AL_OUT_OF_MEMORY)
+ "out of memory"))))
+ (unless (zero? error-id)
+ (apply throw 'openal-error func (string-append message ": ~A")
+ (append args (list error-string))))))
+
+
+;;;
+;;; Devices
+;;;
+
+(define-wrapped-pointer-type <device>
+ device?
+ wrap-device unwrap-device
+ (lambda (device port)
+ (format port "#<device specifier: ~a>"
+ (device-specifier device))))
+
+(define (alc-check-error device func message . args)
+ (let* ((error-id (alc-get-error (unwrap-device device)))
+ (error-string (cond
+ ((= error-id ALC_NO_ERROR)
+ "no error")
+ ((= error-id ALC_INVALID_DEVICE)
+ "invalid device parameter passed to an ALC call")
+ ((= error-id ALC_INVALID_CONTEXT)
+ "invalid context parameter passed to an ALC call")
+ ((= error-id ALC_INVALID_ENUM)
+ "invalid enum parameter passed to an ALC call")
+ ((= error-id ALC_INVALID_VALUE)
+ "invalid value parameter passed to an ALC call")
+ ((= error-id ALC_OUT_OF_MEMORY)
+ "out of memory"))))
+ (unless (zero? error-id)
+ (apply throw 'openal-error func (string-append message ": ~A")
+ (append args (list error-string))))))
+
+(define* (open-device #:optional name)
+ "Open the device NAME, or the default device if NAME is #f"
+ (let ((ptr (alc-open-device
+ (if name
+ (string->pointer name)
+ %null-pointer))))
+ (if (null-pointer? ptr)
+ (al-check-error "open-device" "could not open device '~a'" name)
+ (wrap-device ptr))))
+
+(define (close-device device)
+ "Close DEVICE."
+ (alc-close-device (unwrap-device device))
+ (alc-check-error device "close-device" "could not close device ~a" device))
+
+(define (openal-major-version device)
+ "Return the OpenAL major version used for DEVICE."
+ (let ((bv (make-s32vector 1)))
+ (alc-get-integer-v (unwrap-device device)
+ ALC_MAJOR_VERSION
+ 1
+ (bytevector->pointer bv))
+ (alc-check-error device "openal-major-version"
+ "could not get OpenAL major version")
+ (s32vector-ref bv 0)))
+
+(define (openal-minor-version device)
+ "Return the OpenAL minor version used for DEVICE."
+ (let ((bv (make-s32vector 1)))
+ (alc-get-integer-v (unwrap-device device)
+ ALC_MINOR_VERSION
+ 1
+ (bytevector->pointer bv))
+ (alc-check-error device "openal-minor-version"
+ "could not get OpenAL minor version")
+ (s32vector-ref bv 0)))
+
+(define (device-string device attr proc-name error-msg)
+ (let ((ptr (alc-get-string (unwrap-device device) attr)))
+ (alc-check-error device proc-name error-msg)
+ (pointer->string ptr)))
+
+(define (default-device-specifier device)
+ "Return the default device specifier name for DEVICE."
+ (device-string device
+ ALC_DEFAULT_DEVICE_SPECIFIER
+ "default-device-specifier"
+ "could not get default device specifier"))
+
+(define (device-specifier device)
+ "Return the device specifier name for DEVICE."
+ (device-string device
+ ALC_DEVICE_SPECIFIER
+ "device-specifier"
+ "could not get device specifier"))
+
+(define (capture-default-device-specifier device)
+ "Return the default capture device specifier name for DEVICE."
+ (device-string device
+ ALC_CAPTURE_DEFAULT_DEVICE_SPECIFIER
+ "capture-default-device-specifier"
+ "could not get capture default device specifier"))
+
+(define (capture-device-specifier device)
+ "Return the capture device specifier name for DEVICE."
+ (device-string device
+ ALC_CAPTURE_DEVICE_SPECIFIER
+ "capture-device-specifier"
+ "could not get capture device specifier"))
+
+(define (device-extensions device)
+ "Return a list of available extensions for DEVICE."
+ (string-split (device-string device
+ ALC_EXTENSIONS
+ "device-extensions"
+ "could not get device extensions")
+ #\space))
+
+
+
+;;;
+;;; Contexts
+;;;
+
+(define-record-type <context>
+ (wrap-context ptr device)
+ context?
+ (ptr unwrap-context)
+ (device context-device))
+
+(define (display-context context port)
+ (format port "#<context device: ~a>" (context-device context)))
+
+(set-record-type-printer! <context> display-context)
+
+(define (make-context device)
+ "Return a new OpenAL context for DEVICE."
+ (let ((ptr (alc-create-context (unwrap-device device) %null-pointer)))
+ (if (null-pointer? ptr)
+ (alc-check-error device "make-context"
+ "could not create context for device ~a" device)
+ (wrap-context ptr device))))
+
+(define (destroy-context context)
+ "Destroy CONTEXT. It can no longer be used after this call."
+ (alc-destroy-context (unwrap-context context)))
+
+(define *current-context* #f)
+
+(define (current-context)
+ "Return the current OpenAL context."
+ *current-context*)
+
+(define (set-current-context! context)
+ "Set CONTEXT as the currently active OpenAL context. If CONTEXT is #f,
+then the current context will be cleared and there will be no active
+context."
+ (if (= (alc-make-context-current
+ (if context
+ (unwrap-context context)
+ %null-pointer))
+ 1)
+ (set! *current-context* context)))
+
+(define-syntax-rule (with-context context body ...)
+ (let ((prev (current-context)))
+ (dynamic-wind
+ (lambda ()
+ (set-current-context! context))
+ (lambda ()
+ body ...)
+ (lambda ()
+ (set-current-context! prev)))))
+
+
+;;;
+;;; Buffers
+;;;
+
+(define-record-type <buffer>
+ (%make-buffer id)
+ buffer?
+ (id buffer-id))
+
+(define* (make-buffer #:key data (length (and data (bytevector-length data)))
+ (format 'stereo-16) (frequency 44100))
+ "Return a new audio buffer."
+ (let ((bv (u32vector 0)))
+ (al-gen-buffers 1 (bytevector->pointer bv))
+ (al-check-error "make-buffer" "failed to create buffer")
+ (let* ((id (u32vector-ref bv 0))
+ (buffer (%make-buffer id)))
+ (when data
+ (set-buffer-data! buffer data length format frequency))
+ buffer)))
+
+(define (delete-buffer buffer)
+ "Delete BUFFER."
+ (al-delete-buffers 1 (bytevector->pointer (u32vector (buffer-id buffer))))
+ (al-check-error "delete-buffer" "failed to delete buffer"))
+
+(define (set-buffer-data! buffer bv length format frequency)
+ (al-buffer-data (buffer-id buffer)
+ (match format
+ ('mono-8 AL_FORMAT_MONO8)
+ ('mono-16 AL_FORMAT_MONO16)
+ ('stereo-8 AL_FORMAT_STEREO8)
+ ('stereo-16 AL_FORMAT_STEREO16))
+ (bytevector->pointer bv)
+ length
+ frequency))
+
+
+;;;
+;;; Sources
+;;;
+
+(define-record-type <source>
+ (%make-source id buffer)
+ source?
+ (id source-id)
+ (buffer source-buffer %set-source-buffer!))
+
+(define* (make-source #:key buffer)
+ "Return a new audio source."
+ (let ((bv (u32vector 0)))
+ (al-gen-sources 1 (bytevector->pointer bv))
+ (al-check-error "make-source" "failed to create source")
+ (let ((source (%make-source (u32vector-ref bv 0) #f)))
+ (when buffer
+ (set-source-buffer! source buffer))
+ source)))
+
+(define (delete-source source)
+ "Delete SOURCE."
+ (al-delete-sources 1 (bytevector->pointer (u32vector (source-id source))))
+ (al-check-error "delete-source" "failed to delete source ~a" source))
+
+(define source-state
+ (let* ((bv (make-u32vector 1))
+ (ptr (bytevector->pointer bv)))
+ (lambda (source)
+ (al-get-source-i (source-id source) AL_SOURCE_STATE ptr)
+ (al-check-error "source-state" "failed to get state of source ~a" source)
+ (let ((state (u32vector-ref bv 0)))
+ (cond
+ ((= state AL_INITIAL)
+ 'initial)
+ ((= state AL_PLAYING)
+ 'playing)
+ ((= state AL_PAUSED)
+ 'paused)
+ ((= state AL_STOPPED)
+ 'stopped))))))
+
+(define (set-source-buffer! source buffer)
+ "Associate BUFFER with SOURCE."
+ (al-source-i (source-id source) AL_BUFFER (buffer-id buffer))
+ (%set-source-buffer! source buffer))
+
+(define (set-source-looping! source loop?)
+ "Enables looping for SOURCE if LOOP? is #t, disables looping
+otherwise."
+ (al-source-i (source-id source) AL_LOOPING (if loop? 1 0)))
+
+(define (source-play source)
+ (al-source-play (source-id source))
+ (al-check-error "source-play" "failed to play source ~a" source))
+
+(define (source-pause source)
+ (al-source-pause (source-id source))
+ (al-check-error "source-pause" "failed to pause source ~a" source))
+
+(define (source-stop source)
+ (al-source-stop (source-id source))
+ (al-check-error "source-stop" "failed to pause source ~a" source))
+
+(define (source-rewind source)
+ (al-source-rewind (source-id source))
+ (al-check-error "source-rewind" "failed to rewind source ~a" source))
+
+(define source-queue-buffer
+ (let ((bv (make-u32vector 1)))
+ (lambda (source buffer)
+ (u32vector-set! bv 0 (buffer-id buffer))
+ (al-source-queue-buffers (source-id source) 1 (bytevector->pointer bv))
+ (al-check-error "source-queue-buffer" "failed to queue buffer ~a" buffer))))
+
+(define source-unqueue-buffer
+ (let ((bv (make-u32vector 1)))
+ (lambda (source)
+ (u32vector-set! bv 0 0)
+ (al-source-unqueue-buffers (source-id source) 1 (bytevector->pointer bv))
+ (al-check-error "source-unqueue-buffer" "failed to unqueue buffer for source" source)
+ (u32vector-ref bv 0))))
+
+(define (source-buffers-processed source)
+ (let ((bv (make-s32vector 1)))
+ (al-get-source-i (source-id source) AL_BUFFERS_PROCESSED (bytevector->pointer bv))
+ (s32vector-ref bv 0)))
+
+(define (set-source-property! source property value)
+ (let ((param (match property
+ ('pitch AL_PITCH)
+ ('gain AL_GAIN)
+ ('max-distance AL_MAX_DISTANCE)
+ ('rolloff-factor AL_ROLLOFF_FACTOR)
+ ('reference-distance AL_REFERENCE_DISTANCE)
+ ('min-gain AL_MIN_GAIN)
+ ('max-gain AL_MAX_GAIN)
+ ('cone-outer-gain AL_CONE_OUTER_GAIN)
+ ('cone-inner-angle AL_CONE_INNER_ANGLE)
+ ('cone-outer-angle AL_CONE_OUTER_ANGLE)
+ ('position AL_POSITION)
+ ('velocity AL_VELOCITY)
+ ('direction AL_DIRECTION)
+ ('relative AL_SOURCE_RELATIVE))))
+ (match property
+ ('relative
+ (al-source-i (source-id source) param (if value AL_TRUE AL_FALSE)))
+ ((or 'position 'velocity 'direction)
+ (al-source-fv (source-id source)
+ param
+ ((@@ (chickadee math vector) vec3->pointer) value)))
+ (_
+ (al-source-f (source-id source) param value)))))
+
+
+;;;
+;;; Listener
+;;;
+
+(define (listener-volume)
+ "Return the current master volume of the listener."
+ (let ((bv (make-f32vector 1)))
+ (al-get-listener-f AL_GAIN (bytevector->pointer bv))
+ (al-check-error "listener-volume" "failed to get listener gain")
+ (f32vector-ref bv 0)))
+
+(define (listener-position)
+ "Return the current position of the listener."
+ (let* ((bv (make-f32vector 3))
+ (ptr (bytevector->pointer bv)))
+ (al-get-listener-fv AL_POSITION ptr)
+ (al-check-error "listener-position" "failed to get listener position")
+ ((@@ (chickadee math vector) wrap-vec3) bv ptr)))
+
+(define (listener-velocity)
+ "Return the current velocity of the listener."
+ (let* ((bv (make-f32vector 3))
+ (ptr (bytevector->pointer bv)))
+ (al-get-listener-fv AL_VELOCITY ptr)
+ (al-check-error "listener-velocity" "failed to get listener velocity")
+ ((@@ (chickadee math vector) wrap-vec3) bv ptr)))
+
+(define (listener-orientation)
+ "Return the current orientation of the listener"
+ (let ((bv (make-f32vector 6)))
+ (al-get-listener-fv AL_ORIENTATION (bytevector->pointer bv))
+ (al-check-error "listener-orientation" "failed to get listener orientation")
+ (values (vec3 (f32vector-ref bv 0)
+ (f32vector-ref bv 1)
+ (f32vector-ref bv 2))
+ (vec3 (f32vector-ref bv 3)
+ (f32vector-ref bv 4)
+ (f32vector-ref bv 5)))))
+
+(define (set-listener-volume! volume)
+ "Set listener master volume to VOLUME, a value in the range [0, 1]."
+ (al-listener-f AL_GAIN volume)
+ (al-check-error "set-listener-volume!" "failed to set listener gain"))
+
+(define (set-listener-position! position)
+ "Set the listener's position to the 3D vector POSITION"
+ (al-listener-fv AL_POSITION
+ ((@@ (chickadee math vector) vec3-pointer) position))
+ (al-check-error "set-listener-position!" "failed to set listener position"))
+
+(define (set-listener-velocity! velocity)
+ "Set the listener's velocity to the 3D vector VELOCITY."
+ (al-listener-fv AL_VELOCITY
+ ((@@ (chickadee math vector) vec3-pointer) velocity))
+ (al-check-error "set-listener-velocity!" "failed to set listener velocity"))
+
+(define (set-listener-orientation! at up)
+ "Set the listener's orientation to the 3D vectors AT and UP."
+ (al-listener-fv AL_ORIENTATION
+ (bytevector->pointer
+ (f32vector (vec3-x at) (vec3-y at) (vec3-z at)
+ (vec3-x up) (vec3-y up) (vec3-z up))))
+ (al-check-error "set-listener-orientation!"
+ "failed to set listener orientation"))
+
+
+;;;
+;;; Global state
+;;;
+
+(define (doppler-factor)
+ "Return the current doppler factor."
+ (let ((result (al-get-float AL_DOPPLER_FACTOR)))
+ (al-check-error "doppler-factor" "failed to get doppler factor")
+ result))
+
+(define (speed-of-sound)
+ "Return the current speed of sound."
+ (let ((result (al-get-float AL_SPEED_OF_SOUND)))
+ (al-check-error "speed-of-sound" "failed to get speed of sound")
+ result))
+
+(define (distance-model)
+ "Return the current distance model."
+ (let* ((enum (al-get-integer AL_DISTANCE_MODEL))
+ (result (cond
+ ((= enum AL_NONE)
+ 'none)
+ ((= enum AL_INVERSE_DISTANCE)
+ 'inverse-distance)
+ ((= enum AL_INVERSE_DISTANCE_CLAMPED)
+ 'inverse-distance-clamped)
+ ((= enum AL_LINEAR_DISTANCE)
+ 'linear-distance)
+ ((= enum AL_LINEAR_DISTANCE_CLAMPED)
+ 'linear-distance-clamped)
+ ((= enum AL_EXPONENT_DISTANCE)
+ 'exponent-distance)
+ ((= enum AL_EXPONENT_DISTANCE_CLAMPED)
+ 'exponent-distance-clamped))))
+ (al-check-error "distance-model" "failed to get distance model")
+ result))
+
+(define (set-doppler-factor! doppler-factor)
+ "Change the doppler factor to DOPPLER-FACTOR."
+ (al-doppler-factor doppler-factor)
+ (al-check-error "set-doppler-factor!" "failed to set doppler factor"))
+
+(define (set-speed-of-sound! speed-of-sound)
+ "Change the speed of sound to SPEED-OF-SOUND."
+ (al-speed-of-sound speed-of-sound)
+ (al-check-error "set-speed-of-sound!" "failed to set speed of sound"))
+
+(define (set-distance-model! distance-model)
+ "Change the distance model to DISTANCE-MODEL. Valid distance models
+are:
+
+- none
+- inverse-distance
+- inverse-distance-clamped
+- linear-distance
+- linear-distance-clamped
+- exponent-distance
+- exponent-distance-clamped"
+ (al-distance-model
+ (match distance-model
+ ('none AL_NONE)
+ ('inverse-distance AL_INVERSE_DISTANCE)
+ ('inverse-distance-clamped AL_INVERSE_DISTANCE_CLAMPED)
+ ('linear-distance AL_LINEAR_DISTANCE)
+ ('linear-distance-clamped AL_LINEAR_DISTANCE_CLAMPED)
+ ('exponent-distance AL_EXPONENT_DISTANCE)
+ ('exponent-distance-clamped AL_EXPONENT_DISTANCE_CLAMPED)))
+ (al-check-error "set-distance-model!" "failed to set distance model"))
diff --git a/chickadee/config.scm.in b/chickadee/config.scm.in
index 6ff5a83..083d7ba 100644
--- a/chickadee/config.scm.in
+++ b/chickadee/config.scm.in
@@ -24,6 +24,7 @@
(define-module (chickadee config)
#:export (%datadir
%chickadee-version
+ %libopenal
scope-datadir))
(define %datadir
@@ -31,6 +32,7 @@
(define %chickadee-version "@PACKAGE_VERSION@")
+(define %libopenal "@OPENAL_LIBDIR@/libopenal")
(define (scope-datadir file)
"Append the Chickadee data directory to FILE."
(string-append %datadir "/" file))
diff --git a/configure.ac b/configure.ac
index b5a8925..66be3c0 100644
--- a/configure.ac
+++ b/configure.ac
@@ -23,4 +23,14 @@ GUILE_PROGS
GUILE_MODULE_REQUIRED([gl])
GUILE_MODULE_REQUIRED([sdl2])
+PKG_CHECK_MODULES([OpenAL], [openal])
+PKG_CHECK_VAR([OPENAL_LIBDIR], [openal], [libdir])
+AC_MSG_CHECKING([OpenAL library path])
+AS_IF([test "x$OPENAL_LIBDIR" = "x"], [
+ AC_MSG_FAILURE([Unable to identify OpenAL lib path.])
+], [
+ AC_MSG_RESULT([$OPENAL_LIBDIR])
+])
+AC_SUBST([OPENAL_LIBDIR])
+
AC_OUTPUT