multiple libraries
This commit is contained in:
@@ -12,12 +12,13 @@
|
||||
"playlist.rkt"
|
||||
"player.rkt"
|
||||
"settings.rkt"
|
||||
"libraries.rkt"
|
||||
)
|
||||
|
||||
(provide
|
||||
(all-from-out racket-webview)
|
||||
rktplayer%
|
||||
)
|
||||
(all-from-out racket-webview)
|
||||
rktplayer%
|
||||
)
|
||||
|
||||
(define-runtime-path rkt-gui-dir "gui")
|
||||
|
||||
@@ -25,14 +26,14 @@
|
||||
(define player-menu
|
||||
(λ ()
|
||||
(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-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)
|
||||
)
|
||||
)
|
||||
)))
|
||||
|
||||
(define rktplayer%
|
||||
(class wv-window%
|
||||
@@ -40,14 +41,14 @@
|
||||
(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]
|
||||
)
|
||||
[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)
|
||||
@@ -63,14 +64,19 @@
|
||||
(define cfg (send settings clone 'settings))
|
||||
|
||||
(define current-tab 0)
|
||||
|
||||
|
||||
(define music-library
|
||||
(let ((path (format "~a" (send cfg get 'music-library (find-system-path 'home-dir)))))
|
||||
(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)
|
||||
|
||||
@@ -83,13 +89,13 @@
|
||||
(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)))
|
||||
(not (= current-length-seconds ls)))
|
||||
(set! current-at-seconds as)
|
||||
(set! current-length-seconds ls)
|
||||
(let ((as-str (sprintf "%02d:%02d:%02d"
|
||||
@@ -116,7 +122,7 @@
|
||||
)
|
||||
|
||||
(define current-track-nr #f)
|
||||
|
||||
|
||||
(define (update-track-nr nr)
|
||||
(unless (or (eq? playlist #f)
|
||||
(= (send playlist length) 0))
|
||||
@@ -129,7 +135,7 @@
|
||||
(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")
|
||||
@@ -142,7 +148,7 @@
|
||||
(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)
|
||||
@@ -158,8 +164,8 @@
|
||||
(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)))))
|
||||
(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))))))
|
||||
@@ -199,10 +205,10 @@
|
||||
((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))))
|
||||
(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)
|
||||
)
|
||||
@@ -216,18 +222,18 @@
|
||||
(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)))
|
||||
|
||||
(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))
|
||||
@@ -251,13 +257,13 @@
|
||||
|
||||
(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)))
|
||||
)
|
||||
(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))
|
||||
@@ -289,7 +295,7 @@
|
||||
(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
|
||||
@@ -339,16 +345,16 @@
|
||||
(send el set-attr! (list 'src img)))
|
||||
)
|
||||
)
|
||||
|
||||
|
||||
(define 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]
|
||||
))
|
||||
|
||||
[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]
|
||||
))
|
||||
|
||||
(define inner-html-handlers (make-hash))
|
||||
|
||||
(define/override (page-loaded oke)
|
||||
@@ -371,24 +377,24 @@
|
||||
(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)))))
|
||||
(λ (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))
|
||||
)))))
|
||||
(λ (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))
|
||||
@@ -438,10 +444,10 @@
|
||||
(λ (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))
|
||||
)
|
||||
#:callback (λ ()
|
||||
(send playlist drop-id (send el id))
|
||||
(update-playlist))
|
||||
)
|
||||
)
|
||||
)
|
||||
(clientX (hash-ref data 'clientX 60))
|
||||
@@ -457,23 +463,23 @@
|
||||
(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)
|
||||
(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)
|
||||
@@ -482,25 +488,25 @@
|
||||
(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)))
|
||||
(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)
|
||||
'())))))
|
||||
(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))
|
||||
)
|
||||
@@ -544,21 +550,21 @@
|
||||
|
||||
(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))))))
|
||||
(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)))))))
|
||||
(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
|
||||
))))
|
||||
|
||||
(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)))
|
||||
)))
|
||||
(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))
|
||||
@@ -575,10 +581,10 @@
|
||||
;(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")
|
||||
))
|
||||
#:host "hans@mahler.thuis.local"
|
||||
#:basepaths '(("\\\\panderleou\\music" . "/muziek")
|
||||
("//panderleou/music" . "/muziek")
|
||||
))
|
||||
(send player change-player 'local))
|
||||
(info-rktplayer "Playing remote: ~a" play-remote)
|
||||
)
|
||||
@@ -609,8 +615,8 @@
|
||||
(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)))
|
||||
;(let ((folder (if (file-exists? path) (path-only path) path)))
|
||||
; (open-file-manager folder)))
|
||||
|
||||
(define/public (play-or-pause)
|
||||
(cond
|
||||
@@ -619,7 +625,7 @@
|
||||
((eq? state 'paused)
|
||||
(send player play!))
|
||||
(else
|
||||
(play-track 0))
|
||||
(play-track 0))
|
||||
)
|
||||
)
|
||||
|
||||
@@ -689,35 +695,18 @@
|
||||
(super quit)
|
||||
)
|
||||
|
||||
(define/public (select-library)
|
||||
(let ((dir (send this choose-dir
|
||||
(tr 'choose-lib-folder)
|
||||
(if (string? music-library) music-library (path->string music-library))
|
||||
)))
|
||||
(if (eq? dir 'showing)
|
||||
'done
|
||||
(unless (eq? dir #f)
|
||||
(set! music-library dir)
|
||||
(send settings set! 'music-library dir)
|
||||
(set! current-music-path #f)
|
||||
(send this update-library)
|
||||
)
|
||||
)
|
||||
)
|
||||
)
|
||||
|
||||
(define/public (settings-dlg)
|
||||
(let ((dlg (new settings% [settings (send settings clone 'settings-dlg)]
|
||||
[parent this])))
|
||||
[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)
|
||||
)
|
||||
(send this present)
|
||||
(send this hide)
|
||||
)
|
||||
)
|
||||
)
|
||||
|
||||
@@ -725,7 +714,7 @@
|
||||
|
||||
(define/public (set-window-state-change-callback! f)
|
||||
(set! window-state-change-callback f))
|
||||
|
||||
|
||||
(define/override (window-state-changed st)
|
||||
(window-state-change-callback))
|
||||
|
||||
|
||||
Reference in New Issue
Block a user