;; This module implements contexts libc, libasound and ALSA for
;; providing a higher level ALSA API over a lower level libasound API
;; on top of a libc API.

;;=====================================================================
; The libc context is an API towards libc.so.6 dynamic library which
; offers the basic C functions
(context 'MAIN:libc)

(constant 'LIB "/lib/x86_64-linux-gnu/libc.so.6")

;; The free() function frees the memory space pointed to by ptr, which
;; must have been returned by a previous call to malloc(), calloc(),
;; or realloc(). Otherwise, or if free(ptr) has already been called
;; before, undefined behavior occurs. If ptr is NULL, no operation is
;; performed.
(import LIB "free" "void" 
        "void*" ; void *ptr
        )

;; Function: (freestr ADDR)
; Given a string address, copy that into a newlisp string value, and
; free the memory of the given address.
(define (freestr ADDR)
  (prog1 (get-string ADDR) (free ADDR)))

;;======================================================================
; The libsasound context is an API towards the libasound.so.2 dynammic
; library which offers functions for the Advanced Linux Sound
; Architecture (ALSA)
(context 'MAIN:libasound)


(load "import-api.lsp" libasound)

; Find the library full pathname as constant LIB
(if (exec "find /lib /usr/lib -name 'libasound.so*' -type f")
    (constant 'LIB ($it 0))
  (die 1 "Cannot find libasound.so"))
(when (env "LOG") (println "Using " LIB))

;; == Global functions
; https://alsa-project.org/alsa-doc/alsa-lib/group___global.html

;; Function: char *snd_asoundlib_version()
; Returns the ALSA sound library version string.
(import LIB "snd_asoundlib_version" "char*" "void")

;; Include libasound-config.lsp" into this context
(load "libasound-config.lsp" (context))

;; Include libasound-pcm.lsp" into this context
(load "libasound-pcm.lsp" (context))


;;============================================================
(context 'MAIN:ALSA)

(define (snd_use_case_get_list MGR ID)
  (let ((DATA (pack "Lu" 0)) (LIST nil) (E nil) (RES '()) (i nil))
    (when (>= (setf E (ALSA_UCM:snd_use_case_get_list MGR ID DATA)))
      (setf LIST ((unpack "Lu" DATA) 0))
      (dotimes (i E)
        (push (get-string ((unpack "Lu" LIST) 0)) RES -1)
        (inc LIST 8)))
    (or RES E)))

(define (snd_asoundlib_version)
  (libasound:snd_asoundlib_version))

(define (snd_card_next IX)
  (let ((DATA (pack "ld" IX)) (E 0))
    (if (< (setf E (libasound:snd_card_next DATA))) E
      ((unpack "ld" DATA) 0))))

(define (snd_card_get_longname IX)
  (let ((DATA (pack "Lu" 0)) (E 0))
    (if (< (setf E (libasound:snd_card_get_longname IX DATA))) E
      (libc:freestr ((unpack  "Lu" DATA) 0)))))

(define (snd_card_get_name IX)
  (let ((DATA (pack "Lu" 0)) (E 0) (A 0))
    (if (< (setf E (libasound:snd_card_get_name IX DATA))) E
      (libc:freestr ((unpack  "Lu" DATA) 0)))))

;; Return CTL
(define (snd_ctl_open NAME MODE) 
  (let ((DATA (pack "Lu" 0)) (E 0))
    (if (< (setf E (libasound:snd_ctl_open DATA NAME MODE))) E
      ((unpack  "Lu" DATA) 0))))

(define (snd_ctl_close CTL)
  (libasound:snd_ctl_close CTL))

(define (card-info CTL)
  (let ((DATA (pack "Lu" 0)) (E nil) (INFO nil) (RES nil))
    (when (>= (setf E (libasound:snd_ctl_card_info_malloc DATA)))
      (setf INFO ((unpack  "Lu" DATA) 0))
      (when (>= (setf E (libasound:snd_ctl_card_info CTL INFO)))
        (setf RES
              (list
               (libasound:snd_ctl_card_info_get_card INFO)
               (libasound:snd_ctl_card_info_get_id INFO)
               (libasound:snd_ctl_card_info_get_name INFO)
               (libasound:snd_ctl_card_info_get_longname INFO)
               (libasound:snd_ctl_card_info_get_components INFO)
               (libasound:snd_ctl_card_info_get_driver INFO)
               (libasound:snd_ctl_card_info_get_mixername INFO)))
        )
      (libasound:snd_ctl_card_info_free INFO))
    (or RES E)))

(apply struct (cons 'char44 (dup "char" 44 true)))

(struct 'snd_ctl_elem_id
        "unsigned int" ; numid; /* numeric identifier, zero = invalid */
        "unsigned int" ; snd_ctl_elem_iface_t iface; /* interface identifier */
        "unsigned int" ; device; /* device/client number */
        "unsigned int" ; subdevice; /* subdevice (substream) number */
        "char44" ;; unsigned char name[SNDRV_CTL_ELEM_ID_NAME_MAXLEN (44)];
        ;; /* ASCII name of item */
        "unsigned int" ; index; /* index of item */
)

(define (element-details CTL LIST i)
  (list (libasound:snd_ctl_elem_list_get_index LIST i) ; card index?
        (libasound:snd_ctl_elem_list_get_interface LIST i)
        (libasound:snd_ctl_elem_list_get_name LIST i)
        (libasound:snd_ctl_elem_list_get_device LIST i)
        (libasound:snd_ctl_elem_list_get_numid LIST i)
        (libasound:snd_ctl_elem_list_get_subdevice LIST i)
        ))

(define (elements CTL)
  (let ((DATA (pack "Lu" 0)) (E nil) (LIST nil) (RES '()) (COUNT nil))
    (when (>= (setf E (libasound:snd_ctl_elem_list_malloc DATA)))
      (setf LIST ((unpack  "Lu" DATA) 0))
      (when (>= (setf E (libasound:snd_ctl_elem_list CTL LIST)))
        (setf COUNT (libasound:snd_ctl_elem_list_get_count LIST))
        (when (>= (setf E
                        (libasound:snd_ctl_elem_list_alloc_space LIST COUNT)))
          (when (>= (libasound:snd_ctl_elem_list CTL LIST))
            ;; Process the COUNT elements into RES
            (println COUNT " elements, "
                     (libasound:snd_ctl_elem_list_get_used LIST) " used." )
            (dotimes (i COUNT)
              (push (element-details CTL LIST i) RES -1))
            )
          (libasound:snd_ctl_elem_list_free_space LIST))
        )
      (libasound:snd_ctl_elem_list_free LIST))
    (or RES E)))

;;; PCM API

;; Opens a named PCM and return handle
(define (snd_pcm_open NAME STREAM-TYPE MODE)
  (let ((DATA (pack "Lu" 0)))
    (when (= (libasound:snd_pcm_open (address DATA) NAME STREAM-TYPE MODE))
      ((unpack "LuLu" (address DATA)) 0))))

;; Set the value of given path as given.
(define (set_config_string PATH VALUE)
  (let ((DATA (pack "Lu" 0)) (TREE (libasound:snd_config@)))
    (when (= (libasound:snd_config_search TREE PATH (address DATA)))
      (libasound:snd_config_set_string ((unpack "Lu" DATA) 0) VALUE))))

"libasound.lsp"