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

-

Browse Source
This commit is contained in:
Hans Dijkema
2026-02-25 22:34:22 +01:00
parent 7cefed4d68
commit 63c8bde210
4 changed files with 54 additions and 37 deletions
Download Patch File Download Diff File Expand all files Collapse all files

73
gui.rkt
View File

@@ -50,9 +50,11 @@
(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)
@@ -67,15 +69,12 @@
(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 (if (= ls 0)
0.0
(exact->inexact (/ (* 100 as) ls)))))
;(displayln (format "seeker = ~a" seeker))
(send el-seeker set! (format "~a" seeker)))
(displayln "done")
)
)
)
@@ -84,37 +83,44 @@
(define current-track-nr #f)
(define (update-track-nr nr)
(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))
(unless (eq? playlist #f)
(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 old track: ~a" (id)))
(let ((el (send this element (id))))
(send el remove-class! "current")))
(displayln "Removing current")
(unless (eq? current-track-nr #f)
(displayln (format "current old track: ~a" (id)))
(let ((el (send this element (id))))
(send el remove-class! "current")))
(set! current-track-nr nr)
(set! current-track-nr nr)
(displayln "Adding current")
(unless (eq? current-track-nr #f)
(displayln (format "current new track: ~a" (id)))
(let ((el (send this element (id))))
(send el add-class! "current"))
(displayln "Adding current")
(unless (eq? current-track-nr #f)
(displayln (format "current new track: ~a" (id)))
(let ((el (send this element (id))))
(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))
(displayln "Getting cover image")
(let* ((track (send playlist track current-track-nr))
(img-file (if (eq? (system-type 'os) 'windows)
"c:/tmp/cover-image"
"/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 "<img src=\"~a\" />" stored-file)))
(send el set-inner-html! html))))
;(send el set-attr! 'src stored-file))))
(displayln (format "image mimetype: ~a" (send track image->mimetype)))
(unless (eq? stored-file #f)
(let ((el (send this element 'album-art)))
(when (eq? (system-type 'os) 'windows)
(set! stored-file (string-append "/" stored-file)))
(let ((html (format "<img src=\"~a?~a\" />" stored-file (current-milliseconds))))
(send el set-inner-html! html))))
;(send el set-attr! 'src stored-file))))
)
)
(displayln" Done updating track")
)
(displayln" Done updating track")
)
)
@@ -282,11 +288,14 @@
(define/public (play-path path)
(displayln (format "Playing ~a" path))
(set! playlist (new playlist% [start-map path]))
(send playlist read-tracks)
(displayln (format "number of tracks: ~a" (send playlist length)))
(send this update-playlist)
(send player play playlist)
(let ((pl (new playlist% [start-map path])))
(set! current-track-nr #f)
(send pl read-tracks)
(set! playlist pl)
(send this update-playlist)
(send player play pl)
(displayln (format "number of tracks: ~a" (send playlist length)))
)
)
(define/public (add-path path)