verbetering tray implementatie en prefetching

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
+Onder **Afspelen** toont de agent het playlistnummer, de huidige track en
-en totale tijd, decoderformaat en samplefrequentie. Op Windows kan de agent via
+bestandsnaam, afspeeltoestand, verstreken en totale tijd, bitdiepte,
-de optie onderaan actief blijven in het systeemvak wanneer het venster wordt
+samplefrequentie, kanaalaantal en decoderformaat.
-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.
 
-De eerste implementatie downloadt een geselecteerde track volledig naar een
+Een geselecteerde track wordt volledig naar een tijdelijk bestand gedownload
-tijdelijk bestand voordat `racket-audio` de weergave start. Daardoor is de
+voordat `racket-audio` de weergave start. Tijdens het afspelen stuurt de server
-implementatie klein en zijn geen gedeelde mappen nodig, maar het starten van
+al een `prefetch`-opdracht voor de volgende playlisttrack. De agent bewaart
-grote bestanden kan merkbaar langer duren. Het tijdelijke bestand wordt bij de
+daardoor maximaal het huidige en het volgende bestand lokaal. Bij de overgang
-volgende track of bij afsluiten verwijderd.
+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

@@ -14,8 +14,7 @@
          racket/random
          racket/string
          simple-ini
-         simple-log
+         simple-log)
-         "windows-tray.rkt")
 
 (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
+         (let* ((next-key (command-cache-key data))
-                (download-media!
+                (next-media (ensure-media-cached! data)))
-                 (hash-ref data 'mediaToken)
+           ;; audio-play! already interrupts and closes the previous decoder.
-                 (hash-ref data 'filename "track"))))
+           ;; Calling audio-stop! first can delete a finished FLAC decoder a
-           (when audio (audio-stop! audio))
+           ;; second time in racket-audio.
-           (safe-delete-file temporary-media)
+           (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
+                (if (number? bits) (format "~a bit" bits) "")
-                    (string-upcase format-name))
                 (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)))
+      (for ((path (in-hash-values cached-media)))
-
+        (safe-delete-file path))
-  (define (ensure-tray!)
+      (hash-clear! cached-media)))
-    (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!))))
 
   (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

@@ -34,8 +34,7 @@
    [reported-state #:mutable]
    [commands #:mutable]
    [next-command-id #:mutable]
-   [media-token #:mutable]
+   media
-   [media-file #:mutable]
    [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)
+            (hash-set! (playback-agent-media backend)
-            (set-playback-agent-media-file! backend (track-file item))))
+                       token
-         (enqueue-agent-command!
+                       (track-file item))
-          value
+            (when following-item
-          backend
+              (hash-set! (playback-agent-media backend)
-          "play"
+                         following-token
-          (hasheq 'mediaToken token
+                         (track-file following-item)))))
-                  'filename
+         (enqueue-agent-command! value backend "play" data)
-                  (path->string
+         (when following-data
-                   (or (file-name-from-path (track-file item))
+           (enqueue-agent-command!
-                       (track-file item)))
+            value backend "prefetch" following-data))))
-                  'title (track-title item)
-                  'artist (track-artist item)
-                  'album (track-album item)
-                  'duration (or (track-duration item) 'null)))))
       (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
+            ;; agent acknowledges playback-changing work. Prefetching does not
-            ;; receives a command still describes the state before execution.
+            ;; change playback state and may continue in the background.
             (when (and (hash? reported)
-                       (null? (playback-agent-commands
+                       (andmap
-                               (player-backend value))))
+                        (λ (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))
+            (hash-ref (playback-agent-media agent) token #f))))))
-            (playback-agent-media-file agent))))))
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ; 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

@@ -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))))))))