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

Working racket lib ao async backend

Browse Source
This commit is contained in:
Hans Dijkema
2026-05-08 00:59:13 +02:00
parent b69f29075f
commit be0399796d
3 changed files with 140 additions and 88 deletions
Download Patch File Download Diff File Expand all files Collapse all files
libao-async-ffi-racket.rkt
+127 -85
View File
@@ -30,6 +30,7 @@
ao_set_volume_async
ao_volume_async
ao_reuse_buf_len
ao_sample_queue_len
make-buffer-info
make-BufferInfo_t
)
@@ -127,6 +128,9 @@
(define-struct ao-handle
(queue
in-queue
buf-size
paused
ao-device
@@ -139,36 +143,75 @@
mutex
pause-mutex
clear-mutex
buf-mutex
add-mutex
play-thread
at-second
music-duration
music-id
buf-size
volume-in-10000
valid
bufs
current-elem
bytes-left
)
#:mutable
)
;; -------------------------------------------------------------------------
;; Internal memory structure, to be able to reuse allocated memory bytes
;; And prevent the GC from collecting this memory that is constantly reused
;; -------------------------------------------------------------------------
(define-struct mem
(size bytes allocated) #:mutable)
(define (to-mem m)
(if (mem? m)
m
(if (bytes? m)
(make-mem (bytes-length m) m #f)
(error
(format
"Cannot convert m of other type than bytes? or mem?, got ~a" m)))))
(define (m-memcpy dst from size . args)
(let ((offset (if (null? args) 0 from))
(from* (if (null? args) from size))
(size* (if (null? args) size (car args)))
)
(let ((dst** (if (cpointer? dst) dst (mem-bytes (to-mem dst))))
(from** (if (cpointer? from*) from* (mem-bytes (to-mem from*))))
)
(memcpy dst** offset from** size*)
)
)
)
;; -------------------------------------------------------------------------
;; Playback buffer to send to libao in milliseconds
;; -------------------------------------------------------------------------
(define ao-buf-ms 250) ;; Playback buffer of 0.25s
;; -------------------------------------------------------------------------
;; Sample queue handling
;; -------------------------------------------------------------------------
(define (get h ms-wait)
(let ((el (if (<= ms-wait 0)
(sync/timeout 0 (ao-handle-queue h))
(sync/timeout (/ ms-wait 1000.0) (ao-handle-queue h) ))))
(if (eq? el #f)
(set-ao-handle-buf-size! h 0) ; no elements in queue => empty => no buffer with music samples
(set-ao-handle-buf-size! h (- (ao-handle-buf-size h) (queue-elem-buflen el))))
(begin
(set-ao-handle-buf-size! h 0) ; no elements in queue => empty => no buffer with music samples
(set-ao-handle-in-queue! h 0))
(begin
(set-ao-handle-buf-size! h (- (ao-handle-buf-size h) (queue-elem-buflen el)))
(set-ao-handle-in-queue! h (- (ao-handle-in-queue h) 1))
))
el)
)
@@ -190,18 +233,14 @@
(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-in-queue! h (+ (ao-handle-in-queue h) 1))
(set-ao-handle-current-elem! h #f))
(async-channel-put (ao-handle-queue h) elem)
(set-ao-handle-in-queue! h (+ (ao-handle-in-queue h) 1))
)
(let* ((cb (ao-handle-current-elem h)))
(if (eq? cb #f)
@@ -209,9 +248,8 @@
(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))
(new-buf (alloc-buf h ns)))
(m-memcpy new-buf (queue-elem-buf cb) (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)))
@@ -222,18 +260,19 @@
(< (- (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-in-queue! h (+ (ao-handle-in-queue h) 1))
(set-ao-handle-current-elem! h #f)
(add* h elem))
(add h elem))
(let ((offset (queue-elem-buflen cb)))
(memcpy (queue-elem-buf cb) offset (queue-elem-buf elem) (queue-elem-buflen elem))
(m-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-in-queue! h (+ ao-handle-in-queue h) 1)
(set-ao-handle-current-elem! h #f))
)
)
@@ -243,14 +282,10 @@
)
(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 h elem)
(reuse-buf h (queue-elem-buf elem))
; does nothing
#t)
(define (clear h)
@@ -265,7 +300,6 @@
(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)))
@@ -274,7 +308,6 @@
(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)
@@ -302,15 +335,16 @@
(eq? le-a le-b)))
(define (alloc-buf h size)
(let ((entry #f))
(letrec ((f (λ (entries min-size min-size-idx idx)
(if (null? entries)
min-size-idx
(let ((e (car entries)))
(if (<= size (car e))
(if (or (eq? min-size #f) (< (car e) min-size))
(f (cdr entries) (car e) idx (+ idx 1))
(if (<= size (mem-size e))
(if (or (eq? min-size #f) (< (mem-size e) min-size))
(f (cdr entries) (mem-size e) idx (+ idx 1))
(f (cdr entries) min-size min-size-idx (+ idx 1))
)
(f (cdr entries) min-size min-size-idx (+ idx 1))
@@ -319,24 +353,20 @@
)
)
))
(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))
(make-mem size (make-bytes size) #t)
entry)
)
)
@@ -344,12 +374,8 @@
)
(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))
(when (and (mem? buf) (mem-allocated buf))
(set-ao-handle-bufs! h (cons buf (ao-handle-bufs h)))
)
#t
)
@@ -360,25 +386,35 @@
;;; Volume
(define (adjust-volume h bs buf-size volume-in-10000)
;; bs: bytes
(define (adjust-volume h bs volume-in-10000)
;; bs: mem
;; buf-size: aantal geldige bytes in bs
(let* ([bits (ao-handle-dev-bits-per-sample h)]
(let* ([bs-bytes (mem-bytes bs)]
[buf-size (mem-size bs)]
[bits (ao-handle-dev-bits-per-sample h)]
[bytes-per-sample (arithmetic-shift bits -3)]
[big? (is-big-endian? (ao-handle-dev-endianness h))])
[big? (is-big-endian? (ao-handle-dev-endianness h))]
[min-sample (- (arithmetic-shift 1 (- bits 1)))]
[max-sample (- (arithmetic-shift 1 (- bits 1)) 1)]
[clip (λ (scaled)
(cond
[(< scaled min-sample) min-sample]
[(> scaled max-sample) max-sample]
[else scaled]))]
)
(unless (= volume-in-10000 10000)
(for ([i (in-range 0 buf-size bytes-per-sample)])
(let* ([sample (int-bytes->integer bs #t big?
(let* ([sample (int-bytes->integer bs-bytes #t big?
i
(+ i bytes-per-sample))]
[scaled (quotient (* sample volume-in-10000) 10000)])
[scaled (clip (quotient (* sample volume-in-10000) 10000))])
(integer->int-bytes scaled
bytes-per-sample
#t
big?
bs
bs-bytes
i))))
#t))
@@ -386,16 +422,19 @@
;;; planar -> intereleaved
(define (planar-to-interleaved h mem buf-size info)
(define (planar-to-interleaved h in-buf info)
;; mem: bytes
;; result: (list bytes output-size)
(let* ([type (buffer-info-type info)]
(let* ([in-bytes (mem-bytes in-buf)]
[buf-size (mem-size in-buf)]
[type (buffer-info-type info)]
[bits (buffer-info-sample-bits info)]
[channels (buffer-info-channels info)]
[bytes (arithmetic-shift bits -3)]
[out-size buf-size]
[out (cadr (alloc-buf h out-size))]
[out (alloc-buf h out-size)]
[out-bytes (mem-bytes out)]
)
(unless (or (eq? type 'planar) (eq? type 'flac))
@@ -415,22 +454,25 @@
(* sample-index bytes))]
[out-pos (* (+ (* sample-index channels) channel)
bytes)])
(bytes-copy! out out-pos mem in-pos (+ in-pos bytes)))))
(bytes-copy! out-bytes out-pos in-bytes in-pos (+ in-pos bytes)))))
(list out out-size))))
out out-size)))
;;; requested bits to device bits
(define (convert-bits h buf buf-size in-bits in-endianness out-bits out-endianness)
(define (convert-bits h buf in-bits in-endianness out-bits out-endianness)
;; buf: bytes
;; returns: (list out-bytes out-size)
(let* ([in-bytes (arithmetic-shift in-bits -3)]
[out-bytes (arithmetic-shift out-bits -3)]
[in-buf (mem-bytes buf)]
[buf-size (mem-size buf)]
[samples (quotient buf-size in-bytes)]
[out-size (* samples out-bytes)]
[out (cadr (alloc-buf h out-size))]
[out (alloc-buf h out-size)]
[out-buf (mem-bytes out)]
[shift (- out-bits in-bits)]
[in-big? (is-big-endian? in-endianness)]
[out-big? (is-big-endian? out-endianness)])
@@ -438,17 +480,17 @@
(for ([n (in-range samples)])
(let* ([in-pos (* n in-bytes)]
[out-pos (* n out-bytes)]
[sample (int-bytes->integer buf #t in-big? in-pos (+ in-pos in-bytes))]
[sample (int-bytes->integer in-buf #t in-big? in-pos (+ in-pos in-bytes))]
[converted (arithmetic-shift sample shift)])
(integer->int-bytes converted out-bytes #t out-big? out out-pos)))
(list out out-size #t)))
(integer->int-bytes converted out-bytes #t out-big? out-buf out-pos)))
(define (convert-req-bits-to-dev-bits h mem buf-size info)
(list out #t)))
(define (convert-req-bits-to-dev-bits h mem info)
(if (and (= (buffer-info-sample-bits info) (ao-handle-dev-bits-per-sample h))
(endian-eq? (buffer-info-endianness info) (ao-handle-dev-endianness h)))
(list mem buf-size #f)
(convert-bits h mem buf-size
(list mem #f)
(convert-bits h mem
(buffer-info-sample-bits info)
(buffer-info-endianness info)
(ao-handle-dev-bits-per-sample h)
@@ -475,7 +517,7 @@
(mutex-unlock (ao-handle-clear-mutex h))
(if (eq? elem #f)
(begin
(dbg-sound "nothing in the queue")
;(dbg-sound "nothing in the queue")
(sleep 0.05))
(begin
(if (eq? (queue-elem-command elem) 'stop)
@@ -486,14 +528,15 @@
(set-ao-handle-music-id! h (queue-elem-music-id elem))
(unless (= (ao-handle-volume-in-10000 h) 10000)
(adjust-volume h (queue-elem-buf elem) (queue-elem-buflen elem)
(adjust-volume h (queue-elem-buf elem)
(ao-handle-volume-in-10000 h)))
(let* ((size (queue-elem-buflen elem)))
(let* ((size (queue-elem-buflen elem))
(el-buf (to-mem (queue-elem-buf elem))))
(when (> size buf-size)
(set! buf (malloc size 'atomic-interior ))
(set! buf-size size))
(memcpy buf (queue-elem-buf elem) size)
(m-memcpy buf (mem-bytes el-buf) size)
(ao_play (ao-handle-ao-device h) buf size)
)
)
@@ -510,8 +553,6 @@
)
)
(define handle-admin-mutex (make-mutex))
(define num-of-handles 0)
@@ -621,6 +662,9 @@
(define (ao_create_async bits rate channels byte-format wav-output-file)
(let ((handle (make-ao-handle
(make-async-channel) ; queue
0 ; in-queue
0 ; total buf size
#f ; paused
#f ; ao-device
@@ -633,8 +677,6 @@
(make-mutex) ; mutex
(make-mutex) ; pause-mutex
(make-mutex) ; clear-mutex
(make-mutex) ; buf-mutex
(make-mutex) ; add-mutex
#f ; play-thread
@@ -642,7 +684,6 @@
0.0 ; music-duration
0 ; music-id
0 ; total buf size
10000 ; volume-in-10000
#t ; valid handle
@@ -651,7 +692,7 @@
#f ; current element
0 ; bytes left
)))
(let ((ao-dev-bits (try-open-device bits rate channels byte-format wav-output-file)))
(set-ao-handle-ao-device! handle (car ao-dev-bits))
(set-ao-handle-dev-bits-per-sample! handle (cadr ao-dev-bits))
@@ -697,31 +738,29 @@
h
)
(define (ao_play_async h music-id at-second music-duration buf-size mem info)
(define (ao_play_async h music-id at-second music-duration buf-size au-buf info)
(let ((type (buffer-info-type info)))
(unless (bytes? mem)
(error "ao_play_async: paramater mem must be of type bytes"))
(unless (or (bytes? au-buf) (mem? au-buf))
(error "ao_play_async: paramater au-buf must be of type bytes or mem?"))
(set! au-buf (to-mem au-buf))
(set-mem-size! au-buf buf-size)
(when (or (eq? type 'planar) (eq? type 'flac))
(dbg-sound "Converting from planar to interleaved")
(let ((m (planar-to-interleaved h mem buf-size info)))
(reuse-buf h mem)
(set! mem (car m))
(set! buf-size (cadr m)))
(let ((m (planar-to-interleaved h au-buf info)))
(reuse-buf h au-buf)
(set! au-buf m)
(set! buf-size (mem-size m)))
)
(let ((ao-size buf-size)
(ao-mem mem))
(let ((m (convert-req-bits-to-dev-bits h mem buf-size info)))
(when (eq? (caddr m) #t)
(ao-mem au-buf))
(let ((m (convert-req-bits-to-dev-bits h mem info)))
(when (eq? (cadr m) #t)
(reuse-buf h mem)
(set! ao-mem (car m))
(set! ao-size (cadr m))))
(unless (bytes? ao-mem)
(error "Hey! this was unexpected!"))
(set! ao-size (mem-size ao-mem))))
(let ((elem (new-elem h 'play music-id at-second music-duration ao-size ao-mem)))
(add h elem))
@@ -782,3 +821,6 @@
(define (ao_reuse_buf_len h)
(length (ao-handle-bufs h)))
(define (ao_sample_queue_len h)
(ao-handle-in-queue h))