From 727e0643afa2111ff4425f340c51d02f7ec17d79 Mon Sep 17 00:00:00 2001 From: Hans Dijkema Date: Wed, 29 Jul 2026 13:27:48 +0200 Subject: [PATCH] multiple libraries --- gui.rkt | 265 +++++++++++++++++++--------------------- gui/library-dialog.html | 41 +++++++ gui/rktplayer.html | 2 +- gui/settings.html | 38 +++--- gui/styles.css | 42 ++++++- libraries.rkt | 114 +++++++++++++++++ settings.rkt | 222 +++++++++++++++++++++++++++++---- translate.rkt | 21 ++++ utils.rkt | 12 +- 9 files changed, 573 insertions(+), 184 deletions(-) create mode 100644 gui/library-dialog.html create mode 100644 libraries.rkt diff --git a/gui.rkt b/gui.rkt index cc51b66..617c7b2 100644 --- a/gui.rkt +++ b/gui.rkt @@ -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)) diff --git a/gui/library-dialog.html b/gui/library-dialog.html new file mode 100644 index 0000000..f3894cc --- /dev/null +++ b/gui/library-dialog.html @@ -0,0 +1,41 @@ + + + + + + RktPlayer - A music player - library entry + + +
+
+ + Action +
+
+
+ + +
+
+ +
+ + +
+
+
+ + +
+
+ + +
+
+
+ + + +
+ + \ No newline at end of file diff --git a/gui/rktplayer.html b/gui/rktplayer.html index 40bf702..56a3f9d 100644 --- a/gui/rktplayer.html +++ b/gui/rktplayer.html @@ -5,7 +5,7 @@ RktPlayer - A music player - +
diff --git a/gui/settings.html b/gui/settings.html index 7304a89..bc5914d 100644 --- a/gui/settings.html +++ b/gui/settings.html @@ -1,10 +1,9 @@ - - - RktPlayer - A music player - Settings - + + + RktPlayer - A music player - Settings
@@ -12,19 +11,26 @@ Languages
+
- - - - - - -
-
- - - -
+
+ + + + + + +
+
+ + + +
+
+
+ + +
diff --git a/gui/styles.css b/gui/styles.css index 4b2c7d0..9a74e82 100644 --- a/gui/styles.css +++ b/gui/styles.css @@ -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; } diff --git a/libraries.rkt b/libraries.rkt new file mode 100644 index 0000000..3121fb4 --- /dev/null +++ b/libraries.rkt @@ -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= 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)))) + + )) \ No newline at end of file diff --git a/settings.rkt b/settings.rkt index 244a0b2..65a5124 100644 --- a/settings.rkt +++ b/settings.rkt @@ -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) diff --git a/translate.rkt b/translate.rkt index 1c8e5c9..da6276b 100644 --- a/translate.rkt +++ b/translate.rkt @@ -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")) ) diff --git a/utils.rkt b/utils.rkt index 169232d..16f8b80 100644 --- a/utils.rkt +++ b/utils.rkt @@ -23,6 +23,7 @@ list-drop! path-equal? make-select-list + new-id ) @@ -159,4 +160,13 @@ label)))))) ) items) - slct)) \ No newline at end of file + slct)) + + +(define (new-id) + (let* ((s (current-milliseconds)) + (r (random 1000000)) + (id (string->symbol (format "id-~a-~a" s r)))) + id)) + + \ No newline at end of file