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

Remote usage of audio-placed-player.rkt

Browse Source
This commit is contained in:
Hans Dijkema
2026-06-08 15:46:27 +02:00
parent 17846e068c
commit 6ed566c6cd
9 changed files with 624 additions and 91 deletions
Download Patch File Download Diff File Expand all files Collapse all files
audio-placed-player.rkt
+58 -17
View File
@@ -1,7 +1,8 @@
#lang racket/base
(require racket/place
racket/async-channel
(require racket/port
port-channel
uni-channel
"libao.rkt"
"audio-decoder.rkt"
"private/utils.rkt"
@@ -9,19 +10,43 @@
)
(provide placed-player
placed-player/stdio
audio-known-exts?
)
(define get-current-seconds current-seconds)
(define (placed-player/stdio #:log-file [log-file (racket-sound-log-file 'placed-audio-player-stdio)])
(define stdin-ch
(make-uni-channel
(make-port-channel (current-input-port) #:direction 'input #:source 'stdin #:close? #f)))
(define stdout-ch
(make-uni-channel
(make-port-channel (current-output-port) #:direction 'output #:source 'stdout #:close? #f)))
(define stderr-ch
(make-uni-channel
(make-port-channel (current-error-port) #:direction 'output #:source 'stderr #:close? #f)))
(define log-port (if log-file (open-racket-sound-log-file log-file) (open-output-nowhere)))
(dynamic-wind
void
(lambda ()
;; stdout and stderr are protocol channels in this mode. Redirect ordinary
;; output so that display/log output cannot corrupt the serialized channel
;; streams.
(parameterize ([current-output-port log-port]
[current-error-port log-port])
(placed-player stdin-ch stdout-ch stderr-ch)))
(lambda ()
(with-handlers ([exn:fail? void]) (close-output-port log-port)))))
(define (eq-seconds? s1 s2)
(let ((s1* (inexact->exact (round s1)))
(s2* (inexact->exact (round s2))))
(= s1* s2*)))
(define (placed-player ch-in)
(let ((ch-evt #f)
(ch-out #f)
(define (placed-player ch-in [initial-ch-out #f] [initial-ch-evt #f])
(let ((ch-evt initial-ch-evt)
(ch-out initial-ch-out)
(ao-h #f)
(ao-mutex (make-mutex))
(ao-dec #f)
@@ -53,20 +78,25 @@
(begin b1 ...)
r)))))
(define (->uni-channel ch)
(if (uni-channel? ch) ch (make-uni-channel ch)))
;; ch-in is supplied by dynamic-place or by the async/thread launcher.
;; ch-out and ch-evt are supplied by the init command. Each logical
;; channel is wrapped as a uni-channel on the side where it is used; raw
;; place channels must not be wrapped before they are sent through init.
(set! ch-in (->uni-channel ch-in))
(when ch-out (set! ch-out (->uni-channel ch-out)))
(when ch-evt (set! ch-evt (->uni-channel ch-evt)))
(define (put data)
(if (place-channel? ch-out)
(place-channel-put ch-out data)
(async-channel-put ch-out data)))
(uni-channel-put ch-out data))
(define (evt data)
(if (place-channel? ch-evt)
(place-channel-put ch-evt data)
(async-channel-put ch-evt data)))
(uni-channel-put ch-evt data))
(define (get)
(if (place-channel? ch-in)
(place-channel-get ch-in)
(async-channel-get ch-in)))
(uni-channel-get ch-in))
(define (audio-read-worker ao-dec file-id)
(set! feeding-audio #t)
@@ -456,8 +486,8 @@
(state "quit" evt 'force)
'(quit)))
((eq? cmd 'init) (do-rpc
(set! ch-out (cadr data))
(set! ch-evt (caddr data))
(set! ch-out (->uni-channel (cadr data)))
(set! ch-evt (->uni-channel (caddr data)))
'(initialized))
(loop))
(else
@@ -536,4 +566,15 @@
)
)
)
)
)
(module+ main
(require racket/cmdline)
(define log-file 'default)
(command-line
#:once-each
[("--stdio") "Run the placed audio player over stdin/stdout/stderr." (void)]
[("--log-file") file "Write ordinary worker logging to file." (set! log-file file)]
[("--no-log-file") "Discard ordinary worker logging." (set! log-file #f)])
(placed-player/stdio #:log-file (if (eq? log-file 'default)
(racket-sound-log-file 'placed-audio-player-stdio)
log-file)))