101 lines
3.4 KiB
Racket
101 lines
3.4 KiB
Racket
#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))
|
|
|
|
|
|
|