From 8bba92a619b00277e31f14276d78e8cd531d426f Mon Sep 17 00:00:00 2001 From: David Thompson Date: Wed, 9 Jan 2019 17:44:26 -0500 Subject: audio: Add OpenAL bindings. --- Makefile.am | 1 + chickadee/audio/openal.scm | 888 +++++++++++++++++++++++++++++++++++++++++++++ chickadee/config.scm.in | 2 + configure.ac | 10 + 4 files changed, 901 insertions(+) create mode 100644 chickadee/audio/openal.scm 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 +;;; +;;; 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 +;;; . + +;;; 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? + wrap-device unwrap-device + (lambda (device port) + (format port "#" + (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 + (wrap-context ptr device) + context? + (ptr unwrap-context) + (device context-device)) + +(define (display-context context port) + (format port "#" (context-device context))) + +(set-record-type-printer! 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 + (%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 + (%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 -- cgit v1.2.3