mirror of
https://github.com/alsa-project/alsa-lib.git
synced 2025-10-29 05:40:25 -04:00
523b1eb92e
- force of reusing alisp objects
- added auto-garbage-collect mechanism
- fixed bad garbage-collect (yes, the original code can free "running" lisp program)
- hctl.lisp test example
- reduced lisp object memory pool usage from 240kB to 29kB (auto-gc)
- reduced --''-- from 29kB (auto-gc) to 9kB (manual gc)
FIXME: we need definitely an opminization for the alisp object lookups
- use bsearch()?
90 lines
2.6 KiB
Common Lisp
90 lines
2.6 KiB
Common Lisp
(setq card (acall 'card_next -1))
|
|
(setq card (aresult card))
|
|
(while (>= card 0)
|
|
(progn
|
|
(princ "found card: " card "\n")
|
|
(princ " name : " (aresult (acall 'card_get_name card)) "\n")
|
|
(princ " longname: " (aresult (acall 'card_get_longname card)) "\n")
|
|
(setq card (acall 'card_next card))
|
|
(setq card (aresult card))
|
|
)
|
|
)
|
|
(unsetq card)
|
|
|
|
(princ "card_get_index test (SI7018): " (acall 'card_get_index "SI7018") "\n")
|
|
(princ "card_get_index test (ABCD): " (acall 'card_get_index "ABCD") "\n")
|
|
|
|
(setq hctl (acall 'hctl_open 'default nil))
|
|
(if (= (aerror hctl) 0)
|
|
(progn
|
|
(princ "open success: " hctl "\n")
|
|
(setq hctl (ahandle hctl))
|
|
(princ "open hctl: " hctl "\n")
|
|
(setq hctl (acall 'hctl_close hctl))
|
|
(if (= hctl 0)
|
|
(princ "close success\n")
|
|
(princ "close failed: " hctl "\n")
|
|
)
|
|
)
|
|
(progn
|
|
(princ "open failed: " hctl "\n")
|
|
)
|
|
)
|
|
(unsetq hctl)
|
|
|
|
(setq ctl (acall 'ctl_open 'default nil))
|
|
(if (= (aerror ctl) 0)
|
|
(progn
|
|
(princ "ctl open success: " ctl "\n")
|
|
(setq ctl (ahandle ctl))
|
|
(setq info (aresult (acall 'ctl_card_info ctl)))
|
|
(princ "ctl card info: " info "\n")
|
|
(princ "ctl card info (mixername): " (cdr (assq "mixername" info)) "\n")
|
|
(unsetq info)
|
|
(setq hctl (acall 'hctl_open_ctl ctl))
|
|
(if (= (aerror hctl) 0)
|
|
(progn
|
|
(princ "hctl open success: " hctl "\n")
|
|
(setq hctl (ahandle hctl))
|
|
(princ "open hctl: " hctl "\n")
|
|
(princ "load hctl: " (acall 'hctl_load hctl) "\n")
|
|
(princ "first : " (acall 'hctl_first_elem hctl) "\n")
|
|
(princ "last : " (acall 'hctl_last_elem hctl) "\n")
|
|
(princ "next (first): " (acall 'hctl_elem_next (acall 'hctl_first_elem hctl)) "\n")
|
|
(princ "prev (last) : " (acall 'hctl_elem_prev (acall 'hctl_last_elem hctl)) "\n")
|
|
(setq elem (acall 'hctl_first_elem hctl))
|
|
(while elem
|
|
(progn
|
|
(setq info (acall 'hctl_elem_info elem))
|
|
(princ info "\n")
|
|
(setq value (acall 'hctl_elem_read elem))
|
|
(princ value "\n")
|
|
(when (equal (cdr (assq "name" (car (cdr (assq "id" (aresult info)))))) "Master Playback Volume")
|
|
(princ "write Master: " (acall 'hctl_elem_write elem (20 20)) "\n")
|
|
)
|
|
(unsetq info value)
|
|
(gc)
|
|
(setq elem (acall 'hctl_elem_next elem))
|
|
)
|
|
)
|
|
(setq hctl (acall 'hctl_close hctl))
|
|
(if (= hctl 0)
|
|
(princ "hctl close success\n")
|
|
(princ "hctl close failed: " hctl "\n")
|
|
)
|
|
)
|
|
(progn
|
|
(princ "hctl open failed: " hctl "\n")
|
|
(acall 'ctl_close ctl)
|
|
)
|
|
)
|
|
(unsetq hctl)
|
|
)
|
|
(progn
|
|
(princ "ctl open failed: " ctl "\n")
|
|
)
|
|
)
|
|
(unsetq ctl)
|
|
|
|
(&stat-memory)
|
|
(&dump-memory "memory.dump")
|