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
private/player-agent-gui.rkt
+103 -75
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
@@ -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)
private/player.rkt
+112 -25
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))))
(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!
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))))))))