diff --git a/dlna-player.rkt b/dlna-player.rkt
new file mode 100644
index 0000000..070d14f
--- /dev/null
+++ b/dlna-player.rkt
@@ -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"))))
diff --git a/dlna.rkt b/dlna.rkt
new file mode 100644
index 0000000..ba580f1
--- /dev/null
+++ b/dlna.rkt
@@ -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))
+ )
+ )
+ )
diff --git a/gui.rkt b/gui.rkt
index 617c7b2..54c941a 100644
--- a/gui.rkt
+++ b/gui.rkt
@@ -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)))
diff --git a/gui.rkt-autorec.gui b/gui.rkt-autorec.gui
new file mode 100644
index 0000000..af57414
--- /dev/null
+++ b/gui.rkt-autorec.gui
@@ -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 ""
+ (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)
+ )
+ )
+ )
+
+
diff --git a/gui/rktplayer.html b/gui/rktplayer.html
index 56a3f9d..5d94da5 100644
--- a/gui/rktplayer.html
+++ b/gui/rktplayer.html
@@ -54,6 +54,7 @@
+