hans/rktplayer
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

multiple libraries

Browse Source
This commit is contained in:
Hans Dijkema
2026-07-29 13:27:48 +02:00
parent f949e2dbb3
commit 727e0643af
9 changed files with 573 additions and 184 deletions
Download Patch File Download Diff File Expand all files Collapse all files
gui.rkt
+127 -138
View File
@@ -12,12 +12,13 @@
"playlist.rkt" "playlist.rkt"
"player.rkt" "player.rkt"
"settings.rkt" "settings.rkt"
"libraries.rkt"
) )
(provide (provide
(all-from-out racket-webview) (all-from-out racket-webview)
rktplayer% rktplayer%
) )
(define-runtime-path rkt-gui-dir "gui") (define-runtime-path rkt-gui-dir "gui")
@@ -25,14 +26,14 @@
(define player-menu (define player-menu
(λ () (λ ()
(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)
) )
) )
))) )))
(define rktplayer% (define rktplayer%
(class wv-window% (class wv-window%
@@ -40,14 +41,14 @@
(inherit-field settings icon) (inherit-field settings icon)
(super-new (super-new
[html-path "rktplayer.html"] [html-path "rktplayer.html"]
[title "Racket Music Player"] [title "Racket Music Player"]
[icon (build-path rkt-gui-dir "rktplayer.png")] [icon (build-path rkt-gui-dir "rktplayer.png")]
[quit-on-close #f] [quit-on-close #f]
) )
(define initialized (make-semaphore 0)) (define initialized (make-semaphore 0))
(define closed #f) (define closed #f)
(define el-seeker #f) (define el-seeker #f)
(define el-volume #f) (define el-volume #f)
@@ -63,14 +64,19 @@
(define cfg (send settings clone 'settings)) (define cfg (send settings clone 'settings))
(define current-tab 0) (define current-tab 0)
(define music-library (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) (when (eq? (system-type 'os) 'windows)
(set! path (string-replace path "/" "\\"))) (set! path (string-replace path "/" "\\")))
(dbg-rktplayer "music-library: ~a" path) (dbg-rktplayer "music-library: ~a" path)
path)) path))
(define current-music-path #f) (define current-music-path #f)
(define playlist #f) (define playlist #f)
@@ -83,13 +89,13 @@
(send el set-innerHTML! (sprintf "%s %d%" (tr 'volume) percentage))) (send el set-innerHTML! (sprintf "%s %d%" (tr 'volume) percentage)))
) )
) )
(define (update-time at-seconds length-seconds) (define (update-time at-seconds length-seconds)
(let ((as (inexact->exact (round at-seconds))) (let ((as (inexact->exact (round at-seconds)))
(ls (inexact->exact (round length-seconds)))) (ls (inexact->exact (round length-seconds))))
(when (or (not (= current-at-seconds as)) (when (or (not (= current-at-seconds as))
(not (= current-length-seconds ls))) (not (= current-length-seconds ls)))
(set! current-at-seconds as) (set! current-at-seconds as)
(set! current-length-seconds ls) (set! current-length-seconds ls)
(let ((as-str (sprintf "%02d:%02d:%02d" (let ((as-str (sprintf "%02d:%02d:%02d"
@@ -116,7 +122,7 @@
) )
(define current-track-nr #f) (define current-track-nr #f)
(define (update-track-nr nr) (define (update-track-nr nr)
(unless (or (eq? playlist #f) (unless (or (eq? playlist #f)
(= (send playlist length) 0)) (= (send playlist length) 0))
@@ -129,7 +135,7 @@
(dbg-rktplayer (format "current old track: ~a" (id))) (dbg-rktplayer (format "current old track: ~a" (id)))
(let ((el (send this element (id)))) (let ((el (send this element (id))))
(send el remove-class! "current"))) (send el remove-class! "current")))
(set! current-track-nr nr) (set! current-track-nr nr)
(dbg-rktplayer "Adding current") (dbg-rktplayer "Adding current")
@@ -142,7 +148,7 @@
(let* ((track (send playlist track current-track-nr)) (let* ((track (send playlist track current-track-nr))
(img-file (build-path (find-system-path 'cache-dir) "rktplayer-cover-image")) (img-file (build-path (find-system-path 'cache-dir) "rktplayer-cover-image"))
(stored-file (send track image->file img-file)) (stored-file (send track image->file img-file))
) )
(dbg-rktplayer "image mimetype: ~a" (send track image->mimetype)) (dbg-rktplayer "image mimetype: ~a" (send track image->mimetype))
(dbg-rktplayer "stored-file = ~a" stored-file) (dbg-rktplayer "stored-file = ~a" stored-file)
(unless (eq? stored-file #f) (unless (eq? stored-file #f)
@@ -158,8 +164,8 @@
(send this bind! 'album-image 'contextmenu (send this bind! 'album-image 'contextmenu
(λ (el evt data) (λ (el evt data)
(let ((mnu (wv-menu 'image-menu (let ((mnu (wv-menu 'image-menu
(wv-menu-item 'm-booklet (tr 'open-booklet) (wv-menu-item 'm-booklet (tr 'open-booklet)
#:callback (λ () (send this open-booklet booklet-file #t))))) #:callback (λ () (send this open-booklet booklet-file #t)))))
(clientX (hash-ref data 'clientX 60)) (clientX (hash-ref data 'clientX 60))
(clientY (hash-ref data 'clientY 60))) (clientY (hash-ref data 'clientY 60)))
(send this popup-menu! mnu clientX clientY)))))) (send this popup-menu! mnu clientX clientY))))))
@@ -199,10 +205,10 @@
((eq? st 'quit) ((eq? st 'quit)
(void)) (void))
(else (else
(warn-rktplayer "Unkown state for update-state ~a" st) (warn-rktplayer "Unkown state for update-state ~a" st)
(send el set-innerHTML! (list 'span (send el set-innerHTML! (list 'span
'((class "blink")) '((class "blink"))
(format "~a: ~a" (tr 'unknown-state) st)))) (format "~a: ~a" (tr 'unknown-state) st))))
)) ))
(set! state st) (set! state st)
) )
@@ -216,18 +222,18 @@
(idx 0) (idx 0)
) )
(while (< idx tabs) (while (< idx tabs)
(let ((tab-name (send playlist get-tab-name idx))) (let ((tab-name (send playlist get-tab-name idx)))
(set! html (string-append (set! html (string-append
html html
(xexpr->string (xexpr->string
(list 'span (list (list 'id (format "tab~a" idx)) (list 'span (list (list 'id (format "tab~a" idx))
'(class "tab")) '(class "tab"))
tab-name)))) tab-name))))
) )
(set! idx (+ idx 1))) (set! idx (+ idx 1)))
(send tab-el set-innerHTML! html) (send tab-el set-innerHTML! html)
(send this bind! "#tabs > span" 'click (send this bind! "#tabs > span" 'click
(λ (el evt data) (λ (el evt data)
(let* ((tab-id (send el id)) (let* ((tab-id (send el id))
@@ -251,13 +257,13 @@
(define/public (tab-context evt tab-id tab-idx) (define/public (tab-context evt tab-id tab-idx)
(let ((items (list (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-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-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-add (tr 'add-playlist) #:callback (λ () (send this add-tab)))
) )
) )
) )
(let* ((mnu (wv-menu 'tab-popup items)) (let* ((mnu (wv-menu 'tab-popup items))
(clientX (hash-ref evt 'clientX 60)) (clientX (hash-ref evt 'clientX 60))
(clientY (hash-ref evt 'clientY 60)) (clientY (hash-ref evt 'clientY 60))
@@ -289,7 +295,7 @@
(unbind-events (λ () (unbind-events (λ ()
(send this unbind! inp-id 'change) (send this unbind! inp-id 'change)
(send this unbind! inp-id 'blur))) (send this unbind! inp-id 'blur)))
) )
(send tab-el set-innerHTML! html) (send tab-el set-innerHTML! html)
(send this unbind! tab-el-id '(click contextmenu)) (send this unbind! tab-el-id '(click contextmenu))
(send this bind! inp-id 'change (send this bind! inp-id 'change
@@ -339,16 +345,16 @@
(send el set-attr! (list 'src img))) (send el set-attr! (list 'src img)))
) )
) )
(define player (new player% (define 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]
[repeat-updater update-repeat] [repeat-updater update-repeat]
[audio-info-cb update-audio-info] [audio-info-cb update-audio-info]
[settings settings] [settings settings]
)) ))
(define inner-html-handlers (make-hash)) (define inner-html-handlers (make-hash))
(define/override (page-loaded oke) (define/override (page-loaded oke)
@@ -371,24 +377,24 @@
(set! el-seeker (send this element 'seek)) (set! el-seeker (send this element 'seek))
(dbg-rktplayer "el-seeker: ~a" (send el-seeker get)) (dbg-rktplayer "el-seeker: ~a" (send el-seeker get))
(let ((seek-reactor (webview-delayed-reactor 0.3 (let ((seek-reactor (webview-delayed-reactor 0.3
(λ (percentage) (λ (percentage)
;(displayln (format "el-seeker: ~a" percentage)) ;(displayln (format "el-seeker: ~a" percentage))
(send this seek-to percentage))))) (send this seek-to percentage)))))
(send el-seeker on-change! seek-reactor)) (send el-seeker on-change! seek-reactor))
(set! el-volume (send this element 'volume-range)) (set! el-volume (send this element 'volume-range))
(set! el-vol-perc (send this element 'volume-perc)) (set! el-vol-perc (send this element 'volume-perc))
(dbg-rktplayer "el-volume: ~a" (send el-volume get)) (dbg-rktplayer "el-volume: ~a" (send el-volume get))
(let ((volume-reactor (webview-delayed-reactor 1.0 (let ((volume-reactor (webview-delayed-reactor 1.0
(λ (volume-range) (λ (volume-range)
(let ((percentage (* volume-range volume-range))) (let ((percentage (* volume-range volume-range)))
(send this set-volume! percentage))) (send this set-volume! percentage)))
#:update (λ (val) #:update (λ (val)
(let ((p (* val val))) (let ((p (* val val)))
(send el-vol-perc set-innerHTML! (sprintf "%d%" p)) (send el-vol-perc set-innerHTML! (sprintf "%d%" p))
))))) )))))
(send el-volume on-change! volume-reactor)) (send el-volume on-change! volume-reactor))
(set! el-library (send this element 'library)) (set! el-library (send this element 'library))
(set! el-playlist (send this element 'tracks)) (set! el-playlist (send this element 'tracks))
@@ -438,10 +444,10 @@
(λ (el evt data) (λ (el evt data)
(let ((mnu (wv-menu 'track-menu (let ((mnu (wv-menu 'track-menu
(wv-menu-item 'm-drop-track "Drop track" (wv-menu-item 'm-drop-track "Drop track"
#:callback (λ () #:callback (λ ()
(send playlist drop-id (send el id)) (send playlist drop-id (send el id))
(update-playlist)) (update-playlist))
) )
) )
) )
(clientX (hash-ref data 'clientX 60)) (clientX (hash-ref data 'clientX 60))
@@ -457,23 +463,23 @@
(set! from-idx (send playlist index (send el id))) (set! from-idx (send playlist index (send el id)))
) )
#t) #t)
(send this bind! "table.tracks tr" 'dragover (send this bind! "table.tracks tr" 'dragover
(λ (el evt data) (λ (el evt data)
#t) #t)
) )
(send this bind! "table.tracks tr" 'drop (send this bind! "table.tracks tr" 'drop
(λ (el evt data) (λ (el evt data)
(dbg-rktplayer "Element dropped on ~a" (send el id)) (dbg-rktplayer "Element dropped on ~a" (send el id))
(set! to-idx (send playlist index (send el id))) (set! to-idx (send playlist index (send el id)))
(when (and (integer? from-idx) (integer? to-idx) (when (and (integer? from-idx) (integer? to-idx)
(not (= from-idx to-idx))) (not (= from-idx to-idx)))
(send playlist move-track from-idx to-idx) (send playlist move-track from-idx to-idx)
(update-playlist) (update-playlist)
)
) )
) )
)
) )
(update-track-nr current-track-nr) (update-track-nr current-track-nr)
) )
(send this update-volume) (send this update-volume)
@@ -482,25 +488,25 @@
(define/public (scroll-top id) (define/public (scroll-top id)
(send this run-js (send this run-js
(format (format
(string-append "{ let el_id = '~a';" (string-append "{ let el_id = '~a';"
" console.log('id = ' + el_id);" " console.log('id = ' + el_id);"
" let el = document.getElementById(el_id);" " let el = document.getElementById(el_id);"
" console.log(el);" " console.log(el);"
" el.scrollTop = 0;" " el.scrollTop = 0;"
"}") "}")
id))) id)))
(define/public (update-library) (define/public (update-library)
(when (eq? current-music-path #f) (when (eq? current-music-path #f)
(set! current-music-path music-library)) (set! current-music-path music-library))
(let* ((nr 0) (let* ((nr 0)
(l (filter (λ (r) (music-lib-relevant? (cadr r))) (l (filter (λ (r) (music-lib-relevant? (cadr r)))
(map (λ (e) (map (λ (e)
(set! nr (+ nr 1)) (set! nr (+ nr 1))
(list (format "row-~a" nr) (build-path current-music-path e) (format "path-~a" nr))) (list (format "row-~a" nr) (build-path current-music-path e) (format "path-~a" nr)))
(if (directory-exists? current-music-path) (if (directory-exists? current-music-path)
(directory-list current-music-path) (directory-list current-music-path)
'()))))) '())))))
(unless (path-equal? current-music-path music-library) (unless (path-equal? current-music-path music-library)
(set! l (cons (list "lib-up" "↰" "lib-up") l)) (set! l (cons (list "lib-up" "↰" "lib-up") l))
) )
@@ -544,21 +550,21 @@
(define/public (context-for-path evt path) (define/public (context-for-path evt path)
(let ((items (list (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) (when (file-exists? path)
(set! items (append items (set! items (append items
(list (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")) (when (file-exists? (build-path path "booklet.pdf"))
(set! items (append items (set! items (append items
(list (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 (set! items (append items
(list (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)) (let* ((mnu (wv-menu 'library-popup items))
(clientX (hash-ref evt 'clientX 60)) (clientX (hash-ref evt 'clientX 60))
(clientY (hash-ref evt 'clientY 60)) (clientY (hash-ref evt 'clientY 60))
@@ -575,10 +581,10 @@
;(displayln (format "player = ~a" player)) ;(displayln (format "player = ~a" player))
(if play-remote (if play-remote
(send player change-player 'remote (send player change-player 'remote
#:host "hans@mahler.thuis.local" #:host "hans@mahler.thuis.local"
#:basepaths '(("\\\\panderleou\\music" . "/muziek") #:basepaths '(("\\\\panderleou\\music" . "/muziek")
("//panderleou/music" . "/muziek") ("//panderleou/music" . "/muziek")
)) ))
(send player change-player 'local)) (send player change-player 'local))
(info-rktplayer "Playing remote: ~a" play-remote) (info-rktplayer "Playing remote: ~a" play-remote)
) )
@@ -609,8 +615,8 @@
(define/public (open-folder path) (define/public (open-folder path)
(dbg-rktplayer "path: ~a" path) (dbg-rktplayer "path: ~a" path)
(open-file-manager path)) (open-file-manager path))
;(let ((folder (if (file-exists? path) (path-only path) path))) ;(let ((folder (if (file-exists? path) (path-only path) path)))
; (open-file-manager folder))) ; (open-file-manager folder)))
(define/public (play-or-pause) (define/public (play-or-pause)
(cond (cond
@@ -619,7 +625,7 @@
((eq? state 'paused) ((eq? state 'paused)
(send player play!)) (send player play!))
(else (else
(play-track 0)) (play-track 0))
) )
) )
@@ -689,35 +695,18 @@
(super quit) (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) (define/public (settings-dlg)
(let ((dlg (new settings% [settings (send settings clone 'settings-dlg)] (let ((dlg (new settings% [settings (send settings clone 'settings-dlg)]
[parent this]))) [parent this])))
(send dlg show))) (send dlg show)))
(define/public (show-hide) (define/public (show-hide)
(let ((st (send this window-state))) (let ((st (send this window-state)))
(if (eq? st 'hidden) (if (eq? st 'hidden)
(send this present) (send this present)
(send this hide) (send this hide)
) )
) )
) )
@@ -725,7 +714,7 @@
(define/public (set-window-state-change-callback! f) (define/public (set-window-state-change-callback! f)
(set! window-state-change-callback f)) (set! window-state-change-callback f))
(define/override (window-state-changed st) (define/override (window-state-changed st)
(window-state-change-callback)) (window-state-change-callback))
gui/library-dialog.html
+41
View File
@@ -0,0 +1,41 @@
<!DOCTYPE html>
<html>
<head>
<link rel="stylesheet" href="styles.css" />
<meta charset="UTF-8" />
<title>RktPlayer - A music player - library entry</title>
</head>
<body>
<div class="pane">
<div class="keyval">
<label for="kind" id="lbl-kind">Action:</label>
<span id="kind">Action</span>
</div>
<hr />
<div class="keyval">
<label for="name" id="lbl-name">Name:</label>
<input type="text" id="name" />
</div>
<div class="keyval">
<label for="local-path" id="lbl-local-path">Local path:</label>
<div class="file-box">
<input id="local-path" type="text" />
<button id="browse">Browse</button>
</div>
</div>
<div class="keyval">
<label for="host" id="lbl-host">Host:</label>
<input type="text" id="host" />
</div>
<div class="keyval">
<label for="prefixes" id="lbl-prefixes">Prefixes:</label>
<textarea type="text" id="prefixes"></textarea>
</div>
</div>
<div class="button-box">
<button id="ok">OK</button>
<button id="cancel">Cancel</button>
<button id="dev">devtools</button>
</div>
</body>
</html>
gui/rktplayer.html
+1 -1
View File
@@ -5,7 +5,7 @@
<meta charset="UTF-8" /> <meta charset="UTF-8" />
<title>RktPlayer - A music player</title> <title>RktPlayer - A music player</title>
<!--<script src="../../webui-wire/js/menu.js"></script>--> <!--<script src="../../webui-wire/js/menu.js"></script>-->
<script src="menu.js"></script> <!--<script src="menu.js"></script>-->
</head> </head>
<body> <body>
<div class="pane"> <div class="pane">
gui/settings.html
+22 -16
View File
@@ -1,10 +1,9 @@
<!DOCTYPE html> <!DOCTYPE html>
<html> <html>
<head> <head>
<link rel="stylesheet" href="styles.css" /> <link rel="stylesheet" href="styles.css" />
<meta charset="UTF-8" /> <meta charset="UTF-8" />
<title>RktPlayer - A music player - Settings</title> <title>RktPlayer - A music player - Settings</title>
<script src="menu.js"></script>
</head> </head>
<body> <body>
<div class="pane"> <div class="pane">
@@ -12,19 +11,26 @@
<label for="language" id="lbl-language">Languages:</label> <label for="language" id="lbl-language">Languages:</label>
<span id="language">Languages</span> <span id="language">Languages</span>
</div> </div>
<hr />
<label id="lbl-libary-path">Library path:</label> <label id="lbl-libary-path">Library path:</label>
<table class="libraries"> <hr />
<thead id="lib-head"> <table class="libraries">
<tr><th id="lbl-name"></th><th id="lbl-local-path"></th><th id="lbl-host"></th><th id="lbl-prefixes"></th></tr> <thead id="lib-head">
</thead> <tr><th id="lbl-name"></th><th id="lbl-local-path"></th><th id="lbl-host"></th><th id="lbl-prefixes"></th></tr>
<tbody id="lib-body"> </thead>
</tbody> <tbody id="lib-body">
</table> </tbody>
<div class="button-box"> </table>
<button id="ok">OK</button> <div class="button-box">
<button id="cancel">Cancel</button> <button id="add">Add Library</button>
<button id="dev">devtools</button> <button id="edit">Edit Library</button>
</div> <button id="remove">Remove Library</button>
</div>
</div>
<div class="button-box">
<button id="ok">OK</button>
<button id="cancel">Cancel</button>
<button id="dev">devtools</button>
</div> </div>
</body> </body>
</html> </html>
gui/styles.css
+37 -5
View File
@@ -13,6 +13,27 @@ body {
padding: 3px; padding: 3px;
} }
hr {
border: none;
border-top: 1px solid #909090;
margin: 5px 0;
}
.file-box {
display: inline-block;
width: 100%;
}
.file-box span {
display: inline-block;
width: calc(70% - 5px);
}
.file-box button {
display: inline-block;
width: calc(30% - 5px);
}
.keyval { .keyval {
width: 100%; width: 100%;
padding-bottom: 5px; padding-bottom: 5px;
@@ -23,11 +44,18 @@ body {
width: calc(30% - 5px); width: calc(30% - 5px);
} }
.keyval span { .keyval span, .keyval input, .keyval select,
.keyval textarea, .keyval .file-box {
display: inline-block; display: inline-block;
width: calc(70% - 10px); width: calc(70% - 10px);
} }
.button-box {
border-top: 1px solid #909090;
width: 100%;
padding-top: 5px;
}
.buttons { .buttons {
height: 40px; height: 40px;
width: 100%; width: 100%;
@@ -244,22 +272,26 @@ table.tracks td.title, table.tracks td.album {
} }
table.tracks tr, table.tracks td { table.tracks tr, table.tracks td,
table.libraries tr, table.libraries td {
cursor: default; cursor: default;
user-select: none; user-select: none;
} }
table.tracks tr:hover { table.tracks tr:hover, table.libraries tbody tr:hover {
background: #e0e0e0; background: #e0e0e0;
color: black; color: black;
transition: all 0.5s ease-in; transition: all 0.5s ease-in;
} }
table.tracks tr:hover.current { table.tracks tr:hover.current,
table.libraries tbody tr:hover.current
{
color: #955c12; color: #955c12;
} }
table.tracks tr.current { table.tracks tr.current,
table.libraries tbody tr.current {
font-weight: bold; font-weight: bold;
color: #f3961e; color: #f3961e;
} }
libraries.rkt
+114
View File
@@ -0,0 +1,114 @@
#lang racket/base
(require racket/class
"utils.rkt"
)
(provide libraries%
library%
)
(define library%
(class object%
(init-field [id (new-id)] [name ""] [local-path ""]
[host ""] [prefixes ""] [current #f])
(super-new)
(define/public (get-id) id)
(define/public (get-name) name)
(define/public (get-local-path) local-path)
(define/public (get-host) host)
(define/public (get-prefixes) prefixes)
(define/public (is-current?) current)
(define/public (get-current) current)
(define/public (set-current! c) (set! current c))
(define/public (->list)
(list id name local-path host prefixes current))
))
(define libraries%
(class object%
(init-field [settings settings])
(super-new)
(define libs #f)
(define cfg (send settings clone 'settings))
(define (to-library e)
(let ((f (lambda (id n lp h p . c)
(let ((cc (if (null? c) #f (car c))))
(new library% [id id]
[name n] [local-path lp]
[host h] [prefixes p] [current cc])
))))
(apply f e)
)
)
(define (from-library l)
(send l ->list))
(define/public (libraries)
(when (eq? libs #f)
(set! libs (sort (map to-library (send cfg get 'libraries '()))
(lambda (a b)
(string<? (send a get-name) (send b get-name))))))
libs)
(define/public (set-libraries! libs*)
(send cfg set! 'libraries (map from-library libs*))
(set! libs #f))
(define/public (count)
(length (send this libraries)))
(define/public (library-id idx)
(let ((libs (send this libraries)))
(if (and (>= idx 0) (< idx (length libs)))
(send (list-ref libs idx) get-id)
#f)))
(define/public (get-library id)
(let ((libs (send this libraries)))
(for/or ([lib libs])
(when (eq? (send lib get-id) id)
lib))))
(define/public (remove-library id)
(let ((libs (send this libraries)))
(send this set-libraries! (filter (λ (lib)
(not (eq? (send lib get-id) id)))
libs))))
(define/public (add-library l)
(let ((libs (send this libraries)))
(send this set-libraries!
(cons (send l ->list) libs))
(set! libs #f)
(send l get-id)))
(define/public (update-library l)
(let ((libs (send this libraries))
(id (send l get-id)))
(send this set-libraries! (map (λ (lib)
(if (eq? (send lib get-id) id)
l
lib))
libs))))
(define/public (current-library)
(letrec ((f (lambda (libs)
(if (null? libs)
(if (= (send this count) 0)
#f (send this get-library
(send this library-id 0)))
(let ((l (car libs)))
(if (send l is-current?)
l
(f (cdr libs))))))
))
(f (send this libraries))))
))
settings.rkt
+199 -23
View File
@@ -11,50 +11,71 @@
"translate.rkt" "translate.rkt"
"playlist.rkt" "playlist.rkt"
"player.rkt" "player.rkt"
"libraries.rkt"
) )
(provide (provide
(all-from-out racket-webview) (all-from-out racket-webview)
settings% settings%
) )
(define-runtime-path rkt-gui-dir "gui") (define-runtime-path rkt-gui-dir "gui")
(define settings% (define library-dlg%
(class wv-dialog% (class wv-dialog%
(init-field [log-file #f]) (init-field [kind #f] [result-cb (λ args #f)]
[id (new-id)] [name ""] [local-path ""]
[host ""] [prefixes ""])
(inherit-field settings icon parent) (inherit-field settings icon parent)
(super-new (super-new
[html-path "settings.html"] [html-path "library-dialog.html"]
[title "Racket Music Player - Settings"] [title (tr 'settings-library)]
[icon (build-path rkt-gui-dir "rktplayer.png")] [icon (build-path rkt-gui-dir "rktplayer.png")]
[quit-on-close #f] [quit-on-close #f]
) )
(define initialized #f) (define initialized #f)
(define btn-ok #f) (define btn-ok #f)
(define btn-cancel #f) (define btn-cancel #f)
(define lbl-language #f)
(define lbl-name #f) (define lbl-name #f)
(define lbl-local-path #f) (define lbl-local-path #f)
(define btn-browse #f)
(define lbl-host #f) (define lbl-host #f)
(define lbl-prefixes #f) (define lbl-prefixes #f)
(define div-language #f) (define inp-local-path #f)
(define sel-language #f) (define inp-name #f)
(define inp-host #f)
(define cfg (send settings clone 'settings)) (define inp-prefixes #f)
(define/public (set-labels) (define/public (set-labels)
(send btn-ok set-innerHTML! (tr 'ok)) (send btn-ok set-innerHTML! (tr 'ok))
(send btn-cancel set-innerHTML! (tr 'cancel)) (send btn-cancel set-innerHTML! (tr 'cancel))
(send lbl-language set-innerHTML! (tr 'language))
(send lbl-name set-innerHTML! (tr 'name)) (send lbl-name set-innerHTML! (tr 'name))
(send lbl-local-path set-innerHTML! (tr 'local-path)) (send lbl-local-path set-innerHTML! (tr 'local-path))
(send lbl-host set-innerHTML! (tr 'host)) (send lbl-host set-innerHTML! (tr 'host))
(send lbl-prefixes set-innerHTML! (tr 'prefixes)) (send lbl-prefixes set-innerHTML! (tr 'prefixes))
(send btn-browse set-innerHTML! (tr 'browse))
) )
(define (get el)
(let ((str (send el get)))
(string-trim str)))
(define/public (select-library)
(let* ((music-library (get inp-local-path))
(dir (send this choose-dir
(tr 'choose-lib-folder)
music-library
)))
(displayln "Directory kiezen")
(if (eq? dir 'showing)
'done
(unless (eq? dir #f)
(send inp-local-path set! dir))
)
)
)
(define/override (page-loaded oke) (define/override (page-loaded oke)
(unless initialized (unless initialized
@@ -62,7 +83,159 @@
(set! initialized #t) (set! initialized #t)
(set! btn-ok (send this element 'ok)) (set! btn-ok (send this element 'ok))
(set! btn-cancel (send this element 'cancel)) (set! btn-cancel (send this element 'cancel))
(set! lbl-name (send this element 'lbl-name))
(set! lbl-local-path (send this element 'lbl-local-path))
(set! lbl-host (send this element 'lbl-host))
(set! lbl-prefixes (send this element 'lbl-prefixes))
(set! inp-name (send this element 'name))
(set! inp-local-path (send this element 'local-path))
(set! btn-browse (send this element 'browse))
(set! inp-host (send this element 'host))
(set! inp-prefixes (send this element 'prefixes))
(send inp-name set! name)
(send inp-local-path set! local-path)
(send inp-host set! host)
(send inp-prefixes set! prefixes)
(send this set-labels)
(send this bind! 'browse 'click (λ (el evt data)
(send this select-library)))
(send this bind! 'ok 'click (λ (el evt data)
(let ((name (get inp-name))
(local-path (get inp-local-path))
(host (get inp-host))
(prefixes (get inp-prefixes)))
(result-cb id name local-path host prefixes)
(send this close))))
(send this bind! 'cancel 'click (λ (el evt data) (send this close)))
(send this bind! 'dev 'click (λ args (send this devtools)))
)
))
)
)
(define settings%
(class wv-dialog%
(init-field [log-file #f])
(inherit-field settings icon parent)
(super-new
[html-path "settings.html"]
[title (tr 'settings-title)]
[icon (build-path rkt-gui-dir "rktplayer.png")]
[quit-on-close #f]
)
(define initialized #f)
(define btn-ok #f)
(define btn-cancel #f)
(define btn-add #f)
(define btn-edit #f)
(define btn-remove #f)
(define lbl-language #f)
(define lbl-name #f)
(define lbl-local-path #f)
(define lbl-host #f)
(define lbl-prefixes #f)
(define lbl-lib #f)
(define div-language #f)
(define sel-language #f)
(define libs (new libraries% [settings settings]))
(define cfg (send settings clone 'settings))
(define/public (set-labels)
(send btn-ok set-innerHTML! (tr 'ok))
(send btn-cancel set-innerHTML! (tr 'cancel))
(send btn-add set-innerHTML! (tr 'library-add))
(send btn-edit set-innerHTML! (tr 'library-edit))
(send btn-remove set-innerHTML! (tr 'library-remove))
(send lbl-language set-innerHTML! (tr 'language))
(send lbl-name set-innerHTML! (tr 'name))
(send lbl-local-path set-innerHTML! (tr 'local-path))
(send lbl-host set-innerHTML! (tr 'host))
(send lbl-prefixes set-innerHTML! (tr 'prefixes))
(send lbl-lib set-innerHTML! (tr 'lbl-libary-path))
)
(define/public (update-libraries)
(let ((count (send libs count)))
(letrec ((f (λ (i)
(if (= i count)
'()
(cons
(let* ((id (send libs library-id i))
(entry (send libs get-library id))
(name (send entry get-name))
(local-path (send entry get-local-path))
(host (send entry get-host))
(tr-attr (if (send entry is-current?)
'((class "current"))
'((class "none"))))
)
(list 'tr (append (list (list 'id (format "~a" id)))
tr-attr)
(list 'td (list '(class "name")) name)
(list 'td '((class "path")) local-path)
(list 'td '((class "host")) host)))
(f (+ i 1)))))))
(let* ((tbl (f 0))
(el (send this element 'lib-body))
(html (if (= count 0)
""
(apply string-append (map xexpr->string tbl)))))
(displayln html)
(send el set-innerHTML! html)
(send this bind! "table.libraries tr" 'click
(lambda (el evt data)
(let* ((new-id (string->symbol (send el attr 'id)))
(new-lib (send libs get-library new-id))
(cur-lib (send libs current-library))
)
(displayln new-id)
(displayln new-lib)
(displayln cur-lib)
(unless (eq? cur-lib #f)
(let ((cur-el (send this element (send cur-lib get-id))))
(send cur-el remove-class! 'current)
(send cur-lib set-current! #f)))
(unless (eq? new-id #f)
(let ((new-el (send this element new-id)))
(displayln new-el)
(displayln (send new-el attr 'id))
(send new-el set-attr! '(test "NEE!"))
(send new-el add-class! "current")
(send new-lib set-current! #t)
(send libs update-library new-lib)))
)))
))))
(define/public (add-library)
(let* ((cb (λ (id name local-path host prefixes)
(send libs add-library (new library% [id id]
[name name] [local-path local-path]
[host host] [prefixes prefixes] [current #f]))
(send this update-libraries)))
(dlg (new library-dlg% [parent this]
[settings (send settings clone 'library-dlg)]
[kind 'add] [result-cb cb])))
(send dlg show)))
(define/override (page-loaded oke)
(unless initialized
(when oke
(set! initialized #t)
(set! btn-ok (send this element 'ok))
(set! btn-cancel (send this element 'cancel))
(set! btn-add (send this element 'add))
(set! btn-edit (send this element 'edit))
(set! btn-remove (send this element 'remove))
(set! lbl-language (send this element 'lbl-language)) (set! lbl-language (send this element 'lbl-language))
(set! lbl-lib (send this element 'lbl-libary-path))
(set! lbl-name (send this element 'lbl-name)) (set! lbl-name (send this element 'lbl-name))
(set! lbl-local-path (send this element 'lbl-local-path)) (set! lbl-local-path (send this element 'lbl-local-path))
(set! lbl-host (send this element 'lbl-host)) (set! lbl-host (send this element 'lbl-host))
@@ -75,20 +248,23 @@
(send this bind! 'sel-lang 'change (λ (el evt data) (send this bind! 'sel-lang 'change (λ (el evt data)
(let ((lang (string->symbol (let ((lang (string->symbol
(format "~a" (hash-ref data 'value (current-lang)))))) (format "~a" (hash-ref data 'value (current-lang))))))
(set-lang! lang) (set-lang! lang)
(send cfg set! 'language lang) (send cfg set! 'language lang)
(send this set-labels)))) (send this set-labels))))
(send this bind! 'ok 'click (λ args (displayln args))) (send this bind! 'ok 'click (λ (el evt data) (send this close)))
(send this bind! 'cancel 'click (λ args (displayln args))) (send this bind! 'cancel 'click (λ (el evt data) (send this close)))
(send this bind! 'dev 'click (λ args (send this devtools))) (send this bind! 'dev 'click (λ args (send this devtools)))
(send this bind! 'add 'click (λ (el evt data) (send this add-library)))
(send this bind! 'edit 'click (λ (el evt data) (send this edit-library)))
(send this bind! 'remove 'click (λ (el evt data) (send this remove-library)))
(send this update-libraries)
) )
) )
(info-rktplayer "page loaded")
(info-rktplayer "page loaded")) )
(begin (begin
#t) #t)
translate.rkt
+21
View File
@@ -115,6 +115,15 @@
('ok ('ok
('en "OK") ('en "OK")
('nl "OK")) ('nl "OK"))
('library-add
('en "Add")
('nl "Toevoegen"))
('library-edit
('en "Edit")
('nl "Bewerken"))
('library-remove
('en "Remove")
('nl "Verwijderen"))
('cancel ('cancel
('en "Cancel") ('en "Cancel")
('nl "Annuleren")) ('nl "Annuleren"))
@@ -178,4 +187,16 @@
('play ('play
('en "Play") ('en "Play")
('nl "Afspelen")) ('nl "Afspelen"))
('lbl-libary-path
('en "Library path:")
('nl "Muziek Bibliotheek pad:"))
('settings-title
('en "Racket Music Player - Settings")
('nl "Racket Muziek Speler - Instellingen"))
('settings-library
('en "Racket Music Player - Library Entry")
('nl "Racket Muziek Speler - Muziek Bibliotheek Entry"))
('browse
('en "Browse")
('nl "Bladeren"))
) )
utils.rkt
+11 -1
View File
@@ -23,6 +23,7 @@
list-drop! list-drop!
path-equal? path-equal?
make-select-list make-select-list
new-id
) )
@@ -159,4 +160,13 @@
label)))))) label))))))
) )
items) items)
slct)) slct))
(define (new-id)
(let* ((s (current-milliseconds))
(r (random 1000000))
(id (string->symbol (format "id-~a-~a" s r))))
id))