player agent gui script for exe
This commit is contained in:
@@ -84,6 +84,26 @@
|
||||
(exn-message exception)))))
|
||||
(delete-file file))))
|
||||
|
||||
;;; Evicts least recently used files until the cache fits its byte budget.
|
||||
;;; Entries contain path, byte size and last use; active files remain protected.
|
||||
(define (trim-media-cache! cache protected [limit 1000000000])
|
||||
(let loop ((entries (sort (hash->list cache) <
|
||||
#:key (λ (entry) (cadddr entry))))
|
||||
(size (apply + (map cadr (hash-values cache)))))
|
||||
(when (and (> size limit) (pair? entries))
|
||||
(let* ((entry (car entries))
|
||||
(key (car entry))
|
||||
(path (cadr entry)))
|
||||
(cond
|
||||
((member key protected) (loop (cdr entries) size))
|
||||
(else
|
||||
(safe-delete-file path)
|
||||
(if (file-exists? path)
|
||||
(loop (cdr entries) size)
|
||||
(begin
|
||||
(hash-remove! cache key)
|
||||
(loop (cdr entries) (- size (caddr entry)))))))))))
|
||||
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
;; Provided functions
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
@@ -123,6 +143,8 @@
|
||||
(authorization-notified? #f)
|
||||
(audio #f)
|
||||
(current-media-key #f)
|
||||
(loading-media-key #f)
|
||||
(queued-media-key #f)
|
||||
(cached-media (make-hash))
|
||||
(prefetched-track #f)
|
||||
(auto-started-key #f)
|
||||
@@ -210,7 +232,9 @@
|
||||
(λ (_handle state full-state)
|
||||
(update-from-audio! state full-state))
|
||||
(λ (handle)
|
||||
(advance-at-decoder-eof! handle))))
|
||||
(advance-at-decoder-eof! handle))
|
||||
#:use-place #f
|
||||
))
|
||||
(audio-ao-buf-ms! audio 500)
|
||||
(audio-buf-seconds! audio 4 10)
|
||||
(let ((scaled (/ logical-volume 100.0)))
|
||||
@@ -220,52 +244,84 @@
|
||||
;;; Downloads one protected media resource to a temporary local file.
|
||||
;;; A failed download closes its port and removes its partial file.
|
||||
(define (download-media! token filename)
|
||||
(let* ((extension
|
||||
(let* ((started (current-inexact-monotonic-milliseconds))
|
||||
(extension
|
||||
(or (path-get-extension (string->path filename)) #""))
|
||||
(target
|
||||
(make-temporary-file
|
||||
(string-append "rkt-player-agent-~a"
|
||||
(bytes->string/utf-8 extension))))
|
||||
(path (format "/api/agent/media/~a/~a" app-id token))
|
||||
(input (get-pure-port (endpoint-url server-url path))))
|
||||
(input #f))
|
||||
(with-handlers ((exn:fail?
|
||||
(λ (exception)
|
||||
(close-input-port input)
|
||||
(when input (close-input-port input))
|
||||
(safe-delete-file target)
|
||||
(raise exception))))
|
||||
(info-player-agent "Downloading ~a" filename)
|
||||
(set! input (get-pure-port (endpoint-url server-url path)))
|
||||
(call-with-output-file
|
||||
target
|
||||
(λ (output) (copy-port input output))
|
||||
#:exists 'truncate/replace)
|
||||
(close-input-port input)
|
||||
(info-player-agent "Downloaded ~a: ~a bytes in ~a ms"
|
||||
filename (file-size target)
|
||||
(round (- (current-inexact-monotonic-milliseconds)
|
||||
started)))
|
||||
target)))
|
||||
|
||||
;;; Selects the stable cache key carried by a playback command.
|
||||
;;; Scopes media identity to its server, source path, size and modification time.
|
||||
;;; Older servers without version metadata only reuse the same media token.
|
||||
(define (command-cache-key data)
|
||||
(hash-ref data 'cacheKey (hash-ref data 'mediaToken)))
|
||||
(list server-url
|
||||
(hash-ref data 'cacheKey (hash-ref data 'mediaToken))
|
||||
(hash-ref data 'mediaSize #f)
|
||||
(hash-ref data 'mediaModified (hash-ref data 'mediaToken))))
|
||||
|
||||
;;; Returns cached media or downloads and records it when absent.
|
||||
(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
|
||||
(found (with-agent-state
|
||||
(λ ()
|
||||
(set! loading-media-key key)
|
||||
(hash-ref cached-media key #f)))))
|
||||
(if (and found (file-exists? (car found))
|
||||
(= (file-size (car found)) (cadr found)))
|
||||
(begin
|
||||
(info-player-agent "Cache hit: ~a" (hash-ref data 'filename "track"))
|
||||
(with-agent-state
|
||||
(λ ()
|
||||
(hash-set! cached-media key
|
||||
(list (car found) (cadr found)
|
||||
(current-inexact-monotonic-milliseconds)))))
|
||||
(car found))
|
||||
(let ((downloaded
|
||||
(download-media!
|
||||
(hash-ref data 'mediaToken)
|
||||
(hash-ref data 'filename "track"))))
|
||||
(hash-set! cached-media key downloaded)
|
||||
(when (and (hash-has-key? data 'mediaSize)
|
||||
(not (= (file-size downloaded)
|
||||
(hash-ref data 'mediaSize))))
|
||||
(safe-delete-file downloaded)
|
||||
(error 'player-agent "Downloaded media size does not match the server"))
|
||||
(with-agent-state
|
||||
(λ ()
|
||||
(when found (safe-delete-file (car found)))
|
||||
(hash-set! cached-media key
|
||||
(list downloaded (file-size downloaded)
|
||||
(current-inexact-monotonic-milliseconds)))))
|
||||
downloaded))))
|
||||
|
||||
;;; Removes every cached media file except the entry identified by keep-key.
|
||||
(define (discard-unused-media! keep-key)
|
||||
(let loop ((remaining (hash->list cached-media)))
|
||||
(unless (null? remaining)
|
||||
(let ((entry (car remaining)))
|
||||
(unless (equal? (car entry) keep-key)
|
||||
(safe-delete-file (cdr entry))
|
||||
(hash-remove! cached-media (car entry))))
|
||||
(loop (cdr remaining)))))
|
||||
;;; Bounds retained media while protecting the current and prepared tracks.
|
||||
;;; The caller holds state-lock so decoder callbacks cannot race eviction.
|
||||
(define (trim-cache!)
|
||||
(trim-media-cache!
|
||||
cached-media
|
||||
(list current-media-key
|
||||
loading-media-key
|
||||
queued-media-key
|
||||
(and prefetched-track (command-cache-key (car prefetched-track))))))
|
||||
|
||||
;;; Continues with prefetched media when the current decoder reaches EOF.
|
||||
;;; Decoder EOF precedes audible EOF, so audio-play! queues behind the buffer.
|
||||
@@ -274,6 +330,8 @@
|
||||
(with-agent-state
|
||||
(λ ()
|
||||
(let ((value prefetched-track))
|
||||
(when value
|
||||
(set! queued-media-key (command-cache-key (car value))))
|
||||
(set! prefetched-track #f)
|
||||
value)))))
|
||||
(cond
|
||||
@@ -288,15 +346,19 @@
|
||||
(exn-message exception))
|
||||
(set-agent-error! (exn-message exception))
|
||||
(with-agent-state
|
||||
(λ () (set! ended-counter (+ ended-counter 1)))))))
|
||||
(λ ()
|
||||
(set! queued-media-key #f)
|
||||
(trim-cache!)
|
||||
(set! ended-counter (+ ended-counter 1)))))))
|
||||
(let ((music-id (audio-play! handle path)))
|
||||
(info-player-agent "Queued prefetched track ~a as music id ~a"
|
||||
(hash-ref data 'filename "track")
|
||||
music-id)
|
||||
(set! current-media-key key)
|
||||
(discard-unused-media! key)
|
||||
(with-agent-state
|
||||
(λ ()
|
||||
(set! current-media-key key)
|
||||
(set! queued-media-key #f)
|
||||
(trim-cache!)
|
||||
(hash-set! music-tracks music-id data)
|
||||
(set! auto-started-key key)
|
||||
(set! pending-auto-music-id music-id)))))))
|
||||
@@ -311,7 +373,8 @@
|
||||
(define (execute-command! command)
|
||||
(let ((action (hash-ref command 'action ""))
|
||||
(data (hash-ref command 'data (hasheq))))
|
||||
(info-player-agent "Executing command ~a" action)
|
||||
(info-player-agent "Executing command ~a: ~a"
|
||||
(hash-ref command 'id) action)
|
||||
(cond
|
||||
((string=? action "play")
|
||||
(let* ((next-key (command-cache-key data))
|
||||
@@ -337,29 +400,30 @@
|
||||
(hash-set agent-state 'state "starting")
|
||||
'error 'null))))
|
||||
(let* ((next-media (ensure-media-cached! data))
|
||||
(handle (ensure-audio!))
|
||||
(started (current-inexact-monotonic-milliseconds))
|
||||
;; audio-play! interrupts and closes the previous decoder.
|
||||
(music-id (audio-play! (ensure-audio!) next-media)))
|
||||
(music-id (audio-play! handle next-media)))
|
||||
(info-player-agent "Audio accepted ~a as music id ~a in ~a ms"
|
||||
(hash-ref data 'filename "track") music-id
|
||||
(round (- (current-inexact-monotonic-milliseconds)
|
||||
started)))
|
||||
(with-agent-state
|
||||
(λ ()
|
||||
(hash-clear! music-tracks)
|
||||
(hash-set! music-tracks music-id data)))
|
||||
(set! current-media-key next-key)
|
||||
(discard-unused-media! next-key)))))
|
||||
(hash-set! music-tracks music-id data)
|
||||
(set! current-media-key next-key)
|
||||
(set! loading-media-key #f)
|
||||
(trim-cache!)))))))
|
||||
((string=? action "prefetch")
|
||||
(let ((key (command-cache-key data))
|
||||
(path (ensure-media-cached! data)))
|
||||
(let ((path (ensure-media-cached! data)))
|
||||
(with-agent-state
|
||||
(λ () (set! prefetched-track (cons data path))))
|
||||
(λ ()
|
||||
(set! prefetched-track (cons data path))
|
||||
(set! loading-media-key #f)
|
||||
(trim-cache!)))
|
||||
(info-player-agent "Prefetched ~a"
|
||||
(hash-ref data 'filename "track"))
|
||||
(let loop ((remaining (hash->list cached-media)))
|
||||
(unless (null? remaining)
|
||||
(let ((entry (car remaining)))
|
||||
(unless (or (equal? (car entry) current-media-key)
|
||||
(equal? (car entry) key))
|
||||
(safe-delete-file (cdr entry))
|
||||
(hash-remove! cached-media (car entry))))
|
||||
(loop (cdr remaining))))))
|
||||
(hash-ref data 'filename "track"))))
|
||||
((string=? action "pause")
|
||||
(audio-pause! (ensure-audio!) #t))
|
||||
((string=? action "resume")
|
||||
@@ -371,7 +435,11 @@
|
||||
(set! auto-started-key #f)
|
||||
(set! pending-auto-music-id #f)))
|
||||
(when audio
|
||||
(audio-stop! audio)))
|
||||
(audio-stop! audio))
|
||||
(with-agent-state
|
||||
(λ ()
|
||||
(set! current-media-key #f)
|
||||
(trim-cache!))))
|
||||
((string=? action "seek")
|
||||
(audio-seek! (ensure-audio!) (hash-ref data 'percentage 0)))
|
||||
((string=? action "volume")
|
||||
@@ -444,6 +512,10 @@
|
||||
(λ (exception)
|
||||
(warn-player-agent "Command failed: ~a"
|
||||
(exn-message exception))
|
||||
(with-agent-state
|
||||
(λ ()
|
||||
(set! loading-media-key #f)
|
||||
(trim-cache!)))
|
||||
(set-agent-error! (exn-message exception)))))
|
||||
(clear-agent-error!)
|
||||
(execute-command! command))
|
||||
@@ -488,7 +560,7 @@
|
||||
(set! audio #f))
|
||||
(let loop ((paths (hash-values cached-media)))
|
||||
(unless (null? paths)
|
||||
(safe-delete-file (car paths))
|
||||
(safe-delete-file (caar paths))
|
||||
(loop (cdr paths))))
|
||||
(hash-clear! cached-media))
|
||||
|
||||
@@ -511,6 +583,36 @@
|
||||
(check-equal? (normal-state 'transitioning) "starting")
|
||||
(check-equal? (normal-state 'playing) "playing")
|
||||
|
||||
(let ((directory (make-temporary-file "agent-cache-test-~a" 'directory))
|
||||
(cache (make-hash)))
|
||||
(dynamic-wind
|
||||
void
|
||||
(λ ()
|
||||
(for-each
|
||||
(λ (key age)
|
||||
(let ((path (build-path directory (symbol->string key))))
|
||||
(display-to-file "1234" path)
|
||||
(hash-set! cache key (list path 4 age))))
|
||||
'(old recent current prepared)
|
||||
'(1 4 2 3))
|
||||
;; Entries below the budget survive track changes.
|
||||
(trim-media-cache! cache '(current prepared) 16)
|
||||
(check-equal? (hash-count cache) 4)
|
||||
;; Eviction follows last use, not insertion or playback order.
|
||||
(trim-media-cache! cache '(current prepared) 12)
|
||||
(check-false (hash-has-key? cache 'old))
|
||||
(check-false (file-exists? (build-path directory "old")))
|
||||
(check-true (hash-has-key? cache 'recent))
|
||||
;; Active files survive even when they exceed the entire budget.
|
||||
(trim-media-cache! cache '(current prepared) 4)
|
||||
(check-equal? (hash-count cache) 2)
|
||||
(check-true (file-exists? (build-path directory "current")))
|
||||
(check-true (file-exists? (build-path directory "prepared")))
|
||||
;; Releasing active files lets the cache return to its limit.
|
||||
(trim-media-cache! cache '() 4)
|
||||
(check-equal? (hash-keys cache) '(prepared)))
|
||||
(λ () (delete-directory/files directory))))
|
||||
|
||||
(let* ((app-id (make-string 64 #\a))
|
||||
(runtime
|
||||
(make-player-agent-runtime "http://127.0.0.1:1234"
|
||||
|
||||
@@ -85,8 +85,8 @@
|
||||
; Playback and polling remain in player-agent-core.rkt. racket-tray
|
||||
; owns native tray resources and the portable minimize watcher.
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
(define/contract (run-player-agent-gui)
|
||||
(-> (is-a?/c frame%))
|
||||
(define/contract (run-player-agent-gui* exit-callback)
|
||||
(-> procedure? void?)
|
||||
(sl-log-to-file log-file)
|
||||
(let ((config (load-player-agent-config))
|
||||
(frame #f)
|
||||
@@ -98,9 +98,11 @@
|
||||
(name-field #f)
|
||||
(server-field #f)
|
||||
(connect-button #f)
|
||||
(quit-button #f)
|
||||
(playback-timer #f)
|
||||
(tray #f)
|
||||
(shutting-down? #f))
|
||||
(shutting-down? #f)
|
||||
)
|
||||
|
||||
(define (cap200 msg)
|
||||
(substring msg 0 (min 199 (string-length msg))))
|
||||
@@ -272,7 +274,8 @@
|
||||
((player-agent-runtime-shutdown! runtime))
|
||||
(when tray
|
||||
(tray-close tray)
|
||||
(set! tray #f))))
|
||||
(set! tray #f)))
|
||||
)
|
||||
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
; goal : Terminate the graphical agent from its tray menu.
|
||||
@@ -285,7 +288,9 @@
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
(define (quit!)
|
||||
(shutdown!)
|
||||
(send frame show #f))
|
||||
(send frame show #f)
|
||||
(exit-callback)
|
||||
)
|
||||
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
; goal : Restore the agent frame from the tray.
|
||||
@@ -380,6 +385,11 @@
|
||||
(parent playback-panel)
|
||||
(label "—")
|
||||
[ellipsis 'right] [auto-resize #t] [stretchable-width #t]))
|
||||
(set! quit-button
|
||||
(new button%
|
||||
(parent controls)
|
||||
(label (tr 'quit))
|
||||
(callback (λ (_button _event) (quit!)))))
|
||||
(set! connect-button
|
||||
(new button%
|
||||
(parent controls)
|
||||
@@ -411,8 +421,22 @@
|
||||
|
||||
(send frame show #t)
|
||||
((player-agent-runtime-start! runtime))
|
||||
|
||||
(send connect-button set-label (cap200 (tr 'reconnect)))
|
||||
frame))
|
||||
|
||||
(void)))
|
||||
|
||||
|
||||
(define (run-player-agent-gui)
|
||||
(let ((quit-semaphore (make-semaphore 0)))
|
||||
|
||||
(run-player-agent-gui*
|
||||
(λ ()
|
||||
(semaphore-post quit-semaphore)))
|
||||
|
||||
(yield quit-semaphore)
|
||||
|
||||
(void)))
|
||||
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
;; Tests for module library.rkt
|
||||
|
||||
Reference in New Issue
Block a user