alsa-dispatcher.lsp

   1 #!/usr/bin/newlisp
   2
   3 ;; This script implements dispacth of stdin via first available for
   4 ;; ALSA pcm listed in $HOME/.alsa-dispatcher
   5 ;;
   6 ;; Debug testing, eg
   7 ;; IN=/usr/share/sounds/alsa/Rear_Left.wav
   8 ;; sox $IN -r48000 -esigned -es-b16 -c2 x.wav | ./alsa-dispatcher
   9 ;; o.e. send audio in format [48000 Hz S16_LE stereo wav] to the program
  10 ;;
  11 ;; Installation requires ALSA configuration, e.g. in ~/.asoundrc, like
  12 ;; (replace $PROGRAM with the program's full pathname)
  13 ;; ----
  14 ;; pcm.dispatch {
  15 ;;     type asym
  16 ;;     playback {
  17 ;;         pcm {
  18 ;;             type plug
  19 ;;             slave {
  20 ;;                 pcm "file:|exec $PROGRAM"
  21 ;;                 format S16_LE; channels 2; rate 48000
  22 ;;             }
  23 ;;         }
  24 ;;     }
  25 ;;     capture plughw
  26 ;; }
  27 ;; ----
  28 ;; $ aplav -D dispatch /usr/share/sounds/alsa/Rear_Left.wav
  29 ;;
  30 ;; Maybe setup "dispatch" as default
  31 ;; ----
  32 ;; pcm.!default dispatch
  33 ;; ----
  34
  35 (constant 'DEBUG nil) ;; Set to true to get stdout/stderr while degugging
  36 ; ############################################################
  37 ; misc API
  38 (signal 1 (fn (x) (exit 0)))
  39 (signal 2 (fn (x) (exit 0)))
  40 (signal 15 (fn (x) (exit 0)))
  41
  42 ; Optionally print output to stderr and optionally exit with code
  43 (define (die N)
  44   (when (args) (write-line 2 (join (map string (args)) " ")))
  45   (when (number? N) (exit N)))
  46
  47 ; Return non-nil for comment line (starts with # or is blank)
  48 (define (comment? LINE) (regex "^\\s*(#|$)" LINE 0))
  49
  50 ; Return list of space-separated words on a line
  51 (define (words LINE)
  52   (parse (trim LINE) "\\s+" 0))
  53
  54 ; Read the configuration file and return it as list of plugs or the default
  55 (define (read-config FILE)
  56   (or
  57    (if (read-file FILE) (map words (clean comment? (parse $it "\n"))))
  58    '(("plughw")) ; the default priority list
  59    ))
  60
  61 ;; ############################################################
  62 ;; Load Configuration (~/.alsa-dispatcher)
  63 ; Format: one-liners for each option, ignoring comment lines starting
  64 ; with # and blank lines.
  65 (constant
  66  'CFGMAP (read-config (format "%s/.alsa-dispatcher" (env "HOME")))
  67  'PCM-LIST (map first CFGMAP)
  68  )
  69
  70 ; Return value of configuration setting KEY for plug PCM, or DEFAULT.
  71 ; Only"latency=N" is possible; default 100000 (microseconds).
  72 (define (cfg-lookup PCM KEY DEFAULT)
  73   (if (if (assoc PCM CFGMAP) (lookup KEY $it)) (read-expr $it) DEFAULT))
  74
  75 ; ############################################################
  76 ; libc API
  77 ; https://www.gnu.org/software/libc/manual/html_mono/libc.html
  78 (constant 'libc.so.6 "/lib/x86_64-linux-gnu/libc.so.6")
  79
  80 ;; (dup2 OLDFD NEWFD) - Duplicate file descriptor OLDFD onto NEWFD,
  81 ;; closing the latter first if open.
  82 (import libc.so.6 "dup2" "int"
  83         "int" ; int oldfd
  84         "int" ; int newfd
  85         )
  86
  87 ; ############################################################
  88 ; libasound API
  89 ; https://www.alsa-project.org/alsa-doc/alsa-lib/
  90 ; /usr/include/asm-generic/errno-base.h
  91 (constant 'libasound.so "/usr/lib/x86_64-linux-gnu/libasound.so")
  92
  93 ;; Selected libasound constants
  94 (constant
  95  'SND_PCM_STREAM_PLAYBACK 0
  96  'SND_PCM_MODE_BLOCK 0 ; this mode label is invented here
  97  'SND_PCM_FORMAT_S16_LE 2
  98  'SND_PCM_ACCESS_RW_INTERLEAVED 3
  99  )
 100
 101 ;; (snd_pcm_close PCM) - Close PCM. Closes the given PCM and frees all
 102 ;; associated resources.
 103 (import libasound.so "snd_pcm_close" "int"
 104         "void*" ; snd_pcm_t *pcm
 105         )
 106
 107 ;; (snd_pcm_drain PCM) - Stop PCM whilst preserving pending frames.
 108 ;; For playback: wait for all pending frames to be played and then
 109 ;; stop the PCM. For capture: stop PCM permitting to retrieve residual
 110 ;; frames.
 111 (import libasound.so "snd_pcm_drain" "int"
 112         "void*" ; snd_pcm_t *pcm
 113         )
 114
 115 ;; (snd_pcm_open NAME STREAM MODE) - Opens a PCM and returns its
 116 ;; address or nil. Any actual error code is discarded.
 117 ; Need wrapping so as to provide a memory slot for the returned PCM
 118 ; address. Newlisp doesn't support call-by-reference parameters well.
 119 (letex ((IMP (import libasound.so "snd_pcm_open" "int"
 120                      "void*" ; snd_pcm_t **pcmp [output]
 121                      "char*" ; const char *name
 122                      "int"   ; snd_pcm_stream_t stream
 123                      "int"   ; int mode
 124                      )))
 125   (constant 'snd_pcm_open ; redefine the symbol to wrap the import
 126    (fn (NAME STREAM MODE)
 127      (let ((PCM (pack "Lu" 0)))
 128        (when (= (IMP PCM NAME STREAM MODE)) ((unpack "Lu" PCM) 0))))))
 129
 130 ;; (snd_pcm_set_params PCM FMT ACCESS CH RATE RESAMPLE LATENCY) - Set
 131 ;; hardware and software parameters in a simple way.
 132 (import libasound.so "snd_pcm_set_params" "int"
 133         "void*" ; snd_pcm_t *pcm
 134         "int"   ; snd_pcm_format_t format
 135         "int"   ; snd_pcm_access_t access
 136         "unsigned int" ; unsigned int channels
 137         "unsigned int" ; unsigned int rate
 138         "int"   ;int soft_resample
 139         "unsigned int" ; unsigned int latency
 140         )
 141
 142 ;; (snd_pcm_writei PCM BUFFER FRAMES) - Write interleaved frames to a
 143 ;; PCM. If the blocking behaviour is selected and the PCM is running,
 144 ;; then routine waits until all requested frames are played or put to
 145 ;; the playback ring buffer. The returned number of frames can be less
 146 ;; only if a signal or underrun occurred.
 147 (import libasound.so "snd_pcm_writei" "long" ; snd_pcm_uframes_t
 148         "void*" ; snd_pcm_t *pcm
 149         "void*" ; const void *buffer
 150         "long"   ; snd_pcm_uframes_t size
 151         )
 152
 153 ;; Open a PCM by name. Returns list of (NAME PCM) or nil.
 154 (define (open-pcm NAME)
 155   (if (snd_pcm_open NAME SND_PCM_STREAM_PLAYBACK SND_PCM_MODE_BLOCK)
 156       (list NAME $it)))
 157
 158 ;; Setup PCM. Preset format. access, channels, rate and soft resample.
 159 ;; Configurable latency.
 160 (define (setup-pcm PCM NAME)
 161   (let ((LATENCY (cfg-lookup NAME "latency" 100000)))
 162     (snd_pcm_set_params PCM SND_PCM_FORMAT_S16_LE SND_PCM_ACCESS_RW_INTERLEAVED
 163                         2 48000 1 LATENCY )))
 164
 165 ;; ############################################################
 166 ; The main program
 167
 168 ; redirect stdout/err to /dev/null (flagged for debugging purposes)
 169 (when (not DEBUG)
 170   (let ((REDIR (open "/dev/null" "append")))
 171     (when (< REDIR) (exit 1))
 172     (when (< (dup2 REDIR 2)) (exit 1))
 173     (when (< (dup2 REDIR 1)) (exit 1))
 174     (close REDIR)
 175   ))
 176
 177 ; find the first usable PCM
 178 (map set '(NAME PCM) (unless (dolist (N PCM-LIST (open-pcm N)))
 179                        (die 1 "No PCM available")))
 180
 181 ; configure the PCM
 182 (when (!= (setf E (setup-pcm PCM NAME)))
 183   (snd_pcm_close PCM)
 184   (die 1 "setup pcm" E))
 185
 186 ; channel stdin audio onto selected pcm
 187 (while (> (or (setf N (read 0 BUFFER 2000000)) 0))
 188   (while (> N)
 189     ; N  is in bytes while snd_pcm_writei counts "frames" of 4 bytes
 190     (when (< (setf E (snd_pcm_writei PCM BUFFER (/ N 4))))
 191       (snd_pcm_close PCM)
 192       (die 1 "writing failed"))
 193     (setf E (* E 4))
 194     (setf BUFFER (E BUFFER))
 195     (dec N E)
 196     )
 197   )
 198
 199 ; let the pcm complete its output
 200 (snd_pcm_drain PCM)
 201
 202 (snd_pcm_close PCM)
 203 (exit 0)