1 ;; This is the main script for the pcm-dispatch tool
2 ;; last main-arg nominates the configuration file
4 ; ############################################################
6 (signal 1 (fn (x) (exit 0)))
7 (signal 2 (fn (x) (exit 0)))
8 (signal 15 (fn (x) (exit 0)))
11 (when (args) (write-line 2 (join (map string (args)) " ")))
12 (when (number? N) (exit N)))
14 (define (enlist X) (if (list? X) X (list X)))
16 (define (comment? LINE) (and (regex "^\\s*(#|$)" LINE 0) true))
18 (define (first-word LINE) (and (regex "^\\s*(\\S+)" LINE 0) $1))
22 (define (read-config-line LINE)
23 (map (fn (x) (if (regex "^([^=]+)=(.*)" x) (list $1 $2) x))
24 (map trim (find-all "([^, ]+)" LINE $1 0))))
26 ;; ############################################################
27 ;; Load Configuration (~/.alsa-dispatcher)
28 ; Format: one-liners for each option, ignoring comment lines starting
29 ; with # and blank lines.
32 'CONFIG (format "%s/.alsa-dispatcher" HOME)
33 'CFGLINES (if (read-file CONFIG) (clean comment? (parse $it "\n" ))
34 '("bt,latency=1000" "plughw"))
35 'CFGMAP (map read-config-line CFGLINES)
36 'PCM-LIST (map first-word CFGLINES)
39 (define (cfg-lookup PCM KEY DEFAULT)
40 (if (if (assoc PCM CFGMAP) (lookup KEY $it)) (read-expr $it) DEFAULT))
42 ; ############################################################
44 (constant 'libc.so.6 "/lib/x86_64-linux-gnu/libc.so.6")
45 ; https://www.gnu.org/software/libc/manual/html_mono/libc.html
47 ;; (dup2 OLDFD NEWFD) - Duplicate file descriptor OLDFD onto NEWFD,
48 ;; closing the latter first if open.
49 (import libc.so.6 "dup2" "int"
54 ; ############################################################
56 (constant 'libasound.so "/usr/lib/x86_64-linux-gnu/libasound.so")
57 ; https://www.alsa-project.org/alsa-doc/alsa-lib/
58 ; /usr/include/asm-generic/errno-base.h
62 'SND_PCM_STREAM_PLAYBACK 0
63 'SND_PCM_MODE_BLOCK 0 ; this mode label is invented here
64 'SND_PCM_FORMAT_S16_LE 2
65 'SND_PCM_ACCESS_RW_INTERLEAVED 3
68 ;; (snd_pcm_close PCM) - Close PCM handle. Closes the given PCM handle
69 ;; and frees all associated resources. (The PCM reference is probably
70 ;; "invalid" after closing)
71 (import libasound.so "snd_pcm_close" "int"
72 "void*" ; snd_pcm_t *pcm
75 ;; (snd_pcm_drain PCM) - Stop PCM whilst preserving pending frames.
76 ;; For playback wait for all pending frames to be played and then stop
77 ;; the PCM. For capture stop PCM permitting to retrieve residual
79 (import libasound.so "snd_pcm_drain" "int"
80 "void*" ; snd_pcm_t *pcm
83 ;; (snd_pcm_open NAME STREAM MODE) - Opens a PCM and returns its
84 ;; handle or nil. Actual error code is discarded.
85 (letex ((IMP (import libasound.so "snd_pcm_open" "int"
86 "void*" ; snd_pcm_t **pcmp [output]
87 "char*" ; const char *name
88 "int" ; snd_pcm_stream_t stream
91 (constant 'snd_pcm_open ; redefine the symbol to wrap the import
92 (fn (NAME STREAM MODE)
93 (let ((PCM (pack "Lu" 0)))
94 (when (= (IMP PCM NAME STREAM MODE)) ((unpack "Lu" PCM) 0))))))
96 ;; (snd_pcm_set_params PCM FMT ACCESS CH RATE RESAMPLE LATENCY) - Set
97 ;; the hardware and software parameters in a simple way.
98 (import libasound.so "snd_pcm_set_params" "int"
99 "void*" ; snd_pcm_t *pcm
100 "int" ; snd_pcm_format_t format
101 "int" ; snd_pcm_access_t access
102 "unsigned int" ; unsigned int channels
103 "unsigned int" ; unsigned int rate
104 "int" ;int soft_resample
105 "unsigned int" ; unsigned int latency
108 ;; (snd_pcm_wait PCM TIMEOUT) - Wait for a PCM to become ready.
109 ;; Returns a positive value on success otherwise a negative error code
110 ;; (-EPIPE [-32] for the xrun and -ESTRPIPE [-86] for the suspended
111 ;; status, others for general errors)
112 (import libasound.so "snd_pcm_wait" "int"
113 "void*" ; snd_pcm_t *pcm
117 ;; (snd_pcm_writei PCM BUFFER FRAMES) - Write interleaved frames to a
118 ;; PCM. If the blocking behaviour is selected and the PCM is running,
119 ;; then routine waits until all requested frames are played or put to
120 ;; the playback ring buffer. The returned number of frames can be less
121 ;; only if a signal or underrun occurred.
122 (import libasound.so "snd_pcm_writei" "long" ; snd_pcm_uframes_t
123 "void*" ; snd_pcm_t *pcm
124 "void*" ; const void *buffer
125 "long" ; snd_pcm_uframes_t size
128 ;; Open a PCM by name
129 (define (open-pcm NAME)
130 (snd_pcm_open NAME SND_PCM_STREAM_PLAYBACK SND_PCM_MODE_BLOCK))
133 (define (setup-pcm PCM)
134 (snd_pcm_set_params PCM
135 (cfg-lookup PCM "format" SND_PCM_FORMAT_S16_LE)
136 SND_PCM_ACCESS_RW_INTERLEAVED
137 (cfg-lookup PCM "channels" 2)
138 (cfg-lookup PCM "rate" 48000)
139 1 ; soft resample (0/1)
140 (cfg-lookup PCM "latency" 100000) ; (microseconds)
143 ;; ############################################################
146 ;; redirect stdout/err to /dev/null
148 (let ((REDIR (open "/dev/null" "append")))
149 (when (< REDIR) (exit 1))
150 (when (< (libc:dup2 REDIR 2)) (exit 1))
151 (when (< (libc:dup2 REDIR 1)) (exit 1))
155 ; find the first usable PCM
156 (setf PCM (unless (dolist (NAME PCM-LIST (open-pcm NAME)))
157 (die 1 "No PCM available")))
160 (when (!= (setf E (setup-pcm PCM)))
162 (die 1 "set params" E))
164 (setf N 0 x 0 E 0 i 0)
167 (while (> (or (setf N (read 0 BUFFER 20000000)) 0))
168 ;(println "reading " N)
172 (when (< (setf E (snd_pcm_writei PCM CACHE (/ N 4))))
174 (die 1 "writing" E N))
176 (setf CACHE (E CACHE))
177 ;(println "wrote " E)
182 (snd_pcm_wait PCM -1)