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
private/downloader.rkt
+5 -5
View File
@@ -26,8 +26,8 @@
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(define version-major 1)
(define version-minor 0)
(define version-patch 0)
(define version-minor 1)
(define version-patch 1)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Internal functions
@@ -40,8 +40,8 @@
version-patch
))
(define download-site "git.dijkewijk.nl")
(define base-path "hans/racket-sound-lib/releases/download")
(define download-site "codeberg.org")
(define base-path "hnmdijkema/racket-sound-lib/releases/download")
(define os (system-type 'os*))
(define arch (system-type 'arch))
@@ -145,7 +145,7 @@
(let* ((file (build-path install-path "archive.zip"))
(out (open-output-file file #:exists 'replace))
)
(displayln (format "Downloading racket-webview-qt (~a)..." download-url))
(displayln (format "Downloading racket-sound-lib (~a)..." download-url))
(do-download in out)
(displayln (format "downloaded '~a'" file))
(when (directory-exists? ffi-path)
private/remote-utils.rkt
+153
View File
@@ -0,0 +1,153 @@
#lang racket/base
(require racket/list
racket/path
racket/string
racket/system
port-channel
uni-channel)
(provide remote-path-map?
audio-remote-path
racket-sound-default-ssh-program
racket-sound-default-ssh-options
racket-sound-default-remote-racket
racket-sound-default-remote-module
racket-sound-default-remote-command
racket-sound-resolve-executable
racket-sound-start-ssh-subprocess
current-racket-sound-ssh-program
current-racket-sound-remote-racket
current-racket-sound-remote-module
make-remote-port-uni-channels
start-remote-placed-player)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Remote path mapping
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(define (path-string->string p)
(if (path? p) (path->string p) p))
(define (remote-path-map? v)
(or (not v)
(procedure? v)
(and (list? v)
(andmap (lambda (entry)
(cond [(and (pair? entry) (pair? (cdr entry)) (null? (cddr entry)))
(and (path-string? (car entry)) (path-string? (cadr entry)))]
[(and (pair? entry) (path-string? (car entry)) (path-string? (cdr entry))) #t]
[(vector? entry)
(and (= (vector-length entry) 2)
(path-string? (vector-ref entry 0))
(path-string? (vector-ref entry 1)))]
[else #f]))
v))))
(define (path-map-entry-local entry)
(path-string->string
(cond [(vector? entry) (vector-ref entry 0)]
[(and (pair? entry) (pair? (cdr entry)) (null? (cddr entry))) (car entry)]
[else (car entry)])))
(define (path-map-entry-remote entry)
(path-string->string
(cond [(vector? entry) (vector-ref entry 1)]
[(and (pair? entry) (pair? (cdr entry)) (null? (cddr entry))) (cadr entry)]
[else (cdr entry)])))
(define (replace-prefix s from to)
(string-append to (substring s (string-length from))))
(define (audio-remote-path path map)
(define s (path-string->string path))
(cond [(not map) s]
[(procedure? map) (map s)]
[(null? map) s]
[else
(define matches
(filter (lambda (entry) (string-prefix? s (path-map-entry-local entry))) map))
(cond [(null? matches) s]
[else
(define best
(argmax (lambda (entry) (string-length (path-map-entry-local entry))) matches))
(replace-prefix s (path-map-entry-local best) (path-map-entry-remote best))])]))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; SSH / subprocess defaults
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(define (executable-name p)
(let ((p* (if (path? p) p (string->path p))))
(path->string (file-name-from-path p*))))
(define (plink-program? p)
(regexp-match? #rx"(?i:^plink(\\.exe)?$)" (executable-name p)))
(define (racket-sound-default-ssh-program)
(cond [(eq? (system-type 'os) 'windows)
(cond [(find-executable-path "plink.exe") => values]
[(find-executable-path "plink") => values]
[(find-executable-path "ssh.exe") => values]
[(find-executable-path "ssh") => values]
[else "plink.exe"])]
[else
(cond [(find-executable-path "ssh") => values]
[else "ssh"])]))
(define (racket-sound-default-ssh-options [ssh-program (racket-sound-default-ssh-program)])
(if (plink-program? ssh-program)
'("-batch" "-T")
'("-T" "-q")))
(define (racket-sound-default-remote-racket) "racket")
(define (racket-sound-default-remote-module) "racket-audio/audio-placed-player")
(define (racket-sound-default-remote-command
[remote-racket (racket-sound-default-remote-racket)]
[remote-module (racket-sound-default-remote-module)])
(list remote-racket "-l" remote-module "--" "--stdio"))
(define current-racket-sound-ssh-program
(make-parameter (racket-sound-default-ssh-program)))
(define current-racket-sound-remote-racket
(make-parameter (racket-sound-default-remote-racket)))
(define current-racket-sound-remote-module
(make-parameter (racket-sound-default-remote-module)))
(define (racket-sound-resolve-executable p)
(or (find-executable-path p) p))
(define (racket-sound-start-ssh-subprocess remote-host remote-command
#:ssh-program [ssh-program (current-racket-sound-ssh-program)]
#:ssh-options [ssh-options #f])
(define ssh-options* (or ssh-options (racket-sound-default-ssh-options ssh-program)))
(define args (append ssh-options* (list remote-host) remote-command))
(apply subprocess #f #f #f (racket-sound-resolve-executable ssh-program) args))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Port-channel wrapping
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(define (make-port-uc port direction source)
(make-uni-channel (make-port-channel port #:direction direction #:source source #:close? #t)))
(define (make-remote-port-uni-channels stdout stdin stderr)
(values (make-port-uc stdin 'output 'remote-stdin)
(make-port-uc stdout 'input 'remote-stdout)
(make-port-uc stderr 'input 'remote-stderr)))
(define (start-remote-placed-player remote-host
#:ssh-program [ssh-program (current-racket-sound-ssh-program)]
#:ssh-options [ssh-options #f]
#:remote-command [remote-command (racket-sound-default-remote-command)])
(define-values (proc stdout stdin stderr)
(racket-sound-start-ssh-subprocess remote-host remote-command
#:ssh-program ssh-program
#:ssh-options ssh-options))
(define-values (cmd-ch ret-ch evt-ch)
(make-remote-port-uni-channels stdout stdin stderr))
(define dead-guard (lambda () (subprocess-wait proc)))
(values cmd-ch ret-ch evt-ch proc dead-guard))
private/utils.rkt
+72 -15
View File
@@ -1,7 +1,9 @@
(module utils racket/base
(require racket/path
racket/file
racket/runtime-path
racket/system
ffi/unsafe
setup/dirs
"downloader.rkt"
@@ -19,6 +21,9 @@
warn-sound
fatal-sound
sync-log-sound
racket-sound-cache-directory
racket-sound-log-file
open-racket-sound-log-file
integer->int-bytes
int-bytes->integer
valid-ffmpeg-versions
@@ -34,6 +39,30 @@
(sl-def-log racket-sound sound)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Standard cache/log paths
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(define (racket-sound-cache-directory)
(build-path (find-system-path 'cache-dir) "racket-audio"))
(define (racket-sound-log-file name)
(define filename
(cond [(symbol? name) (format "~a.log" name)]
[(string? name) name]
[else (raise-argument-error 'racket-sound-log-file "(or/c symbol? string?)" name)]))
(build-path (racket-sound-cache-directory) filename))
(define (open-racket-sound-log-file path #:exists [exists 'append])
(define parent (path-only (path->complete-path path)))
(when parent (make-directory* parent))
(open-output-file path #:exists exists))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Mutex definitions
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
@@ -135,16 +164,16 @@
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(define valid-ffmpeg-versions
(make-hash (list (list 'avutil 58 60 "libavcodec")
(list 'avcodec 60 62 "libavutil")
(list 'avformat 60 62 "libswresample")
(list 'swresample 4 6 "libavformat")
(make-hash (list (list 'avutil 58 60 "libavutil")
(list 'avcodec 60 62 "libavcodec")
(list 'avformat 60 62 "libavformat")
(list 'swresample 4 6 "libswresample")
))
)
(define (version-str kind)
(let ((v (hash-ref valid-ffmpeg-versions kind)))
(format " - ~a~a - ~a~a\n" (caddr v) (car v) (caddr v) (cadr v))
(format " - ~a.so.~a - ~a.so.~a\n" (caddr v) (car v) (caddr v) (cadr v))
)
)
@@ -162,22 +191,50 @@
"Make sure you have installed the following libraries,\n"
"e.g. on a debian based system with apt:\n"
"\n"
" FLAC : sudo apt install libflac12\n"
" mpg123 : libmpg123-0\n"
" libao : libao4\n"
" ffmpeg : libavcodec60 libavutil58 libswresample4 libavformat60\n"
"\n"
" sudo apt install libflac12 libmpg123-0 libao4 \
"
" libavcodec60 libavutil58 libswresample4 libavformat60 \
"
" libogg0 libopus0 libopusenc0 libopusfile0 libtag1v5
"
"
"
"For development from source or local FFI rebuilding, install the matching -dev packages,
"
"for example libflac-dev, libmpg123-dev, libao-dev, libavcodec-dev,
"
"libavutil-dev, libswresample-dev, libavformat-dev, libogg-dev,
"
"libopus-dev, libopusenc-dev, libopusfile-dev and libtag1-dev.
"
"
"
)))
((eq? st 'macosx)
(displayln
(string-append
"Make sure you have the right libraries installed, using 'homebrew', see https://brew.sh/\n"
"\n"
" brew install ffmpeg-full\n"
" brew install libao\n"
" brew install mpg123\n"
" brew install flac\n"
"\n"
" brew install ffmpeg
"
" brew install libao
"
" brew install mpg123
"
" brew install flac
"
" brew install opus
"
" brew install libopusenc
"
" brew install taglib
"
"
"
"If your local setup uses ffmpeg-full instead of ffmpeg, install that variant instead.
"
"
"
)))
(else
(displayln