This commit is contained in:
2026-04-09 13:04:42 +02:00
parent ddfc674453
commit c5d3ca5d7a
5 changed files with 27 additions and 20 deletions

View File

@@ -60,7 +60,7 @@
(define (process-meta handle meta)
(let ((type (FLAC__StreamMetadata-type meta)))
(display (format " Got metadata type: ~a\n" type))
(dbg-sound (format " Got metadata type: ~a\n" type))
(cond
([eq? type 'streaminfo]
(let ((mh (flac-ffi-meta meta)))
@@ -86,20 +86,18 @@
(letrec ((reader (lambda (frame-nr)
(if (flac-handle-stop-reading handle)
(begin
(displayln (format "handling stop at: ~a" (current-milliseconds)))
(dbg-sound "handling stop at: ~a" (current-milliseconds))
(set-flac-handle-reading! handle #f)
'stopped-reading)
(let* ((st (ffi-handler 'state)))
(ffi-handler 'process-single)
(unless (eq? state st)
(set! state st)
(displayln
(format "Now in state ~a (frame-nr = ~a) (int-state = ~a)"
st frame-nr (ffi-handler 'int-state)))
(dbg-sound "Now in state ~a (frame-nr = ~a) (int-state = ~a)"
st frame-nr (ffi-handler 'int-state))
)
(when (ffi-handler 'has-errno?)
(displayln
(format "Error in stream: ~a" (ffi-handler 'errno)))
(err-sound "Error in stream: ~a" (ffi-handler 'errno))
)
(when (ffi-handler 'has-meta-data?)
(ffi-handler 'process-meta-data
@@ -138,13 +136,13 @@
(define (flac-stop handle)
(let ((ct (current-milliseconds)))
(displayln (format "requesting stop at: ~a" ct))
(dbg-sound "requesting stop at: ~a" ct)
(set-flac-handle-stop-reading! handle #t)
(while (flac-handle-reading handle)
(sleep 0.01))
(let ((ct* (current-milliseconds)))
(displayln (format "stop came back at: ~a" ct*))
(displayln (format "flac-stop took: ~a ms" (- ct* ct))))
(dbg-sound "stop came back at: ~a" ct*)
(dbg-sound "flac-stop took: ~a ms" (- ct* ct)))
)
)

View File

@@ -15,8 +15,8 @@
)
)
(define deps
'("racket/gui" "racket/base" "racket" "finalizer" "racket/draw" "net/sendurl" "net/dns"))
(bdefine deps
'("racket/gui" "racket/base" "racket" "finalizer" "draw-lib" "net-lib"))
(define build-deps
'("racket-doc"

View File

@@ -196,18 +196,18 @@
(define (ao_pause_async shm pause)
(if pause
(begin
(displayln "Pausing ao play thread")
(dbg-sound "Pausing ao play thread")
(os-semaphore-wait (ao-shm-pause-sem shm))
(displayln (format "Setting pause now to ~a" pause))
(dbg-sound "Setting pause now to ~a" pause)
(mutex-lock (ao-shm-mutex shm))
(set-ao-shm-paused! shm pause)
(mutex-unlock (ao-shm-mutex shm)))
(begin
(displayln (format "Continuing ao play thread, now setting pause to ~a" pause))
(dbg-sound "Continuing ao play thread, now setting pause to ~a" pause)
(mutex-lock (ao-shm-mutex shm))
(set-ao-shm-paused! shm pause)
(mutex-unlock (ao-shm-mutex shm))
(displayln "Posting semaphore twice, one to let play thread continue, one for own use")
(dbg-sound "Posting semaphore twice, one to let play thread continue, one for own use")
(os-semaphore-post (ao-shm-pause-sem shm))
(os-semaphore-post (ao-shm-pause-sem shm))
)

View File

@@ -8,6 +8,7 @@
(prefix-in scm: "libao-async.rkt")
ffi/unsafe
data/queue
"private/utils.rkt"
)
(provide ao-open-live
@@ -55,10 +56,10 @@
(lambda (my-handle)
(hash-for-each devices
(lambda (handle-num device)
(displayln (format "closing ao handle ~a" handle-num))
(dbg-sound "closing ao handle ~a" handle-num)
(ao-close handle-num)))
(set! devices (make-hash))
(displayln "shutting down ao")
(dbg-sound "shutting down ao")
(ao_shutdown)
(plumber-flush-handle-remove! my-handle)
)))
@@ -157,13 +158,13 @@
(if (number? handle)
(let ((ao-device (hash-ref devices handle #f)))
(unless (eq? ao-device #f)
(displayln (format "Closing ao device ~a" ao-device))
(dbg-sound "Closing ao device ~a" ao-device)
(close-device #f ao-device)
(hash-remove! devices handle)))
(let ((handle-num (ao-handle-handle-num handle)))
(let ((ao-device (hash-ref devices handle-num #f)))
(unless (eq? ao-device #f)
(displayln (format "ao-device = ~a" ao-device))
(dbg-sound "ao-device = ~a" ao-device)
(close-device handle ao-device)
(hash-remove! devices handle-num)))
)

View File

@@ -5,6 +5,7 @@
ffi/unsafe
setup/dirs
"downloader.rkt"
simple-log
)
(provide while
@@ -12,8 +13,15 @@
build-lib-path
get-lib
do-for
dbg-sound
info-sound
err-sound
warn-sound
fatal-sound
)
(sl-def-log racket-sound (current-logger) sound)
(define-syntax while
(syntax-rules ()
((_ cond body ...)