lsp-alsa/libasound.lsp

   1 ;; This module implements contexts libc, libasound and ALSA for
   2 ;; providing a higher level ALSA API over a lower level libasound API
   3 ;; on top of a libc API.
   4
   5 ;; This implementation expects lib-utils.lsp to be loaded beforehand
   6 ;; for providing the <prog1> and <loginfo> functions.
   7
   8 ;;=====================================================================
   9 ; The libc context is an API towards libc.so.6 dynamic library which
  10 ; offers the basic C functions
  11 (context 'MAIN:libc)
  12
  13 (constant 'LIB "/lib/x86_64-linux-gnu/libc.so.6")
  14
  15 ;; The free() function frees the memory space pointed to by ptr, which
  16 ;; must have been returned by a previous call to malloc(), calloc(),
  17 ;; or realloc(). Otherwise, or if free(ptr) has already been called
  18 ;; before, undefined behavior occurs. If ptr is NULL, no operation is
  19 ;; performed.
  20 (import LIB "free" "void"
  21         "void*" ; void *ptr
  22         )
  23
  24 ;; Function: (freestr ADDR)
  25 ; Given a string address, copy that into a newlisp string value, and
  26 ; free the memory of the given address.
  27 (define (freestr ADDR)
  28   (prog1 (get-string ADDR) (free ADDR)))
  29
  30 ;;======================================================================
  31 ; The libsasound context is an API towards the libasound.so.2 dynammic
  32 ; library which offers functions for the Advanced Linux Sound
  33 ; Architecture (ALSA)
  34 (context 'MAIN:libasound)
  35
  36
  37 (load "import-api.lsp" libasound)
  38
  39 ; Find the library full pathname as constant LIB
  40 (if (exec "find /lib /usr/lib -name 'libasound.so*' -type f")
  41     (constant 'LIB ($it 0))
  42   (die 1 "Cannot find libasound.so"))
  43 (when (ENV "LOG") (println "Using " LIB))
  44
  45 ;; == Global functions
  46 ; https://alsa-project.org/alsa-doc/alsa-lib/group___global.html
  47
  48 ;; Function: char *snd_asoundlib_version()
  49 ; Returns the ALSA sound library version string.
  50 (import LIB "snd_asoundlib_version" "char*" "void")
  51
  52 ;; Include libasound-config.lsp" into this context
  53 (load "libasound-config.lsp" (context))
  54
  55 ;; Include libasound-pcm.lsp" into this context
  56 (load "libasound-pcm.lsp" (context))
  57
  58
  59 ;;============================================================
  60 (context 'MAIN:ALSA)
  61
  62 (define (snd_use_case_get_list MGR ID)
  63   (let ((DATA (pack "Lu" 0)) (LIST nil) (E nil) (RES '()) (i nil))
  64     (when (>= (setf E (ALSA_UCM:snd_use_case_get_list MGR ID DATA)))
  65       (setf LIST ((unpack "Lu" DATA) 0))
  66       (dotimes (i E)
  67         (push (get-string ((unpack "Lu" LIST) 0)) RES -1)
  68         (inc LIST 8)))
  69     (or RES E)))
  70
  71 (define (snd_asoundlib_version)
  72   (libasound:snd_asoundlib_version))
  73
  74 (define (snd_card_next IX)
  75   (let ((DATA (pack "ld" IX)) (E 0))
  76     (if (< (setf E (libasound:snd_card_next DATA))) E
  77       ((unpack "ld" DATA) 0))))
  78
  79 (define (snd_card_get_longname IX)
  80   (let ((DATA (pack "Lu" 0)) (E 0))
  81     (if (< (setf E (libasound:snd_card_get_longname IX DATA))) E
  82       (libc:freestr ((unpack  "Lu" DATA) 0)))))
  83
  84 (define (snd_card_get_name IX)
  85   (let ((DATA (pack "Lu" 0)) (E 0) (A 0))
  86     (if (< (setf E (libasound:snd_card_get_name IX DATA))) E
  87       (libc:freestr ((unpack  "Lu" DATA) 0)))))
  88
  89 ;; Return CTL
  90 (define (snd_ctl_open NAME MODE)
  91   (let ((DATA (pack "Lu" 0)) (E 0))
  92     (if (< (setf E (libasound:snd_ctl_open DATA NAME MODE))) E
  93       ((unpack  "Lu" DATA) 0))))
  94
  95 (define (snd_ctl_close CTL)
  96   (libasound:snd_ctl_close CTL))
  97
  98 (define (card-info CTL)
  99   (let ((DATA (pack "Lu" 0)) (E nil) (INFO nil) (RES nil))
 100     (when (>= (setf E (libasound:snd_ctl_card_info_malloc DATA)))
 101       (setf INFO ((unpack  "Lu" DATA) 0))
 102       (when (>= (setf E (libasound:snd_ctl_card_info CTL INFO)))
 103         (setf RES
 104               (list
 105                (libasound:snd_ctl_card_info_get_card INFO)
 106                (libasound:snd_ctl_card_info_get_id INFO)
 107                (libasound:snd_ctl_card_info_get_name INFO)
 108                (libasound:snd_ctl_card_info_get_longname INFO)
 109                (libasound:snd_ctl_card_info_get_components INFO)
 110                (libasound:snd_ctl_card_info_get_driver INFO)
 111                (libasound:snd_ctl_card_info_get_mixername INFO)))
 112         )
 113       (libasound:snd_ctl_card_info_free INFO))
 114     (or RES E)))
 115
 116 (apply struct (cons 'char44 (dup "char" 44 true)))
 117
 118 (struct 'snd_ctl_elem_id
 119         "unsigned int" ; numid; /* numeric identifier, zero = invalid */
 120         "unsigned int" ; snd_ctl_elem_iface_t iface; /* interface identifier */
 121         "unsigned int" ; device; /* device/client number */
 122         "unsigned int" ; subdevice; /* subdevice (substream) number */
 123         "char44" ;; unsigned char name[SNDRV_CTL_ELEM_ID_NAME_MAXLEN (44)];
 124         ;; /* ASCII name of item */
 125         "unsigned int" ; index; /* index of item */
 126 )
 127
 128 (define (element-details CTL LIST i)
 129   (list (libasound:snd_ctl_elem_list_get_index LIST i) ; card index?
 130         (libasound:snd_ctl_elem_list_get_interface LIST i)
 131         (libasound:snd_ctl_elem_list_get_name LIST i)
 132         (libasound:snd_ctl_elem_list_get_device LIST i)
 133         (libasound:snd_ctl_elem_list_get_numid LIST i)
 134         (libasound:snd_ctl_elem_list_get_subdevice LIST i)
 135         ))
 136
 137 (define (elements CTL)
 138   (let ((DATA (pack "Lu" 0)) (E nil) (LIST nil) (RES '()) (COUNT nil))
 139     (when (>= (setf E (libasound:snd_ctl_elem_list_malloc DATA)))
 140       (setf LIST ((unpack  "Lu" DATA) 0))
 141       (when (>= (setf E (libasound:snd_ctl_elem_list CTL LIST)))
 142         (setf COUNT (libasound:snd_ctl_elem_list_get_count LIST))
 143         (when (>= (setf E
 144                         (libasound:snd_ctl_elem_list_alloc_space LIST COUNT)))
 145           (when (>= (libasound:snd_ctl_elem_list CTL LIST))
 146             ;; Process the COUNT elements into RES
 147             (println COUNT " elements, "
 148                      (libasound:snd_ctl_elem_list_get_used LIST) " used." )
 149             (dotimes (i COUNT)
 150               (push (element-details CTL LIST i) RES -1))
 151             )
 152           (libasound:snd_ctl_elem_list_free_space LIST))
 153         )
 154       (libasound:snd_ctl_elem_list_free LIST))
 155     (or RES E)))
 156
 157 ;;; PCM API
 158
 159 ;; Opens a PCM
 160 (define (snd_pcm_open NAME STREAM-TYPE MODE)
 161   (let ((PCM (pack "Lu" 0)))
 162     (when (= (libasound:snd_pcm_open (address PCM) NAME STREAM-TYPE MODE))
 163       ((unpack "Lu" PCM) 0))))
 164
 165 "libasound.lsp"