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

Made remote playing possible.

Browse Source
This commit is contained in:
Hans Dijkema
2026-07-06 14:28:28 +02:00
parent de443aad9d
commit c8494e289e
2 changed files with 63 additions and 14 deletions
Download Patch File Download Diff File Expand all files Collapse all files
audio-player.rkt
+23 -2
View File
@@ -4,6 +4,7 @@
racket/contract
racket/async-channel
racket/runtime-path
racket/string
uni-channel
"audio-placed-player.rkt"
"opusfile-decoder.rkt"
@@ -88,6 +89,23 @@
(define (evt-data evt)
(cadr evt))
(define (correct-to-os-path h replacements)
(let ((file (hash-ref h 'file #f)))
(letrec ((f (λ (l fl)
(if (null? l)
fl
(let ((bp-remote (cdar l))
(bp-local (caar l)))
(f (cdr l) (string-replace fl bp-remote bp-local)))))))
(unless (eq? file #f)
(let* ((delim (if (eq? (system-type 'os) 'windows) "\\" "/"))
(file* (string-replace
(string-replace
(f replacements (format "~a" file)) "/" delim)
"\\" delim)))
(hash-set! h 'file (build-path file*))))
h)))
(define-syntax assert
(syntax-rules ()
((_ cond message ...)
@@ -190,8 +208,10 @@
(let ((e (evt-get 500)))
(cond ((eq? e #f) (void))
((is-event? e 'state)
(let ((data (evt-data e)))
(set-audio-play-state! handle (car data))
(let* ((data (evt-data e))
(h (car data)))
(correct-to-os-path h replace-base-paths)
(set-audio-play-state! handle h)
(cb-state* (cadr data) (car data))))
((is-event? e 'audio-done) (cb-eof*))
((is-event? e 'exception)
@@ -214,6 +234,7 @@
(when (hash? (audio-play-state handle))
(let ((h (hash-copy (audio-play-state handle))))
(hash-set! h 'state 'invalid)
(correct-to-os-path h replace-base-paths)
(set-audio-play-state! handle h)))
(dbg-sound "audio-play handle invalidated and cleaned of references")
))
private/remote-utils.rkt
+40 -12
View File
@@ -4,7 +4,9 @@
racket/string
port-channel
uni-channel
"config.rkt")
"config.rkt"
"utils.rkt"
)
(provide replace-base-paths?
replace-base-path
@@ -25,6 +27,14 @@
(path-string? (cdr entry))))
v)))
(define (get-path-separator s)
(let ((m (regexp-match #rx"[\\\\/]" s)))
(if (eq? m #f)
(begin
(warn-sound "No delimiter found in ~a, assuming unix: '/'" s)
"/")
(car m))))
(define (replace-base-path path replace-base-paths)
(let ((s (path-string->string path)))
(let loop ((entries replace-base-paths))
@@ -34,8 +44,13 @@
(base-path-local (path-string->string (car entry)))
(base-path-remote (path-string->string (cdr entry))))
(if (string-prefix? s base-path-local)
(string-append base-path-remote
(substring s (string-length base-path-local)))
(let* ((new-path* (string-append base-path-remote
(substring s (string-length base-path-local))))
(delim (get-path-separator new-path*))
(new-path (string-replace (string-replace new-path* "/" delim) "\\" delim))
)
new-path
)
(loop (cdr entries))))]))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
@@ -51,21 +66,34 @@
(define (ssh-options ssh-program)
(if (plink-program? ssh-program)
'("-batch" "-T")
'("-batch" "-T" "-load")
'("-T" "-q")))
(define (remote-command remote-host)
(list (audio-remote-cfg-get remote-host 'remote-racket)
"-l"
(audio-remote-cfg-get remote-host 'remote-module)
"--"
"--stdio"))
(define (shell-quote s)
(string-append "'"
(regexp-replace* #rx"'" s "'\"'\"'")
"'"))
(define (start-ssh-subprocess remote-host)
(define (remote-command remote-host #:cmd [cmd #f])
(if (eq? cmd #f)
(list (audio-remote-cfg-get remote-host 'remote-racket)
"-l"
(audio-remote-cfg-get remote-host 'remote-module)
"--"
"--stdio")
(list (audio-remote-cfg-get remote-host 'remote-racket)
"-e"
(shell-quote cmd)
"--"
"--stdio")
)
)
(define (start-ssh-subprocess remote-host #:cmd [cmd #f])
(let* ((ssh-program (audio-cfg-get 'ssh-program))
(args (append (ssh-options ssh-program)
(list remote-host)
(remote-command remote-host))))
(remote-command remote-host #:cmd cmd))))
(apply subprocess #f #f #f ssh-program args)))
(define (make-port-uc port direction source)