273 lines
8.6 KiB
Racket
273 lines
8.6 KiB
Racket
#lang racket/base
|
|
|
|
(require racket/class
|
|
racket/format
|
|
racket/gui/base
|
|
racket/os
|
|
racket/path
|
|
racket/string
|
|
simple-log
|
|
"player-agent-config.rkt"
|
|
"player-agent-core.rkt"
|
|
"player-agent-tray.rkt")
|
|
|
|
(provide run-player-agent-gui)
|
|
|
|
(sl-def-log player-agent-gui)
|
|
|
|
(define log-file
|
|
(build-path (find-system-path 'pref-dir)
|
|
"rkt-web-player-agent.log"))
|
|
|
|
(define (input-field label init-value panel)
|
|
(define field
|
|
(new text-field%
|
|
(parent panel)
|
|
(label label)
|
|
(init-value init-value)))
|
|
(send (send field get-editor) set-padding 0 2 0 2)
|
|
field)
|
|
|
|
(define (format-time value)
|
|
(define seconds
|
|
(if (and (number? value) (>= value 0))
|
|
(inexact->exact (floor value))
|
|
0))
|
|
(define hours (quotient seconds 3600))
|
|
(define minutes (quotient (remainder seconds 3600) 60))
|
|
(define remaining (remainder seconds 60))
|
|
(format "~a:~a:~a"
|
|
(~r hours #:min-width 2 #:pad-string "0")
|
|
(~r minutes #:min-width 2 #:pad-string "0")
|
|
(~r remaining #:min-width 2 #:pad-string "0")))
|
|
|
|
(define (run-player-agent-gui)
|
|
(sl-log-to-file log-file)
|
|
|
|
(define config (load-player-agent-config))
|
|
(define frame #f)
|
|
(define runtime #f)
|
|
(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 playback-timer #f)
|
|
(define tray-timer #f)
|
|
(define tray #f)
|
|
(define shutting-down? #f)
|
|
|
|
(define (show-status! message)
|
|
(queue-callback
|
|
(lambda ()
|
|
(when status-message
|
|
(send status-message set-label message)))
|
|
#f))
|
|
|
|
(define (show-denial! message)
|
|
(queue-callback
|
|
(lambda ()
|
|
(message-box "Playback agent niet toegestaan"
|
|
message
|
|
frame
|
|
'(ok stop)))
|
|
#f))
|
|
|
|
(set! runtime
|
|
(make-player-agent-runtime
|
|
(player-agent-config-server-url config)
|
|
(player-agent-config-name config)
|
|
(player-agent-config-app-id config)
|
|
#:status-callback show-status!
|
|
#:denied-callback show-denial!))
|
|
|
|
(define (refresh-playback-status!)
|
|
(when (and playback-message playback-details playback-filename)
|
|
(define snapshot ((player-agent-runtime-snapshot runtime)))
|
|
(define track ((player-agent-runtime-current-track runtime)))
|
|
(define state (hash-ref snapshot 'state "stopped"))
|
|
(define title (and track (hash-ref track 'title #f)))
|
|
(define artist (and track (hash-ref track 'artist #f)))
|
|
(define filename (and track (hash-ref track 'filename #f)))
|
|
(define track-number (and track (hash-ref track 'trackNumber #f)))
|
|
(define track-label
|
|
(cond
|
|
((and artist (not (string=? artist "")) title)
|
|
(format "~a — ~a" artist title))
|
|
(title title)
|
|
(else "Geen track geselecteerd")))
|
|
(define prefix
|
|
(cond
|
|
((string=? state "playing") "Speelt")
|
|
((string=? state "paused") "Gepauzeerd")
|
|
((string=? state "starting") "Laden")
|
|
((string=? state "stopped") "Gestopt")
|
|
(else state)))
|
|
(define position (hash-ref snapshot 'position 0))
|
|
(define duration (hash-ref snapshot 'duration 'null))
|
|
(define format-name (hash-ref snapshot 'format ""))
|
|
(define rate (hash-ref snapshot 'rate 'null))
|
|
(define bits (hash-ref snapshot 'bits 'null))
|
|
(define channels (hash-ref snapshot 'channels 'null))
|
|
(define details
|
|
(filter
|
|
(lambda (value) (not (string=? value "")))
|
|
(list
|
|
(format "~a / ~a"
|
|
(format-time position)
|
|
(if (number? duration) (format-time duration) "--:--:--"))
|
|
(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 track
|
|
(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-filename
|
|
set-label
|
|
(if (and (string? filename) (not (string=? filename "")))
|
|
filename
|
|
"—"))))
|
|
|
|
(define (reconnect!)
|
|
(define next-server (string-trim (send server-field get-value)))
|
|
(define entered-name (string-trim (send name-field get-value)))
|
|
(define next-name
|
|
(if (string=? entered-name "")
|
|
(format "~a playback" (gethostname))
|
|
entered-name))
|
|
(set! config
|
|
(struct-copy player-agent-config config
|
|
(server-url next-server)
|
|
(name next-name)))
|
|
(save-player-agent-config! config)
|
|
(send name-field set-value next-name)
|
|
((player-agent-runtime-reconnect! runtime) next-server next-name)
|
|
(send connect-button set-label "Opnieuw verbinden"))
|
|
|
|
(define (shutdown!)
|
|
(unless shutting-down?
|
|
(set! shutting-down? #t)
|
|
(when playback-timer (send playback-timer stop))
|
|
(when tray-timer (send tray-timer stop))
|
|
((player-agent-runtime-shutdown! runtime))
|
|
(when tray
|
|
((tray-controller-destroy! tray))
|
|
(set! tray #f))))
|
|
|
|
(define (quit!)
|
|
(queue-callback
|
|
(lambda ()
|
|
(shutdown!)
|
|
(when frame (send frame show #f)))
|
|
#f))
|
|
|
|
(define agent-frame%
|
|
(class frame%
|
|
(super-new)
|
|
(define/augment (on-close)
|
|
(if tray
|
|
(send this show #f)
|
|
(begin
|
|
(shutdown!)
|
|
(inner (void) on-close))))))
|
|
|
|
(set! frame
|
|
(new agent-frame%
|
|
(label "RKT Web Player Agent")
|
|
(width 560)
|
|
(height 310)))
|
|
(define panel
|
|
(new vertical-panel%
|
|
(parent frame)
|
|
(alignment '(left top))))
|
|
(set! server-field
|
|
(input-field "RKT Web Player server"
|
|
(player-agent-config-server-url config)
|
|
panel))
|
|
(set! name-field
|
|
(input-field "Naam" (player-agent-config-name config) panel))
|
|
(define id-field
|
|
(input-field "Applicatie-ID" (player-agent-config-app-id config) panel))
|
|
;; Lock the editor, not the native widget. Disabled Windows controls render
|
|
;; their label and text poorly on some display configurations.
|
|
(send (send id-field get-editor) lock #t)
|
|
|
|
(define playback-panel
|
|
(new group-box-panel%
|
|
(parent panel)
|
|
(label "Afspelen")
|
|
(alignment '(left top))
|
|
(stretchable-height #f)))
|
|
(set! playback-message
|
|
(new message%
|
|
(parent playback-panel)
|
|
(label "Er wordt niets afgespeeld")
|
|
(auto-resize #t)))
|
|
(set! playback-details
|
|
(new message%
|
|
(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%
|
|
(parent panel)
|
|
(alignment '(left center))))
|
|
(set! connect-button
|
|
(new button%
|
|
(parent controls)
|
|
(label "Opslaan en verbinden")
|
|
(callback (lambda (_button _event) (reconnect!)))))
|
|
(set! status-message
|
|
(new message%
|
|
(parent controls)
|
|
(label "Verbinden…")
|
|
(auto-resize #t)))
|
|
|
|
(set! playback-timer
|
|
(new timer%
|
|
(notify-callback refresh-playback-status!)
|
|
(interval 500)))
|
|
(refresh-playback-status!)
|
|
|
|
;; If SDL3 and its native runtime are present, closing the frame hides it in
|
|
;; the tray. Otherwise the original close-and-exit behaviour remains.
|
|
(set! tray
|
|
(try-make-tray-controller
|
|
(lambda ()
|
|
(queue-callback (lambda () (send frame show #t)) #f))
|
|
quit!))
|
|
(when tray
|
|
(set! tray-timer
|
|
(new timer%
|
|
(notify-callback (tray-controller-update! tray))
|
|
(interval 100))))
|
|
|
|
(send frame show #t)
|
|
((player-agent-runtime-start! runtime))
|
|
(send connect-button set-label "Opnieuw verbinden")
|
|
frame)
|