audio: Add OpenAL bindings.
authorDavid Thompson <dthompson2@worcester.edu>
Wed, 9 Jan 2019 22:44:26 +0000 (17:44 -0500)
committerDavid Thompson <dthompson2@worcester.edu>
Tue, 7 Apr 2020 20:10:23 +0000 (16:10 -0400)
Makefile.am
chickadee/audio/openal.scm [new file with mode: 0644]
chickadee/config.scm.in
configure.ac

index 32c747d..f9776f8 100644 (file)
@@ -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 (file)
index 0000000..acffe6a
--- /dev/null
@@ -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!))
+
+\f
+;;;
+;;; 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)))
+
+\f
+;;;
+;;; 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))
+
+\f
+;;;
+;;; 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))
+
+\f
+;;;
+;;; 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))))))
+
+\f
+;;;
+;;; 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))
+
+
+\f
+;;;
+;;; 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)))))
+
+\f
+;;;
+;;; 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))
+
+\f
+;;;
+;;; 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)))))
+
+\f
+;;;
+;;; 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"))
+
+\f
+;;;
+;;; 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"))
index 6ff5a83..083d7ba 100644 (file)
@@ -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))
index b5a8925..66be3c0 100644 (file)
@@ -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