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_set_volume_async
ao_volume_async ao_volume_async
ao_reuse_buf_len ao_reuse_buf_len
ao_sample_queue_len
make-buffer-info make-buffer-info
make-BufferInfo_t make-BufferInfo_t
) )
@@ -127,6 +128,9 @@
(define-struct ao-handle (define-struct ao-handle
(queue (queue
in-queue
buf-size
paused paused
ao-device ao-device
@@ -139,36 +143,75 @@
mutex mutex
pause-mutex pause-mutex
clear-mutex clear-mutex
buf-mutex
add-mutex
play-thread play-thread
at-second at-second
music-duration music-duration
music-id music-id
buf-size
volume-in-10000 volume-in-10000
valid valid
bufs bufs
current-elem current-elem
bytes-left bytes-left
) )
#:mutable #: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 (define ao-buf-ms 250) ;; Playback buffer of 0.25s
;; -------------------------------------------------------------------------
;; Sample queue handling
;; -------------------------------------------------------------------------
(define (get h ms-wait) (define (get h ms-wait)
(let ((el (if (<= ms-wait 0) (let ((el (if (<= ms-wait 0)
(sync/timeout 0 (ao-handle-queue h)) (sync/timeout 0 (ao-handle-queue h))
(sync/timeout (/ ms-wait 1000.0) (ao-handle-queue h) )))) (sync/timeout (/ ms-wait 1000.0) (ao-handle-queue h) ))))
(if (eq? el #f) (if (eq? el #f)
(set-ao-handle-buf-size! h 0) ; no elements in queue => empty => no buffer with music samples (begin
(set-ao-handle-buf-size! h (- (ao-handle-buf-size h) (queue-elem-buflen el)))) (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) el)
) )
@@ -190,18 +233,14 @@
(define (add h elem) (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) (if (eq? (queue-elem-command elem) 'stop)
(begin (begin
(unless (eq? (ao-handle-current-elem h) #f) (unless (eq? (ao-handle-current-elem h) #f)
(async-channel-put (ao-handle-queue h) (ao-handle-current-elem h)) (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)) (set-ao-handle-current-elem! h #f))
(async-channel-put (ao-handle-queue h) elem) (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))) (let* ((cb (ao-handle-current-elem h)))
(if (eq? cb #f) (if (eq? cb #f)
@@ -209,9 +248,8 @@
(set-ao-handle-current-elem! h elem) (set-ao-handle-current-elem! h elem)
(set! cb elem) (set! cb elem)
(let* ((ns (needed-bytes h)) (let* ((ns (needed-bytes h))
(new-buf (cadr (alloc-buf h ns)))) (new-buf (alloc-buf h ns)))
(memcpy new-buf (queue-elem-buf cb) (queue-elem-buflen cb)) (m-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)) (reuse-buf h (queue-elem-buf cb))
(set-queue-elem-buf! cb new-buf) (set-queue-elem-buf! cb new-buf)
(set-ao-handle-bytes-left! h (- ns (queue-elem-buflen cb))) (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)) (< (- (ao-handle-bytes-left h) (queue-elem-buflen elem)) 0))
(begin (begin
; push this buffer and restart ; 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) (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) (set-ao-handle-current-elem! h #f)
(add* h elem)) (add h elem))
(let ((offset (queue-elem-buflen cb))) (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-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-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))) (set-ao-handle-buf-size! h (+ (ao-handle-buf-size h) (queue-elem-buflen elem)))
(reuse-buf h (queue-elem-buf elem)) (reuse-buf h (queue-elem-buf elem))
(when (= (ao-handle-bytes-left h) 0) (when (= (ao-handle-bytes-left h) 0)
(async-channel-put (ao-handle-queue h) cb) (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)) (set-ao-handle-current-elem! h #f))
) )
) )
@@ -243,14 +282,10 @@
) )
(define (new-elem h command music-id at-second music-duration buflen buf) (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)) (make-queue-elem command buf buflen at-second music-duration music-id))
(define (del-elem h elem) (define (del-elem h elem)
(reuse-buf h (queue-elem-buf elem)) (reuse-buf h (queue-elem-buf elem))
; does nothing
#t) #t)
(define (clear h) (define (clear h)
@@ -265,7 +300,6 @@
(set! el (get h 0))) (set! el (get h 0)))
; Clear the current element in processing ; Clear the current element in processing
(mutex-lock (ao-handle-add-mutex h))
(unless (eq? (ao-handle-current-elem h) #f) (unless (eq? (ao-handle-current-elem h) #f)
(let* ((ce (ao-handle-current-elem h)) (let* ((ce (ao-handle-current-elem h))
(cb (queue-elem-buf ce))) (cb (queue-elem-buf ce)))
@@ -274,7 +308,6 @@
(set-ao-handle-current-elem! h #f) (set-ao-handle-current-elem! h #f)
(set-ao-handle-bytes-left! h 0) (set-ao-handle-bytes-left! h 0)
(set-ao-handle-buf-size! h 0) (set-ao-handle-buf-size! h 0)
(mutex-unlock (ao-handle-add-mutex h))
(mutex-unlock (ao-handle-clear-mutex h)) (mutex-unlock (ao-handle-clear-mutex h))
(dbg-sound "~a elements cleared" count) (dbg-sound "~a elements cleared" count)
@@ -302,15 +335,16 @@
(eq? le-a le-b))) (eq? le-a le-b)))
(define (alloc-buf h size) (define (alloc-buf h size)
(let ((entry #f)) (let ((entry #f))
(letrec ((f (λ (entries min-size min-size-idx idx) (letrec ((f (λ (entries min-size min-size-idx idx)
(if (null? entries) (if (null? entries)
min-size-idx min-size-idx
(let ((e (car entries))) (let ((e (car entries)))
(if (<= size (car e)) (if (<= size (mem-size e))
(if (or (eq? min-size #f) (< (car e) min-size)) (if (or (eq? min-size #f) (< (mem-size e) min-size))
(f (cdr entries) (car e) idx (+ idx 1)) (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))
) )
(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)) (let ((bufs (ao-handle-bufs h))
(entry #f)) (entry #f))
(unless (null? bufs) (unless (null? bufs)
(let ((idx (f bufs #f #f 0))) (let ((idx (f bufs #f #f 0)))
(unless (eq? idx #f) (unless (eq? idx #f)
(let ((e (list-ref bufs idx))) (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! entry (list-ref bufs idx))
(set-ao-handle-bufs! h (append (take bufs idx) (drop bufs (+ idx 1)))) (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) (if (eq? entry #f)
(list size (make-bytes size)) (make-mem size (make-bytes size) #t)
entry) entry)
) )
) )
@@ -344,12 +374,8 @@
) )
(define (reuse-buf h buf) (define (reuse-buf h buf)
(unless (eq? buf #f) (when (and (mem? buf) (mem-allocated buf))
(mutex-lock (ao-handle-buf-mutex h)) (set-ao-handle-bufs! h (cons buf (ao-handle-bufs 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 #t
) )
@@ -360,25 +386,35 @@
;;; Volume ;;; Volume
(define (adjust-volume h bs buf-size volume-in-10000) (define (adjust-volume h bs volume-in-10000)
;; bs: bytes ;; bs: mem
;; buf-size: aantal geldige bytes in bs ;; 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)] [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) (unless (= volume-in-10000 10000)
(for ([i (in-range 0 buf-size bytes-per-sample)]) (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
(+ i bytes-per-sample))] (+ i bytes-per-sample))]
[scaled (quotient (* sample volume-in-10000) 10000)]) [scaled (clip (quotient (* sample volume-in-10000) 10000))])
(integer->int-bytes scaled (integer->int-bytes scaled
bytes-per-sample bytes-per-sample
#t #t
big? big?
bs bs-bytes
i)))) i))))
#t)) #t))
@@ -386,16 +422,19 @@
;;; planar -> intereleaved ;;; planar -> intereleaved
(define (planar-to-interleaved h mem buf-size info) (define (planar-to-interleaved h in-buf info)
;; mem: bytes ;; mem: bytes
;; result: (list bytes output-size) ;; 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)] [bits (buffer-info-sample-bits info)]
[channels (buffer-info-channels info)] [channels (buffer-info-channels info)]
[bytes (arithmetic-shift bits -3)] [bytes (arithmetic-shift bits -3)]
[out-size buf-size] [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)) (unless (or (eq? type 'planar) (eq? type 'flac))
@@ -415,22 +454,25 @@
(* sample-index bytes))] (* sample-index bytes))]
[out-pos (* (+ (* sample-index channels) channel) [out-pos (* (+ (* sample-index channels) channel)
bytes)]) 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 ;;; 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 ;; buf: bytes
;; returns: (list out-bytes out-size) ;; returns: (list out-bytes out-size)
(let* ([in-bytes (arithmetic-shift in-bits -3)] (let* ([in-bytes (arithmetic-shift in-bits -3)]
[out-bytes (arithmetic-shift out-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)] [samples (quotient buf-size in-bytes)]
[out-size (* samples out-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)] [shift (- out-bits in-bits)]
[in-big? (is-big-endian? in-endianness)] [in-big? (is-big-endian? in-endianness)]
[out-big? (is-big-endian? out-endianness)]) [out-big? (is-big-endian? out-endianness)])
@@ -438,17 +480,17 @@
(for ([n (in-range samples)]) (for ([n (in-range samples)])
(let* ([in-pos (* n in-bytes)] (let* ([in-pos (* n in-bytes)]
[out-pos (* n out-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)]) [converted (arithmetic-shift sample shift)])
(integer->int-bytes converted out-bytes #t out-big? out out-pos))) (integer->int-bytes converted out-bytes #t out-big? out-buf out-pos)))
(list out out-size #t)))
(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)) (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))) (endian-eq? (buffer-info-endianness info) (ao-handle-dev-endianness h)))
(list mem buf-size #f) (list mem #f)
(convert-bits h mem buf-size (convert-bits h mem
(buffer-info-sample-bits info) (buffer-info-sample-bits info)
(buffer-info-endianness info) (buffer-info-endianness info)
(ao-handle-dev-bits-per-sample h) (ao-handle-dev-bits-per-sample h)
@@ -475,7 +517,7 @@
(mutex-unlock (ao-handle-clear-mutex h)) (mutex-unlock (ao-handle-clear-mutex h))
(if (eq? elem #f) (if (eq? elem #f)
(begin (begin
(dbg-sound "nothing in the queue") ;(dbg-sound "nothing in the queue")
(sleep 0.05)) (sleep 0.05))
(begin (begin
(if (eq? (queue-elem-command elem) 'stop) (if (eq? (queue-elem-command elem) 'stop)
@@ -486,14 +528,15 @@
(set-ao-handle-music-id! h (queue-elem-music-id elem)) (set-ao-handle-music-id! h (queue-elem-music-id elem))
(unless (= (ao-handle-volume-in-10000 h) 10000) (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))) (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) (when (> size buf-size)
(set! buf (malloc size 'atomic-interior )) (set! buf (malloc size 'atomic-interior ))
(set! buf-size size)) (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) (ao_play (ao-handle-ao-device h) buf size)
) )
) )
@@ -510,8 +553,6 @@
) )
) )
(define handle-admin-mutex (make-mutex)) (define handle-admin-mutex (make-mutex))
(define num-of-handles 0) (define num-of-handles 0)
@@ -621,6 +662,9 @@
(define (ao_create_async bits rate channels byte-format wav-output-file) (define (ao_create_async bits rate channels byte-format wav-output-file)
(let ((handle (make-ao-handle (let ((handle (make-ao-handle
(make-async-channel) ; queue (make-async-channel) ; queue
0 ; in-queue
0 ; total buf size
#f ; paused #f ; paused
#f ; ao-device #f ; ao-device
@@ -633,8 +677,6 @@
(make-mutex) ; mutex (make-mutex) ; mutex
(make-mutex) ; pause-mutex (make-mutex) ; pause-mutex
(make-mutex) ; clear-mutex (make-mutex) ; clear-mutex
(make-mutex) ; buf-mutex
(make-mutex) ; add-mutex
#f ; play-thread #f ; play-thread
@@ -642,7 +684,6 @@
0.0 ; music-duration 0.0 ; music-duration
0 ; music-id 0 ; music-id
0 ; total buf size
10000 ; volume-in-10000 10000 ; volume-in-10000
#t ; valid handle #t ; valid handle
@@ -651,7 +692,7 @@
#f ; current element #f ; current element
0 ; bytes left 0 ; bytes left
))) )))
(let ((ao-dev-bits (try-open-device bits rate channels byte-format wav-output-file))) (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-ao-device! handle (car ao-dev-bits))
(set-ao-handle-dev-bits-per-sample! handle (cadr ao-dev-bits)) (set-ao-handle-dev-bits-per-sample! handle (cadr ao-dev-bits))
@@ -697,31 +738,29 @@
h 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))) (let ((type (buffer-info-type info)))
(unless (bytes? mem) (unless (or (bytes? au-buf) (mem? au-buf))
(error "ao_play_async: paramater mem must be of type bytes")) (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)) (when (or (eq? type 'planar) (eq? type 'flac))
(dbg-sound "Converting from planar to interleaved") (let ((m (planar-to-interleaved h au-buf info)))
(let ((m (planar-to-interleaved h mem buf-size info))) (reuse-buf h au-buf)
(reuse-buf h mem) (set! au-buf m)
(set! mem (car m)) (set! buf-size (mem-size m)))
(set! buf-size (cadr m)))
) )
(let ((ao-size buf-size) (let ((ao-size buf-size)
(ao-mem mem)) (ao-mem au-buf))
(let ((m (convert-req-bits-to-dev-bits h mem buf-size info))) (let ((m (convert-req-bits-to-dev-bits h mem info)))
(when (eq? (caddr m) #t) (when (eq? (cadr m) #t)
(reuse-buf h mem) (reuse-buf h mem)
(set! ao-mem (car m)) (set! ao-mem (car m))
(set! ao-size (cadr m)))) (set! ao-size (mem-size ao-mem))))
(unless (bytes? ao-mem)
(error "Hey! this was unexpected!"))
(let ((elem (new-elem h '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)) (add h elem))
@@ -782,3 +821,6 @@
(define (ao_reuse_buf_len h) (define (ao_reuse_buf_len h)
(length (ao-handle-bufs h))) (length (ao-handle-bufs h)))
(define (ao_sample_queue_len h)
(ao-handle-in-queue h))
libao.rkt
+6
View File
@@ -19,6 +19,7 @@
ao-at-music-id ao-at-music-id
ao-bufsize-async ao-bufsize-async
ao-reuse-buf-len-async ao-reuse-buf-len-async
ao-sample-queue-len-async
ao-clear-async ao-clear-async
ao-pause ao-pause
ao-set-volume! ao-set-volume!
@@ -208,6 +209,11 @@
(ffi:ao_reuse_buf_len (ao-handle-async-player handle)) (ffi:ao_reuse_buf_len (ao-handle-async-player handle))
) )
(rc:define/contract (ao-sample-queue-len-async handle)
(rc:-> ao-handle? integer?)
(ffi:ao_sample_queue_len (ao-handle-async-player handle))
)
(rc:define/contract (ao-set-volume! handle percentage) (rc:define/contract (ao-set-volume! handle percentage)
(rc:-> ao-handle? number? void?) (rc:-> ao-handle? number? void?)
(ffi:ao_set_volume_async (ao-handle-async-player handle) (ffi:ao_set_volume_async (ao-handle-async-player handle)
play-test.rkt
+7 -3
View File
@@ -122,8 +122,10 @@
(second-printer buf-seconds) (second-printer buf-seconds)
(cond-seek) (cond-seek)
(cond-volume) (cond-volume)
(when (> buf-seconds 5) (when (> buf-seconds 10)
(info-sound "Reuse buf: ~a" (ao-reuse-buf-len-async ao-h)) (info-sound "Reuse buf/Sample queue: ~a/~a"
(ao-reuse-buf-len-async ao-h)
(ao-sample-queue-len-async ao-h))
(letrec ((waiter (λ () (letrec ((waiter (λ ()
(let ((buf-seconds-left (exact->inexact (let ((buf-seconds-left (exact->inexact
(/ (ao-bufsize-async ao-h) (/ (ao-bufsize-async ao-h)
@@ -139,7 +141,9 @@
(waiter))))) (waiter)))))
)) ))
(waiter) (waiter)
(info-sound "Reuse buf: ~a" (ao-reuse-buf-len-async ao-h)) (info-sound "Reuse buf/Sample queue: ~a/~a"
(ao-reuse-buf-len-async ao-h)
(ao-sample-queue-len-async ao-h))
))) )))
) )
) )