DLNA playback

This commit is contained in:
2026-07-31 17:03:19 +02:00
parent 727e0643af
commit e54f6f4a5f
7 changed files with 1325 additions and 6 deletions
+89 -4
View File
@@ -11,8 +11,10 @@
"translate.rkt"
"playlist.rkt"
"player.rkt"
"dlna-player.rkt"
"settings.rkt"
"libraries.rkt"
"dlna.rkt"
)
(provide
@@ -24,14 +26,29 @@
(define player-menu
(λ ()
(λ (renderers connector)
(wv-menu 'main-menu
(wv-menu-item 'm-file (tr 'file)
#:submenu (wv-menu 'file-menu
(wv-menu-item 'm-select-library-dir (tr 'select-library-dir))
(wv-menu-item 'm-settings (tr 'settings))
(wv-menu-item 'm-quit (tr 'quit) #:separator #t)
)
))
(wv-menu-item 'm-players (tr 'players)
#:submenu (apply wv-menu
(append
(list 'dlna-menu
(wv-menu-item 'm-play-local (tr 'play-local))
(wv-menu-item 'm-check-dlna (tr 'check-dlna)))
(let ((rndr-idx 0))
(map (λ (r)
(let* ((idx rndr-idx)
(id (string->symbol
(format "m-renderer-~a" idx))))
(set! rndr-idx (+ rndr-idx 1))
(connector id idx)
(wv-menu-item id (car r) #:separator (= idx 0))))
renderers))))
)
)))
@@ -61,6 +78,7 @@
(define el-format #f)
(define el-channels #f)
(define el-bits #f)
(define el-message #f)
(define cfg (send settings clone 'settings))
(define current-tab 0)
@@ -121,6 +139,18 @@
)
)
(define/public (message! msg #:clear [clear #f])
(when (eq? el-message #f)
(set! el-message (send this element 'message)))
(unless (eq? el-message #f)
(send el-message set-innerHTML! msg)
(when clear
(void
(thread (λ ()
(sleep 10)
(send this message! "" #:clear #f)))))
))
(define current-track-nr #f)
(define (update-track-nr nr)
@@ -346,7 +376,14 @@
)
)
(define player (new player%
(define player #f)
(define dlna-renderers '())
(define/public (play-local)
(unless (eq? player #f)
(send player stop)
(send player quit))
(set! player (new player%
[time-updater update-time]
[track-nr-updater update-track-nr]
[state-updater update-state]
@@ -354,6 +391,49 @@
[audio-info-cb update-audio-info]
[settings settings]
))
(unless (eq? playlist #f)
(send player playlist! playlist))
)
(define/public (play-to-dlna renderer-idx)
(let* ((entry (list-ref dlna-renderers renderer-idx))
(renderer (cadr entry)))
(unless (eq? player #f)
(send player stop)
(send player quit))
(set! player
(new dlna-player%
[renderer renderer]
[time-updater update-time]
[track-nr-updater update-track-nr]
[state-updater update-state]
[repeat-updater update-repeat]
[audio-info-cb update-audio-info]
[settings settings]))
(unless (eq? playlist #f)
(send player playlist! playlist))))
(define/public (dlna-query-busy)
(send this message! (tr 'dlna-query-busy) #:clear #t))
(define/public (set-dlna-renderers! renderers)
(set! dlna-renderers renderers)
(send this message! (format (tr 'dlna-renderers-count) (length renderers)) #:clear #t)
(let ((connector-list '()))
(send this set-menu! (player-menu renderers (λ (id idx)
(set! connector-list
(cons
(λ ()
(send this connect-menu! id
(λ ()
(displayln (format "dlna playback: ~a" idx))
(send this play-to-dlna idx))))
connector-list)))))
(for-each (λ (c) (c)) connector-list)
#t))
(define/public (check-dlna)
(check-dlna-players this))
(define inner-html-handlers (make-hash))
@@ -407,11 +487,13 @@
(set! el-channels (send this element 'channels))
(set! el-format (send this element 'format))
(send this set-menu! (player-menu))
(send this set-menu! (player-menu '() (λ (id idx) #t)))
(send this connect-menu! 'm-quit (λ () (send this quit)))
(send this connect-menu! 'm-select-library-dir (λ () (send this select-library)))
(send this connect-menu! 'm-settings (λ () (send this settings-dlg)))
(send this connect-menu! 'm-add-tab (λ () (send this add-tab)))
(send this connect-menu! 'm-play-local (λ () (send this play-local)))
(send this connect-menu! 'm-check-dlna (λ () (send this check-dlna)))
(dbg-rktplayer "page-loaded, playlist = ~a" playlist)
(send this update-tabs)
@@ -664,6 +746,7 @@
(let* ((volume-meter (send this element 'volume-meter))
(volume-display (send volume-meter display))
)
(display "volume-display = ") (write volume-display) (newline)
(if (eq? volume-display 'block)
(send volume-meter display 'none)
(begin
@@ -723,6 +806,8 @@
#f)
(begin
(dbg-rktplayer "Initializing local player")
(play-local)
(dbg-rktplayer "Initalizing gui")
(dbg-rktplayer "ICON: ~a" (get-field icon this))
(let ((lang (send settings get 'lang 'en)))