hans/rktplayer
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

simple-log integration

Browse Source
This commit is contained in:
Hans Dijkema
2026-04-09 10:43:04 +02:00
parent c35eef081e
commit e099838fb8
6 changed files with 164 additions and 141 deletions
Download Patch File Download Diff File Expand all files Collapse all files

199
gui.rkt
View File

@@ -1,6 +1,6 @@
#lang racket #lang racket
(require web-racket (require racket-webview
racket/runtime-path racket/runtime-path
racket/gui racket/gui
racket-sprintf racket-sprintf
@@ -12,28 +12,31 @@
) )
(provide (provide
(all-from-out web-racket) (all-from-out racket-webview)
rktplayer% rktplayer%
) )
(define-runtime-path rktplayer-start "gui/rktplayer.html") (define-runtime-path rkt-gui-dir "gui")
(define player-menu (define player-menu
(λ () (λ ()
(menu 'main-menu (wv-menu 'main-menu
(menu-item 'm-file (tr "File") (wv-menu-item 'm-file (tr "File")
#:submenu #:submenu
(menu (menu-item 'm-select-library-dir (tr "Select Music Library Folder")) (wv-menu (wv-menu-item 'm-select-library-dir (tr "Select Music Library Folder"))
(menu-item 'm-set-lang (tr "Set language")) (wv-menu-item 'm-set-lang (tr "Set language"))
(menu-item 'm-quit (tr "Quit") #:separator #t))) (wv-menu-item 'm-quit (tr "Quit") #:separator #t)))
) )
)) ))
(define rktplayer% (define rktplayer%
(class ww-webview% (class wv-window%
(inherit-field settings) (inherit-field settings icon)
(super-new (super-new
[html-file rktplayer-start] [html-path "rktplayer.html"]
[title "Racket Music Player"]
[icon (build-path rkt-gui-dir "rktplayer.png")]
) )
(define closed #f) (define closed #f)
@@ -69,8 +72,8 @@
(remainder (remainder ls 3600) 60))) (remainder (remainder ls 3600) 60)))
) )
(unless closed (unless closed
(send el-at set-inner-html! as-str) (send el-at set-innerHTML! as-str)
(send el-length set-inner-html! ls-str) (send el-length set-innerHTML! ls-str)
(let ((seeker (if (= ls 0) (let ((seeker (if (= ls 0)
0.0 0.0
(exact->inexact (/ (* 100 as) ls))))) (exact->inexact (/ (* 100 as) ls)))))
@@ -82,44 +85,45 @@
) )
(define current-track-nr #f) (define current-track-nr #f)
(define (update-track-nr nr) (define (update-track-nr nr)
(unless (eq? playlist #f) (unless (eq? playlist #f)
(displayln (format "update-track-nr ~a" nr)) (dbg-rktplayer "update-track-nr ~a" nr)
(let ((id (λ () (send playlist track-id current-track-nr))) ;string->symbol (format "track-~a" (+ current-track-nr 1))))) (let ((id (λ () (send playlist track-id current-track-nr))) ;string->symbol (format "track-~a" (+ current-track-nr 1)))))
(ct current-track-nr)) (ct current-track-nr))
(displayln "Removing current") (dbg-rktplayer "Removing current")
(unless (eq? current-track-nr #f) (unless (eq? current-track-nr #f)
(displayln (format "current old track: ~a" (id))) (dbg-rktplayer (format "current old track: ~a" (id)))
(let ((el (send this element (id)))) (let ((el (send this element (id))))
(send el remove-class! "current"))) (send el remove-class! "current")))
(set! current-track-nr nr) (set! current-track-nr nr)
(displayln "Adding current") (dbg-rktplayer "Adding current")
(unless (eq? current-track-nr #f) (unless (eq? current-track-nr #f)
(displayln (format "current new track: ~a" (id))) (dbg-rktplayer "current new track: ~a" (id))
(let ((el (send this element (id)))) (let ((el (send this element (id))))
(send el add-class! "current")) (send el add-class! "current"))
(displayln "Getting cover image") (dbg-rktplayer "Getting cover image")
(let* ((track (send playlist track current-track-nr)) (let* ((track (send playlist track current-track-nr))
(img-file (if (eq? (system-type 'os) 'windows) (img-file (if (eq? (system-type 'os) 'windows)
"c:/tmp/cover-image" "c:/tmp/cover-image"
"/tmp/cover-image")) "/tmp/cover-image"))
(stored-file (send track image->file img-file)) (stored-file (send track image->file img-file))
) )
(displayln (format "image mimetype: ~a" (send track image->mimetype))) (dbg-rktplayer "image mimetype: ~a" (send track image->mimetype))
(unless (eq? stored-file #f) (unless (eq? stored-file #f)
(let ((el (send this element 'album-art))) (let ((el (send this element 'album-art)))
(when (eq? (system-type 'os) 'windows) (when (eq? (system-type 'os) 'windows)
(set! stored-file (string-append "/" stored-file))) (set! stored-file (string-append "/" stored-file)))
(let ((html (format "<img src=\"~a?~a\" />" stored-file (current-milliseconds)))) (let ((html (format "<img src=\"~a?~a\" />" stored-file (current-milliseconds))))
(send el set-inner-html! html)))) (send el set-innerHTML! html))))
;(send el set-attr! 'src stored-file)))) ;(send el set-attr! 'src stored-file))))
) )
) )
(displayln" Done updating track") (dbg-rktplayer "Done updating track")
) )
) )
) )
@@ -130,9 +134,9 @@
(set! state st) (set! state st)
(if (eq? st 'playing) (if (eq? st 'playing)
(let ((btn (send this element 'play-img))) (let ((btn (send this element 'play-img)))
(send btn set-attr! 'src "buttons/stop.svg")) (send btn set-attr! '(src "buttons/stop.svg")))
(let ((btn (send this element 'play-img))) (let ((btn (send this element 'play-img)))
(send btn set-attr! 'src "buttons/play.svg"))))) (send btn set-attr! '(src "buttons/play.svg"))))))
(define player (new player% (define player (new player%
[time-updater update-time] [time-updater update-time]
@@ -143,8 +147,8 @@
(define inner-html-handlers (make-hash)) (define inner-html-handlers (make-hash))
(define/override (html-loaded) (define/override (page-loaded oke)
(super html-loaded) (super page-loaded oke)
(ww-connect 'play play-or-stop) (ww-connect 'play play-or-stop)
(ww-connect 'pause pause) (ww-connect 'pause pause)
@@ -154,7 +158,7 @@
(ww-connect 'volume volume) (ww-connect 'volume volume)
(set! el-seeker (send this element 'seek)) (set! el-seeker (send this element 'seek))
(displayln (format "el-seeker: ~a" (send el-seeker get))) (dbg-rktplayer "el-seeker: ~a" (send el-seeker get))
(let ((seek-reactor (make-delayed-reactor 0.3 (λ (percentage) (send this seek-to percentage))))) (let ((seek-reactor (make-delayed-reactor 0.3 (λ (percentage) (send this seek-to percentage)))))
(send el-seeker on-change! seek-reactor)) (send el-seeker on-change! seek-reactor))
@@ -173,36 +177,32 @@
(define/public (update-playlist) (define/public (update-playlist)
(let ((html (send playlist to-html))) (let* ((html (send playlist to-html))
(hash-set! inner-html-handlers (send el-playlist set-inner-html! html) (result (send el-playlist set-innerHTML! html))
(λ (oke) )
(when oke (dbg-rktplayer "result: ~a" result)
(send this bind 'click "table.tracks tr") (send this bind! "table.tracks tr" 'click
(send playlist for-each (λ (el evt data)
(λ (idx track) (let* ((track-id (send el attr/symbol 'id))
(let* ((track-id (send playlist track-id idx)) (idx (send playlist index track-id))
(el (send this new-element track-id))) )
(send el connect 'click (send this play-track idx)
(λ (args)
(send this play-track idx))))
) )
) )
) )
)
)
(displayln "Done.")
(update-track-nr current-track-nr) (update-track-nr current-track-nr)
) )
) )
(define/public (scroll-top id) (define/public (scroll-top id)
(send this exec-js (send this run-js
(format (format
(string-append "let el_id = '~a';" (string-append "{ let el_id = '~a';"
"console.log('id = ' + el_id);" " console.log('id = ' + el_id);"
"let el = document.getElementById(el_id);" " let el = document.getElementById(el_id);"
"console.log(el);" " console.log(el);"
"el.scrollTop = 0;") " el.scrollTop = 0;"
"}")
id))) id)))
(define/public (update-library) (define/public (update-library)
@@ -214,41 +214,32 @@
(set! nr (+ nr 1)) (set! nr (+ nr 1))
(list (format "row-~a" nr) (build-path current-music-path e) (format "path-~a" nr))) (list (format "row-~a" nr) (build-path current-music-path e) (format "path-~a" nr)))
(directory-list current-music-path))))) (directory-list current-music-path)))))
(displayln current-music-path)
(displayln music-library)
(unless (equal? (format "~a" current-music-path) (format "~a" music-library)) (unless (equal? (format "~a" current-music-path) (format "~a" music-library))
(set! l (cons (list "lib-up" "↰" "lib-up") l)) (set! l (cons (list "lib-up" "↰" "lib-up") l))
) )
(let ((html (mktable l 'music-library library-formatter))) (let ((html (mktable l 'music-library library-formatter)))
(let ((handle (send el-library set-inner-html! html))) (let ((result (send el-library set-innerHTML! html)))
(hash-set! inner-html-handlers handle (dbg-rktplayer "set-innerHTML!: ~a" result)
(λ (oke)
(when oke
(send this scroll-top 'library) (send this scroll-top 'library)
(send this bind 'click "td.library-entry") (dbg-rktplayer "Binding...")
(send this bind 'contextmenu "td.library-entry") (send this bind! "td.library-entry" 'click
(for-each (λ (row) (λ (el evt data)
(let ((path-id (string->symbol (caddr row)))) (dbg-rktplayer "~a ~a" evt data)
(let ((el (send this new-element path-id))) (dbg-rktplayer "id:~a, file:~a" (send el attr 'id) (send el attr 'file))
(send el connect 'click (let ((path (send el attr 'file)))
(λ (args) (unless (eq? path #f)
(send this path-choosen (cadr row)))) (send this path-choosen path)))))
(send el connect 'contextmenu (send this bind! "td.library-entry" 'contextmenu
(λ (evt) (λ (el evt data)
(send this context-for-path evt (cadr row)))) (dbg-rktplayer "~a ~a" evt data)
))) (let ((path (send el attr 'file)))
l) (unless (eq? path #f)
)))) (send this context-for-path data path)))
))
(dbg-rktplayer "Done...")
)) ))
) )
(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) (define/public (path-choosen path)
@@ -266,35 +257,34 @@
(define/public (context-for-path evt path) (define/public (context-for-path evt path)
(let ((items (list (let ((items (list
(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) (when (file-exists? path)
(set! items (append items (set! items (append items
(list (list
(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)))))))
(set! items (append items (set! items (append items
(list (list
(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
(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 (menu 'library-popup items)) (let* ((mnu (wv-menu 'library-popup items))
(js-evt (hash-ref evt 'js_evt (make-hash))) (clientX (hash-ref evt 'clientX 60))
(clientX (hash-ref js-evt 'clientX 60)) (clientY (hash-ref evt 'clientY 60))
(clientY (hash-ref js-evt 'clientY 60))
) )
(send this popup-menu mnu clientX clientY) (send this popup-menu! mnu clientX clientY)
) )
) )
) )
(define/public (play-path path) (define/public (play-path path)
(displayln (format "Playing ~a" path)) (dbg-rktplayer "Playing ~a" path)
(let ((pl (new playlist% [start-map path]))) (let ((pl (new playlist% [start-map path])))
(set! current-track-nr #f) (set! current-track-nr #f)
(send pl read-tracks) (send pl read-tracks)
(set! playlist pl) (set! playlist pl)
(send this update-playlist) (send this update-playlist)
(send player play pl) (send player play pl)
(displayln (format "number of tracks: ~a" (send playlist length))) (dbg-rktplayer "number of tracks: ~a" (send playlist length))
) )
) )
@@ -304,13 +294,12 @@
) )
(define/public (open-booklet path) (define/public (open-booklet path)
(displayln (format "Open booklet ~a" path))) (dbg-rktplayer "Open booklet ~a" path))
(define/public (open-folder path) (define/public (open-folder path)
(displayln path) (dbg-rktplayer "path: ~a" path)
(let ((folder (if (file-exists? path) (path-only path) path))) (let ((folder (if (file-exists? path) (path-only path) path)))
(open-file-manager folder))) (open-file-manager folder)))
;(shell-execute #f folder #f #f 'sw_show)))
(define/public (play-or-stop) (define/public (play-or-stop)
(if (eq? state 'playing) (if (eq? state 'playing)
@@ -335,44 +324,44 @@
) )
(define/public (repeat) (define/public (repeat)
(displayln "Repeat") (dbg-rktplayer "Repeat")
) )
(define/public (volume) (define/public (volume)
(displayln "Volume") (dbg-rktplayer "Volume")
) )
(define/public (seek-to percentage) (define/public (seek-to percentage)
(displayln (format "Seeking to percentage: ~a" percentage)) (dbg-rktplayer "Seeking to percentage: ~a" percentage)
) )
(define/public (quit) (define/public (quit)
(displayln (format "Quitting")) (dbg-rktplayer "Quitting")
(send player quit) (send player quit)
(set! closed #t) (set! closed #t)
(send this close)) (send this close))
(define/public (select-library) (define/public (select-library)
;(set! music-library "c:\\Users\\Hans") (let ((dir (send this choose-dir
(let ((handle (send this choose-dir
(tr "Choose the folder containing your music library") (tr "Choose the folder containing your music library")
(if (string? music-library) music-library (path->string music-library)) (if (string? music-library) music-library (path->string music-library))
))) )))
(displayln (format "Selecting Music Library with handle: ~a" handle)) (if (eq? dir 'showing)
) 'done
) (unless (eq? dir #f)
(define/override (dir-choosen handle choosen dir)
(when choosen
(set! music-library dir) (set! music-library dir)
(send settings set! 'music-library dir) (send settings set! 'music-library dir)
(set! current-music-path #f) (set! current-music-path #f)
(send this update-library))) (send this update-library)
)
)
)
)
(begin (begin
(dbg-rktplayer "ICON: ~a" (get-field icon this))
(let ((lang (send settings get 'lang 'en))) (let ((lang (send settings get 'lang 'en)))
(displayln (format "RktPlayer started, current language: ~a" lang))) (dbg-rktplayer "RktPlayer started, current language: ~a" lang))
) )
) )
) )

21
gui/styles.css
View File

@@ -114,7 +114,7 @@ table.music-library {
} }
table.music-library tr td { table.music-library tr td {
border-bottom: 1px solid #f0f0f0; /*border-bottom: 1px solid #f0f0f0;*/
cursor: default; cursor: default;
height: 1.1em; height: 1.1em;
width: 100%; width: 100%;
@@ -166,14 +166,25 @@ input[type="range"] {
table.tracks { table.tracks {
width: 94%; width: 94%;
margin-left: 3%; }
margin-right: 3%;
margin-top: 5px; table.tracks td {
margin-bottom: 5px; text-overflow: ellipsis;
white-space: nowrap;
padding-left: 5px;
} }
table.tracks td.number { table.tracks td.number {
text-align: right; text-align: right;
width: 40px;
}
table.tracks td.length {
width: 30px;
}
table.tracks td.title, table.tracks td.album {
width: calc(50% - 70px);
} }
table.tracks tr, table.tracks td { table.tracks tr, table.tracks td {

8
music-library.rkt
View File

@@ -33,10 +33,12 @@
(path->string name)))) (path->string name))))
(define (library-formatter row) (define (library-formatter row)
(let ((file-entry (car row)) (let* ((file-entry (car row))
(file-id (cadr row)) (file-id (format "file-~a" (cadr row)))
(the-file (if (equal? file-id "lib-up") ".." file-entry))
) )
(list (list 'td (list (list 'class "library-entry") (list 'id file-id) (list 'file (format "~a" file-entry))) ;(displayln row)
(list (list 'td (list (list 'class "library-entry") (list 'id file-id) (list 'file (format "~a" the-file)))
(if (equal? file-id "lib-up") (if (equal? file-id "lib-up")
file-entry file-entry
(basename file-entry)) (basename file-entry))

3
playlist.rkt
View File

@@ -188,6 +188,9 @@
(define/public (track-id i) (define/public (track-id i)
(string->symbol (format "track-~a" (+ i 1)))) (string->symbol (format "track-~a" (+ i 1))))
(define/public (index id)
(- (string->number (substring (symbol->string id) 6)) 1))
(define/public (to-html) (define/public (to-html)
(define (formatter row) (define (formatter row)
(let* ((track-idx (car row)) (let* ((track-idx (car row))

44
rktplayer.rkt
View File

@@ -3,33 +3,37 @@
(require racket/gui (require racket/gui
"gui.rkt" "gui.rkt"
simple-ini/class simple-ini/class
web-racket
racket-sound racket-sound
racket-webview
racket/runtime-path
"utils.rkt"
) )
(define-runtime-path rkt-gui-dir "gui")
(let ((os (system-type 'os)))
(cond
((eq? os 'windows)
(ww-set-custom-webui-wire-command! "C:/devel/racket/webui-wire/build/Release/webui-wire.exe"))
((eq? os 'unix)
(ww-set-custom-webui-wire-command! "/home/hans/src/racket/webui-wire/build/Release/webui-wire"))
(else (error "Cannot set custom webui-wire command"))
)
)
(ww-set-debug #f)
(ww-set-log-level 'info)
;(ww-tail-log)
;(ww-tail-log)
;(ao-set-async-mode! 'scheme)
;(collect-garbage 'incremental)
(ao-set-async-mode! 'ffi) (ao-set-async-mode! 'ffi)
(define log-file (build-path (find-system-path 'home-dir) ".rktplayer.log"))
(sl-log-to-file log-file)
(displayln (format "Logging to file ~a" log-file))
(define (run) (define (run)
(let* ((ini (new ini% [file 'rktplayer])) (let* ((ini (new ini% [file 'rktplayer]))
(settings (new ww-simple-ini% [ini ini] [section 'player])) (context (new wv-context%
(window (new rktplayer% [settings settings] [use-browser #t])) [base-path rkt-gui-dir]
[ini ini]
[file-getter (webview-standard-file-getter rkt-gui-dir
#:not-exist
(λ (file base-path path)
(dbg-rktplayer "FILE:~a, ~a, ~a" file base-path path)
(if (string-prefix? file "/tmp/cover-image")
(begin
(dbg-rktplayer "RETURNING FILE")
file)
path))
)]
))
(window (new rktplayer% [wv-context context]))
) )
window) window)
) )

18
utils.rkt
View File

@@ -3,6 +3,7 @@
(require racket/gui (require racket/gui
xml xml
xml/xexpr xml/xexpr
simple-log
) )
(provide ww-connect (provide ww-connect
@@ -11,9 +12,17 @@
simple-row-formatter simple-row-formatter
while while
open-file-manager open-file-manager
dbg-rktplayer
err-rktplayer
info-rktplayer
warn-rktplayer
fatal-rktplayer
(all-from-out simple-log)
) )
(sl-def-log rktplayer)
(define-syntax while (define-syntax while
(syntax-rules () (syntax-rules ()
((_ cond body ...) ((_ cond body ...)
@@ -31,12 +40,15 @@
(define-syntax ww-connect (define-syntax ww-connect
(syntax-rules (this) (syntax-rules (this)
((_ id method) ((_ id method)
(send (send this element id) connect 'click (λ (data) (send this method))) (begin
(send this bind! id 'click
(λ (el evt data)
(send this method)))
(send this element id))
) )
) )
) )
(define (make-delayed-reactor seconds closure) (define (make-delayed-reactor seconds closure)
(let* ((last-val #f) (let* ((last-val #f)
(last-time -1) (last-time -1)
@@ -67,6 +79,8 @@
(append (list 'tr (list (list 'id (format "~a" row-id)))) (append (list 'tr (list (list 'id (format "~a" row-id))))
(row-formatter (cdr row))))) (row-formatter (cdr row)))))
l) l)
; Add one empty tr
(list (list 'tr (list (list 'class "unresponsive"))))
) )
) )
) )