1 ;; This is the main script for the pcm-dispatch tool
2 ;; last main-arg nominates the configuration file
4 (signal 1 (fn (x) (exit 0)))
5 (signal 2 (fn (x) (exit 0)))
6 (signal 15 (fn (x) (exit 0)))
10 ; load contexts libasound and ALSA
11 (load "libasound.lsp")
13 (unless (> (length (main-args)) 1)
14 (die 1 "Usage: <config>"))
17 (import LIB "dup2" "int"
24 CONFIGFILE (main-args -1)
25 CONFIGTEXT (read-file CONFIGFILE)
26 CONFIG (read-expr CONFIGTEXT)
27 PCM-LIST (rest (assoc "PCM-LIST" CONFIG))
30 (define (open-pcm PCM)
31 (ALSA:snd_pcm_open PCM libasound:SND_PCM_STREAM_PLAYBACK 0 ))
33 (define (setup-pcm PCM)
34 (libasound:snd_pcm_set_params
36 libasound:SND_PCM_FORMAT_S16_LE
37 libasound:SND_PCM_ACCESS_RW_INTERLEAVED
40 1 ; soft resample (0/1)
41 10000 ; latency (microseconds)
44 ;(! (format "ls -l /proc/%d/fd" (sys-info 7)))
45 (let ((REDIR (open "/dev/null" "append"))) ; "/tmp/test1"
46 (when (< REDIR) (exit 1))
47 (when (< (libc:dup2 REDIR 2)) (exit 1))
48 (when (< (libc:dup2 REDIR 1)) (exit 1))
51 ;; Change ALSA configuration for this process
52 (setf KEY "pcm.out1.device" VALUE "20:74:CF:C0:22:81")
53 (when (!= (setf E (ALSA:set_config_string KEY VALUE)))
54 (die 1 "set_config_string " E))
56 ;; Find first usable PCM
57 (setf PCM (unless (dolist (PCM PCM-LIST (open-pcm PCM)))
58 (die 1 "No PCM available")))
61 (dotimes (x 1000 (!= -32 (libasound:snd_pcm_wait PCM -1)))
64 (when (!= (setf E (setup-pcm PCM)))
65 (libasound:snd_pcm_close PCM)
66 (die 1 "set params" E))
68 ;;(die nil "status" (libasound:snd_pcm_start PCM))
70 (setf N 0 x 0 E 0 i 0)
72 ;(define BUFFER:BUFFER (dup "\000" 1000008))
75 (while (> (or (setf N (read 0 BUFFER 20000000)) 0))
76 ;(println "reading " N)
80 (when (< (setf E (libasound:snd_pcm_writei PCM CACHE (/ N 4))))
81 (libasound:snd_pcm_close PCM)
82 (die 1 "writing" E N))
84 (setf CACHE (E CACHE))
90 (libasound:snd_pcm_wait PCM -1)
92 (libasound:snd_pcm_drain PCM)
93 (libasound:snd_pcm_close PCM)