hans/rkt-web-player
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

verbetering tray implementatie en prefetching

Browse Source
This commit is contained in:
Hans Dijkema
2026-08-27 11:26:25 +02:00
parent a2dea77eb0
commit d535bb63d9
4 changed files with 228 additions and 209 deletions
Download Patch File Download Diff File Expand all files Collapse all files
README.md
+13 -12
View File
@@ -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
private/player-agent-gui.rkt
+102 -74
View File
@@ -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
@@ -197,7 +201,7 @@
(λ (_handle)
(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)
private/player.rkt
+110 -23
View File
@@ -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))))
(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
"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)))))
value backend "prefetch" following-data))))
(else
(dlna-player-play! backend (track-file item))))
(clear-error! value)))
@@ -405,10 +432,14 @@
(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
(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!
private/windows-tray.rkt
-97
View File
@@ -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
#<<POWERSHELL
[Console]::OutputEncoding = [System.Text.Encoding]::UTF8
Add-Type -AssemblyName System.Windows.Forms
Add-Type -AssemblyName System.Drawing
$tray = New-Object System.Windows.Forms.NotifyIcon
$tray.Icon = [System.Drawing.SystemIcons]::Application
$tray.Text = "RKT Web Player Agent"
$tray.Visible = $true
$menu = New-Object System.Windows.Forms.ContextMenuStrip
$open = $menu.Items.Add("Open RKT Web Player Agent")
$quit = $menu.Items.Add("Exit")
$tray.ContextMenuStrip = $menu
$send = {
param([string]$message)
[Console]::Out.WriteLine($message)
[Console]::Out.Flush()
}
$open.add_Click({ & $send "open" })
$tray.add_DoubleClick({ & $send "open" })
$quit.add_Click({
& $send "quit"
$tray.Visible = $false
[System.Windows.Forms.Application]::Exit()
})
[System.Windows.Forms.Application]::Run()
$tray.Visible = $false
$tray.Dispose()
POWERSHELL
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
; goal : Add a Windows notification-area icon with open and quit actions.
; pre : Called on Windows with PowerShell and a GUI eventspace available.
; post : Callbacks are delivered from a reader thread; the stop thunk removes
; the helper process and its icon.
; result : A stop thunk, or #f when the platform has no supported tray helper.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(define (start-windows-tray! on-open on-quit)
(cond
((not (windows-tray-available?)) #f)
(else
(let-values (((process output input error-output)
(subprocess
#f #f #f
(find-executable-path "powershell.exe")
"-NoLogo"
"-NoProfile"
"-NonInteractive"
"-WindowStyle"
"Hidden"
"-STA"
"-Command"
tray-script)))
(close-output-port input)
(define stopped? #f)
(define reader
(thread
(λ ()
(let loop ()
(let ((line (read-line output 'any)))
(unless (eof-object? line)
(cond
((string=? line "open") (on-open))
((string=? line "quit") (on-quit)))
(loop)))))))
(thread
(λ ()
;; Drain diagnostics so the helper cannot block on a full pipe.
(copy-port error-output (open-output-nowhere))))
(λ ()
(unless stopped?
(set! stopped? #t)
(when (and reader (not (thread-dead? reader)))
(kill-thread reader))
(close-input-port output)
(close-input-port error-output)
(when (eq? (subprocess-status process) 'running)
(subprocess-kill process #t))))))))