From 7cefed4d689307803bbd37595c661ee6efc83778 Mon Sep 17 00:00:00 2001 From: Hans Dijkema Date: Wed, 25 Feb 2026 18:11:13 +0100 Subject: [PATCH] - --- gui.rkt | 97 ++++++++++++++++++++++++++++++++++++------- gui/buttons/pause.svg | 5 +++ gui/buttons/stop.svg | 17 ++++++++ gui/rktplayer.html | 7 ++-- gui/styles.css | 45 ++++++++++++++++---- player.rkt | 79 ++++++++++++++++++++++------------- playlist.rkt | 64 +++++++++++++++++++++------- rktplayer.rkt | 9 ++-- 8 files changed, 249 insertions(+), 74 deletions(-) create mode 100644 gui/buttons/pause.svg create mode 100644 gui/buttons/stop.svg diff --git a/gui.rkt b/gui.rkt index 8f3659e..0e49d71 100644 --- a/gui.rkt +++ b/gui.rkt @@ -67,11 +67,15 @@ (remainder (remainder ls 3600) 60))) ) (unless closed + (displayln "Updating time widgets") (send el-at set-inner-html! as-str) (send el-length set-inner-html! ls-str) - (let ((seeker (exact->inexact (/ (* 100 as) ls)))) + (let ((seeker (if (= ls 0) + 0.0 + (exact->inexact (/ (* 100 as) ls))))) ;(displayln (format "seeker = ~a" seeker)) (send el-seeker set! (format "~a" seeker))) + (displayln "done") ) ) ) @@ -80,24 +84,54 @@ (define current-track-nr #f) (define (update-track-nr nr) - (let ((id (λ () (string->symbol (format "track-~a" (+ current-track-nr 1)))))) + (displayln (format "update-track-nr ~a" nr)) + (let ((id (λ () (send playlist track-id current-track-nr))) ;string->symbol (format "track-~a" (+ current-track-nr 1))))) + (ct current-track-nr)) + + (displayln "Removing current") (unless (eq? current-track-nr #f) - (displayln (format "current track: ~a" (id))) + (displayln (format "current old track: ~a" (id))) (let ((el (send this element (id)))) (send el remove-class! "current"))) (set! current-track-nr nr) - + + (displayln "Adding current") (unless (eq? current-track-nr #f) - (displayln (format "current track: ~a" (id))) + (displayln (format "current new track: ~a" (id))) (let ((el (send this element (id)))) - (send el add-class! "current"))) + (send el add-class! "current")) + + (displayln "Getting cover image") + (let* ((track (send playlist track current-track-nr)) + (img-file "/tmp/cover-image") + (stored-file (send track image->file img-file)) + ) + (unless (eq? stored-file #f) + (let ((el (send this element 'album-art))) + (let ((html (format "" stored-file))) + (send el set-inner-html! html)))) + ;(send el set-attr! 'src stored-file)))) + ) + ) + (displayln" Done updating track") ) ) + + (define state #f) + (define (update-state st) + (unless (eq? st state) + (set! state st) + (if (eq? st 'playing) + (let ((btn (send this element 'play-img))) + (send btn set-attr! 'src "buttons/stop.svg")) + (let ((btn (send this element 'play-img))) + (send btn set-attr! 'src "buttons/play.svg"))))) (define player (new player% [time-updater update-time] [track-nr-updater update-track-nr] + [state-updater update-state] [settings settings] )) @@ -106,7 +140,8 @@ (define/override (html-loaded) (super html-loaded) - (ww-connect 'play play) + (ww-connect 'play play-or-stop) + (ww-connect 'pause pause) (ww-connect 'prev previous-track) (ww-connect 'next next-track) (ww-connect 'repeat repeat) @@ -133,11 +168,37 @@ (define/public (update-playlist) (let ((html (send playlist to-html))) - (send el-playlist set-inner-html! html) + (hash-set! inner-html-handlers (send el-playlist set-inner-html! html) + (λ (oke) + (when oke + (send this bind 'click "table.tracks tr") + (send playlist for-each + (λ (idx track) + (let* ((track-id (send playlist track-id idx)) + (el (send this new-element track-id))) + (send el connect 'click + (λ (args) + (send this play-track idx)))) + ) + ) + ) + ) + ) + (displayln "Done.") (update-track-nr current-track-nr) ) ) + (define/public (scroll-top id) + (send this exec-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))) + (define/public (update-library) (when (eq? current-music-path #f) (set! current-music-path music-library)) @@ -157,17 +218,15 @@ (hash-set! inner-html-handlers handle (λ (oke) (when oke - (send this bind 'dblclick "td.library-entry") + (send this scroll-top 'library) (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 + (send el connect 'click (λ (args) (send this path-choosen (cadr row)))) - (send el connect 'click - (λ (args) #t)) (send el connect 'contextmenu (λ (evt) (send this context-for-path evt (cadr row)))) @@ -244,10 +303,20 @@ (open-file-manager folder))) ;(shell-execute #f folder #f #f 'sw_show))) - (define/public (play) - (displayln "Play button clicked") + (define/public (play-or-stop) + (if (eq? state 'playing) + (begin + (send player stop) + (update-time 0.0 0.0)) + (send player play-track current-track-nr)) ) + (define/public (play-track idx) + (send player play-track idx)) + + (define/public (pause) + (send player pause-unpause)) + (define/public (next-track) (send player next) ) diff --git a/gui/buttons/pause.svg b/gui/buttons/pause.svg new file mode 100644 index 0000000..3ebf5cc --- /dev/null +++ b/gui/buttons/pause.svg @@ -0,0 +1,5 @@ + + + + + \ No newline at end of file diff --git a/gui/buttons/stop.svg b/gui/buttons/stop.svg new file mode 100644 index 0000000..7ee7e6a --- /dev/null +++ b/gui/buttons/stop.svg @@ -0,0 +1,17 @@ + + + + + stop + Created with Sketch Beta. + + + + + + + + + + + \ No newline at end of file diff --git a/gui/rktplayer.html b/gui/rktplayer.html index b65c65d..ab6b9f1 100644 --- a/gui/rktplayer.html +++ b/gui/rktplayer.html @@ -11,6 +11,7 @@
+ @@ -23,18 +24,18 @@
- Library +
- Album art +
- Music playing +
diff --git a/gui/styles.css b/gui/styles.css index 69daf3b..4a06c2b 100644 --- a/gui/styles.css +++ b/gui/styles.css @@ -1,6 +1,8 @@ body { font-family: Arial; font-size: 11pt; + background: #202020; + color: #ffffff; } .pane { @@ -16,15 +18,15 @@ body { display: flex; justify-content: center; align-items: center; - border: 1px solid black; + border: 1px solid #505050; margin-bottom: 5px; } button { background: #e0e0e0; border: none; - border-left: 1px solid black; - border-right: 1px solid black; + border-left: 1px solid #505050; + border-right: 1px solid #505050; } button:hover { @@ -56,7 +58,7 @@ input.h-slider { justify-content: center; align-items: center; /*width: 4em;*/ - border-left: 1px solid black; + border-left: 1px solid #505050; } .buttons span.time, .buttons span.totaltime { @@ -73,13 +75,13 @@ input.h-slider { } .music-info { - border: 1px solid black; + border: 1px solid #505050; width: 30%; height: 100%; } .music-library { - border-bottom: 1px solid black; + border-bottom: 1px solid #505050; width: 100%; height: 50%; } @@ -91,7 +93,7 @@ input.h-slider { } .music-playing { - border: 1px solid black; + border: 1px solid #505050; border-left: none; width: 70%; height: 100%; @@ -124,6 +126,7 @@ table.music-library tr td { table.music-library tr:hover td { background: #e0e0e0; + color: black; } .popup-menu, .popup-submenu { @@ -135,6 +138,7 @@ table.music-library tr:hover td { z-index: 9999; border: 1px solid black; background: #e0e0e0; + color: black; } .popup-submenu { @@ -149,6 +153,11 @@ table.music-library tr:hover td { .menubar .menu-item { min-width: unset; width: unset; + color: black; +} + +input[type="range"] { + accent-color: #c97101; } .menu-item span.menu-name { @@ -167,17 +176,35 @@ table.tracks td.number { text-align: right; } -table.tracks tr { +table.tracks tr, table.tracks td { cursor: default; + user-select: none; } table.tracks tr:hover { background: #e0e0e0; + color: black; +} + +table.tracks tr:hover.current { + color: #955c12; } table.tracks tr.current { font-weight: bold; - color: blue; + color: #f3961e; +} + +.album-art .content img { + width: auto; + height: calc(100% - 20px); + aspect-ratio: 1 / 1; + margin: auto; +} + +.album-art .content { + display: flex; + justify-content: center; } diff --git a/player.rkt b/player.rkt index 9c8f1bc..c7ef42d 100644 --- a/player.rkt +++ b/player.rkt @@ -14,6 +14,7 @@ (init-field [settings #f] [time-updater (λ (time-s length-s) #t)] [track-nr-updater (λ (nr) #t)] + [state-updater (λ (state) #t)] [buffer-max-seconds 10] [buffer-min-seconds 4] ) @@ -24,6 +25,7 @@ (define current-track -1) (define ct-data #f) (define closing #f) + (define pause #f) (define ao-handle #f) (define flac-handle #f) @@ -39,6 +41,10 @@ (define play-time-updater-state 'stopped) + (define (set-state! st) + (set! state st) + (state-updater st)) + (define (check-ao-handle) (when (eq? ao-handle #f) (unless (or (= current-rate 0) (= current-bits 0) (= current-channels 0)) @@ -62,11 +68,13 @@ (if (or (eq? ao-handle #f) closing) (begin (set! play-time-updater-state 'stopped) - (displayln "Stopping play-time-updater") + (displayln "Terminating play-time-updater") 'done) - (let ((seconds (ao-at-second ao-handle))) + (let ((seconds (ao-at-second ao-handle)) + (duration (ao-music-duration ao-handle)) + ) (set! current-seconds seconds) - (time-updater current-seconds current-length) + (time-updater current-seconds duration) (sleep 0.1) (updater)))) (updater) @@ -100,13 +108,25 @@ (when (> (buf-seconds-left) buffer-max-seconds) (while (and (not (eq? ao-handle #f)) (not closing) + (not pause) (> (buf-seconds-left) buffer-min-seconds)) (sleep 0.25)))) (when (not (eq? ao-handle #f)) - (ao-play ao-handle second buffer) + (ao-play ao-handle second duration buffer) ) ) + + (when pause + (displayln "Pauzing now...") + (ao-pause ao-handle #t) + (while (and (not (eq? ao-handle #f)) + (not closing) + pause) + (sleep 0.25)) + (ao-pause ao-handle #f) + (displayln "Playing on...") + ) ) ) ) @@ -125,14 +145,14 @@ (displayln "Starting flac-read") (let ((result (flac-read flac-handle))) (if (eq? result 'end-of-stream) - (set! state 'track-feeded) + (set-state! 'track-feeded) (displayln "Flac read stopped"))) 'worker-done ) ) ) ) - (set! state 'playing) + (set-state! 'playing) 'playing ) @@ -154,6 +174,7 @@ (let ((h ao-handle)) (displayln "closing ao-handle") (set! ao-handle #f) + (displayln (format "ao-handle = ~a" h)) (ao-close h) )) (displayln (format "close-player*: ao-handle = ~a" ao-handle)) @@ -170,11 +191,11 @@ (define (quit-player) (close-player*) - (set! state 'quitted) + (set-state! 'quitted) ) (define (stop-and-clear) - (set! state 'stopped) + (set-state! 'stopped) (close-player*) ) @@ -182,11 +203,11 @@ (set! track (+ track 1)) (if (>= track (send pl length)) (begin - (set! state 'stopped) + (set-state! 'stopped) (track-nr-updater #f)) (begin (set! ct-data (send pl track track)) - (set! state 'play) + (set-state! 'play) (track-nr-updater track) ) ) @@ -194,24 +215,19 @@ (define/public (play-track i) (displayln (format "play-track ~a" i)) - ;(unless (eq? flac-handle #f) - ; (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)) - ;(unless (eq? ao-handle #f) - ; (ao-clear-async ao-handle)) - ;(set! state 'play) - ;(track-nr-updater i) (set! state 'stopped) (close-player*) + (displayln "Player closed") (set! track i) (set! ct-data (send pl track i)) - (set! state 'play) + (set-state! 'play) + (displayln "Set state to 'play") (track-nr-updater track) + (displayln "track-nr-updater called") + ) + + (define/public (stop) + (stop-and-clear) ) (define/public (next) @@ -233,6 +249,11 @@ (set! idx (- (send pl length) 1))) (send this play-track idx) ))) + + (define/public (pause-unpause) + (set! pause (not pause)) + (displayln (format "pauzed: ~a" pause)) + ) (define (state-machine) (let ((st (orig-current-seconds)) @@ -248,17 +269,17 @@ (sleep 0.01)) ((eq? state 'play) (if (eq? pl #f) - (set! state 'stoppped) + (set-state! 'stoppped) (play-track-worker))) ((eq? state 'playing) (sleep 0.01)) ((eq? state 'track-feeded) (send this next-track)) ) - (let ((ns (orig-current-seconds))) - (when (> (- ns 5) s) - (displayln (format "state-machine: ~a" (- ns st))) - (set! s ns))) + ;(let ((ns (orig-current-seconds))) + ; (when (> (- ns 5) s) + ; (displayln (format "state-machine: ~a" (- ns st))) + ; (set! s ns))) (worker) ) )) @@ -271,7 +292,7 @@ ) (define/public (quit) - (set! state 'quit) + (set-state! 'quit) (while (not (eq? state 'quitted)) (sleep 0.1)) ) diff --git a/playlist.rkt b/playlist.rkt index b2f2ef7..d56bca3 100644 --- a/playlist.rkt +++ b/playlist.rkt @@ -38,19 +38,41 @@ (define/public (get-number) number) (define/public (get-length) length) - (super-new) - (begin - (unless (eq? file #f) - (let ((f (if (path? file) (path->string file) file))) - (let ((tags (id3-tags f)) - (tmpfile #f)) - (unless (tags-valid? tags) - (the-displayln "Invalid, try to open a copy of this file") - (let ((nfile (make-temporary-file "rktplayer-~a" #:copy-from f))) + (define (read-tags) + (let* ((f (if (path? file) (path->string file) file)) + (tags (id3-tags f)) + (tmpfile #f)) + (unless (tags-valid? tags) + (let ((nfile (make-temporary-file "rktplayer-~a" #:copy-from f))) (set! tags (id3-tags nfile)) (set! tmpfile nfile) - ) + )) + (unless (eq? tmpfile #f) + (delete-file tmpfile)) + tags + ) + ) + + (define/public (image->file to-file) + (let ((tags (read-tags))) + (if (tags-valid? tags) + (let ((ext (tags-picture->ext tags))) + (if (eq? ext #f) + #f + (let ((path (string-append to-file "." (symbol->string ext)))) + (if (tags-picture->file tags path) + path + #f) + ) + ) ) + #f))) + + (super-new) + + (begin + (unless (eq? file #f) + (let ((tags (read-tags))) (if (tags-valid? tags) (begin (set! title (tags-title tags)) @@ -67,9 +89,6 @@ (set! length -1) ) ) - (unless (eq? tmpfile #f) - (delete-file tmpfile)) - ) ) ) ) @@ -77,6 +96,7 @@ ) (define list-len length) +(define orig-for-each for-each) (define playlist% (class object% @@ -104,7 +124,7 @@ (add-track dir)) (if (directory-exists? dir) (let ((content (directory-list dir))) - (for-each (λ (entry) + (orig-for-each (λ (entry) (let ((p (build-path dir entry))) (if (directory-exists? p) (read-tracks-internal p) @@ -133,10 +153,22 @@ (list-ref tracks i)) (define/public (display-tracks) - (for-each (λ (track) + (orig-for-each (λ (track) (send track displayln)) tracks)) + (define/public (for-each f) + (let ((idx 0)) + (orig-for-each (λ (track) + (f idx track) + (set! idx (+ idx 1))) + tracks) + ) + ) + + (define/public (track-id i) + (string->symbol (format "track-~a" (+ i 1)))) + (define/public (to-html) (define (formatter row) (let* ((track-idx (car row)) @@ -158,7 +190,7 @@ (letrec ((f (λ (i N) (if (< i N) - (cons (list (format "track-~a" (+ i 1)) i) (f (+ i 1) N)) + (cons (list (send this track-id i) i) (f (+ i 1) N)) '())))) (let ((rows (f 0 (send this length)))) (mktable rows 'tracks formatter)))) diff --git a/rktplayer.rkt b/rktplayer.rkt index ff1d14a..d5c0529 100644 --- a/rktplayer.rkt +++ b/rktplayer.rkt @@ -1,6 +1,7 @@ #lang racket -(require "gui.rkt" +(require racket/gui + "gui.rkt" simple-ini/class web-racket racket-sound @@ -21,12 +22,14 @@ (ww-set-log-level 'warning) ;(ww-tail-log) ;(ww-tail-log) -(ao-set-async-mode! 'scheme) +;(ao-set-async-mode! 'scheme) +;(collect-garbage 'incremental) +(ao-set-async-mode! 'ffi) (define (run) (let* ((ini (new ini% [file 'rktplayer])) (settings (new ww-simple-ini% [ini ini] [section 'player])) - (window (new rktplayer% [settings settings] [use-browser #t])) + (window (new rktplayer% [settings settings] [use-browser #f])) ) window) )