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