editorial
[rrq/newlisp/alsa-dispatcher.git] / alsa-dispatcher.lsp
old mode 100644 (file)
new mode 100755 (executable)
index 8468a12..2439aec
@@ -1,48 +1,81 @@
-;; This is the main script for the pcm-dispatch tool
-;; last main-arg nominates the configuration file
-
+#!/usr/bin/newlisp
+
+;; This script implements dispacth of stdin via first available for
+;; ALSA pcm listed in $HOME/.alsa-dispatcher
+;;
+;; Debug testing, eg
+;; IN=/usr/share/sounds/alsa/Rear_Left.wav
+;; sox $IN -r48000 -esigned -es-b16 -c2 x.wav | ./alsa-dispatcher
+;; o.e. send audio in format [48000 Hz S16_LE stereo wav] to the program
+;;
+;; Installation requires ALSA configuration, e.g. in ~/.asoundrc, like
+;; (replace $PROGRAM with the program's full pathname)
+;; ----
+;; pcm.dispatch {
+;;     type asym
+;;     playback {
+;;         pcm {
+;;             type plug
+;;             slave {
+;;                        pcm "file:|exec $PROGRAM"
+;;                 format S16_LE; channels 2; rate 48000
+;;             }
+;;         }
+;;     }
+;;     capture plughw
+;; }
+;; ----
+;; $ aplav -D dispatch /usr/share/sounds/alsa/Rear_Left.wav
+;;
+;; Maybe setup "dispatch" as default
+;; ----
+;; pcm.!default dispatch
+;; ----
+
+(constant 'DEBUG nil) ;; Set to true to get stdout/stderr while degugging
 ; ############################################################
 ; misc API
 (signal 1 (fn (x) (exit 0)))
 (signal 2 (fn (x) (exit 0)))
 (signal 15 (fn (x) (exit 0)))
 
+; Optionally print output to stderr and optionally exit with code
 (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))
+; Return non-nil for comment line (starts with # or is blank)
+(define (comment? LINE) (regex "^\\s*(#|$)" LINE 0))
 
-(define (first-word LINE) (and (regex "^\\s*(\\S+)" LINE 0) $1))
+; Return list of space-separated words on a line
+(define (words LINE)
+  (parse (trim LINE) "\\s+" 0))
 
-(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))))
+; Read the configuration file and return it as list of plugs or the default
+(define (read-config FILE)
+  (or
+   (if (read-file FILE) (map words (clean comment? (parse $it "\n"))))
+   '(("plughw")) ; the default priority list
+   ))
 
 ;; ############################################################
 ;; 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)
+ 'CFGMAP (read-config (format "%s/.alsa-dispatcher" (env "HOME")))
+ 'PCM-LIST (map first CFGMAP)
  )
 
+; Return value of configuration setting KEY for plug PCM, or DEFAULT.
+; Only"latency=N" is possible; default 100000 (microseconds).
 (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
+(constant 'libc.so.6 "/lib/x86_64-linux-gnu/libc.so.6")
 
 ;; (dup2 OLDFD NEWFD) - Duplicate file descriptor OLDFD onto NEWFD,
 ;; closing the latter first if open.
 
 ; ############################################################
 ; 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
+(constant 'libasound.so "/usr/lib/x86_64-linux-gnu/libasound.so")
 
-;; Used constants
+;; Selected libasound constants
 (constant
  'SND_PCM_STREAM_PLAYBACK 0
  'SND_PCM_MODE_BLOCK 0 ; this mode label is invented here
  '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)
+;; (snd_pcm_close PCM) - Close PCM. Closes the given PCM and frees all
+;; associated resources.
 (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
+;; 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.
+;; address or nil. Any actual error code is discarded.
+; Need wrapping so as to provide a memory slot for the returned PCM
+; address. Newlisp doesn't support call-by-reference parameters well.
 (letex ((IMP (import libasound.so "snd_pcm_open" "int"
                      "void*" ; snd_pcm_t **pcmp [output]
                      "char*" ; const char *name
        (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.
+;; 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
         "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
         "long"   ; snd_pcm_uframes_t size
         )
 
-;; Open a PCM by name
+;; Open a PCM by name. Returns list of (NAME PCM) or nil.
 (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)
-                      ))
+  (if (snd_pcm_open NAME SND_PCM_STREAM_PLAYBACK SND_PCM_MODE_BLOCK)
+      (list NAME $it)))
+
+;; Setup PCM. Preset format. access, channels, rate and soft resample.
+;; Configurable latency.
+(define (setup-pcm PCM NAME)
+  (let ((LATENCY (cfg-lookup NAME "latency" 100000)))
+    (snd_pcm_set_params PCM SND_PCM_FORMAT_S16_LE SND_PCM_ACCESS_RW_INTERLEAVED
+                        2 48000 1 LATENCY )))
 
 ;; ############################################################
 ; The main program
 
-;; redirect stdout/err to /dev/null
-(when nil
+; redirect stdout/err to /dev/null (flagged for debugging purposes)
+(when (not DEBUG)
   (let ((REDIR (open "/dev/null" "append")))
     (when (< REDIR) (exit 1))
-    (when (< (libc:dup2 REDIR 2)) (exit 1))
-    (when (< (libc:dup2 REDIR 1)) (exit 1))
+    (when (< (dup2 REDIR 2)) (exit 1))
+    (when (< (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")))
+(map set '(NAME PCM) (unless (dolist (N PCM-LIST (open-pcm N)))
+                       (die 1 "No PCM available")))
 
 ; configure the PCM
-(when (!= (setf E (setup-pcm PCM)))
+(when (!= (setf E (setup-pcm PCM NAME)))
   (snd_pcm_close PCM)
-  (die 1 "set params" E))
-
-(setf N 0 x 0 E 0 i 0)
+  (die 1 "setup pcm" E))
 
-(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))))
+; channel stdin audio onto selected pcm
+(while (> (or (setf N (read 0 BUFFER 2000000)) 0))
+  (while (> N)
+    ; N  is in bytes while snd_pcm_writei counts "frames" of 4 bytes
+    (when (< (setf E (snd_pcm_writei PCM BUFFER (/ N 4))))
       (snd_pcm_close PCM)
-      (die 1 "writing" E N))
+      (die 1 "writing failed"))
     (setf E (* E 4))
-    (setf CACHE (E CACHE))
-    ;(println "wrote " E)
+    (setf BUFFER (E BUFFER))
     (dec N E)
     )
   )
 
-(snd_pcm_wait PCM -1)
+; let the pcm complete its output
 (snd_pcm_drain PCM)
+
 (snd_pcm_close PCM)
 (exit 0)