From: Ralph Ronnquist Date: Thu, 27 Apr 2023 06:24:57 +0000 (+1000) Subject: Initial plain dispatcher X-Git-Url: https://git.rrq.au/?a=commitdiff_plain;h=d13b34b016a6b4b63de2720a7574527fa1c94b46;p=rrq%2Fnewlisp%2Falsa-dispatcher.git Initial plain dispatcher --- d13b34b016a6b4b63de2720a7574527fa1c94b46 diff --git a/alsa-dispatcher.lsp b/alsa-dispatcher.lsp new file mode 100644 index 0000000..8468a12 --- /dev/null +++ b/alsa-dispatcher.lsp @@ -0,0 +1,185 @@ +;; This is the main script for the pcm-dispatch tool +;; last main-arg nominates the configuration file + +; ############################################################ +; misc API +(signal 1 (fn (x) (exit 0))) +(signal 2 (fn (x) (exit 0))) +(signal 15 (fn (x) (exit 0))) + +(define (die N) + (when (args) (write-line 2 (join (map string (args)) " "))) + (when (number? N) (exit N))) + +(define (enlist X) (if (list? X) X (list X))) + +(define (comment? LINE) (and (regex "^\\s*(#|$)" LINE 0) true)) + +(define (first-word LINE) (and (regex "^\\s*(\\S+)" LINE 0) $1)) + +(define (prog1 X) X) + +(define (read-config-line LINE) + (map (fn (x) (if (regex "^([^=]+)=(.*)" x) (list $1 $2) x)) + (map trim (find-all "([^, ]+)" LINE $1 0)))) + +;; ############################################################ +;; Load Configuration (~/.alsa-dispatcher) +; Format: one-liners for each option, ignoring comment lines starting +; with # and blank lines. +(constant + 'HOME (env "HOME") + 'CONFIG (format "%s/.alsa-dispatcher" HOME) + 'CFGLINES (if (read-file CONFIG) (clean comment? (parse $it "\n" )) + '("bt,latency=1000" "plughw")) + 'CFGMAP (map read-config-line CFGLINES) + 'PCM-LIST (map first-word CFGLINES) + ) + +(define (cfg-lookup PCM KEY DEFAULT) + (if (if (assoc PCM CFGMAP) (lookup KEY $it)) (read-expr $it) DEFAULT)) + +; ############################################################ +; libc API +(constant 'libc.so.6 "/lib/x86_64-linux-gnu/libc.so.6") +; https://www.gnu.org/software/libc/manual/html_mono/libc.html + +;; (dup2 OLDFD NEWFD) - Duplicate file descriptor OLDFD onto NEWFD, +;; closing the latter first if open. +(import libc.so.6 "dup2" "int" + "int" ; int oldfd + "int" ; int newfd + ) + +; ############################################################ +; libasound API +(constant 'libasound.so "/usr/lib/x86_64-linux-gnu/libasound.so") +; https://www.alsa-project.org/alsa-doc/alsa-lib/ +; /usr/include/asm-generic/errno-base.h + +;; Used constants +(constant + 'SND_PCM_STREAM_PLAYBACK 0 + 'SND_PCM_MODE_BLOCK 0 ; this mode label is invented here + 'SND_PCM_FORMAT_S16_LE 2 + 'SND_PCM_ACCESS_RW_INTERLEAVED 3 + ) + +;; (snd_pcm_close PCM) - Close PCM handle. Closes the given PCM handle +;; and frees all associated resources. (The PCM reference is probably +;; "invalid" after closing) +(import libasound.so "snd_pcm_close" "int" + "void*" ; snd_pcm_t *pcm + ) + +;; (snd_pcm_drain PCM) - Stop PCM whilst preserving pending frames. +;; For playback wait for all pending frames to be played and then stop +;; the PCM. For capture stop PCM permitting to retrieve residual +;; frames. +(import libasound.so "snd_pcm_drain" "int" + "void*" ; snd_pcm_t *pcm + ) + +;; (snd_pcm_open NAME STREAM MODE) - Opens a PCM and returns its +;; handle or nil. Actual error code is discarded. +(letex ((IMP (import libasound.so "snd_pcm_open" "int" + "void*" ; snd_pcm_t **pcmp [output] + "char*" ; const char *name + "int" ; snd_pcm_stream_t stream + "int" ; int mode + ))) + (constant 'snd_pcm_open ; redefine the symbol to wrap the import + (fn (NAME STREAM MODE) + (let ((PCM (pack "Lu" 0))) + (when (= (IMP PCM NAME STREAM MODE)) ((unpack "Lu" PCM) 0)))))) + +;; (snd_pcm_set_params PCM FMT ACCESS CH RATE RESAMPLE LATENCY) - Set +;; the hardware and software parameters in a simple way. +(import libasound.so "snd_pcm_set_params" "int" + "void*" ; snd_pcm_t *pcm + "int" ; snd_pcm_format_t format + "int" ; snd_pcm_access_t access + "unsigned int" ; unsigned int channels + "unsigned int" ; unsigned int rate + "int" ;int soft_resample + "unsigned int" ; unsigned int latency + ) + +;; (snd_pcm_wait PCM TIMEOUT) - Wait for a PCM to become ready. +;; Returns a positive value on success otherwise a negative error code +;; (-EPIPE [-32] for the xrun and -ESTRPIPE [-86] for the suspended +;; status, others for general errors) +(import libasound.so "snd_pcm_wait" "int" + "void*" ; snd_pcm_t *pcm + "int" ; int timeout + ) + +;; (snd_pcm_writei PCM BUFFER FRAMES) - Write interleaved frames to a +;; PCM. If the blocking behaviour is selected and the PCM is running, +;; then routine waits until all requested frames are played or put to +;; the playback ring buffer. The returned number of frames can be less +;; only if a signal or underrun occurred. +(import libasound.so "snd_pcm_writei" "long" ; snd_pcm_uframes_t + "void*" ; snd_pcm_t *pcm + "void*" ; const void *buffer + "long" ; snd_pcm_uframes_t size + ) + +;; Open a PCM by name +(define (open-pcm NAME) + (snd_pcm_open NAME SND_PCM_STREAM_PLAYBACK SND_PCM_MODE_BLOCK)) + +;; Setup PCM +(define (setup-pcm PCM) + (snd_pcm_set_params PCM + (cfg-lookup PCM "format" SND_PCM_FORMAT_S16_LE) + SND_PCM_ACCESS_RW_INTERLEAVED + (cfg-lookup PCM "channels" 2) + (cfg-lookup PCM "rate" 48000) + 1 ; soft resample (0/1) + (cfg-lookup PCM "latency" 100000) ; (microseconds) + )) + +;; ############################################################ +; The main program + +;; redirect stdout/err to /dev/null +(when nil + (let ((REDIR (open "/dev/null" "append"))) + (when (< REDIR) (exit 1)) + (when (< (libc:dup2 REDIR 2)) (exit 1)) + (when (< (libc:dup2 REDIR 1)) (exit 1)) + (close REDIR) + )) + +; find the first usable PCM +(setf PCM (unless (dolist (NAME PCM-LIST (open-pcm NAME))) + (die 1 "No PCM available"))) + +; configure the PCM +(when (!= (setf E (setup-pcm PCM))) + (snd_pcm_close PCM) + (die 1 "set params" E)) + +(setf N 0 x 0 E 0 i 0) + +(setf CACHE nil) +(while (> (or (setf N (read 0 BUFFER 20000000)) 0)) + ;(println "reading " N) + (setf CACHE BUFFER) + (while (> N) + ;;(ready PCM) + (when (< (setf E (snd_pcm_writei PCM CACHE (/ N 4)))) + (snd_pcm_close PCM) + (die 1 "writing" E N)) + (setf E (* E 4)) + (setf CACHE (E CACHE)) + ;(println "wrote " E) + (dec N E) + ) + ) + +(snd_pcm_wait PCM -1) +(snd_pcm_drain PCM) +(snd_pcm_close PCM) +(exit 0)