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
+7 -18
View File
@@ -12,6 +12,7 @@
"playlist.rkt"
"player.rkt"
"settings.rkt"
"libraries.rkt"
)
(provide
@@ -65,7 +66,12 @@
(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)
@@ -689,23 +695,6 @@
(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])))
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" />
<title>RktPlayer - A music player</title>
<!--<script src="../../webui-wire/js/menu.js"></script>-->
<script src="menu.js"></script>
<!--<script src="menu.js"></script>-->
</head>
<body>
<div class="pane">
gui/settings.html
+8 -2
View File
@@ -4,7 +4,6 @@
<link rel="stylesheet" href="styles.css" />
<meta charset="UTF-8" />
<title>RktPlayer - A music player - Settings</title>
<script src="menu.js"></script>
</head>
<body>
<div class="pane">
@@ -12,7 +11,9 @@
<label for="language" id="lbl-language">Languages:</label>
<span id="language">Languages</span>
</div>
<hr />
<label id="lbl-libary-path">Library path:</label>
<hr />
<table class="libraries">
<thead id="lib-head">
<tr><th id="lbl-name"></th><th id="lbl-local-path"></th><th id="lbl-host"></th><th id="lbl-prefixes"></th></tr>
@@ -20,11 +21,16 @@
<tbody id="lib-body">
</tbody>
</table>
<div class="button-box">
<button id="add">Add Library</button>
<button id="edit">Edit Library</button>
<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>
</html>
gui/styles.css
+37 -5
View File
@@ -13,6 +13,27 @@ body {
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 {
width: 100%;
padding-bottom: 5px;
@@ -23,11 +44,18 @@ body {
width: calc(30% - 5px);
}
.keyval span {
.keyval span, .keyval input, .keyval select,
.keyval textarea, .keyval .file-box {
display: inline-block;
width: calc(70% - 10px);
}
.button-box {
border-top: 1px solid #909090;
width: 100%;
padding-top: 5px;
}
.buttons {
height: 40px;
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;
user-select: none;
}
table.tracks tr:hover {
table.tracks tr:hover, table.libraries tbody tr:hover {
background: #e0e0e0;
color: black;
transition: all 0.5s ease-in;
}
table.tracks tr:hover.current {
table.tracks tr:hover.current,
table.libraries tbody tr:hover.current
{
color: #955c12;
}
table.tracks tr.current {
table.tracks tr.current,
table.libraries tbody tr.current {
font-weight: bold;
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
+192 -16
View File
@@ -11,6 +11,7 @@
"translate.rkt"
"playlist.rkt"
"player.rkt"
"libraries.rkt"
)
(provide
@@ -20,14 +21,16 @@
(define-runtime-path rkt-gui-dir "gui")
(define settings%
(define library-dlg%
(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)
(super-new
[html-path "settings.html"]
[title "Racket Music Player - Settings"]
[html-path "library-dialog.html"]
[title (tr 'settings-library)]
[icon (build-path rkt-gui-dir "rktplayer.png")]
[quit-on-close #f]
)
@@ -35,26 +38,44 @@
(define initialized #f)
(define btn-ok #f)
(define btn-cancel #f)
(define lbl-language #f)
(define lbl-name #f)
(define lbl-local-path #f)
(define btn-browse #f)
(define lbl-host #f)
(define lbl-prefixes #f)
(define div-language #f)
(define sel-language #f)
(define cfg (send settings clone 'settings))
(define inp-local-path #f)
(define inp-name #f)
(define inp-host #f)
(define inp-prefixes #f)
(define/public (set-labels)
(send btn-ok set-innerHTML! (tr 'ok))
(send btn-cancel set-innerHTML! (tr 'cancel))
(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 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)
(unless initialized
@@ -62,7 +83,159 @@
(set! initialized #t)
(set! btn-ok (send this element 'ok))
(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-lib (send this element 'lbl-libary-path))
(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))
@@ -80,15 +253,18 @@
(send cfg set! 'language lang)
(send this set-labels))))
(send this bind! 'ok 'click (λ args (displayln args)))
(send this bind! 'cancel 'click (λ args (displayln args)))
(send this bind! 'ok 'click (λ (el evt data) (send this close)))
(send this bind! 'cancel 'click (λ (el evt data) (send this close)))
(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
#t)
translate.rkt
+21
View File
@@ -115,6 +115,15 @@
('ok
('en "OK")
('nl "OK"))
('library-add
('en "Add")
('nl "Toevoegen"))
('library-edit
('en "Edit")
('nl "Bewerken"))
('library-remove
('en "Remove")
('nl "Verwijderen"))
('cancel
('en "Cancel")
('nl "Annuleren"))
@@ -178,4 +187,16 @@
('play
('en "Play")
('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
+10
View File
@@ -23,6 +23,7 @@
list-drop!
path-equal?
make-select-list
new-id
)
@@ -160,3 +161,12 @@
)
items)
slct))
(define (new-id)
(let* ((s (current-milliseconds))
(r (random 1000000))
(id (string->symbol (format "id-~a-~a" s r))))
id))