From d535bb63d998e204869faf1dd27a19ce38dda2ff Mon Sep 17 00:00:00 2001 From: Hans Dijkema Date: Thu, 27 Aug 2026 11:26:25 +0200 Subject: [PATCH] verbetering tray implementatie en prefetching --- README.md | 25 ++--- private/player-agent-gui.rkt | 178 ++++++++++++++++++++--------------- private/player.rkt | 137 ++++++++++++++++++++++----- private/windows-tray.rkt | 97 ------------------- 4 files changed, 228 insertions(+), 209 deletions(-) delete mode 100644 private/windows-tray.rkt diff --git a/README.md b/README.md index 12445dc..fcabdca 100644 --- a/README.md +++ b/README.md @@ -92,19 +92,20 @@ in. De naam wordt in dezelfde agent-GUI ingesteld. Na registratie verschijnt de agent met die naam als uitvoer van type `AGENT`; de server volgt latere naamswijzigingen bij registratie en polling. -Onder **Afspelen** toont de agent de huidige track, afspeeltoestand, verstreken -en totale tijd, decoderformaat en samplefrequentie. Op Windows kan de agent via -de optie onderaan actief blijven in het systeemvak wanneer het venster wordt -gesloten. Dubbelklik op het pictogram om het venster terug te halen; via het -contextmenu kan de agent volledig worden afgesloten. Hiervoor gebruikt de -agent de standaard Windows Forms-notificatiezone via de aanwezige Windows -PowerShell. Op andere platforms blijft de optie uitgeschakeld. +Onder **Afspelen** toont de agent het playlistnummer, de huidige track en +bestandsnaam, afspeeltoestand, verstreken en totale tijd, bitdiepte, +samplefrequentie, kanaalaantal en decoderformaat. -De eerste implementatie downloadt een geselecteerde track volledig naar een -tijdelijk bestand voordat `racket-audio` de weergave start. Daardoor is de -implementatie klein en zijn geen gedeelde mappen nodig, maar het starten van -grote bestanden kan merkbaar langer duren. Het tijdelijke bestand wordt bij de -volgende track of bij afsluiten verwijderd. +Een geselecteerde track wordt volledig naar een tijdelijk bestand gedownload +voordat `racket-audio` de weergave start. Tijdens het afspelen stuurt de server +al een `prefetch`-opdracht voor de volgende playlisttrack. De agent bewaart +daardoor maximaal het huidige en het volgende bestand lokaal. Bij de overgang +kan het vooraf opgehaalde bestand direct worden geopend zonder opnieuw over +het LAN te worden gedownload. 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. De applicatie-ID identificeert de agent en begrenst toegang tot zijn tijdelijke media-URL, maar vervangt geen transportbeveiliging of authenticatie. Gebruik de diff --git a/private/player-agent-gui.rkt b/private/player-agent-gui.rkt index 26b072f..e17ae26 100644 --- a/private/player-agent-gui.rkt +++ b/private/player-agent-gui.rkt @@ -14,8 +14,7 @@ racket/random racket/string simple-ini - simple-log - "windows-tray.rkt") + simple-log) (provide run-player-agent-gui) @@ -51,13 +50,9 @@ (ini-get config 'agent 'name (format "~a playback" (gethostname)))) -(define tray-enabled? - (ini-get config 'agent 'system-tray #t)) - (define (save-config!) (ini-set! config 'agent 'app-id app-id) (ini-set! config 'agent 'name assigned-name) - (ini-set! config 'agent 'system-tray tray-enabled?) (ini-set! config 'server 'url server-url) (ini->file config config-file #:private? #t)) @@ -116,9 +111,12 @@ (define running? #f) (define audio #f) (define temporary-media #f) + (define current-media-key #f) + (define cached-media (make-hash)) (define current-track #f) (define acknowledged-command 0) (define ended-counter 0) + (define eof-pending? #f) (define logical-volume 50) (define agent-state (hasheq 'state "stopped" @@ -153,9 +151,10 @@ (define (update-from-audio! state full-state) (with-agent-state (λ () + (define normalized (normal-state state)) (set! agent-state (hasheq - 'state (normal-state state) + 'state normalized 'position (state-value (hash-ref full-state 'at-second #f) 0) 'duration @@ -170,7 +169,12 @@ (let ((decoder (hash-ref full-state 'decoder #f))) (if decoder (format "~a" decoder) "")) 'volume logical-volume - 'error 'null))))) + 'error 'null)) + ;; racket-audio reports decoder EOF before its output buffer has + ;; drained. Advance only when playback itself has actually stopped. + (when (and eof-pending? (string=? normalized "stopped")) + (set! eof-pending? #f) + (set! ended-counter (+ ended-counter 1)))))) (define (set-agent-error! message) (with-agent-state @@ -195,9 +199,9 @@ (λ (_handle state full-state) (update-from-audio! state full-state)) (λ (_handle) - (with-agent-state + (with-agent-state (λ () - (set! ended-counter (+ ended-counter 1))))))) + (set! eof-pending? #t)))))) (audio-ao-buf-ms! audio 500) (audio-buf-seconds! audio 4 10) (let ((scaled (/ logical-volume 100.0))) @@ -228,12 +232,34 @@ (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))))) + (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") + (with-agent-state (λ () (set! eof-pending? #f))) (set! current-track data) (with-agent-state (λ () @@ -242,19 +268,30 @@ (hash-set agent-state 'state "starting") 'error 'null)))) - (let ((next-media - (download-media! - (hash-ref data 'mediaToken) - (hash-ref data 'filename "track")))) - (when audio (audio-stop! audio)) - (safe-delete-file temporary-media) + (let* ((next-key (command-cache-key data)) + (next-media (ensure-media-cached! data))) + ;; audio-play! already interrupts and closes the previous decoder. + ;; Calling audio-stop! first can delete a finished FLAC decoder a + ;; second time in racket-audio. + (audio-play! (ensure-audio!) next-media) + (set! current-media-key next-key) (set! temporary-media next-media) - (audio-play! (ensure-audio!) temporary-media))) + (discard-unused-media! next-key))) + ((string=? action "prefetch") + (let ((key (command-cache-key data))) + (ensure-media-cached! data) + ;; 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! eof-pending? #f))) (when audio (audio-stop! audio))) ((string=? action "seek") (audio-seek! (ensure-audio!) @@ -278,11 +315,10 @@ (define status-message #f) (define playback-message #f) (define playback-details #f) + (define playback-filename #f) (define name-field #f) (define server-field #f) (define connect-button #f) - (define tray-checkbox #f) - (define tray-stop #f) (define shutting-down? #f) (define playback-timer #f) @@ -301,7 +337,7 @@ #f)) (define (refresh-playback-status!) - (when (and playback-message playback-details) + (when (and playback-message playback-details playback-filename) (let* ((snapshot (state-snapshot)) (state (hash-ref snapshot 'state "stopped")) (title @@ -310,6 +346,12 @@ (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) @@ -327,6 +369,8 @@ (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 ""))) @@ -336,18 +380,36 @@ (if (number? duration) (format-time duration) "--:--:--")) - (if (string=? format-name "") format-name - (string-upcase format-name)) + (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" prefix track-label) + (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-details set-label (string-join details " · ")) + (send playback-filename + set-label + (if (and (string? filename) (not (string=? filename ""))) + filename + "—"))))) (define (poll-loop) (with-handlers @@ -440,56 +502,25 @@ (show-status! "Verbinden…") (start-worker!)) - (define (stop-tray!) - (when tray-stop - (tray-stop) - (set! tray-stop #f))) - (define (shutdown!) (unless shutting-down? (set! shutting-down? #t) (stop-worker!) - (stop-tray!) (when playback-timer (send playback-timer stop)) (when audio (with-handlers ((exn:fail? void)) (audio-quit! audio)) (set! audio #f)) - (safe-delete-file temporary-media))) - - (define (ensure-tray!) - (cond - ((and tray-enabled? (not tray-stop)) - (set! - tray-stop - (start-windows-tray! - (λ () - (queue-callback - (λ () - (send frame show #t) - (send frame focus)) - #f)) - (λ () - (queue-callback - (λ () - (shutdown!) - (send frame show #f)) - #f)))) - (when (and tray-enabled? (not tray-stop)) - (set! tray-enabled? #f) - (save-config!) - (when tray-checkbox - (send tray-checkbox set-value #f)))) - ((not tray-enabled?) - (stop-tray!)))) + (for ((path (in-hash-values cached-media))) + (safe-delete-file path)) + (hash-clear! cached-media))) (define agent-frame% (class frame% (super-new) (define/augment (on-close) - (unless (and tray-enabled? tray-stop) - (shutdown!)) + (shutdown!) (inner (void) on-close)))) (set! frame @@ -507,17 +538,22 @@ (new text-field% (parent panel) (label "RKT Web Player server") - (init-value server-url))) + (init-value server-url) + ;; The automatically calculated single-line height can round one + ;; physical pixel too small at fractional Windows DPI scales. + (min-height 32))) (set! name-field (new text-field% (parent panel) (label "Naam") - (init-value assigned-name))) + (init-value assigned-name) + (min-height 32))) (define id-field (new text-field% (parent panel) (label "Applicatie-ID") - (init-value app-id))) + (init-value app-id) + (min-height 32))) ;; 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. @@ -539,6 +575,11 @@ (parent playback-panel) (label "00:00:00 / --:--:--") (auto-resize #t))) + (set! playback-filename + (new message% + (parent playback-panel) + (label "—") + (auto-resize #t))) (define controls (new horizontal-panel% @@ -556,18 +597,6 @@ (label "Verbinden…") (auto-resize #t))) - (set! tray-checkbox - (new check-box% - (parent panel) - (label "In het systeemvak actief blijven na sluiten") - (value (and tray-enabled? (windows-tray-available?))) - (enabled (windows-tray-available?)) - (callback - (λ (box _event) - (set! tray-enabled? (send box get-value)) - (save-config!) - (ensure-tray!))))) - (set! playback-timer (new timer% (notify-callback refresh-playback-status!) @@ -575,6 +604,5 @@ (refresh-playback-status!) (send frame show #t) - (ensure-tray!) (start-worker!) frame) diff --git a/private/player.rkt b/private/player.rkt index 620186e..f661187 100644 --- a/private/player.rkt +++ b/private/player.rkt @@ -34,8 +34,7 @@ [reported-state #:mutable] [commands #:mutable] [next-command-id #:mutable] - [media-token #:mutable] - [media-file #:mutable] + media [ended-counter #:mutable]) #:transparent) @@ -106,6 +105,25 @@ (define (fresh-media-token) (bytes->hex-string (crypto-random-bytes 32))) +(define (track-cache-key item) + (sha1 + (open-input-string + (path->string (track-file item))))) + +(define (agent-track-data item index token) + (hasheq 'playlistIndex index + 'trackNumber (+ index 1) + 'cacheKey (track-cache-key item) + 'mediaToken token + 'filename + (path->string + (or (file-name-from-path (track-file item)) + (track-file item))) + 'title (track-title item) + 'artist (track-artist item) + 'album (track-album item) + 'duration (or (track-duration item) 'null))) + (define (enqueue-agent-command! value agent action [data (hasheq)]) (with-state-lock value @@ -353,25 +371,34 @@ ((eq? kind 'local) (audio-play! backend (track-file item))) ((eq? kind 'agent) - (let ((token (fresh-media-token))) + (let* ((token (fresh-media-token)) + (data (agent-track-data item index token)) + (following-index (next-index value 1)) + (following-item + (and following-index + (not (= following-index index)) + (list-ref (player-tracks value) following-index))) + (following-token + (and following-item (fresh-media-token))) + (following-data + (and following-item + (agent-track-data following-item + following-index + following-token)))) (with-state-lock value (λ () - (set-playback-agent-media-token! backend token) - (set-playback-agent-media-file! backend (track-file item)))) - (enqueue-agent-command! - value - backend - "play" - (hasheq 'mediaToken token - 'filename - (path->string - (or (file-name-from-path (track-file item)) - (track-file item))) - 'title (track-title item) - 'artist (track-artist item) - 'album (track-album item) - 'duration (or (track-duration item) 'null))))) + (hash-set! (playback-agent-media backend) + token + (track-file item)) + (when following-item + (hash-set! (playback-agent-media backend) + following-token + (track-file following-item))))) + (enqueue-agent-command! value backend "play" data) + (when following-data + (enqueue-agent-command! + value backend "prefetch" following-data)))) (else (dlna-player-play! backend (track-file item)))) (clear-error! value))) @@ -405,11 +432,15 @@ (playback-agent-reported-state (player-backend value)))) ;; Keep the server's optimistic command state visible until the - ;; agent acknowledges all queued work. Its report in the poll that - ;; receives a command still describes the state before execution. + ;; agent acknowledges playback-changing work. Prefetching does not + ;; change playback state and may continue in the background. (when (and (hash? reported) - (null? (playback-agent-commands - (player-backend value)))) + (andmap + (λ (command) + (string=? (hash-ref command 'action "") + "prefetch")) + (playback-agent-commands + (player-backend value)))) (with-state-lock value (λ () @@ -1171,7 +1202,7 @@ (hasheq 'state "stopped" 'position 0 'volume 50) - '() 1 #f #f 0))) + '() 1 (make-hash) 0))) (set-player-agents! value (append (player-agents value) (list agent))) @@ -1228,6 +1259,15 @@ (when (hash? reported) (set-playback-agent-reported-state! agent reported)) (when (exact-nonnegative-integer? ack) + (for ((command (in-list (playback-agent-commands agent))) + #:when (<= (hash-ref command 'id) ack)) + (let* ((command-data + (hash-ref command 'data (hasheq))) + (media-token + (hash-ref command-data 'mediaToken #f))) + (when (string? media-token) + (hash-remove! (playback-agent-media agent) + media-token)))) (set-playback-agent-commands! agent (filter @@ -1265,8 +1305,7 @@ (agent-by-id value app-id)))) (and agent (string? token) - (equal? token (playback-agent-media-token agent)) - (playback-agent-media-file agent)))))) + (hash-ref (playback-agent-media agent) token #f)))))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ; goal : Stop playback and release all player resources. @@ -1435,6 +1474,54 @@ (player-renderers example-player))) "Office laptop") + (define first-file (build-path root "Album" "01.flac")) + (define second-file (build-path root "Album" "02.flac")) + (call-with-output-file first-file void #:exists 'truncate/replace) + (call-with-output-file second-file void #:exists 'truncate/replace) + (set-player-tracks! + example-player + (list (track first-file "First" "Artist" "Album" 60 "audio/flac") + (track second-file "Second" "Artist" "Album" 60 "audio/flac"))) + + (player-command! example-player "play" (hasheq 'index 0)) + (define play-poll + (player-agent-poll! + example-player + (hasheq 'appId test-agent-id + 'ack first-command-id + 'endedCounter 0 + 'state (hasheq 'state "starting" 'position 0)))) + (define play-command (hash-ref play-poll 'command)) + (check-equal? (hash-ref play-command 'action) "play") + (check-equal? + (hash-ref (hash-ref play-command 'data) 'trackNumber) + 1) + (check-equal? + (player-agent-media + example-player + test-agent-id + (hash-ref (hash-ref play-command 'data) 'mediaToken)) + first-file) + + (define prefetch-poll + (player-agent-poll! + example-player + (hasheq 'appId test-agent-id + 'ack (hash-ref play-command 'id) + 'endedCounter 0 + 'state (hasheq 'state "playing" 'position 1)))) + (define prefetch-command (hash-ref prefetch-poll 'command)) + (check-equal? (hash-ref prefetch-command 'action) "prefetch") + (check-equal? + (hash-ref (hash-ref prefetch-command 'data) 'trackNumber) + 2) + (check-equal? + (player-agent-media + example-player + test-agent-id + (hash-ref (hash-ref prefetch-command 'data) 'mediaToken)) + second-file) + (check-exn exn:fail? (λ () (player-command! diff --git a/private/windows-tray.rkt b/private/windows-tray.rkt deleted file mode 100644 index 8f61b1a..0000000 --- a/private/windows-tray.rkt +++ /dev/null @@ -1,97 +0,0 @@ -#lang racket/base - -(require racket/port - racket/system) - -(provide windows-tray-available? - start-windows-tray!) - -(define (windows-tray-available?) - (and (eq? (system-type 'os) 'windows) - (find-executable-path "powershell.exe") - #t)) - -(define tray-script - #<