DLNA playback
This commit is contained in:
+373
@@ -0,0 +1,373 @@
|
|||||||
|
#lang racket
|
||||||
|
|
||||||
|
(require racket/class
|
||||||
|
racket/path
|
||||||
|
(prefix-in rad: racket-audio-dlna)
|
||||||
|
"utils.rkt")
|
||||||
|
|
||||||
|
(provide dlna-player%)
|
||||||
|
|
||||||
|
(define dlna-player%
|
||||||
|
(class object%
|
||||||
|
(init-field [renderer #f]
|
||||||
|
[settings #f]
|
||||||
|
[time-updater (lambda (time-s length-s) #t)]
|
||||||
|
[track-nr-updater (lambda (nr) #t)]
|
||||||
|
[state-updater (lambda (state) #t)]
|
||||||
|
[repeat-updater (lambda (state) #t)]
|
||||||
|
[audio-info-cb (lambda (rate channels bits kind) #t)]
|
||||||
|
[buffer-max-seconds 10]
|
||||||
|
[buffer-min-seconds 4]
|
||||||
|
[server-url #f]
|
||||||
|
[server-port 8080]
|
||||||
|
[listen-ip #f]
|
||||||
|
[poll-seconds 1.0]
|
||||||
|
[volume-poll-seconds 5.0])
|
||||||
|
|
||||||
|
(define player #f)
|
||||||
|
(define playlist #f)
|
||||||
|
(define state 'stopped)
|
||||||
|
(define repeat 'no-repeat)
|
||||||
|
(define current-track-nr #f)
|
||||||
|
(define current-uri #f)
|
||||||
|
(define prepared-next-track-nr #f)
|
||||||
|
(define playing-seen? #f)
|
||||||
|
(define stop-requested? #f)
|
||||||
|
(define stopped-polls 0)
|
||||||
|
(define renderer-reachable? #t)
|
||||||
|
(define running #t)
|
||||||
|
(define poll-thread #f)
|
||||||
|
|
||||||
|
(define (check-player)
|
||||||
|
(when (eq? renderer #f)
|
||||||
|
(raise-arguments-error
|
||||||
|
'dlna-player%
|
||||||
|
"no media renderer has been configured"
|
||||||
|
"renderer" renderer))
|
||||||
|
(when (eq? player #f)
|
||||||
|
(unless (eq? server-url #f)
|
||||||
|
(warn-rktplayer
|
||||||
|
"server-url is ignored; racket-audio-dlna determines the server URL"))
|
||||||
|
(set! player
|
||||||
|
(rad:make-dlna-player
|
||||||
|
renderer
|
||||||
|
#:listen-ip listen-ip
|
||||||
|
#:port server-port
|
||||||
|
#:path "/rktplayer/"
|
||||||
|
#:poll-seconds poll-seconds
|
||||||
|
#:volume-poll-seconds volume-poll-seconds))))
|
||||||
|
|
||||||
|
(define (normalize-state st)
|
||||||
|
(cond
|
||||||
|
[(or (eq? st 'playing)
|
||||||
|
(eq? st 'transitioning))
|
||||||
|
'playing]
|
||||||
|
[(eq? st 'paused) 'paused]
|
||||||
|
[(or (eq? st 'stopped)
|
||||||
|
(eq? st 'no-media))
|
||||||
|
'stopped]
|
||||||
|
[else st]))
|
||||||
|
|
||||||
|
(define (set-state! st)
|
||||||
|
(unless (eq? state st)
|
||||||
|
(set! state st)
|
||||||
|
(state-updater state))
|
||||||
|
(repeat-updater repeat)
|
||||||
|
(when (or (eq? state 'stopped)
|
||||||
|
(eq? state 'quit))
|
||||||
|
(audio-info-cb 0 0 0 'none)))
|
||||||
|
|
||||||
|
(define (file-format file)
|
||||||
|
(let ((match
|
||||||
|
(and file
|
||||||
|
(regexp-match
|
||||||
|
#px"(?i:[.]([a-z0-9]+))$"
|
||||||
|
(path->string file)))))
|
||||||
|
(if match
|
||||||
|
(string->symbol (string-downcase (cadr match)))
|
||||||
|
'none)))
|
||||||
|
|
||||||
|
(define (track-audio-info! track)
|
||||||
|
(if track
|
||||||
|
(audio-info-cb
|
||||||
|
(or (rad:dlna-track-info-sample-rate track) 0)
|
||||||
|
(or (rad:dlna-track-info-channels track) 0)
|
||||||
|
0
|
||||||
|
(file-format (rad:dlna-track-info-file track)))
|
||||||
|
(audio-info-cb 0 0 0 'none)))
|
||||||
|
|
||||||
|
(define (normalized-file file)
|
||||||
|
(with-handlers ([exn:fail? (lambda (_) (format "~a" file))])
|
||||||
|
(path->string (path->complete-path file))))
|
||||||
|
|
||||||
|
(define (same-file? file1 file2)
|
||||||
|
(and file1
|
||||||
|
file2
|
||||||
|
((if (eq? (system-type 'os) 'windows)
|
||||||
|
string-ci=?
|
||||||
|
string=?)
|
||||||
|
(normalized-file file1)
|
||||||
|
(normalized-file file2))))
|
||||||
|
|
||||||
|
(define (playlist-track-file nr)
|
||||||
|
(send (send playlist track nr) get-file))
|
||||||
|
|
||||||
|
(define (playlist-track-nr file)
|
||||||
|
(and playlist
|
||||||
|
(for/first ([nr (in-range (send playlist length))]
|
||||||
|
#:when (same-file? file (playlist-track-file nr)))
|
||||||
|
nr)))
|
||||||
|
|
||||||
|
(define (next-track-nr nr)
|
||||||
|
(let ((length (send playlist length)))
|
||||||
|
(cond
|
||||||
|
[(eq? repeat 'repeat-one) nr]
|
||||||
|
[(eq? repeat 'repeat-all)
|
||||||
|
(if (= (+ nr 1) length) 0 (+ nr 1))]
|
||||||
|
[(< (+ nr 1) length) (+ nr 1)]
|
||||||
|
[else #f])))
|
||||||
|
|
||||||
|
(define (prepare-next-track!)
|
||||||
|
(when (and player
|
||||||
|
playlist
|
||||||
|
(exact-nonnegative-integer? current-track-nr))
|
||||||
|
(let ((nr (next-track-nr current-track-nr)))
|
||||||
|
(cond
|
||||||
|
[(eq? nr #f)
|
||||||
|
(set! prepared-next-track-nr #f)]
|
||||||
|
[(not (equal? nr prepared-next-track-nr))
|
||||||
|
(with-handlers
|
||||||
|
([exn:fail?
|
||||||
|
(lambda (e)
|
||||||
|
(set! prepared-next-track-nr #f)
|
||||||
|
(warn-rktplayer
|
||||||
|
"Could not prepare next DLNA track: ~a"
|
||||||
|
(exn-message e)))])
|
||||||
|
(rad:dlna-player-set-next-file!
|
||||||
|
player
|
||||||
|
(playlist-track-file nr))
|
||||||
|
(set! prepared-next-track-nr nr))]))))
|
||||||
|
|
||||||
|
(define (update-current-track! info)
|
||||||
|
(let* ((track (rad:dlna-info-track info))
|
||||||
|
(file (and track (rad:dlna-track-info-file track)))
|
||||||
|
(nr (cond
|
||||||
|
[(and (exact-nonnegative-integer?
|
||||||
|
prepared-next-track-nr)
|
||||||
|
(same-file?
|
||||||
|
file
|
||||||
|
(playlist-track-file prepared-next-track-nr)))
|
||||||
|
prepared-next-track-nr]
|
||||||
|
[else (playlist-track-nr file)])))
|
||||||
|
(when (exact-nonnegative-integer? nr)
|
||||||
|
(set! current-track-nr nr)
|
||||||
|
(set! prepared-next-track-nr #f)
|
||||||
|
(track-nr-updater nr)
|
||||||
|
(track-audio-info! track)
|
||||||
|
(prepare-next-track!))))
|
||||||
|
|
||||||
|
(define (poll-renderer)
|
||||||
|
(when player
|
||||||
|
(let ((info (rad:dlna-player-info player)))
|
||||||
|
(if (not (rad:dlna-info-reachable? info))
|
||||||
|
(when renderer-reachable?
|
||||||
|
(set! renderer-reachable? #f)
|
||||||
|
(warn-rktplayer "DLNA renderer is not reachable"))
|
||||||
|
(let* ((new-state
|
||||||
|
(normalize-state (rad:dlna-info-state info)))
|
||||||
|
(uri (rad:dlna-info-uri info))
|
||||||
|
(position (rad:dlna-info-position info))
|
||||||
|
(duration (rad:dlna-info-duration info)))
|
||||||
|
(unless renderer-reachable?
|
||||||
|
(dbg-rktplayer "DLNA renderer is reachable again"))
|
||||||
|
(set! renderer-reachable? #t)
|
||||||
|
|
||||||
|
(when (and (string? uri)
|
||||||
|
(not (string=? uri ""))
|
||||||
|
(not (equal? uri current-uri)))
|
||||||
|
(set! current-uri uri)
|
||||||
|
(set! stopped-polls 0)
|
||||||
|
(update-current-track! info))
|
||||||
|
|
||||||
|
(when (or (eq? new-state 'playing)
|
||||||
|
(eq? new-state 'paused))
|
||||||
|
(when (and (number? position)
|
||||||
|
(number? duration))
|
||||||
|
(time-updater position duration))
|
||||||
|
(track-audio-info! (rad:dlna-info-track info)))
|
||||||
|
|
||||||
|
(cond
|
||||||
|
[(eq? new-state 'playing)
|
||||||
|
(set! playing-seen? #t)
|
||||||
|
(set! stopped-polls 0)]
|
||||||
|
[(and (eq? new-state 'stopped)
|
||||||
|
stop-requested?)
|
||||||
|
(set! stop-requested? #f)
|
||||||
|
(set! stopped-polls 0)]
|
||||||
|
[(and (eq? new-state 'stopped)
|
||||||
|
playing-seen?)
|
||||||
|
(set! stopped-polls (+ stopped-polls 1))
|
||||||
|
;; Give SetNextAVTransportURI one poll to take over.
|
||||||
|
(when (or (eq? prepared-next-track-nr #f)
|
||||||
|
(> stopped-polls 1))
|
||||||
|
(set! playing-seen? #f)
|
||||||
|
(set! stopped-polls 0)
|
||||||
|
(send this next))])
|
||||||
|
|
||||||
|
(set-state! new-state))))))
|
||||||
|
|
||||||
|
(define (poll)
|
||||||
|
(let loop ()
|
||||||
|
(when running
|
||||||
|
(sleep poll-seconds)
|
||||||
|
(when running
|
||||||
|
(with-handlers
|
||||||
|
([exn:fail?
|
||||||
|
(lambda (e)
|
||||||
|
(warn-rktplayer
|
||||||
|
"Could not update DLNA player state: ~a"
|
||||||
|
(exn-message e)))])
|
||||||
|
(poll-renderer))
|
||||||
|
(loop)))))
|
||||||
|
|
||||||
|
(define/public (change-player kind
|
||||||
|
#:host [host #f]
|
||||||
|
#:basepaths [basepaths #f])
|
||||||
|
(void kind host basepaths)
|
||||||
|
(warn-rktplayer
|
||||||
|
"change-player is not supported by dlna-player%"))
|
||||||
|
|
||||||
|
(define/public (get-volume)
|
||||||
|
(check-player)
|
||||||
|
(or (rad:dlna-info-volume
|
||||||
|
(rad:dlna-player-info player))
|
||||||
|
0))
|
||||||
|
|
||||||
|
(define/public (set-volume! percentage)
|
||||||
|
(check-player)
|
||||||
|
(rad:dlna-player-volume! player percentage))
|
||||||
|
|
||||||
|
(define/public (set-list! playlist*)
|
||||||
|
(when player
|
||||||
|
(with-handlers ([exn:fail? (lambda (_) (void))])
|
||||||
|
(rad:dlna-player-stop! player)))
|
||||||
|
(set! playlist playlist*)
|
||||||
|
(set! current-track-nr #f)
|
||||||
|
(set! current-uri #f)
|
||||||
|
(set! prepared-next-track-nr #f)
|
||||||
|
(set! playing-seen? #f)
|
||||||
|
(set! stop-requested? #f)
|
||||||
|
(set! stopped-polls 0)
|
||||||
|
(set-state! 'stopped))
|
||||||
|
|
||||||
|
(define/public (playlist! playlist*)
|
||||||
|
(check-player)
|
||||||
|
(set-list! playlist*))
|
||||||
|
|
||||||
|
(define/public (play playlist*)
|
||||||
|
(send this playlist! playlist*)
|
||||||
|
(send this play-track 0))
|
||||||
|
|
||||||
|
(define/public (play-track nr)
|
||||||
|
(check-player)
|
||||||
|
(when (and playlist
|
||||||
|
(>= nr 0)
|
||||||
|
(< nr (send playlist length)))
|
||||||
|
(let ((file (playlist-track-file nr)))
|
||||||
|
(rad:dlna-player-play! player file)
|
||||||
|
(let ((info (rad:dlna-player-info player)))
|
||||||
|
(set! current-track-nr nr)
|
||||||
|
(set! current-uri (rad:dlna-info-uri info))
|
||||||
|
(set! prepared-next-track-nr #f)
|
||||||
|
(set! playing-seen? #t)
|
||||||
|
(set! stop-requested? #f)
|
||||||
|
(set! stopped-polls 0)
|
||||||
|
(track-nr-updater nr)
|
||||||
|
(track-audio-info! (rad:dlna-info-track info))
|
||||||
|
(set-state! 'playing)
|
||||||
|
(prepare-next-track!)))))
|
||||||
|
|
||||||
|
(define/public (next)
|
||||||
|
(check-player)
|
||||||
|
(if (eq? current-track-nr #f)
|
||||||
|
(warn-rktplayer
|
||||||
|
"No track-nr set (yet), so can't play anything next")
|
||||||
|
(let ((nr (next-track-nr current-track-nr)))
|
||||||
|
(if (eq? nr #f)
|
||||||
|
(send this stop)
|
||||||
|
(send this play-track nr)))))
|
||||||
|
|
||||||
|
(define/public (previous)
|
||||||
|
(check-player)
|
||||||
|
(if (eq? current-track-nr #f)
|
||||||
|
(warn-rktplayer
|
||||||
|
"No track-nr set (yet), so can't play anything previous")
|
||||||
|
(let ((nr current-track-nr))
|
||||||
|
(cond
|
||||||
|
[(eq? repeat 'repeat-one)
|
||||||
|
(send this play-track nr)]
|
||||||
|
[(eq? repeat 'repeat-all)
|
||||||
|
(send this play-track
|
||||||
|
(if (= nr 0)
|
||||||
|
(- (send playlist length) 1)
|
||||||
|
(- nr 1)))]
|
||||||
|
[else
|
||||||
|
(send this play-track (max 0 (- nr 1)))]))))
|
||||||
|
|
||||||
|
(define/public (pause!)
|
||||||
|
(check-player)
|
||||||
|
(rad:dlna-player-pause! player)
|
||||||
|
(set-state! 'paused))
|
||||||
|
|
||||||
|
(define/public (play!)
|
||||||
|
(check-player)
|
||||||
|
(rad:dlna-player-resume! player)
|
||||||
|
(set-state! 'playing))
|
||||||
|
|
||||||
|
(define/public (pause-unpause)
|
||||||
|
(check-player)
|
||||||
|
(if (eq? state 'paused)
|
||||||
|
(send this play!)
|
||||||
|
(send this pause!)))
|
||||||
|
|
||||||
|
(define/public (stop)
|
||||||
|
(check-player)
|
||||||
|
(set! stop-requested? #t)
|
||||||
|
(set! playing-seen? #f)
|
||||||
|
(set! stopped-polls 0)
|
||||||
|
(rad:dlna-player-stop! player)
|
||||||
|
(set-state! 'stopped))
|
||||||
|
|
||||||
|
(define/public (seek percentage)
|
||||||
|
(check-player)
|
||||||
|
(rad:dlna-player-seek-percentage! player percentage))
|
||||||
|
|
||||||
|
(define/public (get-repeat)
|
||||||
|
(check-player)
|
||||||
|
repeat)
|
||||||
|
|
||||||
|
(define/public (repeat! r)
|
||||||
|
(check-player)
|
||||||
|
(set! repeat r)
|
||||||
|
(repeat-updater repeat)
|
||||||
|
(prepare-next-track!))
|
||||||
|
|
||||||
|
(define/public (quit)
|
||||||
|
(when running
|
||||||
|
(set! running #f)
|
||||||
|
(unless (eq? poll-thread #f)
|
||||||
|
(kill-thread poll-thread)
|
||||||
|
(set! poll-thread #f))
|
||||||
|
(unless (eq? player #f)
|
||||||
|
(rad:dlna-player-close! player)
|
||||||
|
(set! player #f))
|
||||||
|
(set-state! 'quit)))
|
||||||
|
|
||||||
|
(super-new)
|
||||||
|
|
||||||
|
(begin
|
||||||
|
(void settings
|
||||||
|
buffer-max-seconds
|
||||||
|
buffer-min-seconds)
|
||||||
|
(set! poll-thread (thread poll))
|
||||||
|
(dbg-rktplayer "dlna-player% initialized"))))
|
||||||
@@ -0,0 +1,40 @@
|
|||||||
|
#lang racket
|
||||||
|
|
||||||
|
(require racket-upnp)
|
||||||
|
|
||||||
|
(provide check-dlna-players)
|
||||||
|
|
||||||
|
(define running-sem (make-semaphore 1))
|
||||||
|
(define running #f)
|
||||||
|
|
||||||
|
(define (check-dlna-players gui)
|
||||||
|
(let ((can-check (begin
|
||||||
|
(semaphore-wait running-sem)
|
||||||
|
(let ((rng running))
|
||||||
|
(if rng
|
||||||
|
(begin
|
||||||
|
(semaphore-post running-sem)
|
||||||
|
#f)
|
||||||
|
(begin
|
||||||
|
(set! running #t)
|
||||||
|
(semaphore-post running-sem)
|
||||||
|
#t))))))
|
||||||
|
(if can-check
|
||||||
|
(void
|
||||||
|
(thread
|
||||||
|
(λ ()
|
||||||
|
(let ((r (query-media-renderers)))
|
||||||
|
(let ((r* (map (λ (r)
|
||||||
|
(list (media-renderer-name r)
|
||||||
|
r))
|
||||||
|
r)))
|
||||||
|
(send gui set-dlna-renderers! r*)
|
||||||
|
(semaphore-wait running-sem)
|
||||||
|
(set! running #f)
|
||||||
|
(semaphore-post running-sem)
|
||||||
|
)))))
|
||||||
|
(void
|
||||||
|
(send gui dlna-query-busy))
|
||||||
|
)
|
||||||
|
)
|
||||||
|
)
|
||||||
@@ -11,8 +11,10 @@
|
|||||||
"translate.rkt"
|
"translate.rkt"
|
||||||
"playlist.rkt"
|
"playlist.rkt"
|
||||||
"player.rkt"
|
"player.rkt"
|
||||||
|
"dlna-player.rkt"
|
||||||
"settings.rkt"
|
"settings.rkt"
|
||||||
"libraries.rkt"
|
"libraries.rkt"
|
||||||
|
"dlna.rkt"
|
||||||
)
|
)
|
||||||
|
|
||||||
(provide
|
(provide
|
||||||
@@ -24,14 +26,29 @@
|
|||||||
|
|
||||||
|
|
||||||
(define player-menu
|
(define player-menu
|
||||||
(λ ()
|
(λ (renderers connector)
|
||||||
(wv-menu 'main-menu
|
(wv-menu 'main-menu
|
||||||
(wv-menu-item 'm-file (tr 'file)
|
(wv-menu-item 'm-file (tr 'file)
|
||||||
#:submenu (wv-menu 'file-menu
|
#:submenu (wv-menu 'file-menu
|
||||||
(wv-menu-item 'm-select-library-dir (tr 'select-library-dir))
|
(wv-menu-item 'm-select-library-dir (tr 'select-library-dir))
|
||||||
(wv-menu-item 'm-settings (tr 'settings))
|
(wv-menu-item 'm-settings (tr 'settings))
|
||||||
(wv-menu-item 'm-quit (tr 'quit) #:separator #t)
|
(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-format #f)
|
||||||
(define el-channels #f)
|
(define el-channels #f)
|
||||||
(define el-bits #f)
|
(define el-bits #f)
|
||||||
|
(define el-message #f)
|
||||||
(define cfg (send settings clone 'settings))
|
(define cfg (send settings clone 'settings))
|
||||||
|
|
||||||
(define current-tab 0)
|
(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 current-track-nr #f)
|
||||||
|
|
||||||
(define (update-track-nr nr)
|
(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]
|
[time-updater update-time]
|
||||||
[track-nr-updater update-track-nr]
|
[track-nr-updater update-track-nr]
|
||||||
[state-updater update-state]
|
[state-updater update-state]
|
||||||
@@ -354,6 +391,49 @@
|
|||||||
[audio-info-cb update-audio-info]
|
[audio-info-cb update-audio-info]
|
||||||
[settings settings]
|
[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))
|
(define inner-html-handlers (make-hash))
|
||||||
|
|
||||||
@@ -407,11 +487,13 @@
|
|||||||
(set! el-channels (send this element 'channels))
|
(set! el-channels (send this element 'channels))
|
||||||
(set! el-format (send this element 'format))
|
(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-quit (λ () (send this quit)))
|
||||||
(send this connect-menu! 'm-select-library-dir (λ () (send this select-library)))
|
(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-settings (λ () (send this settings-dlg)))
|
||||||
(send this connect-menu! 'm-add-tab (λ () (send this add-tab)))
|
(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)
|
(dbg-rktplayer "page-loaded, playlist = ~a" playlist)
|
||||||
(send this update-tabs)
|
(send this update-tabs)
|
||||||
@@ -664,6 +746,7 @@
|
|||||||
(let* ((volume-meter (send this element 'volume-meter))
|
(let* ((volume-meter (send this element 'volume-meter))
|
||||||
(volume-display (send volume-meter display))
|
(volume-display (send volume-meter display))
|
||||||
)
|
)
|
||||||
|
(display "volume-display = ") (write volume-display) (newline)
|
||||||
(if (eq? volume-display 'block)
|
(if (eq? volume-display 'block)
|
||||||
(send volume-meter display 'none)
|
(send volume-meter display 'none)
|
||||||
(begin
|
(begin
|
||||||
@@ -723,6 +806,8 @@
|
|||||||
#f)
|
#f)
|
||||||
|
|
||||||
(begin
|
(begin
|
||||||
|
(dbg-rktplayer "Initializing local player")
|
||||||
|
(play-local)
|
||||||
(dbg-rktplayer "Initalizing gui")
|
(dbg-rktplayer "Initalizing gui")
|
||||||
(dbg-rktplayer "ICON: ~a" (get-field icon this))
|
(dbg-rktplayer "ICON: ~a" (get-field icon this))
|
||||||
(let ((lang (send settings get 'lang 'en)))
|
(let ((lang (send settings get 'lang 'en)))
|
||||||
|
|||||||
@@ -0,0 +1,802 @@
|
|||||||
|
#lang racket
|
||||||
|
|
||||||
|
(require racket-webview
|
||||||
|
racket/runtime-path
|
||||||
|
racket/gui
|
||||||
|
racket-sprintf
|
||||||
|
open-app
|
||||||
|
xml
|
||||||
|
"utils.rkt"
|
||||||
|
"music-library.rkt"
|
||||||
|
"translate.rkt"
|
||||||
|
"playlist.rkt"
|
||||||
|
"player.rkt"
|
||||||
|
"settings.rkt"
|
||||||
|
"libraries.rkt"
|
||||||
|
"dlna.rkt"
|
||||||
|
)
|
||||||
|
|
||||||
|
(provide
|
||||||
|
(all-from-out racket-webview)
|
||||||
|
rktplayer%
|
||||||
|
)
|
||||||
|
|
||||||
|
(define-runtime-path rkt-gui-dir "gui")
|
||||||
|
|
||||||
|
|
||||||
|
(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))))
|
||||||
|
)
|
||||||
|
)))
|
||||||
|
|
||||||
|
(define rktplayer%
|
||||||
|
(class wv-window%
|
||||||
|
(init-field [log-file #f])
|
||||||
|
(inherit-field settings icon)
|
||||||
|
|
||||||
|
(super-new
|
||||||
|
[html-path "rktplayer.html"]
|
||||||
|
[title "Racket Music Player"]
|
||||||
|
[icon (build-path rkt-gui-dir "rktplayer.png")]
|
||||||
|
[quit-on-close #f]
|
||||||
|
)
|
||||||
|
|
||||||
|
(define initialized (make-semaphore 0))
|
||||||
|
|
||||||
|
(define closed #f)
|
||||||
|
(define el-seeker #f)
|
||||||
|
(define el-volume #f)
|
||||||
|
(define el-vol-perc #f)
|
||||||
|
(define el-library #f)
|
||||||
|
(define el-playlist #f)
|
||||||
|
(define el-at #f)
|
||||||
|
(define el-length #f)
|
||||||
|
(define el-rate #f)
|
||||||
|
(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)
|
||||||
|
|
||||||
|
(define music-library
|
||||||
|
(let* ((libs (new libraries% [settings cfg]))
|
||||||
|
(lib (send libs current-library))
|
||||||
|
(dir (if (eq? lib #f)
|
||||||
|
(find-system-path 'home-dir)
|
||||||
|
(send lib get-local-path)))
|
||||||
|
(path (format "~a" dir)))
|
||||||
|
(when (eq? (system-type 'os) 'windows)
|
||||||
|
(set! path (string-replace path "/" "\\")))
|
||||||
|
(dbg-rktplayer "music-library: ~a" path)
|
||||||
|
path))
|
||||||
|
|
||||||
|
(define current-music-path #f)
|
||||||
|
(define playlist #f)
|
||||||
|
|
||||||
|
(define current-at-seconds 0)
|
||||||
|
(define current-length-seconds 0)
|
||||||
|
|
||||||
|
(define/public (update-volume)
|
||||||
|
(let ((el (send this element 'volume-percentage)))
|
||||||
|
(let ((percentage (send player get-volume)))
|
||||||
|
(send el set-innerHTML! (sprintf "%s %d%" (tr 'volume) percentage)))
|
||||||
|
)
|
||||||
|
)
|
||||||
|
|
||||||
|
(define (update-time at-seconds length-seconds)
|
||||||
|
(let ((as (inexact->exact (round at-seconds)))
|
||||||
|
(ls (inexact->exact (round length-seconds))))
|
||||||
|
|
||||||
|
(when (or (not (= current-at-seconds as))
|
||||||
|
(not (= current-length-seconds ls)))
|
||||||
|
(set! current-at-seconds as)
|
||||||
|
(set! current-length-seconds ls)
|
||||||
|
(let ((as-str (sprintf "%02d:%02d:%02d"
|
||||||
|
(quotient as 3600)
|
||||||
|
(quotient (remainder as 3600) 60)
|
||||||
|
(remainder (remainder as 3600) 60)))
|
||||||
|
(ls-str (sprintf "%02d:%02d:%02d"
|
||||||
|
(quotient ls 3600)
|
||||||
|
(quotient (remainder ls 3600) 60)
|
||||||
|
(remainder (remainder ls 3600) 60)))
|
||||||
|
)
|
||||||
|
(unless closed
|
||||||
|
(send el-at set-innerHTML! as-str)
|
||||||
|
(send el-length set-innerHTML! ls-str)
|
||||||
|
(let ((seeker (if (= ls 0)
|
||||||
|
0.0
|
||||||
|
(exact->inexact (/ (* 100 as) ls)))))
|
||||||
|
(send el-seeker set! (format "~a" seeker)))
|
||||||
|
)
|
||||||
|
)
|
||||||
|
(send this update-volume)
|
||||||
|
)
|
||||||
|
)
|
||||||
|
)
|
||||||
|
|
||||||
|
(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)
|
||||||
|
(unless (or (eq? playlist #f)
|
||||||
|
(= (send playlist length) 0))
|
||||||
|
(dbg-rktplayer "update-track-nr ~a" nr)
|
||||||
|
(let ((id (λ () (send playlist track-id current-track-nr))) ;string->symbol (format "track-~a" (+ current-track-nr 1)))))
|
||||||
|
(ct current-track-nr))
|
||||||
|
|
||||||
|
(dbg-rktplayer "Removing current")
|
||||||
|
(unless (eq? current-track-nr #f)
|
||||||
|
(dbg-rktplayer (format "current old track: ~a" (id)))
|
||||||
|
(let ((el (send this element (id))))
|
||||||
|
(send el remove-class! "current")))
|
||||||
|
|
||||||
|
(set! current-track-nr nr)
|
||||||
|
|
||||||
|
(dbg-rktplayer "Adding current")
|
||||||
|
(unless (eq? current-track-nr #f)
|
||||||
|
(dbg-rktplayer "current new track: ~a" (id))
|
||||||
|
(let ((el (send this element (id))))
|
||||||
|
(send el add-class! "current"))
|
||||||
|
|
||||||
|
(dbg-rktplayer "Getting cover image")
|
||||||
|
(let* ((track (send playlist track current-track-nr))
|
||||||
|
(img-file (build-path (find-system-path 'cache-dir) "rktplayer-cover-image"))
|
||||||
|
(stored-file (send track image->file img-file))
|
||||||
|
)
|
||||||
|
(dbg-rktplayer "image mimetype: ~a" (send track image->mimetype))
|
||||||
|
(dbg-rktplayer "stored-file = ~a" stored-file)
|
||||||
|
(unless (eq? stored-file #f)
|
||||||
|
(dbg-rktplayer "Setting album art")
|
||||||
|
(let ((el (send this element 'album-art)))
|
||||||
|
(let ((html (format "<img id=\"album-image\" src=\"/get-image?~a&~a\" />"
|
||||||
|
(format "~a" stored-file)
|
||||||
|
(current-milliseconds))))
|
||||||
|
(dbg-rktplayer "Html = ~a" html)
|
||||||
|
(send el set-innerHTML! html)
|
||||||
|
(when (send track has-booklet?)
|
||||||
|
(let ((booklet-file (send track booklet-file)))
|
||||||
|
(send this bind! 'album-image 'contextmenu
|
||||||
|
(λ (el evt data)
|
||||||
|
(let ((mnu (wv-menu 'image-menu
|
||||||
|
(wv-menu-item 'm-booklet (tr 'open-booklet)
|
||||||
|
#:callback (λ () (send this open-booklet booklet-file #t)))))
|
||||||
|
(clientX (hash-ref data 'clientX 60))
|
||||||
|
(clientY (hash-ref data 'clientY 60)))
|
||||||
|
(send this popup-menu! mnu clientX clientY))))))
|
||||||
|
)))
|
||||||
|
)
|
||||||
|
)
|
||||||
|
(dbg-rktplayer "Done updating track")
|
||||||
|
)
|
||||||
|
)
|
||||||
|
)
|
||||||
|
|
||||||
|
(define state #f)
|
||||||
|
(define current-play-image "buttons/play.svg")
|
||||||
|
|
||||||
|
(define (set-play-button img)
|
||||||
|
(unless (string=? current-play-image img)
|
||||||
|
(set! current-play-image img)
|
||||||
|
(let ((btn (send this element 'play-img)))
|
||||||
|
(send btn set-attr! (list 'src img))
|
||||||
|
)
|
||||||
|
)
|
||||||
|
)
|
||||||
|
|
||||||
|
(define (update-state st)
|
||||||
|
(unless (eq? st state)
|
||||||
|
(dbg-rktplayer "Changing to state ~a" st)
|
||||||
|
(let ((el (send this element 'paused)))
|
||||||
|
(cond ((or (eq? st 'playing) (eq? st 'play))
|
||||||
|
(set-play-button "buttons/pause.svg")
|
||||||
|
(send el set-innerHTML! (list 'span (tr 'playing))))
|
||||||
|
((eq? st 'stopped)
|
||||||
|
(set-play-button "buttons/play.svg")
|
||||||
|
(send el set-innerHTML! (list 'span (tr 'stopped))))
|
||||||
|
((eq? st 'paused)
|
||||||
|
(set-play-button "buttons/play.svg")
|
||||||
|
(send el set-innerHTML! (list 'span '((class "blink")) (tr 'paused))))
|
||||||
|
((eq? st 'quit)
|
||||||
|
(void))
|
||||||
|
(else
|
||||||
|
(warn-rktplayer "Unkown state for update-state ~a" st)
|
||||||
|
(send el set-innerHTML! (list 'span
|
||||||
|
'((class "blink"))
|
||||||
|
(format "~a: ~a" (tr 'unknown-state) st))))
|
||||||
|
))
|
||||||
|
(set! state st)
|
||||||
|
)
|
||||||
|
)
|
||||||
|
|
||||||
|
(define/public (update-tabs)
|
||||||
|
(dbg-rktplayer "playlist = ~a" playlist)
|
||||||
|
(let* ((tabs (send playlist tab-count))
|
||||||
|
(html "")
|
||||||
|
(tab-el (send this element 'tabs))
|
||||||
|
(idx 0)
|
||||||
|
)
|
||||||
|
(while (< idx tabs)
|
||||||
|
(let ((tab-name (send playlist get-tab-name idx)))
|
||||||
|
(set! html (string-append
|
||||||
|
html
|
||||||
|
(xexpr->string
|
||||||
|
(list 'span (list (list 'id (format "tab~a" idx))
|
||||||
|
'(class "tab"))
|
||||||
|
tab-name))))
|
||||||
|
)
|
||||||
|
(set! idx (+ idx 1)))
|
||||||
|
|
||||||
|
(send tab-el set-innerHTML! html)
|
||||||
|
|
||||||
|
(send this bind! "#tabs > span" 'click
|
||||||
|
(λ (el evt data)
|
||||||
|
(let* ((tab-id (send el id))
|
||||||
|
(tab-idx (string->number (substring (format "~a" tab-id) 3)))
|
||||||
|
)
|
||||||
|
(send this set-tab! tab-idx))))
|
||||||
|
|
||||||
|
(send this bind! "#tabs > span" 'contextmenu
|
||||||
|
(λ (el evt data)
|
||||||
|
(let* ((tab-id (send el id))
|
||||||
|
(tab-idx (string->number (substring (format "~a" tab-id) 3)))
|
||||||
|
)
|
||||||
|
(send this tab-context data tab-id tab-idx))))
|
||||||
|
|
||||||
|
(let ((id (string->symbol (format "tab~a" current-tab))))
|
||||||
|
(let ((el (send this element id)))
|
||||||
|
(send el add-class! 'current))
|
||||||
|
)
|
||||||
|
)
|
||||||
|
)
|
||||||
|
|
||||||
|
(define/public (tab-context evt tab-id tab-idx)
|
||||||
|
(let ((items (list
|
||||||
|
(wv-menu-item 'm-tab-rename (tr 'rename-playlist) #:callback (λ () (send this rename-tab! tab-id tab-idx)))
|
||||||
|
(wv-menu-item 'm-tab-drop (tr 'remove-playlist) #:callback (λ () (send this drop-tab! tab-id tab-idx)))
|
||||||
|
(wv-menu-item 'm-tab-add (tr 'add-playlist) #:callback (λ () (send this add-tab)))
|
||||||
|
)
|
||||||
|
)
|
||||||
|
)
|
||||||
|
|
||||||
|
(let* ((mnu (wv-menu 'tab-popup items))
|
||||||
|
(clientX (hash-ref evt 'clientX 60))
|
||||||
|
(clientY (hash-ref evt 'clientY 60))
|
||||||
|
)
|
||||||
|
(send this popup-menu! mnu clientX clientY)
|
||||||
|
)
|
||||||
|
)
|
||||||
|
)
|
||||||
|
|
||||||
|
(define/public (log-file! file)
|
||||||
|
(set log-file file))
|
||||||
|
|
||||||
|
(define/public (drop-tab! tab-id tab-idx)
|
||||||
|
(when (= current-tab tab-idx)
|
||||||
|
(send this stop))
|
||||||
|
(send playlist drop-tab! tab-idx)
|
||||||
|
(send this set-tab! 0)
|
||||||
|
)
|
||||||
|
|
||||||
|
(define/public (rename-tab! tab-id tab-idx)
|
||||||
|
(let* ((inp-id (string->symbol (format "tab-input~a" tab-idx)))
|
||||||
|
(tab-el-id (string->symbol (format "tab~a" tab-idx)))
|
||||||
|
(html (list 'input (list (list 'id (format "~a" inp-id))
|
||||||
|
(list 'name (format "~a" inp-id))
|
||||||
|
'(type "text")
|
||||||
|
(list 'value (send playlist get-tab-name tab-idx))
|
||||||
|
)))
|
||||||
|
(tab-el (send this element tab-el-id))
|
||||||
|
(unbind-events (λ ()
|
||||||
|
(send this unbind! inp-id 'change)
|
||||||
|
(send this unbind! inp-id 'blur)))
|
||||||
|
)
|
||||||
|
(send tab-el set-innerHTML! html)
|
||||||
|
(send this unbind! tab-el-id '(click contextmenu))
|
||||||
|
(send this bind! inp-id 'change
|
||||||
|
(λ (el evt data)
|
||||||
|
(let ((tab-name (hash-ref data 'value (send playlist get-tab-name tab-idx))))
|
||||||
|
(send playlist set-tab-name! tab-idx tab-name)
|
||||||
|
(unbind-events)
|
||||||
|
(send this update-tabs))))
|
||||||
|
(send this bind! inp-id 'blur
|
||||||
|
(λ (el evt data)
|
||||||
|
(unbind-events)
|
||||||
|
(send this update-tabs)))
|
||||||
|
(let ((inp-el (send this element inp-id)))
|
||||||
|
(send inp-el focus!))
|
||||||
|
)
|
||||||
|
)
|
||||||
|
|
||||||
|
(define/public (set-tab! tab-idx)
|
||||||
|
(send this stop)
|
||||||
|
(set! current-tab tab-idx)
|
||||||
|
(send playlist load-tab tab-idx)
|
||||||
|
(send this update-tabs)
|
||||||
|
(send this update-playlist)
|
||||||
|
)
|
||||||
|
|
||||||
|
(define/public (add-tab)
|
||||||
|
(send playlist add-tab!)
|
||||||
|
(send this update-tabs))
|
||||||
|
|
||||||
|
(define (update-audio-info rate channels bits audio-format)
|
||||||
|
(let ((format-num (λ (x) (if (= x 0) "-" x)))
|
||||||
|
(format-dec (λ (x) (if (eq? x 'none) "-" x))))
|
||||||
|
(send el-bits set-innerHTML! (format "~a ~a" (format-num bits) (tr 'bits)))
|
||||||
|
(send el-channels set-innerHTML! (format "~a ~a" (format-num channels) (tr 'channels)))
|
||||||
|
(send el-rate set-innerHTML! (format "~a Hz" (format-num rate)))
|
||||||
|
(send el-format set-innerHTML! (format "~a" (format-dec audio-format)))
|
||||||
|
)
|
||||||
|
)
|
||||||
|
|
||||||
|
(define (update-repeat state)
|
||||||
|
(let ((img (if (eq? state 'no-repeat)
|
||||||
|
"buttons/repeat-off.svg"
|
||||||
|
(if (eq? state 'repeat-one)
|
||||||
|
"buttons/repeat-one.svg"
|
||||||
|
"buttons/repeat.svg"))))
|
||||||
|
(let ((el (send this element 'repeat-img)))
|
||||||
|
(send el set-attr! (list 'src img)))
|
||||||
|
)
|
||||||
|
)
|
||||||
|
|
||||||
|
(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]
|
||||||
|
[repeat-updater update-repeat]
|
||||||
|
[audio-info-cb update-audio-info]
|
||||||
|
[settings settings]
|
||||||
|
))
|
||||||
|
(unless (eq? playlist #f)
|
||||||
|
(send player playlist! playlist))
|
||||||
|
)
|
||||||
|
|
||||||
|
(define/public (play-to-dlna renderer-idx)
|
||||||
|
(let ((renderer (list-ref dlna-renderers renderer-idx)))
|
||||||
|
(displayln (format "Play to ~a" (car renderer)))))
|
||||||
|
|
||||||
|
(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)
|
||||||
|
(send this set-menu! (player-menu renderers (λ (id idx)
|
||||||
|
(send this connect-menu! id
|
||||||
|
(λ ()
|
||||||
|
(displayln (format "dlna playback: ~a" idx))
|
||||||
|
(send this play-to-dlna idx))))))
|
||||||
|
#t)
|
||||||
|
|
||||||
|
(define/public (check-dlna)
|
||||||
|
(check-dlna-players this))
|
||||||
|
|
||||||
|
(define inner-html-handlers (make-hash))
|
||||||
|
|
||||||
|
(define/override (page-loaded oke)
|
||||||
|
(semaphore-wait initialized)
|
||||||
|
(semaphore-post initialized)
|
||||||
|
|
||||||
|
(super page-loaded oke)
|
||||||
|
|
||||||
|
(let ((el (send this element 'log-file)))
|
||||||
|
(send el set-innerHTML! (format "~a" log-file)))
|
||||||
|
|
||||||
|
(ww-connect 'play play-or-pause)
|
||||||
|
(ww-connect 'stop stop)
|
||||||
|
(ww-connect 'prev previous-track)
|
||||||
|
(ww-connect 'next next-track)
|
||||||
|
(ww-connect 'repeat repeat)
|
||||||
|
(ww-connect 'volume volume)
|
||||||
|
(ww-connect 'devtools devtools)
|
||||||
|
|
||||||
|
(set! el-seeker (send this element 'seek))
|
||||||
|
(dbg-rktplayer "el-seeker: ~a" (send el-seeker get))
|
||||||
|
(let ((seek-reactor (webview-delayed-reactor 0.3
|
||||||
|
(λ (percentage)
|
||||||
|
;(displayln (format "el-seeker: ~a" percentage))
|
||||||
|
(send this seek-to percentage)))))
|
||||||
|
(send el-seeker on-change! seek-reactor))
|
||||||
|
|
||||||
|
(set! el-volume (send this element 'volume-range))
|
||||||
|
(set! el-vol-perc (send this element 'volume-perc))
|
||||||
|
(dbg-rktplayer "el-volume: ~a" (send el-volume get))
|
||||||
|
(let ((volume-reactor (webview-delayed-reactor 1.0
|
||||||
|
(λ (volume-range)
|
||||||
|
(let ((percentage (* volume-range volume-range)))
|
||||||
|
(send this set-volume! percentage)))
|
||||||
|
#:update (λ (val)
|
||||||
|
(let ((p (* val val)))
|
||||||
|
(send el-vol-perc set-innerHTML! (sprintf "%d%" p))
|
||||||
|
)))))
|
||||||
|
(send el-volume on-change! volume-reactor))
|
||||||
|
|
||||||
|
|
||||||
|
(set! el-library (send this element 'library))
|
||||||
|
(set! el-playlist (send this element 'tracks))
|
||||||
|
|
||||||
|
(set! el-at (send this element 'time))
|
||||||
|
(set! el-length (send this element 'totaltime))
|
||||||
|
|
||||||
|
(set! el-rate (send this element 'rate))
|
||||||
|
(set! el-bits (send this element 'bits))
|
||||||
|
(set! el-channels (send this element 'channels))
|
||||||
|
(set! el-format (send this element 'format))
|
||||||
|
|
||||||
|
(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)
|
||||||
|
(send this update-library)
|
||||||
|
(send this update-playlist)
|
||||||
|
|
||||||
|
(when (eq? state #f)
|
||||||
|
(update-audio-info 0 0 0 'none)
|
||||||
|
(update-state 'stopped))
|
||||||
|
)
|
||||||
|
|
||||||
|
(define el-dragged #f)
|
||||||
|
|
||||||
|
(define/public (update-playlist)
|
||||||
|
(let* ((html (send playlist to-html))
|
||||||
|
(result (send el-playlist set-innerHTML! html))
|
||||||
|
)
|
||||||
|
(dbg-rktplayer "result: ~a" result)
|
||||||
|
(send this set-attr! "table.tracks tr" '(draggable "true"))
|
||||||
|
(send this bind! "table.tracks tr" 'click
|
||||||
|
(λ (el evt data)
|
||||||
|
(let* ((track-id (send el attr/symbol 'id))
|
||||||
|
(idx (send playlist index track-id))
|
||||||
|
)
|
||||||
|
(send this play-track idx)
|
||||||
|
)
|
||||||
|
)
|
||||||
|
)
|
||||||
|
(send this bind! "table.tracks tr" 'contextmenu
|
||||||
|
(λ (el evt data)
|
||||||
|
(let ((mnu (wv-menu 'track-menu
|
||||||
|
(wv-menu-item 'm-drop-track "Drop track"
|
||||||
|
#:callback (λ ()
|
||||||
|
(send playlist drop-id (send el id))
|
||||||
|
(update-playlist))
|
||||||
|
)
|
||||||
|
)
|
||||||
|
)
|
||||||
|
(clientX (hash-ref data 'clientX 60))
|
||||||
|
(clientY (hash-ref data 'clientY 60))
|
||||||
|
)
|
||||||
|
(send this popup-menu! mnu clientX clientY))))
|
||||||
|
(let ((from-idx #f)
|
||||||
|
(to-idx #f))
|
||||||
|
(send this bind! "table.tracks tr" 'dragstart
|
||||||
|
(λ (el evt data)
|
||||||
|
(set! el-dragged el)
|
||||||
|
(dbg-rktplayer "Dragging element ~a" (send el id))
|
||||||
|
(set! from-idx (send playlist index (send el id)))
|
||||||
|
)
|
||||||
|
#t)
|
||||||
|
(send this bind! "table.tracks tr" 'dragover
|
||||||
|
(λ (el evt data)
|
||||||
|
#t)
|
||||||
|
)
|
||||||
|
(send this bind! "table.tracks tr" 'drop
|
||||||
|
(λ (el evt data)
|
||||||
|
(dbg-rktplayer "Element dropped on ~a" (send el id))
|
||||||
|
(set! to-idx (send playlist index (send el id)))
|
||||||
|
(when (and (integer? from-idx) (integer? to-idx)
|
||||||
|
(not (= from-idx to-idx)))
|
||||||
|
(send playlist move-track from-idx to-idx)
|
||||||
|
(update-playlist)
|
||||||
|
)
|
||||||
|
)
|
||||||
|
)
|
||||||
|
)
|
||||||
|
|
||||||
|
(update-track-nr current-track-nr)
|
||||||
|
)
|
||||||
|
(send this update-volume)
|
||||||
|
)
|
||||||
|
|
||||||
|
(define/public (scroll-top id)
|
||||||
|
(send this run-js
|
||||||
|
(format
|
||||||
|
(string-append "{ let el_id = '~a';"
|
||||||
|
" console.log('id = ' + el_id);"
|
||||||
|
" let el = document.getElementById(el_id);"
|
||||||
|
" console.log(el);"
|
||||||
|
" el.scrollTop = 0;"
|
||||||
|
"}")
|
||||||
|
id)))
|
||||||
|
|
||||||
|
(define/public (update-library)
|
||||||
|
(when (eq? current-music-path #f)
|
||||||
|
(set! current-music-path music-library))
|
||||||
|
(let* ((nr 0)
|
||||||
|
(l (filter (λ (r) (music-lib-relevant? (cadr r)))
|
||||||
|
(map (λ (e)
|
||||||
|
(set! nr (+ nr 1))
|
||||||
|
(list (format "row-~a" nr) (build-path current-music-path e) (format "path-~a" nr)))
|
||||||
|
(if (directory-exists? current-music-path)
|
||||||
|
(directory-list current-music-path)
|
||||||
|
'())))))
|
||||||
|
(unless (path-equal? current-music-path music-library)
|
||||||
|
(set! l (cons (list "lib-up" "↰" "lib-up") l))
|
||||||
|
)
|
||||||
|
(let ((html (mktable l 'music-library library-formatter)))
|
||||||
|
(let ((result (send el-library set-innerHTML! html)))
|
||||||
|
(dbg-rktplayer "set-innerHTML!: ~a" result)
|
||||||
|
(send this scroll-top 'library)
|
||||||
|
(dbg-rktplayer "Binding...")
|
||||||
|
(send this bind! "td.library-entry" 'click
|
||||||
|
(λ (el evt data)
|
||||||
|
(dbg-rktplayer "~a ~a" evt data)
|
||||||
|
(dbg-rktplayer "id:~a, file:~a" (send el attr 'id) (send el attr 'file))
|
||||||
|
(let ((path (send el attr 'file)))
|
||||||
|
(unless (eq? path #f)
|
||||||
|
(send this path-choosen path)))))
|
||||||
|
(send this bind! "td.library-entry" 'contextmenu
|
||||||
|
(λ (el evt data)
|
||||||
|
(dbg-rktplayer "~a ~a" evt data)
|
||||||
|
(let ((path (send el attr 'file)))
|
||||||
|
(unless (eq? path #f)
|
||||||
|
(send this context-for-path data path)))
|
||||||
|
))
|
||||||
|
(dbg-rktplayer "Done...")
|
||||||
|
|
||||||
|
))
|
||||||
|
)
|
||||||
|
)
|
||||||
|
|
||||||
|
(define/public (path-choosen path)
|
||||||
|
(let ((path-part (if (equal? path "↰") ".." (format "~a" path))))
|
||||||
|
(let ((npath (if (string=? path-part "..")
|
||||||
|
(build-path current-music-path path-part)
|
||||||
|
path)))
|
||||||
|
(when (directory-exists? npath)
|
||||||
|
(set! current-music-path (normalize-path npath))
|
||||||
|
(send this update-library)
|
||||||
|
)
|
||||||
|
)
|
||||||
|
)
|
||||||
|
)
|
||||||
|
|
||||||
|
(define/public (context-for-path evt path)
|
||||||
|
(let ((items (list
|
||||||
|
(wv-menu-item 'm-play-this (tr 'play-this) #:callback (λ () (send this play-path path))))))
|
||||||
|
(when (file-exists? path)
|
||||||
|
(set! items (append items
|
||||||
|
(list
|
||||||
|
(wv-menu-item 'm-add-this (tr 'add-this) #:callback (λ () (send this add-path path)))))))
|
||||||
|
(when (file-exists? (build-path path "booklet.pdf"))
|
||||||
|
(set! items (append items
|
||||||
|
(list
|
||||||
|
(wv-menu-item 'm-booklet (tr 'open-booklet) #:callback (λ () (send this open-booklet path))) ;; todo check if pdf file exists
|
||||||
|
))))
|
||||||
|
|
||||||
|
(set! items (append items
|
||||||
|
(list
|
||||||
|
(wv-menu-item 'm-folder (tr 'open-containing-folder) #:callback (λ () (send this open-folder path)))
|
||||||
|
)))
|
||||||
|
(let* ((mnu (wv-menu 'library-popup items))
|
||||||
|
(clientX (hash-ref evt 'clientX 60))
|
||||||
|
(clientY (hash-ref evt 'clientY 60))
|
||||||
|
)
|
||||||
|
(send this popup-menu! mnu clientX clientY)
|
||||||
|
)
|
||||||
|
)
|
||||||
|
)
|
||||||
|
|
||||||
|
(define play-remote #f)
|
||||||
|
(define/public (toggle-remote)
|
||||||
|
(info-rktplayer "Toggling remote playing")
|
||||||
|
(set! play-remote (not play-remote))
|
||||||
|
;(displayln (format "player = ~a" player))
|
||||||
|
(if play-remote
|
||||||
|
(send player change-player 'remote
|
||||||
|
#:host "hans@mahler.thuis.local"
|
||||||
|
#:basepaths '(("\\\\panderleou\\music" . "/muziek")
|
||||||
|
("//panderleou/music" . "/muziek")
|
||||||
|
))
|
||||||
|
(send player change-player 'local))
|
||||||
|
(info-rktplayer "Playing remote: ~a" play-remote)
|
||||||
|
)
|
||||||
|
|
||||||
|
(define/public (play-path path)
|
||||||
|
(dbg-rktplayer "Playing ~a" path)
|
||||||
|
(let ((pl (new playlist% [start-map path] [settings (send settings clone 'playlists)] [id current-tab])))
|
||||||
|
(set! current-track-nr #f)
|
||||||
|
(send pl read-tracks)
|
||||||
|
(set! playlist pl)
|
||||||
|
(send this update-playlist)
|
||||||
|
(send player play pl)
|
||||||
|
(dbg-rktplayer "number of tracks: ~a" (send playlist length))
|
||||||
|
)
|
||||||
|
)
|
||||||
|
|
||||||
|
(define/public (add-path path)
|
||||||
|
(send playlist add-track path)
|
||||||
|
(send this update-playlist)
|
||||||
|
)
|
||||||
|
|
||||||
|
(define/public (open-booklet path . is-file*)
|
||||||
|
(let* ((is-file (if (null? is-file*) #f (eq? (car is-file*) #t)))
|
||||||
|
(booklet (if is-file path (build-path path "booklet.pdf"))))
|
||||||
|
(dbg-rktplayer "Open booklet ~a" booklet)
|
||||||
|
(open-app booklet)))
|
||||||
|
|
||||||
|
(define/public (open-folder path)
|
||||||
|
(dbg-rktplayer "path: ~a" path)
|
||||||
|
(open-file-manager path))
|
||||||
|
;(let ((folder (if (file-exists? path) (path-only path) path)))
|
||||||
|
; (open-file-manager folder)))
|
||||||
|
|
||||||
|
(define/public (play-or-pause)
|
||||||
|
(cond
|
||||||
|
((eq? state 'playing)
|
||||||
|
(send player pause!))
|
||||||
|
((eq? state 'paused)
|
||||||
|
(send player play!))
|
||||||
|
(else
|
||||||
|
(play-track 0))
|
||||||
|
)
|
||||||
|
)
|
||||||
|
|
||||||
|
(define/public (stop)
|
||||||
|
(dbg-rktplayer "Stop")
|
||||||
|
(send player stop)
|
||||||
|
(update-track-nr #f))
|
||||||
|
|
||||||
|
(define/public (play-track idx)
|
||||||
|
(unless (= (send playlist length) 0)
|
||||||
|
(send player play-track idx)))
|
||||||
|
|
||||||
|
(define/public (pause)
|
||||||
|
(send player pause-unpause))
|
||||||
|
|
||||||
|
(define/public (next-track)
|
||||||
|
(send player next)
|
||||||
|
)
|
||||||
|
|
||||||
|
(define/public (previous-track)
|
||||||
|
(send player previous)
|
||||||
|
)
|
||||||
|
|
||||||
|
(define/public (repeat)
|
||||||
|
(let ((r (send player get-repeat)))
|
||||||
|
(let ((nr (cond
|
||||||
|
((eq? r 'no-repeat) 'repeat-all)
|
||||||
|
((eq? r 'repeat-all) 'repeat-one)
|
||||||
|
(else 'no-repeat))))
|
||||||
|
(send player repeat! nr)
|
||||||
|
)
|
||||||
|
)
|
||||||
|
)
|
||||||
|
|
||||||
|
(define/public (volume)
|
||||||
|
(let* ((volume-meter (send this element 'volume-meter))
|
||||||
|
(volume-display (send volume-meter display))
|
||||||
|
)
|
||||||
|
(if (eq? volume-display 'block)
|
||||||
|
(send volume-meter display 'none)
|
||||||
|
(begin
|
||||||
|
(send volume-meter display 'block)
|
||||||
|
(send el-volume set!
|
||||||
|
(sqrt (send player get-volume)))
|
||||||
|
(send el-vol-perc set-innerHTML!
|
||||||
|
(sprintf "%d%" (send player get-volume))))
|
||||||
|
)
|
||||||
|
)
|
||||||
|
)
|
||||||
|
|
||||||
|
(define/public (set-volume! percentage)
|
||||||
|
(send player set-volume! percentage)
|
||||||
|
(send this update-volume)
|
||||||
|
)
|
||||||
|
|
||||||
|
(define/public (seek-to percentage)
|
||||||
|
(dbg-rktplayer "Seeking to percentage: ~a" percentage)
|
||||||
|
(send player seek percentage)
|
||||||
|
)
|
||||||
|
|
||||||
|
(define/override (quit)
|
||||||
|
(dbg-rktplayer "Quitting")
|
||||||
|
(send player quit)
|
||||||
|
(set! closed #t)
|
||||||
|
(send this close)
|
||||||
|
(dbg-rktplayer "Calling super -> quit")
|
||||||
|
(super quit)
|
||||||
|
)
|
||||||
|
|
||||||
|
(define/public (settings-dlg)
|
||||||
|
(let ((dlg (new settings% [settings (send settings clone 'settings-dlg)]
|
||||||
|
[parent this])))
|
||||||
|
(send dlg show)))
|
||||||
|
|
||||||
|
|
||||||
|
(define/public (show-hide)
|
||||||
|
(let ((st (send this window-state)))
|
||||||
|
(if (eq? st 'hidden)
|
||||||
|
(send this present)
|
||||||
|
(send this hide)
|
||||||
|
)
|
||||||
|
)
|
||||||
|
)
|
||||||
|
|
||||||
|
(define window-state-change-callback (λ () #t))
|
||||||
|
|
||||||
|
(define/public (set-window-state-change-callback! f)
|
||||||
|
(set! window-state-change-callback f))
|
||||||
|
|
||||||
|
(define/override (window-state-changed st)
|
||||||
|
(window-state-change-callback))
|
||||||
|
|
||||||
|
(define/override (can-close?)
|
||||||
|
(show-hide)
|
||||||
|
#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)))
|
||||||
|
(dbg-rktplayer "RktPlayer started, current language: ~a" lang))
|
||||||
|
(set! playlist (new playlist% [settings (send settings clone 'playlists)]))
|
||||||
|
(send player set-list! playlist)
|
||||||
|
(dbg-rktplayer "playlist = ~a" playlist)
|
||||||
|
|
||||||
|
(semaphore-post initialized)
|
||||||
|
)
|
||||||
|
)
|
||||||
|
)
|
||||||
|
|
||||||
|
|
||||||
@@ -54,6 +54,7 @@
|
|||||||
<span class="info" id="channels"></span>
|
<span class="info" id="channels"></span>
|
||||||
<span class="info" id="format"></span>
|
<span class="info" id="format"></span>
|
||||||
<span class="info" id="paused"></span>
|
<span class="info" id="paused"></span>
|
||||||
|
<span class="info" id="message"></span>
|
||||||
<div class="right">
|
<div class="right">
|
||||||
<span class="info" id="volume-percentage"></span>
|
<span class="info" id="volume-percentage"></span>
|
||||||
<span class="info" id="log-file"></span>
|
<span class="info" id="log-file"></span>
|
||||||
|
|||||||
+5
-2
@@ -132,9 +132,12 @@
|
|||||||
(clear-music-ids!)
|
(clear-music-ids!)
|
||||||
)
|
)
|
||||||
|
|
||||||
(define/public (play playlist*)
|
(define/public (playlist! playlist*)
|
||||||
(check-player)
|
(check-player)
|
||||||
(set-list! playlist*)
|
(set-list! playlist*))
|
||||||
|
|
||||||
|
(define/public (play playlist*)
|
||||||
|
(send this playlist! playlist*)
|
||||||
(send this play-track 0))
|
(send this play-track 0))
|
||||||
|
|
||||||
(define/public (play-track nr)
|
(define/public (play-track nr)
|
||||||
|
|||||||
@@ -199,4 +199,19 @@
|
|||||||
('browse
|
('browse
|
||||||
('en "Browse")
|
('en "Browse")
|
||||||
('nl "Bladeren"))
|
('nl "Bladeren"))
|
||||||
|
('dlna-renderers-count
|
||||||
|
('en "Found ~a DLNA Players")
|
||||||
|
('nl "~a DLNA Spelers gevonden"))
|
||||||
|
('dlna-query-busy
|
||||||
|
('en "Busy querying DLNA Media Renderers")
|
||||||
|
('nl "Bezig DLNA Media Rendeerers op te vragen"))
|
||||||
|
('play-local
|
||||||
|
('en "Play music on current hardware")
|
||||||
|
('nl "Muziek afspelen op huidige hardware"))
|
||||||
|
('check-dlna
|
||||||
|
('en "Search DLNA Players on network")
|
||||||
|
('nl "Zoek DLNA Spelers op het netwerk"))
|
||||||
|
('players
|
||||||
|
('en "Audio Players")
|
||||||
|
('nl "Muziek Spelers"))
|
||||||
)
|
)
|
||||||
|
|||||||
Reference in New Issue
Block a user