1189 lines
43 KiB
Racket
1189 lines
43 KiB
Racket
#lang racket
|
|
|
|
(require racket-webview
|
|
racket/runtime-path
|
|
racket/gui
|
|
racket-sprintf
|
|
open-app
|
|
xml
|
|
"../misc/utils.rkt"
|
|
"translate.rkt"
|
|
"../play/playlist.rkt"
|
|
"../play/playlist-gui.rkt"
|
|
"../play/base/player.rkt"
|
|
"../play/dlna-player.rkt"
|
|
"settings.rkt"
|
|
"../library/libraries-config.rkt"
|
|
"../library/library-browser.rkt"
|
|
"../library/library-factory.rkt"
|
|
"../library/library-ref.rkt"
|
|
"../library/base/media-resource.rkt"
|
|
"../play/base/renderer.rkt"
|
|
"../play/dlna.rkt"
|
|
)
|
|
|
|
(provide
|
|
(all-from-out racket-webview)
|
|
rktplayer%
|
|
)
|
|
|
|
(define-runtime-path rkt-gui-dir "html")
|
|
|
|
|
|
(define (checked-title title checked?)
|
|
(if checked?
|
|
(format "✓ ~a" title)
|
|
title))
|
|
|
|
(define (media-item-formatter row)
|
|
(let ((item-id (car row))
|
|
(title (cadr row)))
|
|
(list
|
|
(list 'td
|
|
(list (list 'class "library-entry")
|
|
(list 'id (format "item-~a" item-id))
|
|
(list 'item-id item-id))
|
|
title))))
|
|
|
|
(define player-menu
|
|
(λ (renderers libraries current-player-id current-library-id
|
|
player-connector library-connector)
|
|
(wv-menu 'main-menu
|
|
(wv-menu-item 'm-file (tr 'file)
|
|
#:submenu (wv-menu 'file-menu
|
|
(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
|
|
(checked-title
|
|
(tr 'play-local)
|
|
(eq? current-player-id
|
|
'm-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))
|
|
(player-connector id idx)
|
|
(wv-menu-item
|
|
id
|
|
(checked-title
|
|
(send r get-name)
|
|
(eq? current-player-id id))
|
|
#:separator (= idx 0))))
|
|
renderers)))))
|
|
(wv-menu-item 'm-libraries (tr 'libraries)
|
|
#:submenu
|
|
(apply wv-menu
|
|
(cons
|
|
'libraries-menu
|
|
(let ((library-idx 0))
|
|
(map
|
|
(lambda (cfg)
|
|
(let* ((idx library-idx)
|
|
(id (string->symbol
|
|
(format "m-library-~a" idx))))
|
|
(set! library-idx (+ library-idx 1))
|
|
(library-connector id idx)
|
|
(wv-menu-item
|
|
id
|
|
(checked-title
|
|
(send cfg get-name)
|
|
(eq? current-library-id
|
|
(send cfg get-id))))))
|
|
libraries)))))
|
|
)))
|
|
|
|
(define application-title "Racket Music Player")
|
|
|
|
(define rktplayer%
|
|
(class wv-window%
|
|
(init-field [log-file #f])
|
|
(inherit-field settings icon)
|
|
|
|
(super-new
|
|
[html-path "rktplayer.html"]
|
|
[title application-title]
|
|
[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 playlist-gui #f)
|
|
(define el-at #f)
|
|
(define el-length #f)
|
|
(define el-rate #f)
|
|
(define el-format #f)
|
|
(define el-source #f)
|
|
(define el-channels #f)
|
|
(define el-bits #f)
|
|
(define el-message #f)
|
|
(define cfg (send settings clone 'settings))
|
|
|
|
(define current-tab 0)
|
|
|
|
(define library-factory
|
|
(get-library-factory))
|
|
|
|
(define libraries-config
|
|
(send library-factory
|
|
get-libraries-config))
|
|
|
|
(define library-browser #f)
|
|
|
|
(define library-items
|
|
(make-hash))
|
|
|
|
;; A browse request can finish after another library or container has
|
|
;; already been selected. Only the most recent request may update the GUI.
|
|
(define library-update-request 0)
|
|
|
|
(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]
|
|
#:error [error #f])
|
|
(when (eq? el-message #f)
|
|
(set! el-message (send this element 'message)))
|
|
(unless (eq? el-message #f)
|
|
(send el-message
|
|
set-innerHTML!
|
|
(if error
|
|
(list
|
|
'span
|
|
'((class "blink error"))
|
|
msg)
|
|
msg))
|
|
(when clear
|
|
(void
|
|
(thread (λ ()
|
|
(sleep 10)
|
|
(send this message! "" #:clear #f)))))
|
|
))
|
|
|
|
(define/private (track-source track)
|
|
(let* ((reference
|
|
(send track
|
|
get-music-library-factory-id))
|
|
(library
|
|
(and (library-ref? reference)
|
|
(send libraries-config
|
|
get-library
|
|
(library-ref-library-id
|
|
reference)))))
|
|
(and library
|
|
(send library get-name))))
|
|
|
|
(define/private (update-track-source! track)
|
|
(when el-source
|
|
(if track
|
|
(let* ((resource (send track get-resource))
|
|
(uri (send resource get-uri))
|
|
(source
|
|
(or (track-source track)
|
|
uri)))
|
|
(send el-source
|
|
set-innerHTML!
|
|
(xexpr->string
|
|
(list
|
|
'span
|
|
(list (list 'title uri))
|
|
(format "~a: ~a"
|
|
(tr 'source)
|
|
source)))))
|
|
(send el-source set-innerHTML! ""))))
|
|
|
|
(define (cache-updated entry downloaded total)
|
|
(when (and page-ready
|
|
(not closed))
|
|
(let ((status (send entry get-cache-status)))
|
|
(case status
|
|
((downloading)
|
|
(send this
|
|
message!
|
|
(format
|
|
(tr 'downloading-track)
|
|
(send entry get-number)
|
|
(if (and total (> total 0))
|
|
(inexact->exact
|
|
(round
|
|
(* 100
|
|
(/ downloaded total))))
|
|
0))
|
|
#:clear #t))
|
|
((available)
|
|
(send this update-playlist)
|
|
(send this
|
|
message!
|
|
(format (tr 'download-track-complete)
|
|
(send entry get-number)
|
|
#:clear #t)))
|
|
((failed)
|
|
(send this update-playlist)
|
|
(send this
|
|
message!
|
|
(format (tr 'download-track-failed)
|
|
(send entry get-number))
|
|
#:clear #t))
|
|
))))
|
|
|
|
(define current-track-nr #f)
|
|
|
|
(define/private (popup-current-booklet evt)
|
|
(when (and playlist
|
|
(exact-nonnegative-integer?
|
|
current-track-nr)
|
|
(< current-track-nr
|
|
(send playlist length)))
|
|
(let ((track
|
|
(send playlist
|
|
track
|
|
current-track-nr)))
|
|
(when (and track
|
|
(send track has-booklet?))
|
|
(let ((menu
|
|
(wv-menu
|
|
'image-menu
|
|
(wv-menu-item
|
|
'm-booklet
|
|
(tr 'open-booklet)
|
|
#:callback
|
|
(lambda ()
|
|
(send this
|
|
open-booklet
|
|
(send track booklet-file)
|
|
#t)))))
|
|
(client-x (hash-ref evt 'clientX 60))
|
|
(client-y (hash-ref evt 'clientY 60)))
|
|
(send this
|
|
popup-menu!
|
|
menu
|
|
client-x
|
|
client-y))))))
|
|
|
|
(define (update-track-nr nr)
|
|
(when (eq? nr #f)
|
|
(update-track-source! #f))
|
|
(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)
|
|
(update-track-source!
|
|
(and current-track-nr
|
|
(send playlist
|
|
track
|
|
current-track-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)
|
|
)))
|
|
)
|
|
)
|
|
(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 'starting)
|
|
(set-play-button "buttons/pause.svg")
|
|
(send el
|
|
set-innerHTML!
|
|
(list 'span (tr 'starting))))
|
|
((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 active-player-id 'm-play-local)
|
|
(define dlna-renderers '())
|
|
(define renderer-preferences
|
|
(new renderer-preferences%
|
|
[settings settings]))
|
|
(define page-ready #f)
|
|
|
|
(define/private (get-media-library library-cfg)
|
|
(send library-factory
|
|
get-library
|
|
(send library-cfg get-id)
|
|
(send library-cfg get-kind)
|
|
(send library-cfg get-kind-version)))
|
|
|
|
(define/private (update-library-title! [library-cfg #f])
|
|
(send this
|
|
set-title!
|
|
(if library-cfg
|
|
(format "~a - ~a"
|
|
application-title
|
|
(send library-cfg get-name))
|
|
application-title)))
|
|
|
|
(define/private (use-library! library-cfg)
|
|
(let ((current-library
|
|
(send libraries-config current-library)))
|
|
(unless (and current-library
|
|
(eq? (send current-library get-id)
|
|
(send library-cfg get-id))
|
|
(send library-cfg is-current?))
|
|
(when current-library
|
|
(send current-library set-current! #f))
|
|
(send library-cfg set-current! #t))
|
|
(set! library-browser
|
|
(new library-browser%
|
|
[media-library
|
|
(get-media-library library-cfg)]))
|
|
(update-library-title! library-cfg)))
|
|
|
|
(define/private (initialize-library-browser!)
|
|
(let ((current-library
|
|
(send libraries-config current-library)))
|
|
(if current-library
|
|
(use-library! current-library)
|
|
(begin
|
|
(set! library-browser #f)
|
|
(update-library-title!)))))
|
|
|
|
(define/public (select-library-by-index library-idx)
|
|
(let ((library-cfg
|
|
(list-ref (send libraries-config libraries)
|
|
library-idx)))
|
|
(use-library! library-cfg)
|
|
(send this update-main-menu)
|
|
(send this update-library)))
|
|
|
|
(define/public (update-main-menu)
|
|
(let* ((libraries (send libraries-config libraries))
|
|
(current-library (send libraries-config current-library))
|
|
(current-library-id
|
|
(and current-library
|
|
(send current-library get-id)))
|
|
(connections '())
|
|
(menu
|
|
(player-menu
|
|
dlna-renderers
|
|
libraries
|
|
active-player-id
|
|
current-library-id
|
|
(lambda (id idx)
|
|
(set! connections
|
|
(cons
|
|
(lambda ()
|
|
(send this disconnect-menu! id)
|
|
(send this connect-menu!
|
|
id
|
|
(lambda ()
|
|
(with-handlers
|
|
((exn:fail?
|
|
(lambda (e)
|
|
(warn-rktplayer
|
|
"Could not select media renderer: ~a; context: ~s"
|
|
(exn-message e)
|
|
(continuation-mark-set->context
|
|
(exn-continuation-marks e)))
|
|
(send this
|
|
message!
|
|
(exn-message e)
|
|
#:clear #t
|
|
#:error #t))))
|
|
(send this play-to-dlna idx)))))
|
|
connections)))
|
|
(lambda (id idx)
|
|
(set! connections
|
|
(cons
|
|
(lambda ()
|
|
(send this disconnect-menu! id)
|
|
(send this connect-menu!
|
|
id
|
|
(lambda ()
|
|
(send this select-library-by-index idx))))
|
|
connections))))))
|
|
(send this set-menu! menu)
|
|
(for-each (lambda (connect)
|
|
(connect))
|
|
connections)
|
|
(void)))
|
|
|
|
(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]
|
|
))
|
|
(set! active-player-id 'm-play-local)
|
|
(unless (eq? playlist #f)
|
|
(send player playlist! playlist))
|
|
)
|
|
|
|
(define/public (play-to-dlna renderer-idx)
|
|
(let ((renderer
|
|
(list-ref dlna-renderers renderer-idx)))
|
|
(info-rktplayer
|
|
"Selecting media renderer index=~a name=~a"
|
|
renderer-idx
|
|
(send renderer get-name))
|
|
(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]
|
|
[error-updater
|
|
(lambda (kind detail)
|
|
(send this
|
|
message!
|
|
(case kind
|
|
((renderer-unreachable)
|
|
(format
|
|
(tr 'renderer-unreachable)
|
|
detail))
|
|
((renderer-command-failed)
|
|
(format
|
|
(tr 'renderer-command-failed)
|
|
detail))
|
|
(else
|
|
(format
|
|
(tr 'playback-failed)
|
|
detail)))
|
|
#:clear #t
|
|
#:error #t))]
|
|
[repeat-updater update-repeat]
|
|
[audio-info-cb update-audio-info]
|
|
[settings settings]))
|
|
(set! active-player-id
|
|
(string->symbol
|
|
(format "m-renderer-~a" renderer-idx)))
|
|
(unless (eq? playlist #f)
|
|
(send player playlist! playlist))
|
|
(when page-ready
|
|
(send this update-main-menu))))
|
|
|
|
(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 update-main-menu)
|
|
#t)
|
|
|
|
(define/public (check-dlna)
|
|
(check-dlna-players
|
|
this
|
|
renderer-preferences))
|
|
|
|
(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)
|
|
(send this set-volume! volume-range))
|
|
#:update (λ (val)
|
|
(send el-vol-perc
|
|
set-innerHTML!
|
|
(sprintf "%d%" val))))))
|
|
(send el-volume on-change! volume-reactor))
|
|
|
|
|
|
(set! el-library (send this element 'library))
|
|
(set! el-playlist (send this element 'tracks))
|
|
(send this
|
|
bind!
|
|
'album-art
|
|
'contextmenu
|
|
(lambda (element event data)
|
|
(popup-current-booklet data)))
|
|
(set! playlist-gui
|
|
(new playlist-gui%
|
|
[window this]
|
|
[element el-playlist]
|
|
[play-track-callback
|
|
(lambda (track-idx)
|
|
(send this play-track track-idx))]
|
|
[playlist-changed-callback
|
|
(lambda ()
|
|
(send this update-playlist))]))
|
|
|
|
(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))
|
|
(set! el-source (send this element 'source))
|
|
|
|
(set! page-ready #t)
|
|
(send this update-main-menu)
|
|
(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 update-main-menu)))
|
|
(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/public (update-playlist)
|
|
(send playlist-gui
|
|
update!
|
|
playlist
|
|
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/private (render-library! browser items can-go-up?)
|
|
(hash-clear! library-items)
|
|
(let ((rows '()))
|
|
(when browser
|
|
(let ((item-nr 0))
|
|
(set! rows
|
|
(map
|
|
(lambda (item)
|
|
(let ((item-id (format "media-item-~a" item-nr)))
|
|
(set! item-nr (+ item-nr 1))
|
|
(hash-set! library-items item-id item)
|
|
(list (format "row-~a" item-nr)
|
|
item-id
|
|
(send item get-title))))
|
|
items)))
|
|
(when can-go-up?
|
|
(set! rows
|
|
(cons (list "lib-up" "lib-up" "↰")
|
|
rows))))
|
|
(let ((html (mktable rows 'music-library media-item-formatter)))
|
|
(let ((result (send el-library set-innerHTML! html)))
|
|
(dbg-rktplayer "set-innerHTML!: ~a" result)
|
|
(send this scroll-top 'library)
|
|
(send this bind! "td.library-entry" 'click
|
|
(lambda (el evt data)
|
|
(let ((item-id (send el attr 'item-id)))
|
|
(cond
|
|
((equal? item-id "lib-up")
|
|
(send browser go-up!)
|
|
(send this update-library))
|
|
((hash-has-key? library-items item-id)
|
|
(let ((container
|
|
(send (hash-ref library-items item-id)
|
|
get-container)))
|
|
(when container
|
|
(send browser open-container! container)
|
|
(send this update-library))))))))
|
|
(send this bind! "td.library-entry" 'contextmenu
|
|
(lambda (el evt data)
|
|
(let ((item-id (send el attr 'item-id)))
|
|
(when (hash-has-key? library-items item-id)
|
|
(send this
|
|
context-for-media-item
|
|
data
|
|
(hash-ref library-items item-id))))))))))
|
|
|
|
(define/private (library-update-current? request browser)
|
|
(and (= request library-update-request)
|
|
(eq? browser library-browser)
|
|
page-ready
|
|
(not closed)))
|
|
|
|
(define/public (update-library)
|
|
(set! library-update-request (+ library-update-request 1))
|
|
(let ((request library-update-request)
|
|
(browser library-browser))
|
|
(hash-clear! library-items)
|
|
(if browser
|
|
(begin
|
|
(send el-library
|
|
set-innerHTML!
|
|
(xexpr->string
|
|
(list 'div
|
|
'((class "library-loading"))
|
|
(tr 'searching))))
|
|
(thread
|
|
(lambda ()
|
|
(with-handlers
|
|
((exn:fail?
|
|
(lambda (exception)
|
|
(when (library-update-current? request browser)
|
|
(warn-rktplayer
|
|
"Could not browse music library: ~a"
|
|
(exn-message exception))
|
|
(send this
|
|
message!
|
|
(format
|
|
(tr 'library-browse-failed)
|
|
(exn-message exception))
|
|
#:clear #t
|
|
#:error #t)
|
|
(render-library! browser '() #f)))))
|
|
(let ((items (send browser get-items))
|
|
(can-go-up? (send browser can-go-up?)))
|
|
(when (library-update-current? request browser)
|
|
(render-library! browser items can-go-up?)))))))
|
|
(render-library! #f '() #f)))
|
|
(void))
|
|
|
|
(define/private (media-item-containing-folder item)
|
|
(let ((track (send item get-track)))
|
|
(if track
|
|
(let* ((resource (send track get-resource))
|
|
(file
|
|
(and resource
|
|
(is-a? resource
|
|
media-resource-file%)
|
|
(send resource get-file))))
|
|
(and file
|
|
(path-only file)))
|
|
(let* ((container-id (send item get-id))
|
|
(media-library
|
|
(send library-browser get-media-library)))
|
|
(and (eq? (send media-library get-kind)
|
|
'filesystem)
|
|
(send media-library
|
|
resolve-path
|
|
(cdr container-id)))))))
|
|
|
|
(define/public (context-for-media-item evt item)
|
|
(let* ((track (send item get-track))
|
|
(containing-folder
|
|
(media-item-containing-folder item))
|
|
(items
|
|
(list
|
|
(wv-menu-item
|
|
'm-play-this
|
|
(tr 'play-this)
|
|
#:callback
|
|
(lambda ()
|
|
(send this play-media-item item)))
|
|
(wv-menu-item
|
|
'm-add-this
|
|
(tr 'add-this)
|
|
#:callback
|
|
(lambda ()
|
|
(send this add-media-item item))))))
|
|
(when (and track
|
|
(send track has-booklet?))
|
|
(set! items
|
|
(append
|
|
items
|
|
(list
|
|
(wv-menu-item
|
|
'm-booklet
|
|
(tr 'open-booklet)
|
|
#:callback
|
|
(lambda ()
|
|
(send this
|
|
open-booklet
|
|
(send track booklet-file)
|
|
#t)))))))
|
|
(when containing-folder
|
|
(set! items
|
|
(append
|
|
items
|
|
(list
|
|
(wv-menu-item
|
|
'm-folder
|
|
(tr 'open-containing-folder)
|
|
#:callback
|
|
(lambda ()
|
|
(send this
|
|
open-folder
|
|
containing-folder)))))))
|
|
(let ((menu (wv-menu 'library-popup items))
|
|
(client-x (hash-ref evt 'clientX 60))
|
|
(client-y (hash-ref evt 'clientY 60)))
|
|
(send this
|
|
popup-menu!
|
|
menu
|
|
client-x
|
|
client-y))))
|
|
|
|
(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-media-item item)
|
|
(set! current-track-nr #f)
|
|
(send playlist replace-with-media-item! item)
|
|
(send this update-playlist)
|
|
(send player play playlist)
|
|
(dbg-rktplayer
|
|
"number of tracks: ~a"
|
|
(send playlist length)))
|
|
|
|
(define/public (add-media-item item)
|
|
(send playlist add-media-item item)
|
|
(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))
|
|
)
|
|
(display "volume-display = ") (write volume-display) (newline)
|
|
(if (eq? volume-display 'block)
|
|
(send volume-meter display 'none)
|
|
(begin
|
|
(send volume-meter display 'block)
|
|
(send el-volume set!
|
|
(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")
|
|
(set! closed #t)
|
|
(when playlist
|
|
(send playlist stop-cache!))
|
|
(send player quit)
|
|
(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]
|
|
[renderers dlna-renderers]
|
|
[libraries-changed-callback
|
|
(lambda ()
|
|
(initialize-library-browser!)
|
|
(when page-ready
|
|
(send this update-main-menu)
|
|
(send this update-library)))]
|
|
[cache-cleared-callback
|
|
(lambda ()
|
|
(when playlist
|
|
(send playlist reset-cache!)
|
|
(when page-ready
|
|
(send this update-playlist))))])))
|
|
(send dlg show)))
|
|
|
|
(define/public (select-library)
|
|
(send this settings-dlg))
|
|
|
|
|
|
(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)
|
|
(initialize-library-browser!)
|
|
(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)]
|
|
[cache-updated cache-updated]))
|
|
(send player set-list! playlist)
|
|
(dbg-rktplayer "playlist = ~a" playlist)
|
|
|
|
(semaphore-post initialized)
|
|
)
|
|
)
|
|
)
|
|
|
|
|