#!/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)))

; Return non-nil for comment line (starts with # or is blank)
(define (comment? LINE) (regex "^\\s*(#|$)" LINE 0))

; Return list of space-separated words on a line
(define (words LINE)
  (parse (trim LINE) "\\s+" 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
 '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
; 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.
(import libc.so.6 "dup2" "int"
        "int" ; int oldfd
        "int" ; int newfd
        )

; ############################################################
; libasound API
; 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")

;; Selected libasound constants
(constant
 'SND_PCM_STREAM_PLAYBACK 0
 'SND_PCM_MODE_BLOCK 0 ; this mode label is invented here
 'SND_PCM_FORMAT_S16_LE 2
 'SND_PCM_ACCESS_RW_INTERLEAVED 3
 )

;; (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
;; 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
;; 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
                     "int"   ; snd_pcm_stream_t stream
                     "int"   ; int mode
                     )))
  (constant 'snd_pcm_open ; redefine the symbol to wrap the import
   (fn (NAME STREAM MODE)
     (let ((PCM (pack "Lu" 0)))
       (when (= (IMP PCM NAME STREAM MODE)) ((unpack "Lu" PCM) 0))))))

;; (snd_pcm_set_params PCM FMT ACCESS CH RATE RESAMPLE LATENCY) - Set
;; 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
        "int"   ; snd_pcm_access_t access
        "unsigned int" ; unsigned int channels
        "unsigned int" ; unsigned int rate
        "int"   ;int soft_resample
        "unsigned int" ; unsigned int latency
        )

;; (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
;; the playback ring buffer. The returned number of frames can be less
;; only if a signal or underrun occurred.
(import libasound.so "snd_pcm_writei" "long" ; snd_pcm_uframes_t 
	"void*" ; snd_pcm_t *pcm
        "void*" ; const void *buffer
        "long"   ; snd_pcm_uframes_t size
        )

;; Open a PCM by name. Returns list of (NAME PCM) or nil.
(define (open-pcm NAME)
  (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 (flagged for debugging purposes)
(when (not DEBUG)
  (let ((REDIR (open "/dev/null" "append")))
    (when (< REDIR) (exit 1))
    (when (< (dup2 REDIR 2)) (exit 1))
    (when (< (dup2 REDIR 1)) (exit 1))
    (close REDIR)
  ))

; find the first usable PCM
(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 NAME)))
  (snd_pcm_close PCM)
  (die 1 "setup pcm" E))

; 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 failed"))
    (setf E (* E 4))
    (setf BUFFER (E BUFFER))
    (dec N E)
    )
  )

; let the pcm complete its output
(snd_pcm_drain PCM)

(snd_pcm_close PCM)
(exit 0)