Skip to content

Instantly share code, notes, and snippets.

Embed
What would you like to do?
full-sound-test
(define-foreign-library alsa
(t (:default "libasound")))
(defcenum snd-pcm-stream-t
:snd_pcm_stream_playback
:snd_pcm_stream_capture)
(defcenum snd-pcm-state-t
:SND_PCM_STATE_OPEN
:SND_PCM_STATE_SETUP
:SND_PCM_STATE_PREPARED
:SND_PCM_STATE_RUNNING
:SND_PCM_STATE_XRUN
:SND_PCM_STATE_DRAINING
:SND_PCM_STATE_PAUSED
:SND_PCM_STATE_SUSPENDED
:SND_PCM_STATE_DISCONNECTED)
(defcenum snd-pcm-format-t
(:SND_PCM_FORMAT_UNKNOWN -1)
(:SND_PCM_FORMAT_S8 0)
:SND_PCM_FORMAT_U8
:SND_PCM_FORMAT_S16_LE
:SND_PCM_FORMAT_S16_BE
:SND_PCM_FORMAT_U16_LE
:SND_PCM_FORMAT_U16_BE
:SND_PCM_FORMAT_S24_LE
:SND_PCM_FORMAT_S24_BE
:SND_PCM_FORMAT_U24_LE
:SND_PCM_FORMAT_U24_BE
:SND_PCM_FORMAT_S32_LE
:SND_PCM_FORMAT_S32_BE
:SND_PCM_FORMAT_U32_LE
:SND_PCM_FORMAT_U32_BE
:SND_PCM_FORMAT_FLOAT_LE
:SND_PCM_FORMAT_FLOAT_BE
:SND_PCM_FORMAT_FLOAT64_LE
:SND_PCM_FORMAT_FLOAT64_BE
:SND_PCM_FORMAT_IEC958_SUBFRAME_LE
:SND_PCM_FORMAT_IEC958_SUBFRAME_BE
:SND_PCM_FORMAT_MU_LAW
:SND_PCM_FORMAT_A_LAW
:SND_PCM_FORMAT_IMA_ADPCM :SND_PCM_FORMAT_MPEG
:SND_PCM_FORMAT_GSM
(:SND_PCM_FORMAT_SPECIAL 31)
(:SND_PCM_FORMAT_S24_3LE 32)
:SND_PCM_FORMAT_S24_3BE
:SND_PCM_FORMAT_U24_3LE
:SND_PCM_FORMAT_U24_3BE
:SND_PCM_FORMAT_S20_3LE
:SND_PCM_FORMAT_S20_3BE
:SND_PCM_FORMAT_U20_3LE
:SND_PCM_FORMAT_U20_3BE
:SND_PCM_FORMAT_S18_3LE
:SND_PCM_FORMAT_S18_3BE
:SND_PCM_FORMAT_U18_3LE
:SND_PCM_FORMAT_U18_3BE)
(defcenum snd-pcm-access-t
:SND_PCM_ACCESS_MMAP_INTERLEAVED
:SND_PCM_ACCESS_MMAP_NONINTERLEAVED
:SND_PCM_ACCESS_MMAP_COMPLEX
:SND_PCM_ACCESS_RW_INTERLEAVED
:SND_PCM_ACCESS_RW_NONINTERLEAVED)
(defctype snd-pcm-ptr :pointer)
(defctype snd-pcm-hw-params-ptr :pointer)
(defctype snd-pcm-sw-params-ptr :pointer)
(defcstruct snd-pcm-channel-area-t
"PCM Structure representing the sound buffer area to be written to."
;; Addr is the base address of the pointer
(addr :pointer)
;; First is offset in BITS to the first sample
(first :unsigned-int)
;; Step is the samples distance in bits (i.e. measured in Bits per Sample)
;; NOTE: I'm still not *sure* what this is.
;; but the calculation I use is (when writing to the buffer):
;; samples = addr + first / 8 + offset * area.step / 16
;; where offset is the frame we are writing to relative to the first address
(step :unsigned-int))
(defstruct sound
(format :snd_pcm_format_s16_le)
(access :snd_pcm_access_mmap_interleaved)
(samples-per-second 48000)
(num-channels 2)
(buffer-size 4096)
(num-periods 2)
(period-size nil)
(resample t))
;; TODO: how to build more intricate constructors?
(defstruct square-wave
(running-sample-index 0)
(frequency 440)
(volume 3000)
(half-period))
(defun full-sound-test ()
(let* ((sound (make-sound))
(square-wave (make-square-wave)))
(setf (square-wave-half-period square-wave)
(floor (/ (sound-samples-per-second sound)
(square-wave-frequency square-wave) 2)))
(with-foreign-objects ((handle-ptr 'snd-pcm-ptr)
(hw-params-ptr 'snd-pcm-hw-params-ptr)
(sw-params-ptr 'snd-pcm-sw-params-ptr)
(channels-ptr :uint32)
(rate-ptr :uint32)
(direction-ptr :int32)
(buffer-size-ptr :uint32)
(period-size-ptr :uint32)
(frames-ptr :uint32)
(offset-ptr :uint32)
(sound-buffer :pointer))
;; TODO: fail if fail for all of these calls.
(foreign-funcall "snd_pcm_open"
:pointer handle-ptr
:string "default"
snd-pcm-stream-t :snd_pcm_stream_playback
:int 0 ; NOTE: blocking mode
:int)
(let ((pcm (mem-ref handle-ptr 'snd-pcm-ptr)))
(macrolet ((pcm-call (name &rest args)
"PCM calls start with \"snd_pcm_\", take a snd-pcm-ptr, and return an :int"
`(foreign-funcall ,(concatenate 'string "snd_pcm_" name)
snd-pcm-ptr pcm
,@args
:int)))
(labels ((pcm-prepare ()
(pcm-call "prepare"))
(run-recovery (err)
(case err
(-32 ; EPIPE
(pcm-prepare))
(-86 ; ESTRPIPE
;; I'm thinking I don't like loop very much.
(when (minusp (loop with err = (pcm-call "resume")
while (= err -11 ; EAGAIN
)
do (sleep 0.00000001)
finally (return err)))
(pcm-prepare)))
(t (error "Unrecoverable error: ~a" err))))
(minusp-fail (call-name fn-name val)
(if (minusp val)
(error "~a ~a" call-name fn-name)))
(minusp-recovery (val)
(when (minusp val)
(run-recovery val))))
(block send-sound-parameters
(foreign-funcall "snd_pcm_hw_params_malloc" :pointer hw-params-ptr)
(let ((hw-params (mem-ref hw-params-ptr 'snd-pcm-hw-params-ptr)))
(macrolet ((hw-call (name &rest args)
"hw-calls are pcm-calls that also take a snd-pcm-hw-params-ptr.
Additionally they fail (cause an error) if the return code is "
`(minusp-fail "hw-call" ,name
(pcm-call ,(concatenate 'string "hw_params_" name)
snd-pcm-hw-params-ptr hw-params
,@args))))
;; NOTE: setup hardware
;; NOTE: Just fill the params with anything to make it valid.
(hw-call "any")
(hw-call "set_rate_resample"
;; TODO: Leaving resampling off, because I don't know what it does
:int32 (if (sound-resample sound) 1 0))
(hw-call "set_access"
;; MMAP gives us a direct pointer to the memory to write to.
;; Interleaved mean L/R channels will be every other sample
snd-pcm-access-t (sound-access sound))
(hw-call "set_format"
;; samples are 16-bit signed integers
;; TODO: specify little/big-endianness?
snd-pcm-format-t (sound-format sound))
(setf (mem-ref channels-ptr :uint32) (sound-num-channels sound))
(hw-call "set_channels_near"
;; Two Channels for stereo sound: Left/Right
:pointer channels-ptr)
(setf (sound-num-channels sound) (mem-ref channels-ptr :uint32))
;; NOTE: these functions set to the nearest value, but return the value
;; that was actually set.
(setf (mem-ref rate-ptr :uint32) (sound-samples-per-second sound)
(mem-ref direction-ptr :int32) 0)
(hw-call "set_rate_near"
:pointer rate-ptr
:pointer direction-ptr ; Out-param telling us which side we fell on
)
;; NOTE: Buffer size is in frames. A frame is NumChannels * SampleSize
;; So it is 1/2x the sample size for 2-channel sound.
(setf (mem-ref buffer-size-ptr :uint32)
(floor (sound-buffer-size sound) (sound-num-channels sound))
(mem-ref direction-ptr :int32) 0)
(hw-call "set_buffer_size_near"
:pointer buffer-size-ptr
:pointer direction-ptr)
(setf (sound-buffer-size sound) (mem-ref buffer-size-ptr :uint32))
;; NOTE: Period is how often we transfer memory. It's usually buffer_size/2
;; This way the hardware interrupts 2 times in the course of playing the buffer.
;; See: http://www.alsa-project.org/main/index.php/FramesPeriods
;; period-size is also in frames
(setf (sound-period-size sound) (floor (sound-buffer-size sound)
(sound-num-periods sound)))
(setf (mem-ref period-size-ptr :uint32) (sound-period-size sound)
(mem-ref direction-ptr :int32) 0)
(hw-call "set_period_size_near"
:pointer period-size-ptr
:pointer direction-ptr)
(setf (sound-period-size sound) (mem-ref period-size-ptr :uint32))
;; NOTE: Finally send the parameters. We've only been modifying a local struct.
(minusp-fail "pcm-call" "hw_params"
(pcm-call "hw_params" snd-pcm-hw-params-ptr hw-params))
(setf (sound-samples-per-second sound) (mem-ref rate-ptr :uint32))
;; NOTE: Done with the params structures. free it. (only store ephemoral data)
;; (foreign-funcall "snd_pcm_hw_params_free"
;; snd-pcm-hw-params-ptr (mem-ref hw-params-ptr 'snd-pcm-hw-params-ptr)
;; )
))
(foreign-funcall "snd_pcm_sw_params_malloc" :pointer sw-params-ptr)
;; NOTE: set hardware before software, since sw values depend on it.
(let ((sw-params (mem-ref sw-params-ptr 'snd-pcm-sw-params-ptr)))
(macrolet ((sw-call (name &rest args)
"sw-calls are pcm-calls that also take a snd-pcm-sw-params-ptr.
Additionally they fail (cause an error) if the return code is "
`(minusp-fail "sw-call" ,name
(pcm-call ,(concatenate 'string "sw_params_" name)
snd-pcm-sw-params-ptr sw-params
,@args))))
;; NOTE: Software parameters.
;; NOTE: fill sw-params with the current settings.
(sw-call "current")
;; NOTE: this determines how much to fill the buffer before we start playing.
;; Usually you want it full or mostly full. I set it to the buffer-size since
;; and ASSUME our periods are an even division. The periods seem to be connected to
;; the start threshold somehow...
(sw-call "set_start_threshold" :uint32 (sound-buffer-size sound))
;; NOTE: avail_min is basically the period, since we don't want to write less than one period.
(sw-call "set_avail_min" :uint32 (sound-period-size sound))
;; NOTE: write the params to ALSA
(pcm-call "sw_params" snd-pcm-sw-params-ptr sw-params)
;; (pcm-call "sw_params_free"
;; snd-pcm-sw-params-ptr (mem-ref sw-params-ptr 'snd-pcm-sw-params-ptr))
))
(block print-sound-settings
(format t "access: ~a~%"
(foreign-funcall "snd_pcm_access_name"
snd-pcm-access-t (sound-access sound)
:string))
(format t "format: ~a~%"
(foreign-funcall "snd_pcm_format_name"
snd-pcm-format-t (sound-format sound)
:string))
(format t "samples-per-second: ~a~%buffer-size: ~a~%period-size: ~a~%num-channels: ~a~%resample?: ~a~%"
(sound-samples-per-second sound)
(sound-buffer-size sound)
(sound-period-size sound)
(sound-num-channels sound)
(sound-resample sound))))
;; NOTE: kick it off.
;; TODO: fail if failed.
(pcm-call "start")
;; NOTE: square wave
(loop until (< 48000 (square-wave-running-sample-index square-wave))
do
;; NOTE: check state for XRUN or SUSPENDED, and try to recover.
(case (foreign-funcall "snd_pcm_state"
snd-pcm-ptr pcm
snd-pcm-state-t)
(:snd_pcm_state_xrun (run-recovery -32 ; EPIPE
))
(:snd_pcm_state_suspended (run-recovery -86 ; ESTRPIPE
)))
(let ( ;; NOTE: necessary to call avail_update before snd_pcm_mmap_begin
(avail (pcm-call "avail_update")))
(cond
((minusp avail) (run-recovery avail))
((< avail (sound-period-size sound))
;; NOTE: check the number of frames available to write to is at least one period.
;; TODO: wait here?
)
(t
(loop with size = (sound-period-size sound)
while (plusp size)
do
(setf (mem-ref frames-ptr :uint32) size)
;; NOTE: Grabs the pointer to the chunk of memory we are writing to.
;; as well as the offset into the chunk and locks for writing
(minusp-recovery (pcm-call "mmap_begin"
:pointer sound-buffer
:pointer offset-ptr
:pointer frames-ptr))
(with-foreign-slots ((first step addr)
(mem-ref sound-buffer :pointer)
(:struct snd-pcm-channel-area-t))
(let* ((offset (mem-ref offset-ptr :uint32))
(frames (mem-ref frames-ptr :uint32))
;; first is in bits
(first-byte-offset (floor first 8))
(bytes-per-sample 2)
;; Steps are in bits-per-sample.
(step-size-per-byte (floor step 8))
(samples (inc-pointer addr (+ first-byte-offset
(* offset step-size-per-byte)))))
(loop repeat frames
do
(let ((sample-value
(if (/= 0 (mod (floor (square-wave-running-sample-index square-wave)
(square-wave-half-period square-wave))
2))
(square-wave-volume square-wave)
(- (square-wave-volume square-wave)))))
(incf (square-wave-running-sample-index square-wave))
(setf (mem-ref samples :int16) sample-value)
(incf-pointer samples bytes-per-sample)
(setf (mem-ref samples :int16) sample-value)
(incf-pointer samples bytes-per-sample)))
;; NOTE: Commits the changes and releases the lock.
(let ((commits (pcm-call "mmap_commit"
:uint32 offset
:uint32 frames)))
(when (or (minusp commits)
(/= commits frames))
(run-recovery (if (minusp commits)
commits
;; NOTE: error is -EPIPE if commits is positive
-32))))
(decf size frames))))))))
(pcm-call "close")))))))
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment