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 (define (die N)
  13   (when (args) (write-line 2 (join (map string (args)) " ")))
  14   (when (number? N) (exit N)))
  15
  16 (define (enlist X) (if (list? X) X (list X)))
  17
  18 (define (comment? LINE) (and (regex "^\\s*(#|$)" LINE 0) true))
  19
  20 (define (first-word LINE) (and (regex "^\\s*(\\S+)" LINE 0) $1))
  21
  22 (define (prog1 X) X)
  23
  24 (define (read-config-line LINE)
  25   (map (fn (x) (if (regex "^([^=]+)=(.*)" x) (list $1 $2) x))
  26        (map trim (find-all "([^, ]+)" LINE $1 0))))
  27
  28 ;; ############################################################
  29 ;; Load Configuration (~/.alsa-dispatcher)
  30 ; Format: one-liners for each option, ignoring comment lines starting
  31 ; with # and blank lines.
  32 (constant
  33  'HOME (env "HOME")
  34  'CONFIG (format "%s/.alsa-dispatcher" HOME)
  35  'CFGLINES (if (read-file CONFIG) (clean comment? (parse $it "\n" ))
  36              '("bt,latency=1000" "plughw"))
  37  'CFGMAP (map read-config-line CFGLINES)
  38  'PCM-LIST (map first-word CFGLINES)
  39  )
  40
  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
 121 (define (open-pcm NAME)
 122   (snd_pcm_open NAME SND_PCM_STREAM_PLAYBACK SND_PCM_MODE_BLOCK))
 123
 124 ;; Setup PCM
 125 (define (setup-pcm PCM NAME)
 126   (snd_pcm_set_params PCM
 127                       (cfg-lookup NAME "format" SND_PCM_FORMAT_S16_LE)
 128                       SND_PCM_ACCESS_RW_INTERLEAVED
 129                       2 ; channels
 130                       48000 ; rate
 131                       1 ; soft resample (0/1)
 132                       (cfg-lookup NAME "latency" 100000) ; (microseconds)
 133                       ))
 134
 135 ;; ############################################################
 136 ; The main program
 137
 138 ;; redirect stdout/err to /dev/null
 139 (when true
 140   (let ((REDIR (open "/dev/null" "append")))
 141     (when (< REDIR) (exit 1))
 142     (when (< (dup2 REDIR 2)) (exit 1))
 143     (when (< (dup2 REDIR 1)) (exit 1))
 144     (close REDIR)
 145   ))
 146
 147 ; find the first usable PCM
 148 (setf PCM (unless (dolist (N PCM-LIST (open-pcm (setf NAME N))))
 149             (die 1 "No PCM available")))
 150
 151 ; configure the PCM
 152 (when (!= (setf E (setup-pcm PCM NAME)))
 153   (snd_pcm_close PCM)
 154   (die 1 "setup pcm" E))
 155
 156 (setf N 0 x 0 E 0 i 0)
 157
 158 (while (> (or (setf N (read 0 BUFFER 1000000)) 0))
 159   (while (> N)
 160     (when (< (setf E (snd_pcm_writei PCM BUFFER (/ N 4))))
 161       (snd_pcm_close PCM)
 162       (die 1 "writing" E N))
 163     (setf E (* E 4))
 164     (setf BUFFER (E BUFFER))
 165     (dec N E)
 166     )
 167   )
 168
 169 (snd_pcm_drain PCM)
 170 (snd_pcm_close PCM)
 171 (exit 0)