lsp-alsa/pcm-dispatch.lsp

   1 ;; This is the main script for the pcm-dispatch tool
   2 ;; last main-arg nominates the configuration file
   3
   4 (signal 1 (fn (x) (exit 0)))
   5 (signal 2 (fn (x) (exit 0)))
   6 (signal 15 (fn (x) (exit 0)))
   7
   8 (load "misc.lsp")
   9
  10 ; load contexts libasound and ALSA
  11 (load "libasound.lsp")
  12
  13 (unless (> (length (main-args)) 1)
  14   (die 1 "Usage: <config>"))
  15
  16 (context libc)
  17 (import LIB "dup2" "int"
  18         "int" ; int oldfd
  19         "int" ; int newfd
  20         )
  21 (context MAIN)
  22
  23 (setf
  24  CONFIGFILE (main-args -1)
  25  CONFIGTEXT (read-file CONFIGFILE)
  26  CONFIG (read-expr CONFIGTEXT)
  27  PCM-LIST (rest (assoc "PCM-LIST" CONFIG))
  28  )
  29
  30 (define (open-pcm PCM)
  31   (ALSA:snd_pcm_open PCM libasound:SND_PCM_STREAM_PLAYBACK 0 ))
  32
  33 (define (setup-pcm PCM)
  34   (libasound:snd_pcm_set_params
  35    PCM
  36    libasound:SND_PCM_FORMAT_S16_LE
  37    libasound:SND_PCM_ACCESS_RW_INTERLEAVED
  38    2     ; channels
  39    48000 ; rate
  40    1     ; soft resample (0/1)
  41    10000 ; latency (microseconds)
  42    ))
  43
  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))
  49   (close REDIR)
  50 )
  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))
  55
  56 ;; Find first usable PCM
  57 (setf PCM (unless (dolist (PCM PCM-LIST (open-pcm PCM)))
  58             (die 1 "No PCM available")))
  59
  60 (define (ready PCM)
  61   (dotimes (x 1000 (!= -32 (libasound:snd_pcm_wait PCM -1)))
  62     (sleep 10)))
  63
  64 (when (!= (setf E (setup-pcm PCM)))
  65   (libasound:snd_pcm_close PCM)
  66   (die 1 "set params" E))
  67
  68 ;;(die nil "status" (libasound:snd_pcm_start PCM))
  69
  70 (setf N 0 x 0 E 0 i 0)
  71
  72 ;(define BUFFER:BUFFER (dup "\000" 1000008))
  73
  74 (setf CACHE nil)
  75 (while (> (or (setf N (read 0 BUFFER 20000000)) 0))
  76   ;(println "reading " N)
  77   (setf CACHE BUFFER)
  78   (while (> N)
  79     (ready PCM)
  80     (when (< (setf E (libasound:snd_pcm_writei PCM CACHE (/ N 4))))
  81       (libasound:snd_pcm_close PCM)
  82       (die 1 "writing" E N))
  83     (setf E (* E 4))
  84     (setf CACHE (E CACHE))
  85     ;(println "wrote " E)
  86     (dec N E)
  87     )
  88   )
  89
  90 (libasound:snd_pcm_wait PCM -1)
  91
  92 (libasound:snd_pcm_drain PCM)
  93 (libasound:snd_pcm_close PCM)