refactoring
This commit is contained in:
@@ -0,0 +1,114 @@
|
||||
#lang racket/base
|
||||
|
||||
(require file/sha1
|
||||
racket/contract
|
||||
racket/os
|
||||
racket/path
|
||||
racket/random
|
||||
racket/string
|
||||
simple-ini)
|
||||
|
||||
(provide (struct-out player-agent-config)
|
||||
load-player-agent-config
|
||||
save-player-agent-config!
|
||||
valid-app-id?)
|
||||
|
||||
(struct player-agent-config (file ini app-id server-url name) #:transparent)
|
||||
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
;; Supporting functions
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
|
||||
(define (fresh-app-id)
|
||||
(bytes->hex-string (crypto-random-bytes 32)))
|
||||
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
;; Provided functions
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
; goal : Recognize a playback-agent application identifier.
|
||||
; pre : value is any Racket value.
|
||||
; post : No state is changed.
|
||||
; result : #t only for a 256-bit identifier encoded as 64 hexadecimal digits.
|
||||
; internals:
|
||||
; Identifiers are accepted case-insensitively and normalized while
|
||||
; loading configuration.
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
(define/contract (valid-app-id? value)
|
||||
(-> any/c boolean?)
|
||||
(and (string? value)
|
||||
(regexp-match? #px"^[0-9a-fA-F]{64}$" value)
|
||||
#t))
|
||||
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
; goal : Load the playback-agent INI configuration.
|
||||
; pre : file is a writable path-string understood by simple-ini.
|
||||
; post : Missing defaults and a generated application ID are persisted.
|
||||
; result : A player-agent-config value containing normalized settings.
|
||||
; internals:
|
||||
; Reusing the stored application ID preserves the server allowlist;
|
||||
; only a missing or malformed identifier is replaced.
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
(define/contract (load-player-agent-config
|
||||
[file (get-ini-file 'rkt-web-player-agent)])
|
||||
(->* () (path-string?) player-agent-config?)
|
||||
(let* ((ini (file->ini file))
|
||||
(configured-id (ini-get ini 'agent 'app-id #f))
|
||||
(value
|
||||
(player-agent-config
|
||||
file
|
||||
ini
|
||||
(if (valid-app-id? configured-id)
|
||||
(string-downcase configured-id)
|
||||
(fresh-app-id))
|
||||
(ini-get ini 'server 'url "http://127.0.0.1:8080")
|
||||
(ini-get ini 'agent 'name
|
||||
(format "~a playback" (gethostname))))))
|
||||
(save-player-agent-config! value)
|
||||
value))
|
||||
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
; goal : Persist a playback-agent configuration.
|
||||
; pre : value is a player-agent-config with a writable file path.
|
||||
; post : Its ID, name and server URL are stored in a private INI file.
|
||||
; result : The result returned by simple-ini's ini->file procedure.
|
||||
; internals:
|
||||
; The existing parsed INI value is updated directly so unrelated
|
||||
; settings remain intact.
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
(define/contract (save-player-agent-config! value)
|
||||
(-> player-agent-config? void?)
|
||||
(let ((ini (player-agent-config-ini value)))
|
||||
(ini-set! ini 'agent 'app-id (player-agent-config-app-id value))
|
||||
(ini-set! ini 'agent 'name (player-agent-config-name value))
|
||||
(ini-set! ini 'server 'url (player-agent-config-server-url value))
|
||||
(ini->file ini (player-agent-config-file value) #:private? #t)))
|
||||
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
;; Tests for module library.rkt
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
|
||||
(module+ test
|
||||
(require rackunit
|
||||
racket/file)
|
||||
|
||||
(define test-directory (make-temporary-file "rkt-agent-config-~a" 'directory))
|
||||
(define test-file (build-path test-directory "agent.ini"))
|
||||
(dynamic-wind
|
||||
void
|
||||
(λ ()
|
||||
(let* ((first (load-player-agent-config test-file))
|
||||
(changed
|
||||
(struct-copy player-agent-config first
|
||||
(server-url "https://music.example.test")
|
||||
(name "Test output"))))
|
||||
(check-true (valid-app-id? (player-agent-config-app-id first)))
|
||||
(save-player-agent-config! changed)
|
||||
(let ((second (load-player-agent-config test-file)))
|
||||
(check-equal? (player-agent-config-app-id second)
|
||||
(player-agent-config-app-id first))
|
||||
(check-equal? (player-agent-config-server-url second)
|
||||
"https://music.example.test")
|
||||
(check-equal? (player-agent-config-name second) "Test output"))))
|
||||
(λ () (delete-directory/files test-directory))))
|
||||
@@ -0,0 +1,524 @@
|
||||
#lang racket/base
|
||||
|
||||
(require json
|
||||
net/url
|
||||
racket-audio
|
||||
racket/contract
|
||||
racket/file
|
||||
racket/path
|
||||
racket/port
|
||||
racket/string
|
||||
simple-log
|
||||
"player-agent-translate.rkt")
|
||||
|
||||
(provide (struct-out player-agent-runtime)
|
||||
make-player-agent-runtime)
|
||||
|
||||
(sl-def-log player-agent)
|
||||
|
||||
(struct exn:fail:agent-denied exn:fail () #:transparent)
|
||||
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
; goal : Expose the small procedure-based interface of a running agent.
|
||||
; pre : Constructor fields are lifecycle/query procedures and a stable ID.
|
||||
; post : Creating or recognizing a value changes no external state.
|
||||
; result : player-agent-runtime? recognizes values returned by the factory.
|
||||
; internals: make-player-agent-runtime stores its local start!, reconnect!,
|
||||
; shutdown!, snapshot and current-track procedures in this struct.
|
||||
; Those procedures retain access to the factory closure, keeping the
|
||||
; shared polling and audio state private without introducing a class.
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
(struct player-agent-runtime
|
||||
(start! reconnect! shutdown! snapshot current-track running? app-id)
|
||||
#:transparent)
|
||||
|
||||
;;; Normalizes a configured server address and converts it to a URL value.
|
||||
(define (base-url value)
|
||||
(string->url
|
||||
(regexp-replace #px"/+$" (string-trim value) "")))
|
||||
|
||||
;;; Resolves an agent API path relative to a normalized server URL.
|
||||
(define (endpoint-url base path)
|
||||
(combine-url/relative (base-url base) path))
|
||||
|
||||
;;; Posts JSON to an agent API endpoint and reads its JSON response.
|
||||
;;; Authorization failures receive a distinct exception for poll-loop.
|
||||
(define (post-json base path data)
|
||||
(let ((input
|
||||
(post-pure-port
|
||||
(endpoint-url base path)
|
||||
(jsexpr->bytes data)
|
||||
(list "Content-Type: application/json"
|
||||
"Cache-Control: no-store"))))
|
||||
(dynamic-wind
|
||||
void
|
||||
(λ ()
|
||||
(let ((response (read-json input)))
|
||||
(when (and (hash? response)
|
||||
(string? (hash-ref response 'error #f)))
|
||||
(if (equal? (hash-ref response 'code #f)
|
||||
"agent-not-authorized")
|
||||
(raise
|
||||
(exn:fail:agent-denied
|
||||
(hash-ref response 'error)
|
||||
(current-continuation-marks)))
|
||||
(error 'player-agent (hash-ref response 'error))))
|
||||
response))
|
||||
(λ () (close-input-port input)))))
|
||||
|
||||
;;; Converts racket-audio states to the state names sent to the web player.
|
||||
(define (normal-state state)
|
||||
(cond
|
||||
((memq state '(initialized no-media)) "stopped")
|
||||
((eq? state 'transitioning) "starting")
|
||||
(else (symbol->string state))))
|
||||
|
||||
;;; Deletes a temporary media file and logs recoverable deletion failures.
|
||||
(define (safe-delete-file file)
|
||||
(when (and file (file-exists? file))
|
||||
(with-handlers ((exn:fail?
|
||||
(λ (exception)
|
||||
(warn-player-agent
|
||||
"Could not remove temporary media file ~a: ~a"
|
||||
file
|
||||
(exn-message exception)))))
|
||||
(delete-file file))))
|
||||
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
;; Provided functions
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
; goal : Create the headless polling and audio runtime for one agent.
|
||||
; pre : Server URL, display name and application ID are strings; callbacks
|
||||
; accept the status/denial messages supplied to them.
|
||||
; post : Mutable state is initialized but no worker thread or audio backend
|
||||
; is started until the returned start! procedure is called.
|
||||
; result : A player-agent-runtime containing its lifecycle/query procedures.
|
||||
; internals: start! launches poll-loop, which registers through post-json and
|
||||
; sends snapshots until it receives a command. A command worker runs
|
||||
; execute-command! and acknowledges it only after completion.
|
||||
; ensure-audio! connects racket-audio callbacks to update-from-audio!
|
||||
; and advance-at-decoder-eof!. with-agent-state protects their shared
|
||||
; state; stop! and shutdown! stop threads, audio and cached files.
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
(define/contract (make-player-agent-runtime initial-server-url
|
||||
initial-name
|
||||
app-id
|
||||
#:status-callback
|
||||
[status-callback void]
|
||||
#:denied-callback
|
||||
[denied-callback void])
|
||||
(->* (string? string? string?)
|
||||
(#:status-callback (-> string? any/c)
|
||||
#:denied-callback (-> string? any/c))
|
||||
player-agent-runtime?)
|
||||
(let* ((server-url initial-server-url)
|
||||
(assigned-name initial-name)
|
||||
(state-lock (make-semaphore 1))
|
||||
(worker #f)
|
||||
(command-worker #f)
|
||||
(executing-command-id 0)
|
||||
(running #f)
|
||||
(authorization-notified? #f)
|
||||
(audio #f)
|
||||
(current-media-key #f)
|
||||
(cached-media (make-hash))
|
||||
(prefetched-track #f)
|
||||
(auto-started-key #f)
|
||||
(pending-auto-music-id #f)
|
||||
(music-tracks (make-hash))
|
||||
(current-track-value #f)
|
||||
(acknowledged-command 0)
|
||||
(ended-counter 0)
|
||||
(logical-volume 50)
|
||||
(agent-state
|
||||
(hasheq 'state "stopped"
|
||||
'position 0
|
||||
'duration 'null
|
||||
'rate 'null
|
||||
'channels 'null
|
||||
'bits 'null
|
||||
'format ""
|
||||
'volume logical-volume
|
||||
'error 'null)))
|
||||
|
||||
;;; Runs a procedure while holding the semaphore for shared agent state.
|
||||
(define (with-agent-state proc)
|
||||
(call-with-semaphore state-lock proc))
|
||||
|
||||
;;; Replaces an unavailable state value with its JSON fallback.
|
||||
(define (state-value value fallback)
|
||||
(if (eq? value #f) fallback value))
|
||||
|
||||
;;; Returns the latest audio state while holding the state semaphore.
|
||||
(define (snapshot)
|
||||
(with-agent-state (λ () agent-state)))
|
||||
|
||||
;;; Returns the currently audible track while holding the state semaphore.
|
||||
(define (current-track)
|
||||
(with-agent-state (λ () current-track-value)))
|
||||
|
||||
;;; Stores an error in the state reported by the next poll.
|
||||
(define (set-agent-error! message)
|
||||
(with-agent-state
|
||||
(λ ()
|
||||
(set! agent-state (hash-set agent-state 'error message)))))
|
||||
|
||||
;;; Removes an earlier error from the state reported by the next poll.
|
||||
(define (clear-agent-error!)
|
||||
(with-agent-state
|
||||
(λ ()
|
||||
(set! agent-state (hash-set agent-state 'error 'null)))))
|
||||
|
||||
;;; Copies racket-audio state into the agent snapshot.
|
||||
;;; It also confirms when a prefetched track has become audible.
|
||||
(define (update-from-audio! state full-state)
|
||||
(with-agent-state
|
||||
(λ ()
|
||||
(let ((audible-music-id (hash-ref full-state 'at-music-id #f)))
|
||||
(set! agent-state
|
||||
(hasheq
|
||||
'state (normal-state state)
|
||||
'position (state-value (hash-ref full-state 'at-second #f) 0)
|
||||
'duration (state-value (hash-ref full-state 'duration #f) 'null)
|
||||
'rate (state-value (hash-ref full-state 'rate #f) 'null)
|
||||
'channels (state-value (hash-ref full-state 'channels #f) 'null)
|
||||
'bits (state-value (hash-ref full-state 'bits #f) 'null)
|
||||
'format (let ((decoder (hash-ref full-state 'decoder #f)))
|
||||
(if decoder (format "~a" decoder) ""))
|
||||
'volume logical-volume
|
||||
'error 'null))
|
||||
(when (and pending-auto-music-id
|
||||
(number? audible-music-id)
|
||||
(= pending-auto-music-id audible-music-id))
|
||||
(let ((audible-track
|
||||
(hash-ref music-tracks audible-music-id #f)))
|
||||
(when audible-track
|
||||
(set! current-track-value audible-track)
|
||||
(hash-clear! music-tracks)
|
||||
(hash-set! music-tracks audible-music-id audible-track)))
|
||||
(set! pending-auto-music-id #f)
|
||||
(set! ended-counter (+ ended-counter 1)))))))
|
||||
|
||||
;;; Creates and configures the audio player on first use.
|
||||
;;; Its callbacks update reported state and continue prefetched playback.
|
||||
(define (ensure-audio!)
|
||||
(unless audio
|
||||
(set! audio
|
||||
(make-audio-player
|
||||
(λ (_handle state full-state)
|
||||
(update-from-audio! state full-state))
|
||||
(λ (handle)
|
||||
(advance-at-decoder-eof! handle))))
|
||||
(audio-ao-buf-ms! audio 500)
|
||||
(audio-buf-seconds! audio 4 10)
|
||||
(let ((scaled (/ logical-volume 100.0)))
|
||||
(audio-volume! audio (* 100.0 scaled scaled))))
|
||||
audio)
|
||||
|
||||
;;; Downloads one protected media resource to a temporary local file.
|
||||
;;; A failed download closes its port and removes its partial file.
|
||||
(define (download-media! token filename)
|
||||
(let* ((extension
|
||||
(or (path-get-extension (string->path filename)) #""))
|
||||
(target
|
||||
(make-temporary-file
|
||||
(string-append "rkt-player-agent-~a"
|
||||
(bytes->string/utf-8 extension))))
|
||||
(path (format "/api/agent/media/~a/~a" app-id token))
|
||||
(input (get-pure-port (endpoint-url server-url path))))
|
||||
(with-handlers ((exn:fail?
|
||||
(λ (exception)
|
||||
(close-input-port input)
|
||||
(safe-delete-file target)
|
||||
(raise exception))))
|
||||
(call-with-output-file
|
||||
target
|
||||
(λ (output) (copy-port input output))
|
||||
#:exists 'truncate/replace)
|
||||
(close-input-port input)
|
||||
target)))
|
||||
|
||||
;;; Selects the stable cache key carried by a playback command.
|
||||
(define (command-cache-key data)
|
||||
(hash-ref data 'cacheKey (hash-ref data 'mediaToken)))
|
||||
|
||||
;;; Returns cached media or downloads and records it when absent.
|
||||
(define (ensure-media-cached! data)
|
||||
(let* ((key (command-cache-key data))
|
||||
(found (hash-ref cached-media key #f)))
|
||||
(if (and found (file-exists? found))
|
||||
found
|
||||
(let ((downloaded
|
||||
(download-media!
|
||||
(hash-ref data 'mediaToken)
|
||||
(hash-ref data 'filename "track"))))
|
||||
(hash-set! cached-media key downloaded)
|
||||
downloaded))))
|
||||
|
||||
;;; Removes every cached media file except the entry identified by keep-key.
|
||||
(define (discard-unused-media! keep-key)
|
||||
(let loop ((remaining (hash->list cached-media)))
|
||||
(unless (null? remaining)
|
||||
(let ((entry (car remaining)))
|
||||
(unless (equal? (car entry) keep-key)
|
||||
(safe-delete-file (cdr entry))
|
||||
(hash-remove! cached-media (car entry))))
|
||||
(loop (cdr remaining)))))
|
||||
|
||||
;;; Continues with prefetched media when the current decoder reaches EOF.
|
||||
;;; Decoder EOF precedes audible EOF, so audio-play! queues behind the buffer.
|
||||
(define (advance-at-decoder-eof! handle)
|
||||
(let ((prepared
|
||||
(with-agent-state
|
||||
(λ ()
|
||||
(let ((value prefetched-track))
|
||||
(set! prefetched-track #f)
|
||||
value)))))
|
||||
(cond
|
||||
(prepared
|
||||
(let* ((data (car prepared))
|
||||
(path (cdr prepared))
|
||||
(key (command-cache-key data)))
|
||||
(with-handlers
|
||||
((exn:fail?
|
||||
(λ (exception)
|
||||
(warn-player-agent "Could not start prefetched track: ~a"
|
||||
(exn-message exception))
|
||||
(set-agent-error! (exn-message exception))
|
||||
(with-agent-state
|
||||
(λ () (set! ended-counter (+ ended-counter 1)))))))
|
||||
(let ((music-id (audio-play! handle path)))
|
||||
(info-player-agent "Queued prefetched track ~a as music id ~a"
|
||||
(hash-ref data 'filename "track")
|
||||
music-id)
|
||||
(set! current-media-key key)
|
||||
(discard-unused-media! key)
|
||||
(with-agent-state
|
||||
(λ ()
|
||||
(hash-set! music-tracks music-id data)
|
||||
(set! auto-started-key key)
|
||||
(set! pending-auto-music-id music-id)))))))
|
||||
(else
|
||||
(warn-player-agent
|
||||
"Decoder reached EOF before the next track was prefetched")
|
||||
(with-agent-state
|
||||
(λ () (set! ended-counter (+ ended-counter 1))))))))
|
||||
|
||||
;;; Applies one server command to audio, cache and reported agent state.
|
||||
;;; Play and prefetch commands also maintain gapless track bookkeeping.
|
||||
(define (execute-command! command)
|
||||
(let ((action (hash-ref command 'action ""))
|
||||
(data (hash-ref command 'data (hasheq))))
|
||||
(info-player-agent "Executing command ~a" action)
|
||||
(cond
|
||||
((string=? action "play")
|
||||
(let* ((next-key (command-cache-key data))
|
||||
(already-started?
|
||||
(with-agent-state
|
||||
(λ ()
|
||||
(let ((matches?
|
||||
(and auto-started-key
|
||||
(equal? auto-started-key next-key))))
|
||||
(when matches?
|
||||
(set! auto-started-key #f))
|
||||
matches?)))))
|
||||
(with-agent-state
|
||||
(λ () (set! current-track-value data)))
|
||||
(unless already-started?
|
||||
(with-agent-state
|
||||
(λ ()
|
||||
(set! prefetched-track #f)
|
||||
(set! auto-started-key #f)
|
||||
(set! pending-auto-music-id #f)
|
||||
(set! agent-state
|
||||
(hash-set
|
||||
(hash-set agent-state 'state "starting")
|
||||
'error 'null))))
|
||||
(let* ((next-media (ensure-media-cached! data))
|
||||
;; audio-play! interrupts and closes the previous decoder.
|
||||
(music-id (audio-play! (ensure-audio!) next-media)))
|
||||
(with-agent-state
|
||||
(λ ()
|
||||
(hash-clear! music-tracks)
|
||||
(hash-set! music-tracks music-id data)))
|
||||
(set! current-media-key next-key)
|
||||
(discard-unused-media! next-key)))))
|
||||
((string=? action "prefetch")
|
||||
(let ((key (command-cache-key data))
|
||||
(path (ensure-media-cached! data)))
|
||||
(with-agent-state
|
||||
(λ () (set! prefetched-track (cons data path))))
|
||||
(info-player-agent "Prefetched ~a"
|
||||
(hash-ref data 'filename "track"))
|
||||
(let loop ((remaining (hash->list cached-media)))
|
||||
(unless (null? remaining)
|
||||
(let ((entry (car remaining)))
|
||||
(unless (or (equal? (car entry) current-media-key)
|
||||
(equal? (car entry) key))
|
||||
(safe-delete-file (cdr entry))
|
||||
(hash-remove! cached-media (car entry))))
|
||||
(loop (cdr remaining))))))
|
||||
((string=? action "pause")
|
||||
(audio-pause! (ensure-audio!) #t))
|
||||
((string=? action "resume")
|
||||
(audio-pause! (ensure-audio!) #f))
|
||||
((string=? action "stop")
|
||||
(with-agent-state
|
||||
(λ ()
|
||||
(set! prefetched-track #f)
|
||||
(set! auto-started-key #f)
|
||||
(set! pending-auto-music-id #f)))
|
||||
(when audio
|
||||
(audio-stop! audio)))
|
||||
((string=? action "seek")
|
||||
(audio-seek! (ensure-audio!) (hash-ref data 'percentage 0)))
|
||||
((string=? action "volume")
|
||||
(set! logical-volume (min 100 (max 0 (hash-ref data 'value 50))))
|
||||
(let ((scaled (/ logical-volume 100.0)))
|
||||
(audio-volume! (ensure-audio!) (* 100.0 scaled scaled)))
|
||||
(with-agent-state
|
||||
(λ ()
|
||||
(set! agent-state
|
||||
(hash-set agent-state 'volume logical-volume)))))
|
||||
(else
|
||||
(error 'player-agent "unknown command: ~a" action)))))
|
||||
|
||||
;;; Registers the agent and repeatedly exchanges state for server commands.
|
||||
;;; Connection and authorization failures are reported before a delayed retry.
|
||||
(define (poll-loop)
|
||||
(with-handlers
|
||||
((exn:fail:agent-denied?
|
||||
(λ (exception)
|
||||
(let ((message (format (tr 'denied-message) app-id)))
|
||||
(warn-player-agent "Agent authorization refused: ~a"
|
||||
(exn-message exception))
|
||||
(set-agent-error! message)
|
||||
(status-callback
|
||||
(tr 'unauthorized-status))
|
||||
(unless authorization-notified?
|
||||
(set! authorization-notified? #t)
|
||||
(denied-callback message))
|
||||
(when running
|
||||
(sleep 3)
|
||||
(poll-loop)))))
|
||||
(exn:fail?
|
||||
(λ (exception)
|
||||
(warn-player-agent "Connection cycle failed: ~a"
|
||||
(exn-message exception))
|
||||
(set-agent-error! (exn-message exception))
|
||||
(status-callback
|
||||
(format (tr 'disconnected) (exn-message exception)))
|
||||
(when running
|
||||
(sleep 3)
|
||||
(poll-loop)))))
|
||||
(post-json server-url
|
||||
"/api/agent/register"
|
||||
(hasheq 'appId app-id 'name assigned-name))
|
||||
(clear-agent-error!)
|
||||
(status-callback (tr 'connected))
|
||||
(info-player-agent "Registered at ~a as ~a" server-url assigned-name)
|
||||
(let loop ()
|
||||
(when running
|
||||
(let* ((response
|
||||
(post-json
|
||||
server-url
|
||||
"/api/agent/poll"
|
||||
(hasheq 'appId app-id
|
||||
'name assigned-name
|
||||
'ack acknowledged-command
|
||||
'endedCounter ended-counter
|
||||
'state (snapshot))))
|
||||
(command (hash-ref response 'command 'null)))
|
||||
(when (and (hash? command)
|
||||
(> (hash-ref command 'id 0) acknowledged-command)
|
||||
(not (= (hash-ref command 'id 0)
|
||||
executing-command-id)))
|
||||
(set! executing-command-id (hash-ref command 'id))
|
||||
(set! command-worker
|
||||
(thread
|
||||
(λ ()
|
||||
(with-handlers
|
||||
((exn:fail?
|
||||
(λ (exception)
|
||||
(warn-player-agent "Command failed: ~a"
|
||||
(exn-message exception))
|
||||
(set-agent-error! (exn-message exception)))))
|
||||
(clear-agent-error!)
|
||||
(execute-command! command))
|
||||
(set! acknowledged-command (hash-ref command 'id))
|
||||
(set! executing-command-id 0)
|
||||
(set! command-worker #f))))))
|
||||
(sleep 1)
|
||||
(loop)))))
|
||||
|
||||
;;; Starts the polling worker once and reports the connecting state.
|
||||
(define (start!)
|
||||
(unless running
|
||||
(set! running #t)
|
||||
(status-callback (tr 'connecting))
|
||||
(set! worker (thread poll-loop))))
|
||||
|
||||
;;; Stops polling and command workers and clears their lifecycle state.
|
||||
(define (stop!)
|
||||
(set! running #f)
|
||||
(when (and worker (not (thread-dead? worker)))
|
||||
(kill-thread worker))
|
||||
(when (and command-worker (not (thread-dead? command-worker)))
|
||||
(kill-thread command-worker))
|
||||
(set! worker #f)
|
||||
(set! command-worker #f)
|
||||
(set! executing-command-id 0))
|
||||
|
||||
;;; Restarts the runtime with a new normalized server address and name.
|
||||
(define (reconnect! new-server-url new-name)
|
||||
(stop!)
|
||||
(set! authorization-notified? #f)
|
||||
(set! server-url (string-trim new-server-url))
|
||||
(set! assigned-name (string-trim new-name))
|
||||
(start!))
|
||||
|
||||
;;; Stops the runtime, closes audio and removes all cached media files.
|
||||
(define (shutdown!)
|
||||
(stop!)
|
||||
(when audio
|
||||
(with-handlers ((exn:fail? void))
|
||||
(audio-quit! audio))
|
||||
(set! audio #f))
|
||||
(let loop ((paths (hash-values cached-media)))
|
||||
(unless (null? paths)
|
||||
(safe-delete-file (car paths))
|
||||
(loop (cdr paths))))
|
||||
(hash-clear! cached-media))
|
||||
|
||||
(player-agent-runtime start!
|
||||
reconnect!
|
||||
shutdown!
|
||||
snapshot
|
||||
current-track
|
||||
(λ () running)
|
||||
app-id)))
|
||||
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
;; Tests for module player-agent-core.rkt
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
|
||||
(module+ test
|
||||
(require rackunit)
|
||||
|
||||
(check-equal? (normal-state 'initialized) "stopped")
|
||||
(check-equal? (normal-state 'transitioning) "starting")
|
||||
(check-equal? (normal-state 'playing) "playing")
|
||||
|
||||
(let* ((app-id (make-string 64 #\a))
|
||||
(runtime
|
||||
(make-player-agent-runtime "http://127.0.0.1:1234"
|
||||
"Test agent"
|
||||
app-id)))
|
||||
(check-false ((player-agent-runtime-running? runtime)))
|
||||
(check-false ((player-agent-runtime-current-track runtime)))
|
||||
(check-equal?
|
||||
(hash-ref ((player-agent-runtime-snapshot runtime)) 'state)
|
||||
"stopped")
|
||||
(check-equal? (player-agent-runtime-app-id runtime) app-id)))
|
||||
@@ -0,0 +1,417 @@
|
||||
#lang racket/base
|
||||
|
||||
(require racket/class
|
||||
racket/contract
|
||||
racket/format
|
||||
racket/gui/base
|
||||
racket/os
|
||||
racket/runtime-path
|
||||
racket/string
|
||||
racket-tray
|
||||
simple-log
|
||||
"player-agent-config.rkt"
|
||||
"player-agent-core.rkt"
|
||||
"player-agent-translate.rkt")
|
||||
|
||||
(provide run-player-agent-gui)
|
||||
|
||||
(sl-def-log player-agent-gui)
|
||||
|
||||
(define log-file
|
||||
(build-path (find-system-path 'pref-dir)
|
||||
"rkt-web-player-agent.log"))
|
||||
|
||||
(define-runtime-path tray-icon
|
||||
"../public/rkt-web-player.png")
|
||||
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
;; Supporting functions
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
; goal : Create a labelled text field with compact editor padding.
|
||||
; pre : label and init-value are strings; panel accepts GUI children.
|
||||
; post : A text field has been added to panel.
|
||||
; result : The newly created text-field% object.
|
||||
; internals:
|
||||
; Padding is set on the editor because it renders consistently on
|
||||
; the supported desktop platforms.
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
(define (input-field label init-value panel)
|
||||
(let ((field
|
||||
(new text-field%
|
||||
(parent panel)
|
||||
(label label)
|
||||
(init-value init-value))))
|
||||
(send (send field get-editor) set-padding 0 2 0 2)
|
||||
field))
|
||||
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
; goal : Format a playback position as hours, minutes and seconds.
|
||||
; pre : value is any Racket value.
|
||||
; post : No state is changed.
|
||||
; result : A zero-padded HH:MM:SS string; invalid values are treated as zero.
|
||||
; internals:
|
||||
; Fractional seconds are deliberately rounded down so the displayed
|
||||
; position never runs ahead of the audio runtime.
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
(define (format-time value)
|
||||
(let* ((seconds
|
||||
(if (and (number? value) (>= value 0))
|
||||
(inexact->exact (floor value))
|
||||
0))
|
||||
(hours (quotient seconds 3600))
|
||||
(minutes (quotient (remainder seconds 3600) 60))
|
||||
(remaining (remainder seconds 60)))
|
||||
(format "~a:~a:~a"
|
||||
(~r hours #:min-width 2 #:pad-string "0")
|
||||
(~r minutes #:min-width 2 #:pad-string "0")
|
||||
(~r remaining #:min-width 2 #:pad-string "0"))))
|
||||
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
;; Provided functions
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
; goal : Start the graphical polling playback agent.
|
||||
; pre : A graphical desktop and the platform support required by
|
||||
; racket-tray are available.
|
||||
; post : The agent runtime is started, its frame and tray icon are visible,
|
||||
; and closing or minimizing the frame hides it in the system tray.
|
||||
; result : The live frame% object belonging to the playback agent.
|
||||
; internals:
|
||||
; The GUI owns only widgets, configuration and lifecycle callbacks.
|
||||
; Playback and polling remain in player-agent-core.rkt. racket-tray
|
||||
; owns native tray resources and the portable minimize watcher.
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
(define/contract (run-player-agent-gui)
|
||||
(-> (is-a?/c frame%))
|
||||
(sl-log-to-file log-file)
|
||||
(let ((config (load-player-agent-config))
|
||||
(frame #f)
|
||||
(runtime #f)
|
||||
(status-message #f)
|
||||
(playback-message #f)
|
||||
(playback-details #f)
|
||||
(playback-filename #f)
|
||||
(name-field #f)
|
||||
(server-field #f)
|
||||
(connect-button #f)
|
||||
(playback-timer #f)
|
||||
(tray #f)
|
||||
(shutting-down? #f))
|
||||
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
; goal : Queue a status-label update in the GUI eventspace.
|
||||
; pre : message is a string supplied by the agent runtime.
|
||||
; post : The status widget shows message when it has been created.
|
||||
; result : Unspecified.
|
||||
; internals:
|
||||
; Runtime callbacks can originate outside the GUI eventspace, so
|
||||
; widget access is always forwarded with queue-callback.
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
(define (show-status! message)
|
||||
(queue-callback
|
||||
(λ ()
|
||||
(when status-message
|
||||
(send status-message set-label message)))
|
||||
#f))
|
||||
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
; goal : Show a playback-agent authorization failure.
|
||||
; pre : message is a string supplied by the agent runtime.
|
||||
; post : A modal error dialog is queued for the agent frame.
|
||||
; result : Unspecified.
|
||||
; internals:
|
||||
; The callback is eventspace-safe for the same reason as the
|
||||
; status callback above.
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
(define (show-denial! message)
|
||||
(queue-callback
|
||||
(λ ()
|
||||
(message-box (tr 'denied-title)
|
||||
message
|
||||
frame
|
||||
'(ok stop)))
|
||||
#f))
|
||||
|
||||
(set! runtime
|
||||
(make-player-agent-runtime
|
||||
(player-agent-config-server-url config)
|
||||
(player-agent-config-name config)
|
||||
(player-agent-config-app-id config)
|
||||
#:status-callback show-status!
|
||||
#:denied-callback show-denial!))
|
||||
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
; goal : Refresh the visible playback summary from the runtime cache.
|
||||
; pre : runtime exists; the widgets may still be uninitialized.
|
||||
; post : Initialized playback widgets reflect one coherent cached
|
||||
; snapshot and its current track.
|
||||
; result : Unspecified.
|
||||
; internals:
|
||||
; This procedure never performs network I/O. The timer reads only
|
||||
; the cache maintained by player-agent-core.rkt.
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
(define (refresh-playback-status!)
|
||||
(when (and playback-message playback-details playback-filename)
|
||||
(let* ((snapshot ((player-agent-runtime-snapshot runtime)))
|
||||
(track ((player-agent-runtime-current-track runtime)))
|
||||
(state (hash-ref snapshot 'state "stopped"))
|
||||
(title (and track (hash-ref track 'title #f)))
|
||||
(artist (and track (hash-ref track 'artist #f)))
|
||||
(filename (and track (hash-ref track 'filename #f)))
|
||||
(track-number (and track (hash-ref track 'trackNumber #f)))
|
||||
(track-label
|
||||
(cond
|
||||
((and artist (not (string=? artist "")) title)
|
||||
(format "~a — ~a" artist title))
|
||||
(title title)
|
||||
(else (tr 'no-track-selected))))
|
||||
(prefix
|
||||
(cond
|
||||
((string=? state "playing") (tr 'playing))
|
||||
((string=? state "paused") (tr 'paused))
|
||||
((string=? state "starting") (tr 'loading))
|
||||
((string=? state "stopped") (tr 'stopped))
|
||||
(else state)))
|
||||
(position (hash-ref snapshot 'position 0))
|
||||
(duration (hash-ref snapshot 'duration 'null))
|
||||
(format-name (hash-ref snapshot 'format ""))
|
||||
(rate (hash-ref snapshot 'rate 'null))
|
||||
(bits (hash-ref snapshot 'bits 'null))
|
||||
(channels (hash-ref snapshot 'channels 'null))
|
||||
(details
|
||||
(filter
|
||||
(λ (value) (not (string=? value "")))
|
||||
(list
|
||||
(format "~a / ~a"
|
||||
(format-time position)
|
||||
(if (number? duration)
|
||||
(format-time duration)
|
||||
"--:--:--"))
|
||||
(if (number? bits) (format "~a bit" bits) "")
|
||||
(if (number? rate)
|
||||
(format "~a kHz"
|
||||
(~r (/ rate 1000.0) #:precision '(= 1)))
|
||||
"")
|
||||
(if (number? channels)
|
||||
(format "~a ~a"
|
||||
channels
|
||||
(tr (if (= channels 1) 'channel 'channels)))
|
||||
"")
|
||||
(if (and (string? format-name)
|
||||
(not (string=? format-name "")))
|
||||
format-name
|
||||
"")))))
|
||||
(send playback-message
|
||||
set-label
|
||||
(if track
|
||||
(format "~a~a: ~a"
|
||||
prefix
|
||||
(if (number? track-number)
|
||||
(format " #~a" track-number)
|
||||
"")
|
||||
track-label)
|
||||
(tr 'no-track)))
|
||||
(send playback-details set-label (string-join details " · "))
|
||||
(send playback-filename
|
||||
set-label
|
||||
(if (and (string? filename)
|
||||
(not (string=? filename "")))
|
||||
filename
|
||||
"—")))))
|
||||
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
; goal : Persist edited connection settings and reconnect the runtime.
|
||||
; pre : The name, server and connect widgets have been initialized.
|
||||
; post : config and the INI file contain normalized values; the runtime
|
||||
; reconnects with them and the button becomes a reconnect button.
|
||||
; result : Unspecified.
|
||||
; internals:
|
||||
; An empty name receives the same hostname-based default used by
|
||||
; initial configuration loading.
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
(define (reconnect!)
|
||||
(let* ((next-server (string-trim (send server-field get-value)))
|
||||
(entered-name (string-trim (send name-field get-value)))
|
||||
(next-name
|
||||
(if (string=? entered-name "")
|
||||
(format "~a playback" (gethostname))
|
||||
entered-name)))
|
||||
(set! config
|
||||
(struct-copy player-agent-config config
|
||||
(server-url next-server)
|
||||
(name next-name)))
|
||||
(save-player-agent-config! config)
|
||||
(send name-field set-value next-name)
|
||||
((player-agent-runtime-reconnect! runtime) next-server next-name)
|
||||
(send connect-button set-label (tr 'reconnect))))
|
||||
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
; goal : Release resources owned by the GUI agent exactly once.
|
||||
; pre : runtime has been created; timer and tray may be #f.
|
||||
; post : Playback polling, audio, the GUI timer and native tray resources
|
||||
; have stopped; subsequent calls do nothing.
|
||||
; result : Unspecified.
|
||||
; internals:
|
||||
; The guard makes this procedure safe from both the window close
|
||||
; path and the tray Exit action.
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
(define (shutdown!)
|
||||
(unless shutting-down?
|
||||
(set! shutting-down? #t)
|
||||
(when playback-timer
|
||||
(send playback-timer stop))
|
||||
((player-agent-runtime-shutdown! runtime))
|
||||
(when tray
|
||||
(tray-close tray)
|
||||
(set! tray #f))))
|
||||
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
; goal : Terminate the graphical agent from its tray menu.
|
||||
; pre : frame and runtime have been initialized.
|
||||
; post : Resources are released and the frame is hidden.
|
||||
; result : Unspecified.
|
||||
; internals:
|
||||
; racket-tray invokes actions in the frame eventspace, so no
|
||||
; additional GUI callback queue is needed here.
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
(define (quit!)
|
||||
(shutdown!)
|
||||
(send frame show #f))
|
||||
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
; goal : Restore the agent frame from the tray.
|
||||
; pre : frame has been initialized and has not been destroyed.
|
||||
; post : frame is visible and no longer iconized.
|
||||
; result : Unspecified.
|
||||
; internals:
|
||||
; De-iconizing is needed because racket-tray hides minimized
|
||||
; frames instead of changing their iconized state.
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
(define (show-window!)
|
||||
(send frame show #t)
|
||||
(when (send frame is-iconized?)
|
||||
(send frame iconize #f)))
|
||||
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
; goal : Dispatch a symbolic racket-tray action.
|
||||
; pre : action is installed in the tray menu below.
|
||||
; post : 'open restores the frame; 'exit shuts down the agent.
|
||||
; result : Unspecified.
|
||||
; internals:
|
||||
; One callback handles both direct tray activation and menu
|
||||
; selection on every platform.
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
(define (tray-action! action)
|
||||
(case action
|
||||
((open) (show-window!))
|
||||
((exit) (quit!))))
|
||||
|
||||
(let* ((agent-frame%
|
||||
(class frame%
|
||||
(super-new)
|
||||
(define/augment (on-close)
|
||||
(if tray
|
||||
(send this show #f)
|
||||
(begin
|
||||
(shutdown!)
|
||||
(inner (void) on-close))))))
|
||||
(new-frame
|
||||
(new agent-frame%
|
||||
(label (tr 'app-title))
|
||||
(width 560)
|
||||
(height 310))))
|
||||
(set! frame new-frame))
|
||||
|
||||
(let* ((panel
|
||||
(new vertical-panel%
|
||||
(parent frame)
|
||||
(alignment '(left top))))
|
||||
(server
|
||||
(input-field (tr 'server)
|
||||
(player-agent-config-server-url config)
|
||||
panel))
|
||||
(name
|
||||
(input-field (tr 'name)
|
||||
(player-agent-config-name config)
|
||||
panel))
|
||||
(id-field
|
||||
(input-field (tr 'application-id)
|
||||
(player-agent-config-app-id config)
|
||||
panel))
|
||||
(playback-panel
|
||||
(new group-box-panel%
|
||||
(parent panel)
|
||||
(label (tr 'playback))
|
||||
(alignment '(left top))
|
||||
(stretchable-height #f)))
|
||||
(controls
|
||||
(new horizontal-panel%
|
||||
(parent panel)
|
||||
(alignment '(left center)))))
|
||||
(set! server-field server)
|
||||
(set! name-field name)
|
||||
;; Lock the editor, not the native widget. Disabled Windows controls
|
||||
;; render their label and text poorly on some display configurations.
|
||||
(send (send id-field get-editor) lock #t)
|
||||
(set! playback-message
|
||||
(new message%
|
||||
(parent playback-panel)
|
||||
(label (tr 'no-track))
|
||||
(auto-resize #t)))
|
||||
(set! playback-details
|
||||
(new message%
|
||||
(parent playback-panel)
|
||||
(label "00:00:00 / --:--:--")
|
||||
(auto-resize #t)))
|
||||
(set! playback-filename
|
||||
(new message%
|
||||
(parent playback-panel)
|
||||
(label "—")
|
||||
(auto-resize #t)))
|
||||
(set! connect-button
|
||||
(new button%
|
||||
(parent controls)
|
||||
(label (tr 'save-connect))
|
||||
(callback (λ (_button _event) (reconnect!)))))
|
||||
(set! status-message
|
||||
(new message%
|
||||
(parent controls)
|
||||
(label (tr 'connecting))
|
||||
(auto-resize #t))))
|
||||
|
||||
(set! playback-timer
|
||||
(new timer%
|
||||
(notify-callback refresh-playback-status!)
|
||||
(interval 500)))
|
||||
(refresh-playback-status!)
|
||||
|
||||
(set! tray
|
||||
(mk-tray frame
|
||||
tray-icon
|
||||
(list tray-action! 'open)
|
||||
#:hide-on-minimize? #t))
|
||||
(tray-set-menu!
|
||||
tray
|
||||
(list
|
||||
(list 'open (tr 'tray-open))
|
||||
'separator
|
||||
(list 'exit (tr 'quit))))
|
||||
|
||||
(send frame show #t)
|
||||
((player-agent-runtime-start! runtime))
|
||||
(send connect-button set-label (tr 'reconnect))
|
||||
frame))
|
||||
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
;; Tests for module library.rkt
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
|
||||
(module+ test
|
||||
(require rackunit)
|
||||
|
||||
;; The runtime path must remain valid after package installation; relying on
|
||||
;; the development working directory would make the tray fail elsewhere.
|
||||
(check-true (file-exists? tray-icon)))
|
||||
@@ -0,0 +1,366 @@
|
||||
#lang racket/base
|
||||
|
||||
(require racket/list
|
||||
racket/string)
|
||||
|
||||
(provide tr
|
||||
__
|
||||
languages
|
||||
set-lang!
|
||||
current-lang)
|
||||
|
||||
(define translation-map
|
||||
(hasheq
|
||||
'en
|
||||
(hasheq
|
||||
'app-title "RKT Web Player Agent"
|
||||
'server "RKT Web Player server"
|
||||
'name "Name"
|
||||
'application-id "Application ID"
|
||||
'playback "Playback"
|
||||
'no-track "Nothing is playing"
|
||||
'no-track-selected "No track selected"
|
||||
'save-connect "Save and connect"
|
||||
'reconnect "Reconnect"
|
||||
'connecting "Connecting…"
|
||||
'connected "Connected"
|
||||
'denied-title "Playback agent not allowed"
|
||||
'denied-message "This playback agent is not allowed by the server. Add the following application ID to [playback-agents] in the server INI:\n\n~a"
|
||||
'unauthorized-status "Not authorized — application ID is not in the server INI"
|
||||
'disconnected "Not connected: ~a"
|
||||
'playing "Playing"
|
||||
'paused "Paused"
|
||||
'loading "Loading"
|
||||
'stopped "Stopped"
|
||||
'channel "channel"
|
||||
'channels "channels"
|
||||
'tray-open "Open RKT Web Player Agent"
|
||||
'quit "Quit")
|
||||
'nl
|
||||
(hasheq
|
||||
'app-title "RKT Web Player Agent"
|
||||
'server "RKT Web Player server"
|
||||
'name "Naam"
|
||||
'application-id "Applicatie-ID"
|
||||
'playback "Afspelen"
|
||||
'no-track "Er wordt niets afgespeeld"
|
||||
'no-track-selected "Geen track geselecteerd"
|
||||
'save-connect "Opslaan en verbinden"
|
||||
'reconnect "Opnieuw verbinden"
|
||||
'connecting "Verbinden…"
|
||||
'connected "Verbonden"
|
||||
'denied-title "Playback agent niet toegestaan"
|
||||
'denied-message "Deze playback agent is niet toegelaten door de server. Voeg het volgende applicatie-ID toe aan [playback-agents] in de server-INI:\n\n~a"
|
||||
'unauthorized-status "Niet geautoriseerd — applicatie-ID staat niet in de server-INI"
|
||||
'disconnected "Niet verbonden: ~a"
|
||||
'playing "Speelt"
|
||||
'paused "Gepauzeerd"
|
||||
'loading "Laden"
|
||||
'stopped "Gestopt"
|
||||
'channel "kanaal"
|
||||
'channels "kanalen"
|
||||
'tray-open "RKT Web Player Agent openen"
|
||||
'quit "Afsluiten")
|
||||
'de
|
||||
(hasheq
|
||||
'app-title "RKT Web Player Agent"
|
||||
'server "RKT Web Player Server"
|
||||
'name "Name"
|
||||
'application-id "Anwendungs-ID"
|
||||
'playback "Wiedergabe"
|
||||
'no-track "Keine Wiedergabe"
|
||||
'no-track-selected "Kein Titel ausgewählt"
|
||||
'save-connect "Speichern und verbinden"
|
||||
'reconnect "Neu verbinden"
|
||||
'connecting "Verbinden…"
|
||||
'connected "Verbunden"
|
||||
'denied-title "Playback-Agent nicht zugelassen"
|
||||
'denied-message "Dieser Playback-Agent ist vom Server nicht zugelassen. Fügen Sie die folgende Anwendungs-ID unter [playback-agents] in die Server-INI ein:\n\n~a"
|
||||
'unauthorized-status "Nicht autorisiert — Anwendungs-ID fehlt in der Server-INI"
|
||||
'disconnected "Nicht verbunden: ~a"
|
||||
'playing "Wiedergabe"
|
||||
'paused "Pausiert"
|
||||
'loading "Laden"
|
||||
'stopped "Gestoppt"
|
||||
'channel "Kanal"
|
||||
'channels "Kanäle"
|
||||
'tray-open "RKT Web Player Agent öffnen"
|
||||
'quit "Beenden")
|
||||
'fr
|
||||
(hasheq
|
||||
'app-title "Agent RKT Web Player"
|
||||
'server "Serveur RKT Web Player"
|
||||
'name "Nom"
|
||||
'application-id "ID d’application"
|
||||
'playback "Lecture"
|
||||
'no-track "Aucune lecture en cours"
|
||||
'no-track-selected "Aucune piste sélectionnée"
|
||||
'save-connect "Enregistrer et connecter"
|
||||
'reconnect "Reconnecter"
|
||||
'connecting "Connexion…"
|
||||
'connected "Connecté"
|
||||
'denied-title "Agent de lecture non autorisé"
|
||||
'denied-message "Cet agent de lecture n’est pas autorisé par le serveur. Ajoutez l’ID d’application suivant à [playback-agents] dans le fichier INI du serveur :\n\n~a"
|
||||
'unauthorized-status "Non autorisé — l’ID d’application est absent du fichier INI du serveur"
|
||||
'disconnected "Non connecté : ~a"
|
||||
'playing "Lecture"
|
||||
'paused "En pause"
|
||||
'loading "Chargement"
|
||||
'stopped "Arrêté"
|
||||
'channel "canal"
|
||||
'channels "canaux"
|
||||
'tray-open "Ouvrir l’agent RKT Web Player"
|
||||
'quit "Quitter")
|
||||
'es
|
||||
(hasheq
|
||||
'app-title "Agente de RKT Web Player"
|
||||
'server "Servidor RKT Web Player"
|
||||
'name "Nombre"
|
||||
'application-id "ID de aplicación"
|
||||
'playback "Reproducción"
|
||||
'no-track "No se está reproduciendo nada"
|
||||
'no-track-selected "No hay ninguna pista seleccionada"
|
||||
'save-connect "Guardar y conectar"
|
||||
'reconnect "Volver a conectar"
|
||||
'connecting "Conectando…"
|
||||
'connected "Conectado"
|
||||
'denied-title "Agente de reproducción no permitido"
|
||||
'denied-message "El servidor no permite este agente de reproducción. Añade el siguiente ID de aplicación a [playback-agents] en el INI del servidor:\n\n~a"
|
||||
'unauthorized-status "No autorizado — el ID de aplicación no está en el INI del servidor"
|
||||
'disconnected "Sin conexión: ~a"
|
||||
'playing "Reproduciendo"
|
||||
'paused "En pausa"
|
||||
'loading "Cargando"
|
||||
'stopped "Detenido"
|
||||
'channel "canal"
|
||||
'channels "canales"
|
||||
'tray-open "Abrir el agente de RKT Web Player"
|
||||
'quit "Salir")
|
||||
'it
|
||||
(hasheq
|
||||
'app-title "Agente RKT Web Player"
|
||||
'server "Server RKT Web Player"
|
||||
'name "Nome"
|
||||
'application-id "ID applicazione"
|
||||
'playback "Riproduzione"
|
||||
'no-track "Nessuna riproduzione in corso"
|
||||
'no-track-selected "Nessuna traccia selezionata"
|
||||
'save-connect "Salva e connetti"
|
||||
'reconnect "Riconnetti"
|
||||
'connecting "Connessione…"
|
||||
'connected "Connesso"
|
||||
'denied-title "Agente di riproduzione non consentito"
|
||||
'denied-message "Questo agente di riproduzione non è consentito dal server. Aggiungi il seguente ID applicazione a [playback-agents] nel file INI del server:\n\n~a"
|
||||
'unauthorized-status "Non autorizzato — l’ID applicazione non è nel file INI del server"
|
||||
'disconnected "Non connesso: ~a"
|
||||
'playing "In riproduzione"
|
||||
'paused "In pausa"
|
||||
'loading "Caricamento"
|
||||
'stopped "Arrestato"
|
||||
'channel "canale"
|
||||
'channels "canali"
|
||||
'tray-open "Apri l’agente RKT Web Player"
|
||||
'quit "Esci")
|
||||
'sv
|
||||
(hasheq
|
||||
'app-title "RKT Web Player-agent"
|
||||
'server "RKT Web Player-server"
|
||||
'name "Namn"
|
||||
'application-id "Program-ID"
|
||||
'playback "Uppspelning"
|
||||
'no-track "Inget spelas upp"
|
||||
'no-track-selected "Inget spår har valts"
|
||||
'save-connect "Spara och anslut"
|
||||
'reconnect "Anslut igen"
|
||||
'connecting "Ansluter…"
|
||||
'connected "Ansluten"
|
||||
'denied-title "Uppspelningsagenten är inte tillåten"
|
||||
'denied-message "Servern tillåter inte den här uppspelningsagenten. Lägg till följande program-ID under [playback-agents] i serverns INI-fil:\n\n~a"
|
||||
'unauthorized-status "Inte behörig — program-ID saknas i serverns INI-fil"
|
||||
'disconnected "Inte ansluten: ~a"
|
||||
'playing "Spelar"
|
||||
'paused "Pausad"
|
||||
'loading "Läser in"
|
||||
'stopped "Stoppad"
|
||||
'channel "kanal"
|
||||
'channels "kanaler"
|
||||
'tray-open "Öppna RKT Web Player-agenten"
|
||||
'quit "Avsluta")
|
||||
'no
|
||||
(hasheq
|
||||
'app-title "RKT Web Player-agent"
|
||||
'server "RKT Web Player-server"
|
||||
'name "Navn"
|
||||
'application-id "Applikasjons-ID"
|
||||
'playback "Avspilling"
|
||||
'no-track "Ingenting spilles av"
|
||||
'no-track-selected "Ingen spor er valgt"
|
||||
'save-connect "Lagre og koble til"
|
||||
'reconnect "Koble til på nytt"
|
||||
'connecting "Kobler til…"
|
||||
'connected "Tilkoblet"
|
||||
'denied-title "Avspillingsagenten er ikke tillatt"
|
||||
'denied-message "Serveren tillater ikke denne avspillingsagenten. Legg til følgende applikasjons-ID under [playback-agents] i serverens INI-fil:\n\n~a"
|
||||
'unauthorized-status "Ikke autorisert — applikasjons-ID mangler i serverens INI-fil"
|
||||
'disconnected "Ikke tilkoblet: ~a"
|
||||
'playing "Spiller"
|
||||
'paused "På pause"
|
||||
'loading "Laster"
|
||||
'stopped "Stoppet"
|
||||
'channel "kanal"
|
||||
'channels "kanaler"
|
||||
'tray-open "Åpne RKT Web Player-agenten"
|
||||
'quit "Avslutt")
|
||||
'fi
|
||||
(hasheq
|
||||
'app-title "RKT Web Player -agentti"
|
||||
'server "RKT Web Player -palvelin"
|
||||
'name "Nimi"
|
||||
'application-id "Sovellustunnus"
|
||||
'playback "Toisto"
|
||||
'no-track "Mitään ei toisteta"
|
||||
'no-track-selected "Kappaletta ei ole valittu"
|
||||
'save-connect "Tallenna ja yhdistä"
|
||||
'reconnect "Yhdistä uudelleen"
|
||||
'connecting "Yhdistetään…"
|
||||
'connected "Yhdistetty"
|
||||
'denied-title "Toistoagenttia ei sallita"
|
||||
'denied-message "Palvelin ei salli tätä toistoagenttia. Lisää seuraava sovellustunnus palvelimen INI-tiedoston [playback-agents]-osioon:\n\n~a"
|
||||
'unauthorized-status "Ei valtuutettu — sovellustunnus puuttuu palvelimen INI-tiedostosta"
|
||||
'disconnected "Ei yhteyttä: ~a"
|
||||
'playing "Toistetaan"
|
||||
'paused "Keskeytetty"
|
||||
'loading "Ladataan"
|
||||
'stopped "Pysäytetty"
|
||||
'channel "kanava"
|
||||
'channels "kanavaa"
|
||||
'tray-open "Avaa RKT Web Player -agentti"
|
||||
'quit "Lopeta")
|
||||
'is
|
||||
(hasheq
|
||||
'app-title "RKT Web Player-spilari"
|
||||
'server "RKT Web Player-þjónn"
|
||||
'name "Nafn"
|
||||
'application-id "Forritsauðkenni"
|
||||
'playback "Spilun"
|
||||
'no-track "Ekkert er í spilun"
|
||||
'no-track-selected "Ekkert lag valið"
|
||||
'save-connect "Vista og tengjast"
|
||||
'reconnect "Tengjast aftur"
|
||||
'connecting "Tengist…"
|
||||
'connected "Tengt"
|
||||
'denied-title "Spilarinn er ekki leyfður"
|
||||
'denied-message "Þessi spilari er ekki leyfður af þjóninum. Bættu eftirfarandi forritsauðkenni við [playback-agents] í INI-skrá þjónsins:\n\n~a"
|
||||
'unauthorized-status "Ekki heimilað — forritsauðkenni vantar í INI-skrá þjónsins"
|
||||
'disconnected "Ekki tengt: ~a"
|
||||
'playing "Spilar"
|
||||
'paused "Í bið"
|
||||
'loading "Hleður"
|
||||
'stopped "Stöðvað"
|
||||
'channel "rás"
|
||||
'channels "rásir"
|
||||
'tray-open "Opna RKT Web Player-spilarann"
|
||||
'quit "Hætta")))
|
||||
|
||||
(define (system-language)
|
||||
(define language-name
|
||||
(string-downcase (format "~a" (system-language+country))))
|
||||
(define short-name (car (regexp-split #px"[-_]" language-name)))
|
||||
(define candidate
|
||||
(case (string->symbol short-name)
|
||||
((nb nn) 'no)
|
||||
(else (string->symbol short-name))))
|
||||
(if (hash-has-key? translation-map candidate) candidate 'en))
|
||||
|
||||
(define language (system-language))
|
||||
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
; goal : Return the supported language symbols and their native names.
|
||||
; pre : None.
|
||||
; post : Translation state remains unchanged.
|
||||
; result : An association list suitable for a language selector.
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
(define (languages)
|
||||
'((en "English")
|
||||
(nl "Nederlands")
|
||||
(de "Deutsch")
|
||||
(fr "Français")
|
||||
(es "Español")
|
||||
(it "Italiano")
|
||||
(sv "Svenska")
|
||||
(no "Norsk")
|
||||
(fi "Suomi")
|
||||
(is "Íslenska")))
|
||||
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
; goal : Select the language used by tr and __.
|
||||
; pre : Value is one of the symbols returned by languages.
|
||||
; post : Subsequent translations use value.
|
||||
; result : Void.
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
(define (set-lang! value)
|
||||
(unless (hash-has-key? translation-map value)
|
||||
(raise-argument-error 'set-lang! "supported language symbol" value))
|
||||
(set! language value))
|
||||
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
; goal : Report the active translation language.
|
||||
; pre : None.
|
||||
; post : Translation state remains unchanged.
|
||||
; result : A supported language symbol.
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
(define (current-lang)
|
||||
language)
|
||||
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
; goal : Translate an application string identifier.
|
||||
; pre : Id is a symbol.
|
||||
; post : Translation state remains unchanged.
|
||||
; result : The active translation, its English fallback, or the identifier.
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
(define (tr id)
|
||||
(hash-ref (hash-ref translation-map language)
|
||||
id
|
||||
(λ ()
|
||||
(hash-ref (hash-ref translation-map 'en)
|
||||
id
|
||||
(λ () (symbol->string id))))))
|
||||
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
; goal : Provide the conventional short alias used by rktplayer GUI code.
|
||||
; pre : Id is a symbol.
|
||||
; post : Translation state remains unchanged.
|
||||
; result : The same translated string as tr.
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
(define (__ id)
|
||||
(tr id))
|
||||
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
;; Tests for module library.rkt
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
|
||||
(module+ test
|
||||
(require rackunit)
|
||||
|
||||
(define original-language (current-lang))
|
||||
(define english-keys
|
||||
(sort (hash-keys (hash-ref translation-map 'en)) symbol<?))
|
||||
(dynamic-wind
|
||||
void
|
||||
(λ ()
|
||||
(for ((entry (in-list (languages))))
|
||||
(define candidate (car entry))
|
||||
(check-equal?
|
||||
(sort (hash-keys (hash-ref translation-map candidate)) symbol<?)
|
||||
english-keys)
|
||||
(set-lang! candidate)
|
||||
(check-true (string? (tr 'connected))))
|
||||
(set-lang! 'nl)
|
||||
(check-equal? (tr 'connected) "Verbonden")
|
||||
(set-lang! 'de)
|
||||
(check-equal? (__ 'quit) "Beenden")
|
||||
(set-lang! 'is)
|
||||
(check-equal? (tr 'connected) "Tengt")
|
||||
(check-equal? (tr 'unknown-translation) "unknown-translation")
|
||||
(check-exn exn:fail:contract? (λ () (set-lang! 'xx))))
|
||||
(λ () (set-lang! original-language))))
|
||||
Reference in New Issue
Block a user