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"
"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))
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
+22 -16
View File
@@ -1,10 +1,9 @@
<!DOCTYPE html>
<html>
<head>
<link rel="stylesheet" href="styles.css" />
<meta charset="UTF-8" />
<title>RktPlayer - A music player - Settings</title>
<script src="menu.js"></script>
<link rel="stylesheet" href="styles.css" />
<meta charset="UTF-8" />
<title>RktPlayer - A music player - Settings</title>
</head>
<body>
<div class="pane">
@@ -12,19 +11,26 @@
<label for="language" id="lbl-language">Languages:</label>
<span id="language">Languages</span>
</div>
<hr />
<label id="lbl-libary-path">Library path:</label>
<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>
</thead>
<tbody id="lib-body">
</tbody>
</table>
<div class="button-box">
<button id="ok">OK</button>
<button id="cancel">Cancel</button>
<button id="dev">devtools</button>
</div>
<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>
</thead>
<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>
</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
+199 -23
View File
@@ -11,50 +11,71 @@
"translate.rkt"
"playlist.rkt"
"player.rkt"
"libraries.rkt"
)
(provide
(all-from-out racket-webview)
settings%
)
(all-from-out racket-webview)
settings%
)
(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"]
[icon (build-path rkt-gui-dir "rktplayer.png")]
[quit-on-close #f]
)
[html-path "library-dialog.html"]
[title (tr 'settings-library)]
[icon (build-path rkt-gui-dir "rktplayer.png")]
[quit-on-close #f]
)
(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))
@@ -75,20 +248,23 @@
(send this bind! 'sel-lang 'change (λ (el evt data)
(let ((lang (string->symbol
(format "~a" (hash-ref data 'value (current-lang))))))
(format "~a" (hash-ref data 'value (current-lang))))))
(set-lang! lang)
(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
+11 -1
View File
@@ -23,6 +23,7 @@
list-drop!
path-equal?
make-select-list
new-id
)
@@ -159,4 +160,13 @@
label))))))
)
items)
slct))
slct))
(define (new-id)
(let* ((s (current-milliseconds))
(r (random 1000000))
(id (string->symbol (format "id-~a-~a" s r))))
id))