Remote audio player much simpler.

2026-07-06 11:45:10 +02:00
parent 06c332474a
commit de443aad9d
6 changed files with 182 additions and 234 deletions
@@ -0,0 +1,100 @@
+#lang racket/base
+
+(provide audio-cfg-get
+         audio-cfg-set!
+         audio-remote-cfg-get
+         audio-remote-cfg-set!
+         )
+
+(require simple-ini/class)
+
+        
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; Supporting functions
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(define (build-env-path env . parts)
+  (let ((base (getenv env)))
+    (if (eq? base #f)
+        #f
+        (apply build-path (cons base parts)))))
+    
+(define (try-programs . prgs)
+  (letrec ((f (λ (l)
+                (if (null? l)
+                    #f
+                    (if (and (car l) (file-exists? (car l)))
+                        (car l)
+                        (f (cdr l)))))))
+    (f prgs)))
+   
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; Initialization
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(define cfg (new ini% [file 'racket-audio]))
+
+(when (eq? (send cfg get 'init 'initialized #f) #f)
+  (let ((s! (λ (e v)
+              (send cfg set! 'racket-audio e v))))
+    (s! 'remote-racket "racket")
+    (s! 'remote-module "racket-audio/audio-placed-player")
+    (s! 'ssh-program (cond
+                       ((eq? (system-type 'os) 'windows)
+                        (let ((p (try-programs
+                                  (build-env-path "ProgramFiles" "PuTTY" "plink.exe")
+                                  (build-env-path "ProgramFiles" "OpenSSH" "ssh.exe")
+                                  (build-env-path "SystemRoot" "System32" "OpenSSH" "ssh.exe")
+                                  (find-executable-path "ssh.exe")
+                                  (find-executable-path "plink.exe"))))
+                          (if (eq? p #f)
+                              "plink.exe"
+                              p)))
+                       (else (let ((p (find-executable-path "ssh")))
+                               (if (eq? p #f)
+                                   "ssh"
+                                   p))))
+        )
+    (send cfg set! 'init 'initialized #t)
+    )
+  )
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; Provided API
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(define (missing-cfg-value? v)
+  (eq? v '@racket-audio-no-value@))
+
+(define (audio-getter section entry default-provider)
+  (let ((v (send cfg get section entry '@racket-audio-no-value@)))
+    (if (missing-cfg-value? v)
+        (cond ((null? default-provider)
+               (error (format
+                       "audio-cfg-get: No such entry ~a in section ~a"
+                       section entry)))
+              ((procedure? (car default-provider))
+               ((car default-provider) entry))
+              (else
+               (car default-provider)))
+        v)))
+  
+        
+(define (audio-cfg-get entry . default-provider)
+  (audio-getter 'racket-audio entry default-provider))
+
+(define (audio-cfg-set! entry val)
+  (send cfg set! 'racket-audio entry val))
+
+(define (audio-remote-cfg-get host entry . default-provider)
+  (audio-getter (string->symbol (format "~a" host))
+                entry
+                (list (lambda (entry)
+                        (apply audio-cfg-get (cons entry default-provider))))))
+
+(define (audio-remote-cfg-set! host entry val)
+  (send cfg set! (string->symbol (format "~a" host)) entry val))
+                                    
+    
+