3 ;; This is the main script for the pcm-dispatch tool
4 ;; last main-arg nominates the configuration file
6 ; ############################################################
8 (signal 1 (fn (x) (exit 0)))
9 (signal 2 (fn (x) (exit 0)))
10 (signal 15 (fn (x) (exit 0)))
13 (when (args) (write-line 2 (join (map string (args)) " ")))
14 (when (number? N) (exit N)))
16 (define (enlist X) (if (list? X) X (list X)))
18 (define (comment? LINE) (and (regex "^\\s*(#|$)" LINE 0) true))
20 (define (first-word LINE) (and (regex "^\\s*(\\S+)" LINE 0) $1))
24 (define (read-config-line LINE)
25 (map (fn (x) (if (regex "^([^=]+)=(.*)" x) (list $1 $2) x))
26 (map trim (find-all "([^, ]+)" LINE $1 0))))
28 ;; ############################################################
29 ;; Load Configuration (~/.alsa-dispatcher)
30 ; Format: one-liners for each option, ignoring comment lines starting
31 ; with # and blank lines.
34 'CONFIG (format "%s/.alsa-dispatcher" HOME)
35 'CFGLINES (if (read-file CONFIG) (clean comment? (parse $it "\n" ))
36 '("bt,latency=1000" "plughw"))
37 'CFGMAP (map read-config-line CFGLINES)
38 'PCM-LIST (map first-word CFGLINES)
41 (define (cfg-lookup PCM KEY DEFAULT)
42 (if (if (assoc PCM CFGMAP) (lookup KEY $it)) (read-expr $it) DEFAULT))
44 ; ############################################################
46 (constant 'libc.so.6 "/lib/x86_64-linux-gnu/libc.so.6")
47 ; https://www.gnu.org/software/libc/manual/html_mono/libc.html
49 ;; (dup2 OLDFD NEWFD) - Duplicate file descriptor OLDFD onto NEWFD,
50 ;; closing the latter first if open.
51 (import libc.so.6 "dup2" "int"
56 ; ############################################################
58 (constant 'libasound.so "/usr/lib/x86_64-linux-gnu/libasound.so")
59 ; https://www.alsa-project.org/alsa-doc/alsa-lib/
60 ; /usr/include/asm-generic/errno-base.h
64 'SND_PCM_STREAM_PLAYBACK 0
65 'SND_PCM_MODE_BLOCK 0 ; this mode label is invented here
66 'SND_PCM_FORMAT_S16_LE 2
67 'SND_PCM_ACCESS_RW_INTERLEAVED 3
70 ;; (snd_pcm_close PCM) - Close PCM handle. Closes the given PCM handle
71 ;; and frees all associated resources.
72 (import libasound.so "snd_pcm_close" "int"
73 "void*" ; snd_pcm_t *pcm
76 ;; (snd_pcm_drain PCM) - Stop PCM whilst preserving pending frames.
77 ;; For playback wait for all pending frames to be played and then stop
78 ;; the PCM. For capture stop PCM permitting to retrieve residual
80 (import libasound.so "snd_pcm_drain" "int"
81 "void*" ; snd_pcm_t *pcm
84 ;; (snd_pcm_open NAME STREAM MODE) - Opens a PCM and returns its
85 ;; handle or nil. Actual error code is discarded.
86 (letex ((IMP (import libasound.so "snd_pcm_open" "int"
87 "void*" ; snd_pcm_t **pcmp [output]
88 "char*" ; const char *name
89 "int" ; snd_pcm_stream_t stream
92 (constant 'snd_pcm_open ; redefine the symbol to wrap the import
93 (fn (NAME STREAM MODE)
94 (let ((PCM (pack "Lu" 0)))
95 (when (= (IMP PCM NAME STREAM MODE)) ((unpack "Lu" PCM) 0))))))
97 ;; (snd_pcm_set_params PCM FMT ACCESS CH RATE RESAMPLE LATENCY) - Set
98 ;; the hardware and software parameters in a simple way.
99 (import libasound.so "snd_pcm_set_params" "int"
100 "void*" ; snd_pcm_t *pcm
101 "int" ; snd_pcm_format_t format
102 "int" ; snd_pcm_access_t access
103 "unsigned int" ; unsigned int channels
104 "unsigned int" ; unsigned int rate
105 "int" ;int soft_resample
106 "unsigned int" ; unsigned int latency
109 ;; (snd_pcm_writei PCM BUFFER FRAMES) - Write interleaved frames to a
110 ;; PCM. If the blocking behaviour is selected and the PCM is running,
111 ;; then routine waits until all requested frames are played or put to
112 ;; the playback ring buffer. The returned number of frames can be less
113 ;; only if a signal or underrun occurred.
114 (import libasound.so "snd_pcm_writei" "long" ; snd_pcm_uframes_t
115 "void*" ; snd_pcm_t *pcm
116 "void*" ; const void *buffer
117 "long" ; snd_pcm_uframes_t size
120 ;; Open a PCM by name
121 (define (open-pcm NAME)
122 (snd_pcm_open NAME SND_PCM_STREAM_PLAYBACK SND_PCM_MODE_BLOCK))
125 (define (setup-pcm PCM NAME)
126 (snd_pcm_set_params PCM
127 (cfg-lookup NAME "format" SND_PCM_FORMAT_S16_LE)
128 SND_PCM_ACCESS_RW_INTERLEAVED
131 1 ; soft resample (0/1)
132 (cfg-lookup NAME "latency" 100000) ; (microseconds)
135 ;; ############################################################
138 ;; redirect stdout/err to /dev/null
140 (let ((REDIR (open "/dev/null" "append")))
141 (when (< REDIR) (exit 1))
142 (when (< (dup2 REDIR 2)) (exit 1))
143 (when (< (dup2 REDIR 1)) (exit 1))
147 ; find the first usable PCM
148 (setf PCM (unless (dolist (N PCM-LIST (open-pcm (setf NAME N))))
149 (die 1 "No PCM available")))
152 (when (!= (setf E (setup-pcm PCM NAME)))
154 (die 1 "setup pcm" E))
156 (setf N 0 x 0 E 0 i 0)
158 (while (> (or (setf N (read 0 BUFFER 1000000)) 0))
160 (when (< (setf E (snd_pcm_writei PCM BUFFER (/ N 4))))
162 (die 1 "writing" E N))
164 (setf BUFFER (E BUFFER))