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)