From 344be1952107cefad87384af82316b3ddbed8ee2 Mon Sep 17 00:00:00 2001 From: Hans Dijkema Date: Thu, 27 Aug 2026 17:10:33 +0200 Subject: [PATCH] cli player agent added --- ARCHITECTURE.md | 15 +- README.md | 47 +- player-agent-cli.rkt | 112 +++++ player-agent.rkt | 17 +- private/player-agent-config.rkt | 69 +++ private/player-agent-core.rkt | 429 +++++++++++++++++ private/player-agent-gui.rkt | 781 +++++++------------------------ private/player-agent-tray.rkt | 34 ++ public/app.js | 5 +- scribblings/rkt-web-player.scrbl | 11 + 10 files changed, 896 insertions(+), 624 deletions(-) create mode 100644 player-agent-cli.rkt create mode 100644 private/player-agent-config.rkt create mode 100644 private/player-agent-core.rkt create mode 100644 private/player-agent-tray.rkt 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. +}