path: root/chickadee/audio/openal.scm

;;; Chickadee Game Toolkit
;;; Copyright © 2019 David Thompson <dthompson2@worcester.edu>
;;;
;;; Licensed under the Apache License, Version 2.0 (the "License");
;;; you may not use this file except in compliance with the License.
;;; You may obtain a copy of the License at
;;;
;;;    http://www.apache.org/licenses/LICENSE-2.0
;;;
;;; Unless required by applicable law or agreed to in writing, software
;;; distributed under the License is distributed on an "AS IS" BASIS,
;;; WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
;;; See the License for the specific language governing permissions and
;;; limitations under the License.

;;; Commentary:
;;
;; OpenAL bindings.
;;
;;; Code:

(define-module (chickadee audio openal)
  #:use-module (chickadee config)
  #:use-module (chickadee data bytestruct)
  #: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
                     (bytestruct->pointer <vec3> 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"))