From 8fb7cca9c296ea5c0486c222fc88f267ede78b74 Mon Sep 17 00:00:00 2001 From: Hans Dijkema Date: Tue, 24 Feb 2026 18:16:55 +0100 Subject: [PATCH] - --- gui.rkt | 116 +++++++++++++++++++++++++------- gui/menu.js | 128 +++++++++++++++++++++++++++++++++++ gui/rktplayer.html | 7 +- gui/styles.css | 23 ++++++- player.rkt | 163 ++++++++++++++++++++++++++++++++++----------- playlist.rkt | 35 +++++++++- rktplayer.rkt | 6 +- 7 files changed, 406 insertions(+), 72 deletions(-) create mode 100644 gui/menu.js diff --git a/gui.rkt b/gui.rkt index 92bbee1..0551d5e 100644 --- a/gui.rkt +++ b/gui.rkt @@ -3,6 +3,7 @@ (require web-racket racket/runtime-path racket/gui + racket-sprintf "utils.rkt" "music-library.rkt" "translate.rkt" @@ -35,14 +36,70 @@ [html-file rktplayer-start] ) + (define closed #f) (define el-seeker #f) (define el-library #f) (define el-playlist #f) + (define el-at #f) + (define el-length #f) (define music-library (send settings get 'music-library (find-system-path 'home-dir))) (define current-music-path #f) (define playlist #f) - (define player (new player%)) + + (define current-at-seconds 0) + (define current-length-seconds 0) + + (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))) + (set! current-at-seconds as) + (set! current-length-seconds ls) + (let ((as-str (sprintf "%02d:%02d:%02d" + (quotient as 3600) + (quotient (remainder as 3600) 60) + (remainder (remainder as 3600) 60))) + (ls-str (sprintf "%02d:%02d:%02d" + (quotient ls 3600) + (quotient (remainder ls 3600) 60) + (remainder (remainder ls 3600) 60))) + ) + (unless closed + (send el-at set-inner-html! as-str) + (send el-length set-inner-html! ls-str) + (let ((seeker (exact->inexact (/ (* 100 as) ls)))) + (displayln (format "seeker = ~a" seeker)) + (send el-seeker set! (format "~a" seeker))) + ) + ) + ) + ) + ) + + (define current-track-nr #f) + (define (update-track-nr nr) + (let ((id (λ () (string->symbol (format "track-~a" (+ current-track-nr 1)))))) + (unless (eq? current-track-nr #f) + (displayln (format "current track: ~a" (id))) + (let ((el (send this element (id)))) + (send el remove-class! "current"))) + + (set! current-track-nr nr) + + (unless (eq? current-track-nr #f) + (displayln (format "current track: ~a" (id))) + (let ((el (send this element (id)))) + (send el add-class! "current"))) + ) + ) + + (define player (new player% + [time-updater update-time] + [track-nr-updater update-track-nr] + [settings settings] + )) (define inner-html-handlers (make-hash)) @@ -61,6 +118,10 @@ (send el-seeker on-change! seek-reactor)) (set! el-library (send this element 'library)) + (set! el-playlist (send this element 'tracks)) + + (set! el-at (send this element 'time)) + (set! el-length (send this element 'totaltime)) (send this set-menu! (player-menu)) (send this connect-menu! 'm-quit (λ () (send this quit))) @@ -71,7 +132,10 @@ (define/public (update-playlist) - (displayln "Updating playlist") + (let ((html (send playlist to-html))) + (send el-playlist set-inner-html! html) + (update-track-nr current-track-nr) + ) ) (define/public (update-library) @@ -103,8 +167,7 @@ (λ (args) (send this path-choosen (cadr row)))) (send el connect 'click - (λ (args) - (displayln args))) + (λ (args) #t)) (send el connect 'contextmenu (λ (evt) (send this context-for-path evt (cadr row)))) @@ -137,26 +200,24 @@ ) (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) + (let ((items (list + (menu-item 'm-play-this (tr "Play this") #:callback (λ () (send this play-path path)))))) + (when (file-exists? path) + (set! items (append items + (list + (menu-item 'm-add-this (tr "Add this") #:callback (λ () (send this add-path path))))))) + (set! items (append items + (list + (menu-item 'm-booklet (tr "Open booklet") #:callback (λ () (send this open-booklet path))) ;; todo check if pdf file exists + (menu-item 'm-folder (tr "Open containing folder") #:callback (λ () (send this open-folder path))) + ))) + (let* ((mnu (menu 'library-popup items)) + (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) + ) ) ) @@ -169,6 +230,11 @@ (send player play playlist) ) + (define/public (add-path path) + (send playlist add-track path) + (send this update-playlist) + ) + (define/public (open-booklet path) (displayln (format "Open booklet ~a" path))) @@ -201,6 +267,8 @@ (define/public (quit) (displayln (format "Quitting")) + (send player quit) + (set! closed #t) (send this close)) (define/public (select-library) diff --git a/gui/menu.js b/gui/menu.js new file mode 100644 index 0000000..a2abe05 --- /dev/null +++ b/gui/menu.js @@ -0,0 +1,128 @@ +window._web_wire_popup_menu = function(menu, x = -1, y = -1, kind = 'popup') { + if (menu.id == '#f') { menu.id = null; } + let menu_id = (kind == 'popup') ? '@@popup-menu@@' : '@@menubar@@'; + let submenu_els = []; + let triggerMenuItem; + let clearPopupMenu = function() { + if (kind == 'popup') { + let el = document.getElementById(menu_id); + if (el !== null) { + el.innerHTML = ''; + el.style.display = 'none'; + } + if (menu.id !== null) { + // Delay this trigger, because one could have choosen a menu item and we want this + // to be triggered before the clear command is send. + // But if no menu item has been selected, the clear command should + // eventually be send. + setTimeout(function () { + console.log("Sending clear trigger for menu clearance : " + menu.id); + let obj = { evt: 'menu-item-choosen', item: menu.id }; + window._web_wire_put_evt(obj); + }, 250); + } + } else { + // hide all submenus + submenu_els.forEach(function (el) { el.style.display = 'none'; }); + } + }; + triggerMenuItem = function(id) { + console.log("Triggering menu item : " + id); + let obj = { evt: 'menu-item-choosen', item: id }; + window._web_wire_put_evt(obj); + }; + let showSubMenu = function(menu_el, item_el, el, parent_type) { + if (parent_type == 'menu') { + el.style.display = 'flex'; + let rect = item_el.getBoundingClientRect(); + let r = rect.left; + let t = rect.height; + el.style.left = r + 'px'; + el.style.top = t + 'px'; + } else { + el.style.display = "flex"; + let rect = menu_el.getBoundingClientRect(); + let irect =item_el.getBoundingClientRect(); + let r = rect.width + 5; + let t = irect.y - rect.y; + el.style.left = r + "px"; + el.style.top = t + "px"; + } + }; + let hideSubMenu = function(el) { el.style.display = "none"; }; + let makePopupMenu = function(el, menu, visible, type) { + let i; + let N = menu.length; + for(i = 0; i < N; i++) { + let item = menu[i]; + let item_el = document.createElement("div"); + item_el.id = item.id; + item_el.classList.add("menu-item"); + let item_el_icon = document.createElement('span'); + item_el_icon.classList.add("menu-icon"); + if (item.icon) { + let icon_img = document.createElement('img'); + icon_img.setAttribute('src', item.icon); + item_el_icon.appendChild(icon_img); + } + if (item.separator) { + item_el.classList.add("separator"); + } + let item_el_name = document.createElement('span'); + item_el_name.classList.add('menu-name'); + item_el_name.innerHTML = item.name; + let item_el_submenu = document.createElement('span'); + item_el_submenu.classList.add('menu-submenu'); + if (item.submenu) { + if (type == 'submenu' || kind == 'popup') { + item_el_submenu.innerHTML = '>'; + } + item_el.setAttribute('type', 'submenu'); + let submenu_el = document.createElement("div"); + submenu_els.push(submenu_el); + submenu_el.classList.add("submenu"); + submenu_el.classList.add("menu"); + item_el.appendChild(submenu_el); + submenu_el.style.display = 'none'; + makePopupMenu(submenu_el, item.submenu.menu, false, 'submenu'); + item_el.addEventListener('mouseenter', function () { showSubMenu(el, item_el, submenu_el, type); }); + item_el.addEventListener('mouseleave', function () { hideSubMenu(submenu_el); }); + } else { + item_el.setAttribute('type', 'item'); + item_el.addEventListener('click', function() { triggerMenuItem(item.id); }); + } + item_el.appendChild(item_el_icon); + item_el.appendChild(item_el_name); + item_el.appendChild(item_el_submenu); + el.appendChild(item_el); + } + }; + let el = document.getElementById(menu_id); + if (el === null) { + el = document.createElement("div"); + el.id = menu_id; + el.classList.add((kind == 'popup') ? "popup-menu" : "menubar"); + if (kind == 'popup') { + el.classList.add("menu"); + document.body.appendChild(el); + } else { + document.body.prepend(el); + } + } else { + el.innerHTML = ''; + } + makePopupMenu(el, menu.menu, true, 'menu'); + el.style.left = x + "px"; + el.style.top = y + "px"; + el.style.display = "flex"; + let clearer_f = function() { + clearPopupMenu(); + document.body.removeEventListener('click', clearer_f); + document.body.removeEventListener('contextmenu', clearer_f); + }; + document.body.addEventListener('click', clearer_f); + document.body.addEventListener('contextmenu', clearer_f); +}; +window._web_wire_menu = function(menubar) { + window._web_wire_popup_menu(menubar, -1, -1, 'menubar'); +}; diff --git a/gui/rktplayer.html b/gui/rktplayer.html index 3601211..b65c65d 100644 --- a/gui/rktplayer.html +++ b/gui/rktplayer.html @@ -4,7 +4,8 @@ RktPlayer - A music player - + +
@@ -13,8 +14,8 @@ -
0:00
-
0:00
+
00:00:00
+
00:00:00
diff --git a/gui/styles.css b/gui/styles.css index 68363c5..5ecc0a6 100644 --- a/gui/styles.css +++ b/gui/styles.css @@ -55,13 +55,15 @@ input.h-slider { display: flex; justify-content: center; align-items: center; - width: 4em; + /*width: 4em;*/ border-left: 1px solid black; } -.buttons span.time { +.buttons span.time, .buttons span.totaltime { font-weight: bold; text-align: center; + padding-left: 0.5em; + padding-right: 0.5em; } .hpane { @@ -153,4 +155,21 @@ table.music-library tr:hover td { text-wrap: nowrap; } +table.tracks { + width: 94%; + margin-left: 3%; + margin-right: 3%; + margin-top: 5px; + margin-bottom: 5px; +} + +table.tracks td.number { + text-align: right; +} + +table.tracks tr.current { + font-weight: bold; + color: blue; +} + diff --git a/player.rkt b/player.rkt index eaba1f9..5a85bf9 100644 --- a/player.rkt +++ b/player.rkt @@ -13,6 +13,7 @@ (class object% (init-field [settings #f] [time-updater (λ (time-s length-s) #t)] + [track-nr-updater (λ (nr) #t)] [buffer-max-seconds 10] [buffer-min-seconds 4] ) @@ -22,6 +23,7 @@ (define track -1) (define current-track -1) (define ct-data #f) + (define closing #f) (define ao-handle #f) (define flac-handle #f) @@ -33,52 +35,78 @@ (define current-length 0) (define current-seconds 0) + (define play-time-updater-state 'stopped) + (define (check-ao-handle) - (unless ao-handle + (when (eq? ao-handle #f) (unless (or (= current-rate 0) (= current-bits 0) (= current-channels 0)) + (displayln (format "current-rate = ~a, current-bits = ~a, current-channels = ~a, ao-handle = ~a" + current-rate current-bits current-channels ao-handle)) + (displayln "Opening ao-handle") (let ((fmt (ao-mk-format current-bits current-rate current-channels 'big-endian))) - (set! ao-handle (ao-open-live #f fmt))) + (set! ao-handle (ao-open-live #f fmt)) + (start-play-time-updater) + ) ) ) ) - (define (update-play-time) - (unless (eq? ao-handle #f) - (let ((seconds (ao-at-second ao-handle))) - (set! current-seconds seconds) - (time-updater current-seconds current-length) - ) + (define (start-play-time-updater) + (when (eq? play-time-updater-state 'stopped) + (set! play-time-updater-state 'updating) + (displayln "Starting play-time-updater") + (thread (λ () + (define (updater) + (if (eq? ao-handle #f) + (begin + (set! play-time-updater-state 'stopped) + (displayln "Stopping play-time-updater") + 'done) + (let ((seconds (ao-at-second ao-handle))) + (set! current-seconds seconds) + (time-updater current-seconds current-length) + (sleep 0.1) + (updater)))) + (updater) + ) + ) ) ) (define (flac-play frame buffer) - (let* ((sample (hash-ref frame 'number)) - (rate (hash-ref frame 'sample-rate)) - (second (/ (* sample 1.0) (* rate 1.0))) - (bits-per-sample (hash-ref frame 'bits-per-sample)) - (bytes-per-sample (/ bits-per-sample 8)) - (channels (hash-ref frame 'channels)) - (bytes-per-sample-all-channels (* channels bytes-per-sample)) - (duration (hash-ref frame 'duration)) - ) - (set! current-rate rate) - (set! current-bits bits-per-sample) - (set! current-channels channels) - (set! current-length duration) + (unless (eq? state 'quitted) + (let* ((sample (hash-ref frame 'number)) + (rate (hash-ref frame 'sample-rate)) + (second (/ (* sample 1.0) (* rate 1.0))) + (bits-per-sample (hash-ref frame 'bits-per-sample)) + (bytes-per-sample (/ bits-per-sample 8)) + (channels (hash-ref frame 'channels)) + (bytes-per-sample-all-channels (* channels bytes-per-sample)) + (duration (hash-ref frame 'duration)) + ) + (set! current-rate rate) + (set! current-bits bits-per-sample) + (set! current-channels channels) + (set! current-length duration) - (check-ao-handle) + (check-ao-handle) + (when (not (eq? ao-handle #f)) + (let ((buf-seconds-left (λ () (exact->inexact + (/ (ao-bufsize-async ao-handle) + bytes-per-sample-all-channels + rate))))) + (when (> (buf-seconds-left) buffer-max-seconds) + (while (and (not (eq? ao-handle #f)) + (not closing) + (> (buf-seconds-left) buffer-min-seconds)) + (sleep 0.25)))) - (let ((buf-seconds-left (λ () (exact->inexact - (/ (ao-bufsize-async ao-handle) - bytes-per-sample-all-channels - rate))))) - (when (> (buf-seconds-left) buffer-max-seconds) - (while (> (buf-seconds-left) buffer-min-seconds) - (update-play-time) - (sleep 0.25)))) - - (ao-play ao-handle second buffer) - ) + (when (not (eq? ao-handle #f)) + (ao-play ao-handle second buffer) + ) + ) + ) + ) ) (define (flac-meta meta) @@ -90,9 +118,12 @@ (if (eq? ct-data #f) 'no-track-data (let ((file (send ct-data get-file))) + (displayln (format "opening flac handle for file: ~a" file)) (set! flac-handle (flac-open file flac-meta flac-play)) + (displayln "Starting flac-read") (flac-read flac-handle) (set! state 'track-feeded) + (displayln "Flac read stopped") 'track-feeded ) ) @@ -102,32 +133,83 @@ 'playing ) + (define (close-player*) + (displayln "Closing flac handle") + + (set! closing #t) + + (unless (eq? flac-handle #f) + (flac-stop flac-handle) + (set! flac-handle #f)) + + (set! current-rate 0) + (set! current-channels 0) + (set! current-bits 0) + (set! ct-data #f) + + (unless (eq? ao-handle #f) + (let ((h ao-handle)) + (displayln "closing ao-handle") + (set! ao-handle #f) + (ao-close h) + )) + (displayln (format "close-player*: ao-handle = ~a" ao-handle)) + (displayln "Waiting for updater to stop") + (while (eq? play-time-updater-state 'updating) + (displayln (format "close-player*: ao-handle = ~a" ao-handle)) + (sleep 0.1)) + (displayln "resetting tracks") + (set! track -1) + (set! current-track -1) + + (set! closing #f) + ) + + (define (quit-player) + (close-player*) + (set! state 'quitted) + ) + + (define (stop-and-clear) + (set! state 'stopped) + (close-player*) + ) + (define/public (next-track) (set! track (+ track 1)) (if (>= track (send pl length)) - (set! state 'stopped) + (begin + (set! state 'stopped) + (track-nr-updater #f)) (begin (set! ct-data (send pl track track)) (set! state 'play) + (track-nr-updater track) ) ) ) (define/public (play-track i) (unless (eq? flac-handle #f) - (flac-stop flac-handle)) + (flac-stop flac-handle) + (set! flac-handle #f) + ) (set! track i) (set! ct-data (send pl track i)) (while (eq? state 'playing) (sleep 0.1)) - (set! state 'play)) + (set! state 'play) + (track-nr-updater i) + ) (define (state-machine) (let ((st (orig-current-seconds)) (s (orig-current-seconds))) (define (worker) (if (eq? state 'quit) - 'done + (begin + (quit-player) + 'done) (begin (cond ((eq? state 'stopped) @@ -151,13 +233,16 @@ (worker))) (define/public (play playlist) - (set! state 'stopped) + (stop-and-clear) (set! pl playlist) (send this play-track 0) ) (define/public (quit) - (set! state 'quit)) + (set! state 'quit) + (while (not (eq? state 'quitted)) + (sleep 0.1)) + ) (super-new) diff --git a/playlist.rkt b/playlist.rkt index 23540b4..730bda1 100644 --- a/playlist.rkt +++ b/playlist.rkt @@ -3,6 +3,8 @@ (require racket/class "music-library.rkt" racket-sound + "utils.rkt" + racket-sprintf ) (provide track% @@ -65,7 +67,7 @@ (and (<= (list-len tracks) max-tracks) (is-music-file? file))) - (define (add-track file) + (define (add-track* file) (let ((track (new track% [file file]))) (set! tracks (append tracks (list track))))) @@ -83,7 +85,7 @@ (if (directory-exists? p) (read-tracks-internal p) (when (and (file-exists? p) (can-add? p)) - (add-track p))))) + (add-track* p))))) content)) 'no-file-or-dir ) @@ -99,6 +101,9 @@ (define/public (length) (list-len tracks)) + (define/public (add-track file) + (add-track* file)) + (define/public (track i) (list-ref tracks i)) @@ -107,6 +112,32 @@ (send track displayln)) tracks)) + (define/public (to-html) + (define (formatter row) + (let* ((track-idx (car row)) + (track (track track-idx))) + (list + (list 'td (list (list 'class "number")) + (format "~a." (send track get-number))) + (list 'td (list (list 'class "title")) + (send track get-title)) + (list 'td (list (list 'class "album")) + (send track get-album)) + (list 'td (list (list 'class "length")) + (let* ((length-s (send track get-length)) + (hour (quotient length-s 3600)) + (min (quotient (remainder length-s 3600) 60)) + (sec (remainder (remainder length-s 3600) 60))) + (sprintf "%02d:%02d:%02d" hour min sec))) + ))) + + (letrec ((f (λ (i N) + (if (< i N) + (cons (list (format "track-~a" (+ i 1)) i) (f (+ i 1) N)) + '())))) + (let ((rows (f 0 (send this length)))) + (mktable rows 'tracks formatter)))) + (super-new) (begin (when (eq? start-map #f) diff --git a/rktplayer.rkt b/rktplayer.rkt index a4e0ea3..43ea952 100644 --- a/rktplayer.rkt +++ b/rktplayer.rkt @@ -17,13 +17,15 @@ ) ) -(ww-set-debug #t) +(ww-set-debug #f) +(ww-set-log-level 'warning) +;(ww-tail-log) ;(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] [use-browser #f])) + (window (new rktplayer% [settings settings] [use-browser #t])) ) window) )