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 ;; This implementation expects lib-utils.lsp to be loaded beforehand
6 ;; for providing the <prog1> and <loginfo> functions.
8 ;;=====================================================================
9 ; The libc context is an API towards libc.so.6 dynamic library which
10 ; offers the basic C functions
13 (constant 'LIB "/lib/x86_64-linux-gnu/libc.so.6")
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
20 (import LIB "free" "void"
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)))
30 ;;======================================================================
31 ; The libsasound context is an API towards the libasound.so.2 dynammic
32 ; library which offers functions for the Advanced Linux Sound
34 (context 'MAIN:libasound)
37 (load "import-api.lsp" libasound)
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))
45 ;; == Global functions
46 ; https://alsa-project.org/alsa-doc/alsa-lib/group___global.html
48 ;; Function: char *snd_asoundlib_version()
49 ; Returns the ALSA sound library version string.
50 (import LIB "snd_asoundlib_version" "char*" "void")
52 ;; Include libasound-config.lsp" into this context
53 (load "libasound-config.lsp" (context))
55 ;; Include libasound-pcm.lsp" into this context
56 (load "libasound-pcm.lsp" (context))
59 ;;============================================================
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))
67 (push (get-string ((unpack "Lu" LIST) 0)) RES -1)
71 (define (snd_asoundlib_version)
72 (libasound:snd_asoundlib_version))
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))))
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)))))
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)))))
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))))
95 (define (snd_ctl_close CTL)
96 (libasound:snd_ctl_close CTL))
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)))
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)))
113 (libasound:snd_ctl_card_info_free INFO))
116 (apply struct (cons 'char44 (dup "char" 44 true)))
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 */
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)
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))
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." )
150 (push (element-details CTL LIST i) RES -1))
152 (libasound:snd_ctl_elem_list_free_space LIST))
154 (libasound:snd_ctl_elem_list_free LIST))
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))))