hans/gemigreerd-racket-audio
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

finally a working libao-async racket backend

Browse Source
This commit is contained in:
Hans Dijkema
2026-05-07 14:17:55 +02:00
parent a59c3b7c41
commit a30111ecf5
3 changed files with 254 additions and 76 deletions
Download Patch File Download Diff File Expand all files Collapse all files
libao-async-ffi-racket.rkt
+225 -48
View File
@@ -13,6 +13,7 @@
ffi/unsafe/custodian
racket/async-channel
data/queue
racket/list
"private/utils.rkt")
(provide ao_version_async
@@ -86,9 +87,9 @@
;; so other Racket places/threads are not needlessly held up by the foreign
;; call. This is the important part that makes the C backend much less useful.
(define-ao ao_play
;(_fun #:blocking? #t _ao-device _pointer _uint32 -> _int))
(_fun #:blocking? #t _ao-device _pointer _uint32 -> _int))
;(_fun _ao-device _pointer _uint32 -> _int))
(_fun #:blocking? #t _ao-device _bytes _uint32 -> _int))
;(_fun #:blocking? #t _ao-device _bytes _uint32 -> _int))
;; -------------------------------------------------------------------------
;; Mutex stuff
@@ -119,7 +120,9 @@
at-second
music-duration
music-id
))
)
#:mutable
)
(define-struct ao-handle
@@ -136,6 +139,9 @@
mutex
pause-mutex
clear-mutex
buf-mutex
add-mutex
play-thread
at-second
@@ -147,10 +153,15 @@
valid
bufs
current-elem
bytes-left
)
#:mutable
)
(define ao-buf-ms 500) ;; Playback buffer of 0.5s
(define (get h ms-wait)
(let ((el (if (<= ms-wait 0)
(sync/timeout 0 (ao-handle-queue h))
@@ -159,33 +170,115 @@
(set-ao-handle-buf-size! h (- (ao-handle-buf-size h) (queue-elem-buflen el))))
el))
(define (add h elem)
(set-ao-handle-buf-size! h (+ (ao-handle-buf-size h) (queue-elem-buflen elem)))
(async-channel-put (ao-handle-queue h) elem)
(define (needed-bytes h)
(let ((req-bytes (/ (ao-handle-dev-bits-per-sample h) 8))
(rate-s (ao-handle-dev-rate h))
(channels (ao-handle-dev-channels h))
)
(/ (* req-bytes rate-s channels ao-buf-ms) 1000)
)
)
(define (new-elem command music-id at-second music-duration buflen buf)
(define (bytes->samples h s)
(let ((req-bytes (/ (ao-handle-dev-bits-per-sample h) 8))
(rate-s (ao-handle-dev-rate h))
(channels (ao-handle-dev-channels h)))
(/ s req-bytes channels)))
(define (add h elem)
(mutex-lock (ao-handle-add-mutex h))
(add* h elem)
(mutex-unlock (ao-handle-add-mutex h))
)
(define (add* h elem)
(if (eq? (queue-elem-command elem) 'stop)
(begin
(unless (eq? (ao-handle-current-elem h) #f)
(async-channel-put (ao-handle-queue h) (ao-handle-current-elem h))
(set-ao-handle-current-elem! h #f))
(async-channel-put (ao-handle-queue h) elem)
)
(let* ((cb (ao-handle-current-elem h)))
(if (eq? cb #f)
(begin
(set-ao-handle-current-elem! h elem)
(set! cb elem)
(let* ((ns (needed-bytes h))
(new-buf (cadr (alloc-buf h ns))))
(memcpy new-buf (queue-elem-buf cb) (queue-elem-buflen cb))
;(dbg-sound "Allocated new buffer of ~a bytes (~a samples) for elem size ~a" ns (bytes->samples h ns) (queue-elem-buflen cb))
(reuse-buf h (queue-elem-buf cb))
(set-queue-elem-buf! cb new-buf)
(set-ao-handle-bytes-left! h (- ns (queue-elem-buflen cb)))
(set-ao-handle-buf-size! h (+ (ao-handle-buf-size h) (queue-elem-buflen elem)))
))
(if (or
(not (equal? (queue-elem-music-id cb) (queue-elem-music-id elem)))
(< (- (ao-handle-bytes-left h) (queue-elem-buflen elem)) 0))
(begin
; push this buffer and restart
;(dbg-sound "Pushing sound buffer with ~a samples left" (ao-handle-bytes-left h))
(async-channel-put (ao-handle-queue h) cb)
(set-ao-handle-current-elem! h #f)
(add* h elem))
(let ((offset (queue-elem-buflen cb)))
(memcpy (queue-elem-buf cb) offset (queue-elem-buf elem) (queue-elem-buflen elem))
(set-queue-elem-buflen! cb (+ offset (queue-elem-buflen elem)))
(set-ao-handle-bytes-left! h (- (ao-handle-bytes-left h) (queue-elem-buflen elem)))
(set-ao-handle-buf-size! h (+ (ao-handle-buf-size h) (queue-elem-buflen elem)))
(reuse-buf h (queue-elem-buf elem))
(when (= (ao-handle-bytes-left h) 0)
(async-channel-put (ao-handle-queue h) cb)
(set-ao-handle-current-elem! h #f))
)
)
)
)
)
)
(define (new-elem h command music-id at-second music-duration buflen buf)
;(let ((new-buf (make-bytes buflen))) ;((new-buf (malloc buflen 'atomic)))
; (memcpy new-buf buf buflen)
;(make-queue-elem command new-buf buflen at-second music-duration music-id)))
(make-queue-elem command buf buflen at-second music-duration music-id))
(define (del-elem elem)
(define (del-elem h elem)
(reuse-buf h (queue-elem-buf elem))
; does nothing
#t)
(define (clear h)
(let ((count 0)
(el (get h 0)))
(let ((count 0))
(mutex-lock (ao-handle-clear-mutex h))
(let ((el (get h 0)))
; Clear the elements in the queue
(while (not (eq? el #f))
(del-elem el)
(del-elem h el)
(set! count (+ count 1))
(set! el (get h 0)))
; Clear the current element in processing
(mutex-lock (ao-handle-add-mutex h))
(unless (eq? (ao-handle-current-elem h) #f)
(let* ((ce (ao-handle-current-elem h))
(cb (queue-elem-buf ce)))
(unless (eq? cb #f)
(reuse-buf h cb))))
(set-ao-handle-current-elem! h #f)
(set-ao-handle-bytes-left! h 0)
(set-ao-handle-buf-size! h 0)
(mutex-unlock (ao-handle-add-mutex h))
(mutex-unlock (ao-handle-clear-mutex h))
(dbg-sound "~a elements cleared" count)
)
)
)
(define-syntax system-little-endian?
(syntax-rules ()
@@ -209,31 +302,54 @@
(define (alloc-buf h size)
(let ((entry #f))
(letrec ((f (λ (entries)
(letrec ((f (λ (entries min-size min-size-idx idx)
(if (null? entries)
'()
min-size-idx
(let ((e (car entries)))
(if (< size (car e))
(begin
(set! entry e)
(cdr entries))
(begin
(cons e (f (cdr entries))))
(if (<= size (car e))
(if (or (eq? min-size #f) (< (car e) min-size))
(f (cdr entries) (car e) idx (+ idx 1))
(f (cdr entries) min-size min-size-idx (+ idx 1))
)
(f (cdr entries) min-size min-size-idx (+ idx 1))
)
)
)
)
))
(set-ao-handle-bufs! h (f (ao-handle-bufs h)))
(mutex-lock (ao-handle-buf-mutex h))
(let ((bufs (ao-handle-bufs h))
(entry #f))
(unless (null? bufs)
(let ((idx (f bufs #f #f 0)))
(unless (eq? idx #f)
(let ((e (list-ref bufs idx)))
;(dbg-sound "Reusing index ~a, ~a for size ~a" idx (car e) size)
(set! entry (list-ref bufs idx))
(set-ao-handle-bufs! h (append (take bufs idx) (drop bufs (+ idx 1))))
)
)
)
)
(mutex-unlock (ao-handle-buf-mutex h))
;(dbg-sound "Alloc buf: ~a, got ~a" size (map (λ (e) (car e)) (ao-handle-bufs h)))
(if (eq? entry #f)
(list size (make-bytes size))
entry)
)
)
)
)
(define (reuse-buf h buf size)
(set-ao-handle-bufs! h (cons (list size buf) (ao-handle-bufs h)))
(define (reuse-buf h buf)
(unless (eq? buf #f)
(mutex-lock (ao-handle-buf-mutex h))
(set-ao-handle-bufs! h (cons (list (bytes-length buf) buf) (ao-handle-bufs h)))
(when (> (length (ao-handle-bufs h)) 10)
(set-ao-handle-bufs! h (take (ao-handle-bufs h) 5)))
(mutex-unlock (ao-handle-buf-mutex h))
)
#t
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
@@ -346,7 +462,9 @@
(define (run h)
(thread
(λ ()
(let ((go-on #t))
(let ((go-on #t)
(buf #f)
(buf-size 0))
(while go-on
(mutex-lock (ao-handle-pause-mutex h))
(mutex-unlock (ao-handle-pause-mutex h))
@@ -354,7 +472,12 @@
(let ((elem (get h 250)))
(mutex-unlock (ao-handle-clear-mutex h))
(if (eq? elem #f)
(sleep 0.005)
(begin
(dbg-sound "nothing in the queue")
(sleep 0.005))
(begin
(if (eq? (queue-elem-command elem) 'stop)
(set! go-on #f)
(begin
(set-ao-handle-at-second! h (queue-elem-at-second elem))
(set-ao-handle-music-duration! h (queue-elem-music-duration elem))
@@ -364,13 +487,19 @@
(adjust-volume h (queue-elem-buf elem) (queue-elem-buflen elem)
(ao-handle-volume-in-10000 h)))
(if (eq? (queue-elem-command elem) 'stop)
(set! go-on #f)
(ao_play (ao-handle-ao-device h)
(queue-elem-buf elem) (queue-elem-buflen elem)))
(let* ((size (queue-elem-buflen elem)))
(when (> size buf-size)
(set! buf (malloc size 'atomic-interior ))
(set! buf-size size))
(memcpy buf (queue-elem-buf elem) size)
(ao_play (ao-handle-ao-device h) buf size)
)
)
)
(del-elem elem)
))
(del-elem h elem)
)
)
)
)
)
@@ -380,20 +509,61 @@
)
(define init #f)
(define (init-ao)
(when (eq? init #f)
(set! init #t)
(ao_initialize)
(define handle-admin-mutex (make-mutex))
(define num-of-handles 0)
(register-finalizer-and-custodian-shutdown
init
num-of-handles
(λ (v)
(ao_shutdown))
(unless (= num-of-handles 0)
(ao_shutdown)))
#:at-exit? #t
)
(define (dec-ao-handles)
(mutex-lock handle-admin-mutex)
(set! num-of-handles (- num-of-handles 1))
(when (= num-of-handles 0)
(ao_shutdown)
(dbg-sound "ao_shutdown executed")
)
(mutex-unlock handle-admin-mutex)
)
(define (inc-ao-handles)
(mutex-lock handle-admin-mutex)
(when (= num-of-handles 0)
(ao_initialize)
(dbg-sound "ao_initialized executed")
)
(set! num-of-handles (+ num-of-handles 1))
(mutex-unlock handle-admin-mutex)
)
(define (ao_close* ao_ffi_handle)
(ao_close ao_ffi_handle)
(dec-ao-handles))
(define (ao_open_live* driver-id fmt matrix)
(inc-ao-handles)
(let ((r (ao_open_live driver-id fmt matrix)))
(when (eq? r #f)
(dec-ao-handles))
r))
(define (ao_open_file* driver-id file x fmt matrix)
(inc-ao-handles)
(let ((r (ao_open_file driver-id file x fmt matrix)))
(when (eq? r #f)
(dec-ao-handles))
r))
(define (ao_default_driver_id*)
(inc-ao-handles)
(let ((r (ao_default_driver_id)))
(dec-ao-handles)
r))
(define (try-open-device bits rate channels byte-format wav-output-file)
(let ((candidates (make-vector 3 bits))
@@ -416,11 +586,11 @@
byte-format
#f))
(driver-id (if (eq? wav-output-file #f)
(ao_default_driver_id)
(ao_default_driver_id*)
(ao_driver_id "wav")))
(dev (if (eq? wav-output-file #f)
(ao_open_live driver-id fmt #f)
(ao_open_file driver-id wav-output-file 1 fmt #f)))
(ao_open_live* driver-id fmt #f)
(ao_open_file* driver-id wav-output-file 1 fmt #f)))
)
(unless (eq? dev #f)
@@ -447,8 +617,6 @@
AO-ASYNC-VERSION)
(define (ao_create_async bits rate channels byte-format wav-output-file)
(init-ao)
(let ((handle (make-ao-handle
(make-async-channel) ; queue
#f ; paused
@@ -463,6 +631,8 @@
(make-mutex) ; mutex
(make-mutex) ; pause-mutex
(make-mutex) ; clear-mutex
(make-mutex) ; buf-mutex
(make-mutex) ; add-mutex
#f ; play-thread
@@ -475,6 +645,9 @@
#t ; valid handle
'() ; reuse buffer
#f ; current element
0 ; bytes left
)))
(let ((ao-dev-bits (try-open-device bits rate channels byte-format wav-output-file)))
@@ -487,6 +660,9 @@
#f)
(begin
(set-ao-handle-play-thread! handle (run handle))
(register-finalizer handle (λ (v)
(when (ao-handle-valid v)
ao_stop_async v)))
handle)
)
)
@@ -504,7 +680,7 @@
(when (ao-handle-paused h)
(mutex-unlock (ao-handle-pause-mutex h)))
(let ((elem (new-elem 'stop 0 0.0 0.0 0 #f)))
(let ((elem (new-elem h 'stop 0 0.0 0.0 0 #f)))
(add h elem))
(dbg-sound "Stop command queued")
@@ -512,7 +688,7 @@
(thread-wait (ao-handle-play-thread h))
(dbg-sound "Play thread stopped")
(ao_close (ao-handle-ao-device h))
(ao_close* (ao-handle-ao-device h))
(dbg-sound "AO Device closed")
(set-ao-handle-valid! h #f)
@@ -527,8 +703,8 @@
(when (or (eq? type 'planar) (eq? type 'flac))
(dbg-sound "Converting from planar to interleaved")
(let ((m (planar-to-interleaved mem buf-size info)))
(reuse-buf h mem buf-size)
(let ((m (planar-to-interleaved h mem buf-size info)))
(reuse-buf h mem)
(set! mem (car m))
(set! buf-size (cadr m)))
)
@@ -537,7 +713,7 @@
(ao-mem mem))
(let ((m (convert-req-bits-to-dev-bits h mem buf-size info)))
(when (eq? (caddr m) #t)
(reuse-buf h mem buf-size)
(reuse-buf h mem)
(set! ao-mem (car m))
(set! ao-size (cadr m))))
@@ -545,7 +721,7 @@
(error "Hey! this was unexpected!"))
(let ((elem (new-elem 'play music-id at-second music-duration ao-size ao-mem)))
(let ((elem (new-elem h 'play music-id at-second music-duration ao-size ao-mem)))
(add h elem))
)
)
@@ -598,3 +774,4 @@
(define (ao_reuse_buf_len h)
(length (ao-handle-bufs h)))
libao.rkt
+3 -2
View File
@@ -1,7 +1,7 @@
#lang racket/base
(require (prefix-in fin: finalizer)
(prefix-in ffi: "libao-async-ffi.rkt")
(prefix-in ffi: "libao-async-ffi-racket.rkt")
ffi/unsafe
ffi/unsafe/custodian
data/queue
@@ -164,13 +164,14 @@
(unless (ao-valid? handle)
(err-sound "Cannot play on an invalid ao-device")
(error "Cannot play on an invalid ao-device"))
(void
(ffi:ao_play_async (ao-handle-async-player handle)
music-id
(exact->inexact at-time-in-s)
(exact->inexact music-duration-s)
buf-len
buffer
buf-info)
buf-info))
)
)
play-test.rkt
+1 -1
View File
@@ -46,7 +46,7 @@
(bytes-per-sample-all-channels (* channels bytes-per-sample))
(duration (hash-ref buf-info 'duration))
(cond-seek (λ ()
(when (= (round current-seconds) 10)
(when (>= (round current-seconds) 10)
(when (and (= current-file-id 3) (not seeked))
(set! seeked #t)
(let ((perc (exact->inexact (* (/ (- duration 15) duration) 100.0))))