alsa-dispatcher.lsp

   1 #!/usr/bin/newlisp
   2
   3 ;; This is the main script for the pcm-dispatch tool
   4 ;; last main-arg nominates the configuration file
   5
   6 ; ############################################################
   7 ; misc API
   8 (signal 1 (fn (x) (exit 0)))
   9 (signal 2 (fn (x) (exit 0)))
  10 (signal 15 (fn (x) (exit 0)))
  11
  12 ; Optionally print output to stderr and optionally exit with code
  13 (define (die N)
  14   (when (args) (write-line 2 (join (map string (args)) " ")))
  15   (when (number? N) (exit N)))
  16
  17 ; Return non-nil for comment line (starts with # or is blank)
  18 (define (comment? LINE) (regex "^\\s*(#|$)" LINE 0))
  19
  20 ; Return list of space-separated words on a line
  21 (define (words LINE)
  22   (parse (trim LINE) "\\s+" 0))
  23
  24 ; Read the configuration file and return it as list of plugs or the default
  25 (define (read-config FILE)
  26   (or
  27    (if (read-file FILE) (map words (clean comment? (parse $it "\n"))))
  28    '(("plughw")) ; the default priority list
  29    ))
  30
  31 ;; ############################################################
  32 ;; Load Configuration (~/.alsa-dispatcher)
  33 ; Format: one-liners for each option, ignoring comment lines starting
  34 ; with # and blank lines.
  35 (constant
  36  'CFGMAP (read-config (format "%s/.alsa-dispatcher" (env "HOME")))
  37  'PCM-LIST (map first CFGMAP)
  38  )
  39
  40 ; Return value of configuration setting KEY for plug PCM, or DEFAULT.
  41 (define (cfg-lookup PCM KEY DEFAULT)
  42   (if (if (assoc PCM CFGMAP) (lookup KEY $it)) (read-expr $it) DEFAULT))
  43
  44 ; ############################################################
  45 ; libc API
  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
  48
  49 ;; (dup2 OLDFD NEWFD) - Duplicate file descriptor OLDFD onto NEWFD,
  50 ;; closing the latter first if open.
  51 (import libc.so.6 "dup2" "int"
  52         "int" ; int oldfd
  53         "int" ; int newfd
  54         )
  55
  56 ; ############################################################
  57 ; libasound API
  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
  61
  62 ;; Used constants
  63 (constant
  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
  68  )
  69
  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
  74         )
  75
  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
  79 ;; frames.
  80 (import libasound.so "snd_pcm_drain" "int"
  81         "void*" ; snd_pcm_t *pcm
  82         )
  83
  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
  90                      "int"   ; int mode
  91                      )))
  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))))))
  96
  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
 107         )
 108
 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
 118         )
 119
 120 ;; Open a PCM by name. Returns list of (NAME PCM) or nil.
 121 (define (open-pcm NAME)
 122   (if (snd_pcm_open NAME SND_PCM_STREAM_PLAYBACK SND_PCM_MODE_BLOCK)
 123       (list NAME $it)))
 124
 125 ;; Setup PCM. Preset format. access, channels, rate and soft resample.
 126 ;; Configurable latency.
 127 (define (setup-pcm PCM NAME)
 128   (let ((LATENCY (cfg-lookup NAME "latency" 100000)))
 129     (snd_pcm_set_params PCM SND_PCM_FORMAT_S16_LE SND_PCM_ACCESS_RW_INTERLEAVED
 130                         2 48000 1 LATENCY )))
 131
 132 ;; ############################################################
 133 ; The main program
 134
 135 ; redirect stdout/err to /dev/null (flagged for debugging purposes)
 136 (when true
 137   (let ((REDIR (open "/dev/null" "append")))
 138     (when (< REDIR) (exit 1))
 139     (when (< (dup2 REDIR 2)) (exit 1))
 140     (when (< (dup2 REDIR 1)) (exit 1))
 141     (close REDIR)
 142   ))
 143
 144 ; find the first usable PCM
 145 (map set '(NAME PCM) (unless (dolist (N PCM-LIST (open-pcm N)))
 146                        (die 1 "No PCM available")))
 147
 148 ; configure the PCM
 149 (when (!= (setf E (setup-pcm PCM NAME)))
 150   (snd_pcm_close PCM)
 151   (die 1 "setup pcm" E))
 152
 153 ; channel stdin audio onto selected pcm
 154 (while (> (or (setf N (read 0 BUFFER 2000000)) 0))
 155   (while (> N)
 156     ; N  is in bytes while snd_pcm_writei counts "frames" of 4 bytes
 157     (when (< (setf E (snd_pcm_writei PCM BUFFER (/ N 4))))
 158       (snd_pcm_close PCM)
 159       (die 1 "writing failed"))
 160     (setf E (* E 4))
 161     (setf BUFFER (E BUFFER))
 162     (dec N E)
 163     )
 164   )
 165
 166 ; let the pcm complete its output
 167 (snd_pcm_drain PCM)
 168
 169 (snd_pcm_close PCM)
 170 (exit 0)