diff --git a/ARCHITECTURE.md b/ARCHITECTURE.md
index f733917..1febb6e 100644
--- a/ARCHITECTURE.md
+++ b/ARCHITECTURE.md
@@ -44,7 +44,9 @@ flowchart TB
Audio[racket-audio
local backend]
Discovery[racket-upnp + racket-sonos
device discovery]
DLNA[racket-audio-dlna
network backend and media server]
- Agent[player-agent.rkt
polling Windows renderer]
+ AgentGUI[private/player-agent-gui.rkt
GUI adapter]
+ AgentCLI[player-agent-cli.rkt
CLI adapter]
+ AgentCore[private/player-agent-core.rkt
polling and audio runtime]
Main --> Server
Main --> Player
@@ -56,8 +58,10 @@ flowchart TB
Player --> Audio
Player --> Discovery
Player --> DLNA
- Agent --> Server
- Agent --> Audio
+ AgentGUI --> AgentCore
+ AgentCLI --> AgentCore
+ AgentCore --> Server
+ AgentCore --> Audio
```
### 3.1 Entrypoint and lifecycle
@@ -327,6 +331,11 @@ INI allowlist. Media URLs additionally contain an opaque per-track token. The
random application ID therefore acts as a shared bearer credential, but must
not be treated as strong authentication when transported over unencrypted HTTP.
+The GUI and CLI playback agents share one headless runtime. The GUI only adapts
+configuration and state to widgets. Optional tray integration is loaded
+dynamically through SDL3, so CLI use and the default GUI installation do not
+acquire a mandatory SDL dependency.
+
The configured library roots define the intended filesystem boundary. Clients
operate on opaque indexes instead of sending paths directly. The DLNA backend
must make a selected local file reachable by the network renderer, so its media
diff --git a/README.md b/README.md
index 509bfd2..75539dc 100644
--- a/README.md
+++ b/README.md
@@ -154,8 +154,48 @@ De server wordt bijgewerkt zodra het nieuwe music-id werkelijk hoorbaar is en
stuurt vervolgens de daaropvolgende prefetch. Tijdelijke bestanden worden
opgeruimd zodra ze niet meer nodig zijn en bij afsluiten van de agent.
-Een systeemvakfunctie is voorlopig niet opgenomen. De agent start geen
-PowerShell-proces of andere externe tray-helper.
+### Systeemvak
+
+De GUI gebruikt optioneel de open-source SDL3-tray-API. Als zowel het Racket-
+pakket `sdl3` als de native SDL3-, SDL3_image- en SDL3_ttf-libraries aanwezig
+zijn, sluit de vensterknop de agent naar het systeemvak. Het menu bevat
+**RKT Web Player Agent openen** en **Afsluiten**. Zonder SDL3 blijft de agent
+gewoon werken en sluit de vensterknop het proces af. Er wordt geen PowerShell-
+proces of externe tray-helper gestart.
+
+```console
+raco pkg install sdl3
+```
+
+SDL3 is bewust geen verplichte package-dependency: de agent blijft daardoor
+klein voor gebruikers die geen systeemvak nodig hebben. Op Windows moeten de
+bijbehorende native DLL's daarnaast vindbaar zijn, bijvoorbeeld naast het
+gebouwde executable of via `PATH`.
+
+### CLI playback agent
+
+De headless agent gebruikt exact dezelfde polling-, download-, audio- en
+gapless-prefetchkern als de GUI-agent:
+
+```console
+racket player-agent-cli.rkt
+racket player-agent-cli.rkt --server https://muziek.example.nl --name "Werkkamer"
+```
+
+GUI en CLI gebruiken standaard hetzelfde gebruikersspecifieke
+`rkt-web-player-agent.ini`, dus ook hetzelfde application-ID. Met `--config`
+kan de CLI een afzonderlijk INI-bestand en daarmee een afzonderlijke identiteit
+gebruiken. Bij het starten worden naam, server en application-ID afgedrukt;
+stoppen gaat met `Ctrl+C`.
+
+Vanuit Racket is de headless variant eveneens beschikbaar:
+
+```racket
+(require rkt-web-player/player-agent)
+
+(run-player-agent-cli #:server-url "https://muziek.example.nl"
+ #:name "Werkkamer")
+```
De allowlist voorkomt dat een onbekende agent zich als uitvoerpunt registreert
of opdrachten en tijdelijke media ontvangt. Het applicatie-ID is een gedeeld
@@ -166,6 +206,7 @@ geen TLS heeft.
## Controleren
```console
-raco test private/users.rkt private/library.rkt private/player.rkt
+raco test private/users.rkt private/library.rkt private/player.rkt \
+ private/player-agent-config.rkt
raco setup --check-pkg-deps rkt-web-player
```
diff --git a/player-agent-cli.rkt b/player-agent-cli.rkt
new file mode 100644
index 0000000..bf913be
--- /dev/null
+++ b/player-agent-cli.rkt
@@ -0,0 +1,112 @@
+#lang racket/base
+
+(require racket/cmdline
+ racket/format
+ racket/string
+ simple-log
+ "private/player-agent-config.rkt"
+ "private/player-agent-core.rkt")
+
+(provide run-player-agent-cli)
+
+(define (track-description track)
+ (cond
+ ((not track) "geen track")
+ (else
+ (define title (hash-ref track 'title #f))
+ (define artist (hash-ref track 'artist #f))
+ (define filename (hash-ref track 'filename "onbekend"))
+ (cond
+ ((and artist title (not (string=? artist "")))
+ (format "~a — ~a" artist title))
+ (title title)
+ (else filename)))))
+
+(define (run-player-agent-cli #:server-url [server-override #f]
+ #:name [name-override #f]
+ #:config-file [config-file #f])
+ (sl-log-to-display)
+ (define loaded
+ (if config-file
+ (load-player-agent-config config-file)
+ (load-player-agent-config)))
+ (define server-url
+ (string-trim (or server-override
+ (player-agent-config-server-url loaded))))
+ (define name
+ (string-trim (or name-override
+ (player-agent-config-name loaded))))
+ (define config
+ (struct-copy player-agent-config loaded
+ (server-url server-url)
+ (name name)))
+ (save-player-agent-config! config)
+
+ (define (write-status message)
+ (printf "[agent] ~a~n" message)
+ (flush-output))
+
+ (define runtime
+ (make-player-agent-runtime
+ server-url
+ name
+ (player-agent-config-app-id config)
+ #:status-callback write-status
+ #:denied-callback
+ (lambda (message)
+ (eprintf "~a~n" message)
+ (flush-output (current-error-port)))))
+
+ (printf "RKT Web Player CLI Agent~n")
+ (printf "Naam: ~a~n" name)
+ (printf "Server: ~a~n" server-url)
+ (printf "Applicatie-ID: ~a~n" (player-agent-config-app-id config))
+ (printf "Stoppen: Ctrl+C~n")
+ (flush-output)
+
+ (define monitor #f)
+ (dynamic-wind
+ (lambda ()
+ ((player-agent-runtime-start! runtime))
+ (set! monitor
+ (thread
+ (lambda ()
+ (let loop ((previous #f))
+ (define snapshot
+ ((player-agent-runtime-snapshot runtime)))
+ (define summary
+ (cons (hash-ref snapshot 'state "stopped")
+ (track-description
+ ((player-agent-runtime-current-track runtime)))))
+ (unless (equal? summary previous)
+ (printf "[playback] ~a — ~a~n" (car summary) (cdr summary))
+ (flush-output))
+ (sleep 1)
+ (loop summary))))))
+ (lambda ()
+ (with-handlers ((exn:break? void))
+ (sync never-evt)))
+ (lambda ()
+ (when (and monitor (not (thread-dead? monitor)))
+ (kill-thread monitor))
+ ((player-agent-runtime-shutdown! runtime)))))
+
+(module+ main
+ (define server-url #f)
+ (define name #f)
+ (define config-file #f)
+ (command-line
+ #:program "rkt-web-player-agent-cli"
+ #:once-each
+ (("--server") value
+ "RKT Web Player base URL"
+ (set! server-url value))
+ (("--name") value
+ "Name shown in the output selector"
+ (set! name value))
+ (("--config") value
+ "Agent INI file (defaults to the same file as the GUI agent)"
+ (set! config-file value)))
+ (run-player-agent-cli #:server-url server-url
+ #:name name
+ #:config-file config-file))
diff --git a/player-agent.rkt b/player-agent.rkt
index 63d8640..4d15d51 100644
--- a/player-agent.rkt
+++ b/player-agent.rkt
@@ -1,6 +1,7 @@
#lang racket/base
-(provide run-player-agent)
+(provide run-player-agent
+ run-player-agent-cli)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
; goal : Start the graphical polling playback agent.
@@ -12,5 +13,19 @@
((dynamic-require "private/player-agent-gui.rkt"
'run-player-agent-gui)))
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+; goal : Start the headless polling playback agent.
+; pre : The configured server is reachable.
+; post : The agent remains active until interrupted.
+; result : Void after the agent has shut down.
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+(define (run-player-agent-cli #:server-url [server-url #f]
+ #:name [name #f]
+ #:config-file [config-file #f])
+ ((dynamic-require "player-agent-cli.rkt" 'run-player-agent-cli)
+ #:server-url server-url
+ #:name name
+ #:config-file config-file))
+
(module+ main
(run-player-agent))
diff --git a/private/player-agent-config.rkt b/private/player-agent-config.rkt
new file mode 100644
index 0000000..871a45f
--- /dev/null
+++ b/private/player-agent-config.rkt
@@ -0,0 +1,69 @@
+#lang racket/base
+
+(require file/sha1
+ 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)
+
+(define (fresh-app-id)
+ (bytes->hex-string (crypto-random-bytes 32)))
+
+(define (valid-app-id? value)
+ (and (string? value)
+ (regexp-match? #px"^[0-9a-fA-F]{64}$" value)))
+
+(define (load-player-agent-config [file (get-ini-file 'rkt-web-player-agent)])
+ (define ini (file->ini file))
+ (define configured-id (ini-get ini 'agent 'app-id #f))
+ (define 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)
+
+(define (save-player-agent-config! value)
+ (define 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))
+
+(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
+ (lambda ()
+ (define first (load-player-agent-config test-file))
+ (check-true (valid-app-id? (player-agent-config-app-id first)))
+ (define changed
+ (struct-copy player-agent-config first
+ (server-url "https://music.example.test")
+ (name "Test output")))
+ (save-player-agent-config! changed)
+ (define 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"))
+ (lambda () (delete-directory/files test-directory))))
diff --git a/private/player-agent-core.rkt b/private/player-agent-core.rkt
new file mode 100644
index 0000000..a8e4b87
--- /dev/null
+++ b/private/player-agent-core.rkt
@@ -0,0 +1,429 @@
+#lang racket/base
+
+(require json
+ net/url
+ racket-audio
+ racket/file
+ racket/path
+ racket/port
+ racket/string
+ simple-log)
+
+(provide (struct-out player-agent-runtime)
+ make-player-agent-runtime)
+
+(sl-def-log player-agent)
+
+(struct exn:fail:agent-denied exn:fail () #:transparent)
+
+(struct player-agent-runtime
+ (start! reconnect! shutdown! snapshot current-track running? app-id)
+ #:transparent)
+
+(define (base-url value)
+ (string->url
+ (regexp-replace #px"/+$" (string-trim value) "")))
+
+(define (endpoint-url base path)
+ (combine-url/relative (base-url base) path))
+
+(define (post-json base path data)
+ (define input
+ (post-pure-port
+ (endpoint-url base path)
+ (jsexpr->bytes data)
+ (list "Content-Type: application/json"
+ "Cache-Control: no-store")))
+ (dynamic-wind
+ void
+ (lambda ()
+ (define 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)
+ (lambda () (close-input-port input))))
+
+(define (normal-state state)
+ (cond
+ ((memq state '(initialized no-media)) "stopped")
+ ((eq? state 'transitioning) "starting")
+ (else (symbol->string state))))
+
+(define (safe-delete-file file)
+ (when (and file (file-exists? file))
+ (with-handlers ((exn:fail?
+ (lambda (exception)
+ (warn-player-agent
+ "Could not remove temporary media file ~a: ~a"
+ file
+ (exn-message exception)))))
+ (delete-file file))))
+
+(define (make-player-agent-runtime initial-server-url
+ initial-name
+ app-id
+ #:status-callback
+ [status-callback void]
+ #:denied-callback
+ [denied-callback void])
+ (define server-url initial-server-url)
+ (define assigned-name initial-name)
+ (define state-lock (make-semaphore 1))
+ (define worker #f)
+ (define command-worker #f)
+ (define executing-command-id 0)
+ (define running #f)
+ (define authorization-notified? #f)
+ (define audio #f)
+ (define current-media-key #f)
+ (define cached-media (make-hash))
+ (define prefetched-track #f)
+ (define auto-started-key #f)
+ (define pending-auto-music-id #f)
+ (define music-tracks (make-hash))
+ (define current-track-value #f)
+ (define acknowledged-command 0)
+ (define ended-counter 0)
+ (define logical-volume 50)
+ (define agent-state
+ (hasheq 'state "stopped"
+ 'position 0
+ 'duration 'null
+ 'rate 'null
+ 'channels 'null
+ 'bits 'null
+ 'format ""
+ 'volume logical-volume
+ 'error 'null))
+
+ (define (with-agent-state proc)
+ (call-with-semaphore state-lock proc))
+
+ (define (state-value value fallback)
+ (if (eq? value #f) fallback value))
+
+ (define (snapshot)
+ (with-agent-state (lambda () agent-state)))
+
+ (define (current-track)
+ (with-agent-state (lambda () current-track-value)))
+
+ (define (set-agent-error! message)
+ (with-agent-state
+ (lambda ()
+ (set! agent-state (hash-set agent-state 'error message)))))
+
+ (define (clear-agent-error!)
+ (with-agent-state
+ (lambda ()
+ (set! agent-state (hash-set agent-state 'error 'null)))))
+
+ (define (update-from-audio! state full-state)
+ (with-agent-state
+ (lambda ()
+ (define 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))
+ (define 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))))))
+
+ (define (ensure-audio!)
+ (unless audio
+ (set! audio
+ (make-audio-player
+ (lambda (_handle state full-state)
+ (update-from-audio! state full-state))
+ (lambda (handle)
+ (advance-at-decoder-eof! handle))))
+ (audio-ao-buf-ms! audio 500)
+ (audio-buf-seconds! audio 4 10)
+ (define scaled (/ logical-volume 100.0))
+ (audio-volume! audio (* 100.0 scaled scaled)))
+ audio)
+
+ (define (download-media! token filename)
+ (define extension
+ (or (path-get-extension (string->path filename)) #""))
+ (define target
+ (make-temporary-file
+ (string-append "rkt-player-agent-~a"
+ (bytes->string/utf-8 extension))))
+ (define path (format "/api/agent/media/~a/~a" app-id token))
+ (define input (get-pure-port (endpoint-url server-url path)))
+ (with-handlers ((exn:fail?
+ (lambda (exception)
+ (close-input-port input)
+ (safe-delete-file target)
+ (raise exception))))
+ (call-with-output-file
+ target
+ (lambda (output) (copy-port input output))
+ #:exists 'truncate/replace)
+ (close-input-port input)
+ target))
+
+ (define (command-cache-key data)
+ (hash-ref data 'cacheKey (hash-ref data 'mediaToken)))
+
+ (define (ensure-media-cached! data)
+ (define key (command-cache-key data))
+ (define 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)))
+
+ (define (discard-unused-media! keep-key)
+ (for ((entry (in-list (hash->list cached-media))))
+ (unless (equal? (car entry) keep-key)
+ (safe-delete-file (cdr entry))
+ (hash-remove! cached-media (car entry)))))
+
+ ;; Decoder EOF occurs before audible EOF. Queueing the prefetched decoder at
+ ;; this point appends it behind racket-audio's remaining output buffer.
+ (define (advance-at-decoder-eof! handle)
+ (define prepared
+ (with-agent-state
+ (lambda ()
+ (define value prefetched-track)
+ (set! prefetched-track #f)
+ value)))
+ (cond
+ (prepared
+ (define data (car prepared))
+ (define path (cdr prepared))
+ (define key (command-cache-key data))
+ (with-handlers
+ ((exn:fail?
+ (lambda (exception)
+ (warn-player-agent "Could not start prefetched track: ~a"
+ (exn-message exception))
+ (set-agent-error! (exn-message exception))
+ (with-agent-state
+ (lambda () (set! ended-counter (+ ended-counter 1)))))))
+ (define 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
+ (lambda ()
+ (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
+ (lambda () (set! ended-counter (+ ended-counter 1)))))))
+
+ (define (execute-command! command)
+ (define action (hash-ref command 'action ""))
+ (define data (hash-ref command 'data (hasheq)))
+ (info-player-agent "Executing command ~a" action)
+ (cond
+ ((string=? action "play")
+ (define next-key (command-cache-key data))
+ (define already-started?
+ (with-agent-state
+ (lambda ()
+ (define matches?
+ (and auto-started-key (equal? auto-started-key next-key)))
+ (when matches? (set! auto-started-key #f))
+ matches?)))
+ (with-agent-state
+ (lambda () (set! current-track-value data)))
+ (unless already-started?
+ (with-agent-state
+ (lambda ()
+ (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))))
+ (define next-media (ensure-media-cached! data))
+ ;; audio-play! interrupts and closes the previous decoder itself.
+ (define music-id (audio-play! (ensure-audio!) next-media))
+ (with-agent-state
+ (lambda ()
+ (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")
+ (define key (command-cache-key data))
+ (define path (ensure-media-cached! data))
+ (with-agent-state
+ (lambda () (set! prefetched-track (cons data path))))
+ (info-player-agent "Prefetched ~a" (hash-ref data 'filename "track"))
+ (for ((entry (in-list (hash->list cached-media))))
+ (unless (or (equal? (car entry) current-media-key)
+ (equal? (car entry) key))
+ (safe-delete-file (cdr entry))
+ (hash-remove! cached-media (car entry)))))
+ ((string=? action "pause")
+ (audio-pause! (ensure-audio!) #t))
+ ((string=? action "resume")
+ (audio-pause! (ensure-audio!) #f))
+ ((string=? action "stop")
+ (with-agent-state
+ (lambda ()
+ (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))))
+ (define scaled (/ logical-volume 100.0))
+ (audio-volume! (ensure-audio!) (* 100.0 scaled scaled))
+ (with-agent-state
+ (lambda ()
+ (set! agent-state
+ (hash-set agent-state 'volume logical-volume)))))
+ (else
+ (error 'player-agent "unknown command: ~a" action))))
+
+ (define (poll-loop)
+ (with-handlers
+ ((exn:fail:agent-denied?
+ (lambda (exception)
+ (define message
+ (string-append
+ "Deze playback agent is niet toegelaten door de server. "
+ "Voeg het volgende applicatie-ID toe aan [playback-agents] "
+ "in de server-INI:\n\n"
+ app-id))
+ (warn-player-agent "Agent authorization refused: ~a"
+ (exn-message exception))
+ (set-agent-error! message)
+ (status-callback
+ "Niet geautoriseerd — applicatie-ID staat niet in de server-INI")
+ (unless authorization-notified?
+ (set! authorization-notified? #t)
+ (denied-callback message))
+ (when running
+ (sleep 3)
+ (poll-loop))))
+ (exn:fail?
+ (lambda (exception)
+ (warn-player-agent "Connection cycle failed: ~a"
+ (exn-message exception))
+ (set-agent-error! (exn-message exception))
+ (status-callback
+ (format "Niet verbonden: ~a" (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 "Verbonden")
+ (info-player-agent "Registered at ~a as ~a" server-url assigned-name)
+ (let loop ()
+ (when running
+ (define response
+ (post-json
+ server-url
+ "/api/agent/poll"
+ (hasheq 'appId app-id
+ 'name assigned-name
+ 'ack acknowledged-command
+ 'endedCounter ended-counter
+ 'state (snapshot))))
+ (define 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
+ (lambda ()
+ (with-handlers
+ ((exn:fail?
+ (lambda (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)))))
+
+ (define (start!)
+ (unless running
+ (set! running #t)
+ (status-callback "Verbinden…")
+ (set! worker (thread poll-loop))))
+
+ (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))
+
+ (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!))
+
+ (define (shutdown!)
+ (stop!)
+ (when audio
+ (with-handlers ((exn:fail? void))
+ (audio-quit! audio))
+ (set! audio #f))
+ (for ((path (in-hash-values cached-media)))
+ (safe-delete-file path))
+ (hash-clear! cached-media))
+
+ (player-agent-runtime start!
+ reconnect!
+ shutdown!
+ snapshot
+ current-track
+ (lambda () running)
+ app-id))
diff --git a/private/player-agent-gui.rkt b/private/player-agent-gui.rkt
index 64c4fe0..c28a235 100644
--- a/private/player-agent-gui.rkt
+++ b/private/player-agent-gui.rkt
@@ -1,423 +1,52 @@
#lang racket/base
-(require file/sha1
- json
- net/url
- racket-audio
- racket/class
- racket/file
+(require racket/class
racket/format
racket/gui/base
racket/os
racket/path
- racket/port
- racket/random
racket/string
- simple-ini
- simple-log)
+ simple-log
+ "player-agent-config.rkt"
+ "player-agent-core.rkt"
+ "player-agent-tray.rkt")
(provide run-player-agent-gui)
-(struct exn:fail:agent-denied exn:fail ()
- #:transparent)
-
-
-(define (input-field label init-val panel)
- (let ((tf (new text-field%
- [parent panel]
- [label label]
- [init-value init-val]))
- )
- (let ((editor (send tf get-editor)))
- (send editor set-padding 0 2 0 2))
-
- tf))
-
-
-(sl-def-log player-agent)
-
-(define config-file
- (get-ini-file 'rkt-web-player-agent))
+(sl-def-log player-agent-gui)
(define log-file
(build-path (find-system-path 'pref-dir)
"rkt-web-player-agent.log"))
-(define (fresh-app-id)
- (bytes->hex-string (crypto-random-bytes 32)))
+(define (input-field label init-value panel)
+ (define field
+ (new text-field%
+ (parent panel)
+ (label label)
+ (init-value init-value)))
+ (send (send field get-editor) set-padding 0 2 0 2)
+ field)
-(define (valid-app-id? value)
- (and (string? value)
- (regexp-match? #px"^[0-9a-fA-F]{64}$" value)))
-
-(define config
- (file->ini config-file))
-
-(define app-id
- (let ((configured (ini-get config 'agent 'app-id #f)))
- (if (valid-app-id? configured)
- (string-downcase configured)
- (fresh-app-id))))
-
-(define server-url
- (ini-get config 'server 'url "http://127.0.0.1:8080"))
-
-(define assigned-name
- (ini-get config 'agent 'name
- (format "~a playback" (gethostname))))
-
-(define (save-config!)
- (ini-set! config 'agent 'app-id app-id)
- (ini-set! config 'agent 'name assigned-name)
- (ini-set! config 'server 'url server-url)
- (ini->file config config-file #:private? #t))
-
-(save-config!)
-
-(define (base-url value)
- (string->url
- (regexp-replace #px"/+$" (string-trim value) "")))
-
-(define (endpoint-url base path)
- (combine-url/relative (base-url base) path))
-
-(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)))))
-
-(define (normal-state state)
- (cond
- ((eq? state 'transitioning) "starting")
- ((eq? state 'initialized) "stopped")
- ((eq? state 'no-media) "stopped")
- (else (symbol->string state))))
-
-(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))))
+(define (format-time value)
+ (define seconds
+ (if (and (number? value) (>= value 0))
+ (inexact->exact (floor value))
+ 0))
+ (define hours (quotient seconds 3600))
+ (define minutes (quotient (remainder seconds 3600) 60))
+ (define 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")))
(define (run-player-agent-gui)
(sl-log-to-file log-file)
- (define state-lock (make-semaphore 1))
- (define worker #f)
- (define command-worker #f)
- (define executing-command-id 0)
- (define running? #f)
- (define authorization-notified? #f)
- (define audio #f)
- (define temporary-media #f)
- (define current-media-key #f)
- (define cached-media (make-hash))
- (define prefetched-track #f)
- (define auto-started-key #f)
- (define pending-auto-music-id #f)
- (define music-tracks (make-hash))
- (define current-track #f)
- (define acknowledged-command 0)
- (define ended-counter 0)
- (define logical-volume 50)
- (define agent-state
- (hasheq 'state "stopped"
- 'position 0
- 'duration 'null
- 'rate 'null
- 'channels 'null
- 'bits 'null
- 'format ""
- 'volume logical-volume
- 'error 'null))
-
- (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"))))
-
- (define (with-agent-state proc)
- (call-with-semaphore state-lock proc))
-
- (define (state-value value fallback)
- (if (eq? value #f) fallback value))
-
- (define (update-from-audio! state full-state)
- (with-agent-state
- (λ ()
- (define 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 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))))))
-
- (define (set-agent-error! message)
- (with-agent-state
- (λ ()
- (set! agent-state
- (hash-set agent-state 'error message)))))
-
- (define (clear-agent-error!)
- (with-agent-state
- (λ ()
- (set! agent-state
- (hash-set agent-state 'error 'null)))))
-
- (define (state-snapshot)
- (with-agent-state
- (λ () agent-state)))
-
- (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)
-
- (define (download-media! token filename)
- (let* ((extension
- (or (path-get-extension (string->path filename)) #""))
- (template
- (string-append "rkt-player-agent-~a"
- (bytes->string/utf-8 extension)))
- (target (make-temporary-file template))
- (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)))
-
- (define (command-cache-key data)
- (hash-ref data 'cacheKey (hash-ref data 'mediaToken)))
-
- (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))))
-
- (define (discard-unused-media! keep-key)
- (for ((entry (in-list (hash->list cached-media))))
- (unless (equal? (car entry) keep-key)
- (safe-delete-file (cdr entry))
- (hash-remove! cached-media (car entry)))))
-
- ;; Decoder EOF is intentionally earlier than audible EOF: racket-audio may
- ;; still have several seconds buffered in libao. Starting the prepared file
- ;; here appends it to that same output queue, which is the gapless transition
- ;; used by rktplayer as well.
- (define (advance-at-decoder-eof! handle)
- (define 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)))))))
- (define 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)
- (set! temporary-media path)
- (discard-unused-media! key)
- (with-agent-state
- (λ ()
- (hash-set! music-tracks music-id data)
- (set! auto-started-key key)
- ;; Inform the server only when libao reports this id as audible,
- ;; not while the preceding track is still draining.
- (set! pending-auto-music-id music-id))))))
- (else
- ;; The server-driven fallback remains available when prefetching did
- ;; not complete before EOF.
- (warn-player-agent
- "Decoder reached EOF before the next track was prefetched")
- (with-agent-state
- (λ ()
- (set! ended-counter (+ ended-counter 1)))))))
-
- (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?)))))
- (set! current-track 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! already interrupts and closes the previous
- ;; decoder; an extra audio-stop! can double-delete FLAC.
- (define 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)
- (set! temporary-media next-media)
- (discard-unused-media! next-key)))))
- ((string=? action "prefetch")
- (let ((key (command-cache-key data)))
- (let ((path (ensure-media-cached! data)))
- (with-agent-state
- (λ ()
- (set! prefetched-track (cons data path))))
- (info-player-agent
- "Prefetched ~a"
- (hash-ref data 'filename "track")))
- ;; Retain the playing file and the one prepared for playback.
- (for ((entry (in-list (hash->list cached-media))))
- (unless (or (equal? (car entry) current-media-key)
- (equal? (car entry) key))
- (safe-delete-file (cdr entry))
- (hash-remove! cached-media (car entry))))))
- ((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)))))
-
+ (define config (load-player-agent-config))
(define frame #f)
+ (define runtime #f)
(define status-message #f)
(define playback-message #f)
(define playback-details #f)
@@ -425,233 +54,140 @@
(define name-field #f)
(define server-field #f)
(define connect-button #f)
- (define shutting-down? #f)
(define playback-timer #f)
+ (define tray-timer #f)
+ (define tray #f)
+ (define shutting-down? #f)
(define (show-status! message)
(queue-callback
- (λ ()
+ (lambda ()
(when status-message
(send status-message set-label message)))
#f))
- (define (show-name! name)
+ (define (show-denial! message)
(queue-callback
- (λ ()
- (when name-field
- (send name-field set-value name)))
+ (lambda ()
+ (message-box "Playback agent niet toegestaan"
+ 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!))
+
(define (refresh-playback-status!)
(when (and playback-message playback-details playback-filename)
- (let* ((snapshot (state-snapshot))
- (state (hash-ref snapshot 'state "stopped"))
- (title
- (and current-track
- (hash-ref current-track 'title #f)))
- (artist
- (and current-track
- (hash-ref current-track 'artist #f)))
- (filename
- (and current-track
- (hash-ref current-track 'filename #f)))
- (track-number
- (and current-track
- (hash-ref current-track 'trackNumber #f)))
- (track-label
- (cond
- ((and artist (not (string=? artist "")) title)
- (format "~a — ~a" artist title))
- (title title)
- (else "Geen track geselecteerd")))
- (prefix
- (cond
- ((string=? state "playing") "Speelt")
- ((string=? state "paused") "Gepauzeerd")
- ((string=? state "starting") "Laden")
- ((string=? state "stopped") "Gestopt")
- (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
- (if (= channels 1) "kanaal" "kanalen"))
- "")
- (if (and (string? format-name)
- (not (string=? format-name "")))
- format-name
- "")))))
- (send playback-message
- set-label
- (if current-track
- (format "~a~a: ~a"
- prefix
- (if (number? track-number)
- (format " #~a" track-number)
- "")
- track-label)
- "Er wordt niets afgespeeld"))
- (send playback-details set-label (string-join details " · "))
- (send playback-filename
- set-label
- (if (and (string? filename) (not (string=? filename "")))
- filename
- "—")))))
-
- (define (poll-loop)
- (with-handlers
- ((exn:fail:agent-denied?
- (λ (exception)
- (define message
- (string-append
- "Deze playback agent is niet toegelaten door de server. "
- "Voeg het volgende applicatie-ID toe aan [playback-agents] "
- "in de server-INI:\n\n"
- app-id))
- (warn-player-agent "Agent authorization refused: ~a"
- (exn-message exception))
- (set-agent-error! message)
- (show-status! "Niet geautoriseerd — applicatie-ID staat niet in de server-INI")
- (unless authorization-notified?
- (set! authorization-notified? #t)
- (queue-callback
- (λ ()
- (message-box "Playback agent niet toegestaan"
- message
- frame
- '(ok stop)))))
- (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))
- (show-status! (format "Niet verbonden: ~a"
- (exn-message exception)))
- (when running?
- (sleep 3)
- (poll-loop)))))
- (let ((registration
- (post-json
- server-url
- "/api/agent/register"
- (hasheq 'appId app-id
- 'name assigned-name))))
- (show-name! assigned-name)
- (clear-agent-error!)
- (show-status! "Verbonden")
- (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 (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)))))))
-
- (define (start-worker!)
- (set! running? #t)
- (set! worker (thread poll-loop))
- (send connect-button set-label "Opnieuw verbinden"))
-
- (define (stop-worker!)
- (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))
+ (define snapshot ((player-agent-runtime-snapshot runtime)))
+ (define track ((player-agent-runtime-current-track runtime)))
+ (define state (hash-ref snapshot 'state "stopped"))
+ (define title (and track (hash-ref track 'title #f)))
+ (define artist (and track (hash-ref track 'artist #f)))
+ (define filename (and track (hash-ref track 'filename #f)))
+ (define track-number (and track (hash-ref track 'trackNumber #f)))
+ (define track-label
+ (cond
+ ((and artist (not (string=? artist "")) title)
+ (format "~a — ~a" artist title))
+ (title title)
+ (else "Geen track geselecteerd")))
+ (define prefix
+ (cond
+ ((string=? state "playing") "Speelt")
+ ((string=? state "paused") "Gepauzeerd")
+ ((string=? state "starting") "Laden")
+ ((string=? state "stopped") "Gestopt")
+ (else state)))
+ (define position (hash-ref snapshot 'position 0))
+ (define duration (hash-ref snapshot 'duration 'null))
+ (define format-name (hash-ref snapshot 'format ""))
+ (define rate (hash-ref snapshot 'rate 'null))
+ (define bits (hash-ref snapshot 'bits 'null))
+ (define channels (hash-ref snapshot 'channels 'null))
+ (define details
+ (filter
+ (lambda (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
+ (if (= channels 1) "kanaal" "kanalen"))
+ "")
+ (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)
+ "Er wordt niets afgespeeld"))
+ (send playback-details set-label (string-join details " · "))
+ (send playback-filename
+ set-label
+ (if (and (string? filename) (not (string=? filename "")))
+ filename
+ "—"))))
(define (reconnect!)
- (stop-worker!)
- (set! authorization-notified? #f)
- (set! server-url (string-trim (send server-field get-value)))
- (let ((new-name (string-trim (send name-field get-value))))
- (set! assigned-name
- (if (string=? new-name "")
- (format "~a playback" (gethostname))
- new-name)))
- (save-config!)
- (show-status! "Verbinden…")
- (start-worker!))
+ (define next-server (string-trim (send server-field get-value)))
+ (define entered-name (string-trim (send name-field get-value)))
+ (define 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 "Opnieuw verbinden"))
(define (shutdown!)
(unless shutting-down?
(set! shutting-down? #t)
- (stop-worker!)
- (when playback-timer
- (send playback-timer stop))
- (when audio
- (with-handlers ((exn:fail? void))
- (audio-quit! audio))
- (set! audio #f))
- (for ((path (in-hash-values cached-media)))
- (safe-delete-file path))
- (hash-clear! cached-media)))
+ (when playback-timer (send playback-timer stop))
+ (when tray-timer (send tray-timer stop))
+ ((player-agent-runtime-shutdown! runtime))
+ (when tray
+ ((tray-controller-destroy! tray))
+ (set! tray #f))))
+
+ (define (quit!)
+ (queue-callback
+ (lambda ()
+ (shutdown!)
+ (when frame (send frame show #f)))
+ #f))
(define agent-frame%
(class frame%
(super-new)
(define/augment (on-close)
- (shutdown!)
- (inner (void) on-close))))
+ (if tray
+ (send this show #f)
+ (begin
+ (shutdown!)
+ (inner (void) on-close))))))
(set! frame
(new agent-frame%
@@ -661,17 +197,17 @@
(define panel
(new vertical-panel%
(parent frame)
- (alignment '(left top))
- ;(border 12)
- ;(spacing 8)
- ))
- (set! server-field (input-field "RKT Web Player server" server-url panel))
- (set! name-field (input-field "Naam" assigned-name panel))
- (define id-field (input-field "Applicatie-ID" app-id panel))
-
- ;; Lock just the editor instead of disabling the complete widget. Windows
- ;; renders disabled native controls in grey, which made the label and ID look
- ;; as though their glyphs were damaged.
+ (alignment '(left top))))
+ (set! server-field
+ (input-field "RKT Web Player server"
+ (player-agent-config-server-url config)
+ panel))
+ (set! name-field
+ (input-field "Naam" (player-agent-config-name config) panel))
+ (define id-field
+ (input-field "Applicatie-ID" (player-agent-config-app-id config) panel))
+ ;; 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)
(define playback-panel
@@ -704,8 +240,7 @@
(new button%
(parent controls)
(label "Opslaan en verbinden")
- (callback (λ (_button _event)
- (reconnect!)))))
+ (callback (lambda (_button _event) (reconnect!)))))
(set! status-message
(new message%
(parent controls)
@@ -718,6 +253,20 @@
(interval 500)))
(refresh-playback-status!)
+ ;; If SDL3 and its native runtime are present, closing the frame hides it in
+ ;; the tray. Otherwise the original close-and-exit behaviour remains.
+ (set! tray
+ (try-make-tray-controller
+ (lambda ()
+ (queue-callback (lambda () (send frame show #t)) #f))
+ quit!))
+ (when tray
+ (set! tray-timer
+ (new timer%
+ (notify-callback (tray-controller-update! tray))
+ (interval 100))))
+
(send frame show #t)
- (start-worker!)
+ ((player-agent-runtime-start! runtime))
+ (send connect-button set-label "Opnieuw verbinden")
frame)
diff --git a/private/player-agent-tray.rkt b/private/player-agent-tray.rkt
new file mode 100644
index 0000000..4367dd5
--- /dev/null
+++ b/private/player-agent-tray.rkt
@@ -0,0 +1,34 @@
+#lang racket/base
+
+;; SDL3 is deliberately loaded dynamically. The GUI agent keeps working
+;; without the optional Racket package and native SDL3 runtime.
+
+(provide (struct-out tray-controller)
+ try-make-tray-controller)
+
+(struct tray-controller (update! destroy!) #:transparent)
+
+(define (try-make-tray-controller show-window! quit!)
+ (with-handlers ((exn:fail? (lambda (_) #f)))
+ (define sdl-init! (dynamic-require 'sdl3 'sdl-init!))
+ (define sdl-quit! (dynamic-require 'sdl3 'sdl-quit!))
+ (define make-tray (dynamic-require 'sdl3 'make-tray))
+ (define make-tray-menu (dynamic-require 'sdl3 'make-tray-menu))
+ (define insert-tray-entry! (dynamic-require 'sdl3 'insert-tray-entry!))
+ (define set-tray-entry-callback!
+ (dynamic-require 'sdl3 'set-tray-entry-callback!))
+ (define update-trays! (dynamic-require 'sdl3 'update-trays!))
+ (define tray-destroy! (dynamic-require 'sdl3 'tray-destroy!))
+ (sdl-init! '(video events))
+ (define tray (make-tray #f "RKT Web Player Agent"))
+ (define menu (make-tray-menu tray))
+ (define show-entry (insert-tray-entry! menu "RKT Web Player Agent openen"))
+ (insert-tray-entry! menu #f)
+ (define quit-entry (insert-tray-entry! menu "Afsluiten"))
+ (set-tray-entry-callback! show-entry (lambda (_) (show-window!)))
+ (set-tray-entry-callback! quit-entry (lambda (_) (quit!)))
+ (tray-controller
+ update-trays!
+ (lambda ()
+ (tray-destroy! tray)
+ (sdl-quit!)))))
diff --git a/public/app.js b/public/app.js
index 4cb5897..7e869c5 100644
--- a/public/app.js
+++ b/public/app.js
@@ -84,9 +84,12 @@ async function api(path, body) {
}
function showLogin(message = null) {
+ const wasHidden = elements.loginOverlay.hidden;
if (message !== null) elements.loginError.textContent = message;
elements.loginOverlay.hidden = false;
- window.setTimeout(() => elements.loginUsername.focus(), 0);
+ if (wasHidden) {
+ window.setTimeout(() => elements.loginUsername.focus(), 0);
+ }
}
function hideLogin() {
diff --git a/scribblings/rkt-web-player.scrbl b/scribblings/rkt-web-player.scrbl
index 1806e42..f583bee 100644
--- a/scribblings/rkt-web-player.scrbl
+++ b/scribblings/rkt-web-player.scrbl
@@ -70,3 +70,14 @@ plays them with @tt{racket-audio}. Its configured display name is authoritative
and is followed by the server. Importing the module does not start the GUI; the
function must be called explicitly.
}
+
+@defproc[(run-player-agent-cli [#:server-url server-url
+ (or/c string? #f) #f]
+ [#:name name (or/c string? #f) #f]
+ [#:config-file config-file
+ (or/c path-string? #f) #f]) void?] {
+
+Starts a headless playback agent using the same audio and gapless-prefetch
+runtime as the GUI. Missing keyword values are read from the normal agent INI
+file. The procedure runs until interrupted.
+}