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.
5 ;;=====================================================================
6 ; The libc context is an API towards libc.so.6 dynamic library which
7 ; offers the basic C functions
10 (constant 'LIB "/lib/x86_64-linux-gnu/libc.so.6")
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
17 (import LIB "free" "void"
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)))
27 ;;======================================================================
28 ; The libsasound context is an API towards the libasound.so.2 dynammic
29 ; library which offers functions for the Advanced Linux Sound
31 (context 'MAIN:libasound)
34 (load "import-api.lsp" libasound)
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))
42 ;; == Global functions
43 ; https://alsa-project.org/alsa-doc/alsa-lib/group___global.html
45 ;; Function: char *snd_asoundlib_version()
46 ; Returns the ALSA sound library version string.
47 (import LIB "snd_asoundlib_version" "char*" "void")
49 ;; Include libasound-config.lsp" into this context
50 (load "libasound-config.lsp" (context))
52 ;; Include libasound-pcm.lsp" into this context
53 (load "libasound-pcm.lsp" (context))
56 ;;============================================================
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))
64 (push (get-string ((unpack "Lu" LIST) 0)) RES -1)
68 (define (snd_asoundlib_version)
69 (libasound:snd_asoundlib_version))
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))))
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)))))
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)))))
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))))
92 (define (snd_ctl_close CTL)
93 (libasound:snd_ctl_close CTL))
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)))
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)))
110 (libasound:snd_ctl_card_info_free INFO))
113 (apply struct (cons 'char44 (dup "char" 44 true)))
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 */
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)
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))
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." )
147 (push (element-details CTL LIST i) RES -1))
149 (libasound:snd_ctl_elem_list_free_space LIST))
151 (libasound:snd_ctl_elem_list_free LIST))
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))))
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))))