refactoring volgens skill
This commit is contained in:
+374
-236
@@ -1,15 +1,16 @@
|
||||
#lang racket/base
|
||||
|
||||
(require racket/class
|
||||
racket/contract
|
||||
racket/format
|
||||
racket/gui/base
|
||||
racket/os
|
||||
racket/path
|
||||
racket/runtime-path
|
||||
racket/string
|
||||
racket-tray
|
||||
simple-log
|
||||
"player-agent-config.rkt"
|
||||
"player-agent-core.rkt"
|
||||
"player-agent-tray.rkt"
|
||||
"translate.rkt")
|
||||
|
||||
(provide run-player-agent-gui)
|
||||
@@ -20,256 +21,393 @@
|
||||
(build-path (find-system-path 'pref-dir)
|
||||
"rkt-web-player-agent.log"))
|
||||
|
||||
(define-runtime-path tray-icon
|
||||
"../public/rkt-web-player.png")
|
||||
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
;; Supporting functions
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
; goal : Create a labelled text field with compact editor padding.
|
||||
; pre : label and init-value are strings; panel accepts GUI children.
|
||||
; post : A text field has been added to panel.
|
||||
; result : The newly created text-field% object.
|
||||
; internals:
|
||||
; Padding is set on the editor because it renders consistently on
|
||||
; the supported desktop platforms.
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
(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)
|
||||
(let ((field
|
||||
(new text-field%
|
||||
(parent panel)
|
||||
(label label)
|
||||
(init-value init-value))))
|
||||
(send (send field get-editor) set-padding 0 2 0 2)
|
||||
field))
|
||||
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
; goal : Format a playback position as hours, minutes and seconds.
|
||||
; pre : value is any Racket value.
|
||||
; post : No state is changed.
|
||||
; result : A zero-padded HH:MM:SS string; invalid values are treated as zero.
|
||||
; internals:
|
||||
; Fractional seconds are deliberately rounded down so the displayed
|
||||
; position never runs ahead of the audio runtime.
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
(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")))
|
||||
(let* ((seconds
|
||||
(if (and (number? value) (>= value 0))
|
||||
(inexact->exact (floor value))
|
||||
0))
|
||||
(hours (quotient seconds 3600))
|
||||
(minutes (quotient (remainder seconds 3600) 60))
|
||||
(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)
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
;; Provided functions
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
; goal : Start the graphical polling playback agent.
|
||||
; pre : A graphical desktop and the platform support required by
|
||||
; racket-tray are available.
|
||||
; post : The agent runtime is started, its frame and tray icon are visible,
|
||||
; and closing or minimizing the frame hides it in the system tray.
|
||||
; result : The live frame% object belonging to the playback agent.
|
||||
; internals:
|
||||
; The GUI owns only widgets, configuration and lifecycle callbacks.
|
||||
; 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%))
|
||||
(sl-log-to-file log-file)
|
||||
(let ((config (load-player-agent-config))
|
||||
(frame #f)
|
||||
(runtime #f)
|
||||
(status-message #f)
|
||||
(playback-message #f)
|
||||
(playback-details #f)
|
||||
(playback-filename #f)
|
||||
(name-field #f)
|
||||
(server-field #f)
|
||||
(connect-button #f)
|
||||
(playback-timer #f)
|
||||
(tray #f)
|
||||
(shutting-down? #f))
|
||||
|
||||
(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)
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
; goal : Queue a status-label update in the GUI eventspace.
|
||||
; pre : message is a string supplied by the agent runtime.
|
||||
; post : The status widget shows message when it has been created.
|
||||
; result : Unspecified.
|
||||
; internals:
|
||||
; Runtime callbacks can originate outside the GUI eventspace, so
|
||||
; widget access is always forwarded with queue-callback.
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
(define (show-status! message)
|
||||
(queue-callback
|
||||
(λ ()
|
||||
(when status-message
|
||||
(send status-message set-label message)))
|
||||
#f))
|
||||
|
||||
(define (show-status! message)
|
||||
(queue-callback
|
||||
(lambda ()
|
||||
(when status-message
|
||||
(send status-message set-label message)))
|
||||
#f))
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
; goal : Show a playback-agent authorization failure.
|
||||
; pre : message is a string supplied by the agent runtime.
|
||||
; post : A modal error dialog is queued for the agent frame.
|
||||
; result : Unspecified.
|
||||
; internals:
|
||||
; The callback is eventspace-safe for the same reason as the
|
||||
; status callback above.
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
(define (show-denial! message)
|
||||
(queue-callback
|
||||
(λ ()
|
||||
(message-box (tr 'denied-title)
|
||||
message
|
||||
frame
|
||||
'(ok stop)))
|
||||
#f))
|
||||
|
||||
(define (show-denial! message)
|
||||
(queue-callback
|
||||
(lambda ()
|
||||
(message-box (tr 'denied-title)
|
||||
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!))
|
||||
|
||||
(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!))
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
; goal : Refresh the visible playback summary from the runtime cache.
|
||||
; pre : runtime exists; the widgets may still be uninitialized.
|
||||
; post : Initialized playback widgets reflect one coherent cached
|
||||
; snapshot and its current track.
|
||||
; result : Unspecified.
|
||||
; internals:
|
||||
; This procedure never performs network I/O. The timer reads only
|
||||
; the cache maintained by player-agent-core.rkt.
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
(define (refresh-playback-status!)
|
||||
(when (and playback-message playback-details playback-filename)
|
||||
(let* ((snapshot ((player-agent-runtime-snapshot runtime)))
|
||||
(track ((player-agent-runtime-current-track runtime)))
|
||||
(state (hash-ref snapshot 'state "stopped"))
|
||||
(title (and track (hash-ref track 'title #f)))
|
||||
(artist (and track (hash-ref track 'artist #f)))
|
||||
(filename (and track (hash-ref track 'filename #f)))
|
||||
(track-number (and track (hash-ref track 'trackNumber #f)))
|
||||
(track-label
|
||||
(cond
|
||||
((and artist (not (string=? artist "")) title)
|
||||
(format "~a — ~a" artist title))
|
||||
(title title)
|
||||
(else (tr 'no-track-selected))))
|
||||
(prefix
|
||||
(cond
|
||||
((string=? state "playing") (tr 'playing))
|
||||
((string=? state "paused") (tr 'paused))
|
||||
((string=? state "starting") (tr 'loading))
|
||||
((string=? state "stopped") (tr 'stopped))
|
||||
(else state)))
|
||||
(position (hash-ref snapshot 'position 0))
|
||||
(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 "")))
|
||||
(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
|
||||
(tr (if (= channels 1) 'channel 'channels)))
|
||||
"")
|
||||
(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)
|
||||
(tr 'no-track)))
|
||||
(send playback-details set-label (string-join details " · "))
|
||||
(send playback-filename
|
||||
set-label
|
||||
(if (and (string? filename)
|
||||
(not (string=? filename "")))
|
||||
filename
|
||||
"—")))))
|
||||
|
||||
(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 (tr 'no-track-selected))))
|
||||
(define prefix
|
||||
(cond
|
||||
((string=? state "playing") (tr 'playing))
|
||||
((string=? state "paused") (tr 'paused))
|
||||
((string=? state "starting") (tr 'loading))
|
||||
((string=? state "stopped") (tr 'stopped))
|
||||
(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
|
||||
(tr (if (= channels 1) 'channel 'channels)))
|
||||
"")
|
||||
(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)
|
||||
(tr 'no-track)))
|
||||
(send playback-details set-label (string-join details " · "))
|
||||
(send playback-filename
|
||||
set-label
|
||||
(if (and (string? filename) (not (string=? filename "")))
|
||||
filename
|
||||
"—"))))
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
; goal : Persist edited connection settings and reconnect the runtime.
|
||||
; pre : The name, server and connect widgets have been initialized.
|
||||
; post : config and the INI file contain normalized values; the runtime
|
||||
; reconnects with them and the button becomes a reconnect button.
|
||||
; result : Unspecified.
|
||||
; internals:
|
||||
; An empty name receives the same hostname-based default used by
|
||||
; initial configuration loading.
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
(define (reconnect!)
|
||||
(let* ((next-server (string-trim (send server-field get-value)))
|
||||
(entered-name (string-trim (send name-field get-value)))
|
||||
(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 (tr 'reconnect))))
|
||||
|
||||
(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 (tr 'reconnect)))
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
; goal : Release resources owned by the GUI agent exactly once.
|
||||
; pre : runtime has been created; timer and tray may be #f.
|
||||
; post : Playback polling, audio, the GUI timer and native tray resources
|
||||
; have stopped; subsequent calls do nothing.
|
||||
; result : Unspecified.
|
||||
; internals:
|
||||
; The guard makes this procedure safe from both the window close
|
||||
; path and the tray Exit action.
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
(define (shutdown!)
|
||||
(unless shutting-down?
|
||||
(set! shutting-down? #t)
|
||||
(when playback-timer
|
||||
(send playback-timer stop))
|
||||
((player-agent-runtime-shutdown! runtime))
|
||||
(when tray
|
||||
(tray-close tray)
|
||||
(set! tray #f))))
|
||||
|
||||
(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))))
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
; goal : Terminate the graphical agent from its tray menu.
|
||||
; pre : frame and runtime have been initialized.
|
||||
; post : Resources are released and the frame is hidden.
|
||||
; result : Unspecified.
|
||||
; internals:
|
||||
; racket-tray invokes actions in the frame eventspace, so no
|
||||
; additional GUI callback queue is needed here.
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
(define (quit!)
|
||||
(shutdown!)
|
||||
(send frame show #f))
|
||||
|
||||
(define (quit!)
|
||||
(queue-callback
|
||||
(lambda ()
|
||||
(shutdown!)
|
||||
(when frame (send frame show #f)))
|
||||
#f))
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
; goal : Restore the agent frame from the tray.
|
||||
; pre : frame has been initialized and has not been destroyed.
|
||||
; post : frame is visible and no longer iconized.
|
||||
; result : Unspecified.
|
||||
; internals:
|
||||
; De-iconizing is needed because racket-tray hides minimized
|
||||
; frames instead of changing their iconized state.
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
(define (show-window!)
|
||||
(send frame show #t)
|
||||
(when (send frame is-iconized?)
|
||||
(send frame iconize #f)))
|
||||
|
||||
(define agent-frame%
|
||||
(class frame%
|
||||
(super-new)
|
||||
(define/augment (on-close)
|
||||
(if tray
|
||||
(send this show #f)
|
||||
(begin
|
||||
(shutdown!)
|
||||
(inner (void) on-close))))))
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
; goal : Dispatch a symbolic racket-tray action.
|
||||
; pre : action is installed in the tray menu below.
|
||||
; post : 'open restores the frame; 'exit shuts down the agent.
|
||||
; result : Unspecified.
|
||||
; internals:
|
||||
; One callback handles both direct tray activation and menu
|
||||
; selection on every platform.
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
(define (tray-action! action)
|
||||
(case action
|
||||
((open) (show-window!))
|
||||
((exit) (quit!))))
|
||||
|
||||
(set! frame
|
||||
(new agent-frame%
|
||||
(label (tr 'app-title))
|
||||
(width 560)
|
||||
(height 310)))
|
||||
(define panel
|
||||
(new vertical-panel%
|
||||
(parent frame)
|
||||
(alignment '(left top))))
|
||||
(set! server-field
|
||||
(input-field (tr 'server)
|
||||
(player-agent-config-server-url config)
|
||||
panel))
|
||||
(set! name-field
|
||||
(input-field (tr 'name) (player-agent-config-name config) panel))
|
||||
(define id-field
|
||||
(input-field (tr 'application-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)
|
||||
(let* ((agent-frame%
|
||||
(class frame%
|
||||
(super-new)
|
||||
(define/augment (on-close)
|
||||
(if tray
|
||||
(send this show #f)
|
||||
(begin
|
||||
(shutdown!)
|
||||
(inner (void) on-close))))))
|
||||
(new-frame
|
||||
(new agent-frame%
|
||||
(label (tr 'app-title))
|
||||
(width 560)
|
||||
(height 310))))
|
||||
(set! frame new-frame))
|
||||
|
||||
(define playback-panel
|
||||
(new group-box-panel%
|
||||
(parent panel)
|
||||
(label (tr 'playback))
|
||||
(alignment '(left top))
|
||||
(stretchable-height #f)))
|
||||
(set! playback-message
|
||||
(new message%
|
||||
(parent playback-panel)
|
||||
(label (tr 'no-track))
|
||||
(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)))
|
||||
(let* ((panel
|
||||
(new vertical-panel%
|
||||
(parent frame)
|
||||
(alignment '(left top))))
|
||||
(server
|
||||
(input-field (tr 'server)
|
||||
(player-agent-config-server-url config)
|
||||
panel))
|
||||
(name
|
||||
(input-field (tr 'name)
|
||||
(player-agent-config-name config)
|
||||
panel))
|
||||
(id-field
|
||||
(input-field (tr 'application-id)
|
||||
(player-agent-config-app-id config)
|
||||
panel))
|
||||
(playback-panel
|
||||
(new group-box-panel%
|
||||
(parent panel)
|
||||
(label (tr 'playback))
|
||||
(alignment '(left top))
|
||||
(stretchable-height #f)))
|
||||
(controls
|
||||
(new horizontal-panel%
|
||||
(parent panel)
|
||||
(alignment '(left center)))))
|
||||
(set! server-field server)
|
||||
(set! name-field name)
|
||||
;; 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)
|
||||
(set! playback-message
|
||||
(new message%
|
||||
(parent playback-panel)
|
||||
(label (tr 'no-track))
|
||||
(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)))
|
||||
(set! connect-button
|
||||
(new button%
|
||||
(parent controls)
|
||||
(label (tr 'save-connect))
|
||||
(callback (λ (_button _event) (reconnect!)))))
|
||||
(set! status-message
|
||||
(new message%
|
||||
(parent controls)
|
||||
(label (tr 'connecting))
|
||||
(auto-resize #t))))
|
||||
|
||||
(define controls
|
||||
(new horizontal-panel%
|
||||
(parent panel)
|
||||
(alignment '(left center))))
|
||||
(set! connect-button
|
||||
(new button%
|
||||
(parent controls)
|
||||
(label (tr 'save-connect))
|
||||
(callback (lambda (_button _event) (reconnect!)))))
|
||||
(set! status-message
|
||||
(new message%
|
||||
(parent controls)
|
||||
(label (tr 'connecting))
|
||||
(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
|
||||
(set! playback-timer
|
||||
(new timer%
|
||||
(notify-callback (tray-controller-update! tray))
|
||||
(interval 100))))
|
||||
(notify-callback refresh-playback-status!)
|
||||
(interval 500)))
|
||||
(refresh-playback-status!)
|
||||
|
||||
(send frame show #t)
|
||||
((player-agent-runtime-start! runtime))
|
||||
(send connect-button set-label (tr 'reconnect))
|
||||
frame)
|
||||
(set! tray
|
||||
(mk-tray frame
|
||||
tray-icon
|
||||
(list tray-action! 'open)
|
||||
#:hide-on-minimize? #t))
|
||||
(tray-set-menu!
|
||||
tray
|
||||
(list
|
||||
(list 'open (tr 'tray-open))
|
||||
'separator
|
||||
(list 'exit (tr 'quit))))
|
||||
|
||||
(send frame show #t)
|
||||
((player-agent-runtime-start! runtime))
|
||||
(send connect-button set-label (tr 'reconnect))
|
||||
frame))
|
||||
|
||||
(module+ test
|
||||
(require rackunit)
|
||||
|
||||
;; The runtime path must remain valid after package installation; relying on
|
||||
;; the development working directory would make the tray fail elsewhere.
|
||||
(check-true (file-exists? tray-icon)))
|
||||
|
||||
Reference in New Issue
Block a user