From 0fffd544c0b590961ee53aa7d8e021cce5a323c5 Mon Sep 17 00:00:00 2001 From: Hans Dijkema Date: Thu, 19 Feb 2026 20:29:36 +0100 Subject: [PATCH] - --- gui.rkt | 180 ++++++++++++++++-- next.svg => gui/buttons/next.svg | 0 play.svg => gui/buttons/play.svg | 0 previous.svg => gui/buttons/previous.svg | 0 repeat-off.svg => gui/buttons/repeat-off.svg | 0 repeat-one.svg => gui/buttons/repeat-one.svg | 0 repeat.svg => gui/buttons/repeat.svg | 0 .../buttons/volume-high.svg | 0 volume-low.svg => gui/buttons/volume-low.svg | 0 .../buttons/volume-mute.svg | 0 gui/rktplayer.html | 166 ++++++++++++++++ gui/styles.css | 156 +++++++++++++++ music-library.rkt | 47 +++++ player.rkt | 1 + playlist.rkt | 1 + rktplayer.html | 35 ---- rktplayer.rkt | 10 +- styles.css | 66 ------- translate.rkt | 53 ++++++ utils.rkt | 58 ++++++ 20 files changed, 659 insertions(+), 114 deletions(-) rename next.svg => gui/buttons/next.svg (100%) rename play.svg => gui/buttons/play.svg (100%) rename previous.svg => gui/buttons/previous.svg (100%) rename repeat-off.svg => gui/buttons/repeat-off.svg (100%) rename repeat-one.svg => gui/buttons/repeat-one.svg (100%) rename repeat.svg => gui/buttons/repeat.svg (100%) rename volume-high.svg => gui/buttons/volume-high.svg (100%) rename volume-low.svg => gui/buttons/volume-low.svg (100%) rename volume-mute.svg => gui/buttons/volume-mute.svg (100%) create mode 100644 gui/rktplayer.html create mode 100644 gui/styles.css create mode 100644 music-library.rkt create mode 100644 player.rkt create mode 100644 playlist.rkt delete mode 100644 rktplayer.html delete mode 100644 styles.css create mode 100644 translate.rkt create mode 100644 utils.rkt diff --git a/gui.rkt b/gui.rkt index 5c85ed5..3530e12 100644 --- a/gui.rkt +++ b/gui.rkt @@ -2,6 +2,10 @@ (require web-racket racket/runtime-path + racket/gui + "utils.rkt" + "music-library.rkt" + "translate.rkt" ) (provide @@ -9,16 +13,18 @@ rktplayer% ) -(define-runtime-path rktplayer-start "rktplayer.html") +(define-runtime-path rktplayer-start "gui/rktplayer.html") -(define-syntax ww-connect - (syntax-rules (this) - ((_ id method) - (send (send this element id) connect 'click (λ (data) (send this method))) - ) - ) - ) - +(define player-menu + (λ () + (menu 'main-menu + (menu-item 'm-file (tr "File") + #:submenu + (menu (menu-item 'm-select-library-dir (tr "Select Music Library Folder")) + (menu-item 'm-set-lang (tr "Set language")) + (menu-item 'm-quit (tr "Quit") #:separator #t))) + ) + )) (define rktplayer% (class ww-webview% @@ -27,15 +33,132 @@ [html-file rktplayer-start] ) + (define el-seeker #f) + (define el-library #f) + + (define music-library (send settings get 'music-library (find-system-path 'home-dir))) + (define current-music-path #f) + + (define inner-html-handlers (make-hash)) + (define/override (html-loaded) (super html-loaded) (ww-connect 'play play) (ww-connect 'prev previous-track) (ww-connect 'next next-track) - + (ww-connect 'repeat repeat) + (ww-connect 'volume volume) + + (set! el-seeker (send this element 'seek)) + (displayln (format "el-seeker: ~a" (send el-seeker get))) + (let ((seek-reactor (make-delayed-reactor 0.3 (λ (percentage) (send this seek-to percentage))))) + (send el-seeker on-change! seek-reactor)) + + (set! el-library (send this element 'library)) + + (send this set-menu! (player-menu)) + (send this connect-menu! 'm-quit (λ () (send this quit))) + (send this connect-menu! 'm-select-library-dir (λ () (send this select-library))) + + (send this update-library) ) + (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))) + (directory-list current-music-path))))) + (displayln current-music-path) + (displayln music-library) + (unless (equal? (format "~a" current-music-path) (format "~a" music-library)) + (set! l (cons (list "lib-up" "↰" "lib-up") l)) + ) + (let ((html (mktable l 'music-library library-formatter))) + (let ((handle (send el-library set-inner-html! html))) + (hash-set! inner-html-handlers handle + (λ (oke) + (when oke + (send this bind 'dblclick "td.library-entry") + (send this bind 'click "td.library-entry") + (send this bind 'contextmenu "td.library-entry") + (for-each (λ (row) + (let ((path-id (string->symbol (caddr row)))) + (let ((el (send this new-element path-id))) + (send el connect 'dblclick + (λ (args) + (send this path-choosen (cadr row)))) + (send el connect 'click + (λ (args) + (displayln args))) + (send el connect 'contextmenu + (λ (evt) + (send this context-for-path evt (cadr row)))) + ))) + l) + )))) + )) + ) + + (define/override (inner-html-set handle oke) + (ww-debug "inner-html-set called") + (let ((cb (hash-ref inner-html-handlers handle #f))) + (ww-debug (format "got cb = ~a for handle ~a" cb handle)) + (when cb + (hash-remove! inner-html-handlers handle) + (cb oke))) + ) + + (define/public (path-choosen path) + (let ((path-part (if (equal? path "↰") ".." (format "~a" path)))) + (let ((npath (if (string=? path-part "..") + (build-path current-music-path path-part) + path))) + (when (directory-exists? npath) + (set! current-music-path (normalize-path npath)) + (send this update-library) + ) + ) + ) + ) + + (define/public (context-for-path evt path) + (let* ((mnu (menu 'library-popup + (menu-item 'm-play-this (tr "Play this") #:callback (λ () (send this play-path path))) + (menu-item 'm-booklet (tr "Open booklet") #:callback (λ () (send this open-booklet path))) + (menu-item 'm-folder (tr "Open containing folder") #:callback (λ () (send this open-folder path)) + #:submenu + (menu (menu-item 'm-idx (tr "Select Music Library Folder") #:separator #t) + (menu-item 'm-idy (tr "Quit") #:separator #t + #:submenu + (menu (menu-item 'mabd (tr "Ja")) + (menu-item 'mdedjk (tr "No")) + (menu-item 'sdakjfas (tr "akjfhalk")) + )) + )) + ) + ) + (js-evt (hash-ref evt 'js_evt (make-hash))) + (clientX (hash-ref js-evt 'clientX 60)) + (clientY (hash-ref js-evt 'clientY 60)) + ) + (send this popup-menu mnu clientX clientY) + ) + ) + + (define/public (play-path path) + (displayln (format "Playing ~a" path))) + + (define/public (open-booklet path) + (displayln (format "Open booklet ~a" path))) + + (define/public (open-folder path) + (displayln (format "open folder ~a" path))) + (define/public (play) (displayln "Play button clicked") ) @@ -48,9 +171,42 @@ (displayln "Previous track") ) + (define/public (repeat) + (displayln "Repeat") + ) + + (define/public (volume) + (displayln "Volume") + ) + + (define/public (seek-to percentage) + (displayln (format "Seeking to percentage: ~a" percentage)) + ) + + (define/public (quit) + (displayln (format "Quitting")) + (send this close)) + + (define/public (select-library) + (let ((handle (send this choose-dir + (tr "Choose the folder containing your music library") + (format "~a" music-library)))) + (displayln (format "Selecting Music Library with handle: ~a" handle)) + ) + ) + + (define/override (dir-choosen handle choosen dir) + (when choosen + (set! music-library dir) + (send settings set! 'music-library dir) + (set! current-music-path #f) + (send this update-library))) + + (begin - (displayln "RktPlayer started") - ) + (let ((lang (send settings get 'lang 'en))) + (displayln (format "RktPlayer started, current language: ~a" lang))) + ) ) ) diff --git a/next.svg b/gui/buttons/next.svg similarity index 100% rename from next.svg rename to gui/buttons/next.svg diff --git a/play.svg b/gui/buttons/play.svg similarity index 100% rename from play.svg rename to gui/buttons/play.svg diff --git a/previous.svg b/gui/buttons/previous.svg similarity index 100% rename from previous.svg rename to gui/buttons/previous.svg diff --git a/repeat-off.svg b/gui/buttons/repeat-off.svg similarity index 100% rename from repeat-off.svg rename to gui/buttons/repeat-off.svg diff --git a/repeat-one.svg b/gui/buttons/repeat-one.svg similarity index 100% rename from repeat-one.svg rename to gui/buttons/repeat-one.svg diff --git a/repeat.svg b/gui/buttons/repeat.svg similarity index 100% rename from repeat.svg rename to gui/buttons/repeat.svg diff --git a/volume-high.svg b/gui/buttons/volume-high.svg similarity index 100% rename from volume-high.svg rename to gui/buttons/volume-high.svg diff --git a/volume-low.svg b/gui/buttons/volume-low.svg similarity index 100% rename from volume-low.svg rename to gui/buttons/volume-low.svg diff --git a/volume-mute.svg b/gui/buttons/volume-mute.svg similarity index 100% rename from volume-mute.svg rename to gui/buttons/volume-mute.svg diff --git a/gui/rktplayer.html b/gui/rktplayer.html new file mode 100644 index 0000000..5270f53 --- /dev/null +++ b/gui/rktplayer.html @@ -0,0 +1,166 @@ + + + + + + RktPlayer - A music player + + + +
+
+ + + + +
0:00
+
0:00
+ + +
+
+
+
+
+ Library +
+
+
+
+ Album art +
+
+
+
+
+ Music playing +
+
+
+
+ + diff --git a/gui/styles.css b/gui/styles.css new file mode 100644 index 0000000..68363c5 --- /dev/null +++ b/gui/styles.css @@ -0,0 +1,156 @@ +body { + font-family: Arial; + font-size: 11pt; +} + +.pane { + height: calc(100vh - 40px - 2em - 10px); + width: calc(100% - 10px); + display: flex; + flex-direction: column; +} + +.buttons { + height: 40px; + width: 100%; + display: flex; + justify-content: center; + align-items: center; + border: 1px solid black; + margin-bottom: 5px; +} + +button { + background: #e0e0e0; + border: none; + border-left: 1px solid black; + border-right: 1px solid black; +} + +button:hover { + background: #909090; +} + + +button.command { + margin: 0; + padding: 0; + width: 40px; + height: 40px; +} + +button.command img { + height: 32px; + width: 32px; + margin: 0; + padding: 2px; +} + +input.h-slider { + flex-grow: 1; +} + +.buttons .text-block { + height: 100%; + display: flex; + justify-content: center; + align-items: center; + width: 4em; + border-left: 1px solid black; +} + +.buttons span.time { + font-weight: bold; + text-align: center; +} + +.hpane { + height: 100%; + width: 100%; + display: flex; +} + +.music-info { + border: 1px solid black; + width: 30%; + height: 100%; +} + +.music-library { + border-bottom: 1px solid black; + width: 100%; + height: 50%; +} + +.album-art { + width: 100%; + height: 50%; + padding: 5px; +} + +.music-playing { + border: 1px solid black; + border-left: none; + width: 70%; + height: 100%; +} + +.content { + width: 100%; + height: 100%; + overflow: hidden; +} + +.scrolly { + overflow-y: auto; +} + +table.music-library { + padding: 5px; +} + +table.music-library tr td { + border-bottom: 1px solid #f0f0f0; + cursor: default; + height: 1.1em; + width: 100%; + overflow: hidden; + text-overflow: ellipsis; + white-space: nowrap; + user-select: none; +} + +table.music-library tr:hover td { + background: #e0e0e0; +} + +.popup-menu, .popup-submenu { + display: flex; + flex-direction: column; + margin: 5px; + padding: 5px; + position: absolute; + z-index: 9999; + border: 1px solid black; + background: #e0e0e0; +} + +.popup-submenu { + display: none; +} + +.menubar .menu-item span.menu-icon, .popup-menu .menu-item span.menu-icon { + min-width: unset; + width: unset; +} + +.menubar .menu-item { + min-width: unset; + width: unset; +} + +.menu-item span.menu-name { + text-wrap: nowrap; +} + + diff --git a/music-library.rkt b/music-library.rkt new file mode 100644 index 0000000..5ba4248 --- /dev/null +++ b/music-library.rkt @@ -0,0 +1,47 @@ +#lang racket + +(provide music-lib-relevant? + is-music-dir? + is-music-file? + basename + library-formatter + ) + +(define (music-lib-relevant? f) + (let ((type (file-or-directory-type f #t))) + (if (eq? type 'directory) + (let ((name (basename f))) + (not (string-prefix? name "."))) + (if (eq? type 'file) + (let* ((fn (string-downcase (format "~a" f))) + (exts (list "flac" "mp3"))) + (let ((l (filter (λ (e) (string-suffix? fn (string-append "." e))) exts))) + (not (null? l)))) + #f)))) + +(define (is-music-dir? f) + (and (music-lib-relevant? f) + (directory-exists? f))) + +(define (is-music-file? f) + (and (music-lib-relevant? f) + (file-exists? f))) + +(define (basename file) + (call-with-values (λ () (split-path file)) + (λ (base name is-dir) + (path->string name)))) + +(define (library-formatter row) + (let ((file-entry (car row)) + (file-id (cadr row)) + ) + (list (list 'td (list (list 'class "library-entry") (list 'id file-id) (list 'file (format "~a" file-entry))) + (if (equal? file-id "lib-up") + file-entry + (basename file-entry)) + )) + ) + ) + + diff --git a/player.rkt b/player.rkt new file mode 100644 index 0000000..6f1f7b4 --- /dev/null +++ b/player.rkt @@ -0,0 +1 @@ +#lang racket diff --git a/playlist.rkt b/playlist.rkt new file mode 100644 index 0000000..6f1f7b4 --- /dev/null +++ b/playlist.rkt @@ -0,0 +1 @@ +#lang racket diff --git a/rktplayer.html b/rktplayer.html deleted file mode 100644 index 147fc2a..0000000 --- a/rktplayer.html +++ /dev/null @@ -1,35 +0,0 @@ - - - - - - RktPlayer - A music player - - -
-
- - - - -
0:00
-
0:00
- - -
-
-
-
- Library -
-
- Album art -
-
-
- Music playing -
-
-
- - diff --git a/rktplayer.rkt b/rktplayer.rkt index 79af6e5..4ddb105 100644 --- a/rktplayer.rkt +++ b/rktplayer.rkt @@ -2,13 +2,21 @@ (require "gui.rkt" simple-ini/class + web-racket + racket-sound ) + +(ww-set-custom-webui-wire-command! "/home/hans/src/racket/webui-wire/build/Release/webui-wire") +(ww-set-debug #t) +;(ww-tail-log) + (define (run) (let* ((ini (new ini% [file 'rktplayer])) (settings (new ww-simple-ini% [ini ini] [section 'player])) - (window (new rktplayer% [settings settings])) + (window (new rktplayer% [settings settings] [use-browser #t])) ) window) ) +;(run) \ No newline at end of file diff --git a/styles.css b/styles.css deleted file mode 100644 index 9ba29b9..0000000 --- a/styles.css +++ /dev/null @@ -1,66 +0,0 @@ -body { - font-family: Arial; - font-size: 11pt; -} - -.pane { - height: 100%; - width: 100%; - display: flex; - flex-direction: column; -} - -.buttons { - height: 40px; - width: 100%; - display: flex; - justify-content: center; - align-items: center; - border: 1px solid black; -} - -button { - background: #e0e0e0; - border: none; - border-left: 1px solid black; - border-right: 1px solid black; -} - -button:hover { - background: #909090; -} - - -button.command { - margin: 0; - padding: 0; - width: 40px; - height: 40px; -} - -button.command img { - height: 32px; - width: 32px; - margin: 0; - padding: 2px; -} - -span.h-slider { - flex-grow: 1; -} - -.buttons .text-block { - height: 100%; - display: flex; - justify-content: center; - align-items: center; - width: 4em; - border-left: 1px solid black; -} - -.buttons span.time { - font-weight: bold; - text-align: center; -} - - diff --git a/translate.rkt b/translate.rkt new file mode 100644 index 0000000..e91b018 --- /dev/null +++ b/translate.rkt @@ -0,0 +1,53 @@ +#lang racket + +(provide tr) + +(define tr_map (make-hash)) + +(define (add-tr sentence language translated-sentence) + (let ((lang-hash (hash-ref tr_map language (make-hash)))) + (hash-set! lang-hash sentence translated-sentence) + (hash-set! tr_map language lang-hash))) + +(define-syntax add2 + (syntax-rules () + ((_ s (l ts)) + (add-tr s l ts)))) + +(define-syntax add + (syntax-rules () + ((_ s l1 ...) + (begin + (add2 s l1) + ...)))) + + +(define language 'en) + +(define (languages) + '((en "English") (nl "Nederlands"))) + +(define (set-lang! l) + (set! language l)) + +(define (tr s) + (if (eq? language 'en) + s + (let ((lang-hash (hash-ref tr_map language (make-hash)))) + (let ((translated (hash-ref lang-hash s (format "~a:~a" language s)))) + translated + ) + ) + ) + ) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Translations +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(add "Select Music Library Folder" + ('nl "Selecteer map met Muziek Bibliotheek")) +(add "Choose the folder containing your music library" + ('nl "Kies de map met de Muziek Bibliotheek")) +(add "Quit" + ('nl "Beëindigen")) diff --git a/utils.rkt b/utils.rkt new file mode 100644 index 0000000..ea97986 --- /dev/null +++ b/utils.rkt @@ -0,0 +1,58 @@ +#lang racket/base + +(require racket/gui + xml + xml/xexpr + ) + +(provide ww-connect + make-delayed-reactor + mktable + simple-row-formatter + ) + +(define-syntax ww-connect + (syntax-rules (this) + ((_ id method) + (send (send this element id) connect 'click (λ (data) (send this method))) + ) + ) + ) + + +(define (make-delayed-reactor seconds closure) + (let* ((last-val #f) + (last-time -1) + (interval-ms (* seconds 1000)) + (timeout-check (λ () + (let ((ms (current-milliseconds))) + (unless (= last-time -1) + (when (> ms (+ last-time interval-ms)) + (set! last-time -1) + (closure last-val)))))) + (timer (new timer% [notify-callback timeout-check] [interval 100])) + ) + (λ (val) + (set! last-val val) + (set! last-time (current-milliseconds)) + ))) + + +(define (simple-row-formatter row) + (map (λ (e) (list 'td (format "~a" e))) row)) + +(define (mktable l table-class row-formatter) + (xexpr->string + (append + (list 'table (list (list 'class (format "~a" table-class)))) + (map (λ (row) + (let ((row-id (car row))) + (append (list 'tr (list (list 'id (format "~a" row-id)))) + (row-formatter (cdr row))))) + l) + ) + ) + ) + + +