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

developing

Browse Source
This commit is contained in:
Hans Dijkema
2026-04-10 09:01:19 +02:00
parent 5dee69316a
commit fb99e97577
5 changed files with 94 additions and 55 deletions
Download Patch File Download Diff File Expand all files Collapse all files

10
gui.rkt
View File

@@ -108,19 +108,17 @@
(dbg-rktplayer "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 (build-path (find-system-path 'cache-dir) "rktplayer-cover-image"))
"c:/tmp/cover-image"
"/tmp/cover-image"))
(stored-file (send track image->file img-file)) (stored-file (send track image->file img-file))
) )
(dbg-rktplayer "image mimetype: ~a" (send track image->mimetype)) (dbg-rktplayer "image mimetype: ~a" (send track image->mimetype))
(dbg-rktplayer "stored-file = ~a" stored-file)
(unless (eq? stored-file #f) (unless (eq? stored-file #f)
(dbg-rktplayer "Setting album art")
(let ((el (send this element 'album-art))) (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)))) (let ((html (format "<img src=\"~a?~a\" />" stored-file (current-milliseconds))))
(dbg-rktplayer "Html = ~a" html)
(send el set-innerHTML! html)))) (send el set-innerHTML! html))))
;(send el set-attr! 'src stored-file))))
) )
) )
(dbg-rktplayer "Done updating track") (dbg-rktplayer "Done updating track")

50
player.rkt
View File

@@ -49,9 +49,9 @@
(define (check-ao-handle) (define (check-ao-handle)
(when (eq? ao-handle #f) (when (eq? ao-handle #f)
(unless (or (= current-rate 0) (= current-bits 0) (= current-channels 0)) (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" (dbg-rktplayer "current-rate = ~a, current-bits = ~a, current-channels = ~a, ao-handle = ~a"
current-rate current-bits current-channels ao-handle)) current-rate current-bits current-channels ao-handle)
(displayln "Opening ao-handle") (dbg-rktplayer "Opening ao-handle")
(when use-ao (when use-ao
(let ((fmt (ao-mk-format current-bits current-rate current-channels 'big-endian))) (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))
@@ -64,13 +64,13 @@
(define (start-play-time-updater) (define (start-play-time-updater)
(when (eq? play-time-updater-state 'stopped) (when (eq? play-time-updater-state 'stopped)
(set! play-time-updater-state 'updating) (set! play-time-updater-state 'updating)
(displayln "Starting play-time-updater") (dbg-rktplayer "Starting play-time-updater")
(thread (λ () (thread (λ ()
(define (updater) (define (updater)
(if (or (eq? ao-handle #f) closing) (if (or (eq? ao-handle #f) closing)
(begin (begin
(set! play-time-updater-state 'stopped) (set! play-time-updater-state 'stopped)
(displayln "Terminating play-time-updater") (dbg-rktplayer "Terminating play-time-updater")
'done) 'done)
(let ((seconds (ao-at-second ao-handle)) (let ((seconds (ao-at-second ao-handle))
(duration (ao-music-duration ao-handle)) (duration (ao-music-duration ao-handle))
@@ -85,7 +85,7 @@
) )
) )
(define (flac-play frame buffer) (define (flac-play frame buffer buf-len)
(unless (eq? state 'quitted) (unless (eq? state 'quitted)
(let* ((sample (hash-ref frame 'number)) (let* ((sample (hash-ref frame 'number))
(rate (hash-ref frame 'sample-rate)) (rate (hash-ref frame 'sample-rate))
@@ -115,26 +115,26 @@
(sleep 0.25)))) (sleep 0.25))))
(when (not (eq? ao-handle #f)) (when (not (eq? ao-handle #f))
(ao-play ao-handle second duration buffer) (ao-play ao-handle second duration buffer buf-len 'flac)
) )
) )
(when pause (when pause
(displayln "Pauzing now...") (dbg-rktplayer "Pauzing now...")
(ao-pause ao-handle #t) (ao-pause ao-handle #t)
(while (and (not (eq? ao-handle #f)) (while (and (not (eq? ao-handle #f))
(not closing) (not closing)
pause) pause)
(sleep 0.25)) (sleep 0.25))
(ao-pause ao-handle #f) (ao-pause ao-handle #f)
(displayln "Playing on...") (dbg-rktplayer "Playing on...")
) )
) )
) )
) )
(define (flac-meta meta) (define (flac-meta meta)
(displayln meta)) (dbg-rktplayer "flac meta: ~a" meta))
(define (play-track-worker) (define (play-track-worker)
(thread (thread
@@ -142,13 +142,13 @@
(if (eq? ct-data #f) (if (eq? ct-data #f)
'no-track-data 'no-track-data
(let ((file (send ct-data get-file))) (let ((file (send ct-data get-file)))
(displayln (format "opening flac handle for file: ~a" file)) (dbg-rktplayer "opening flac handle for file: ~a" file)
(set! flac-handle (flac-open file flac-meta flac-play)) (set! flac-handle (flac-open file flac-meta flac-play))
(displayln "Starting flac-read") (dbg-rktplayer "Starting flac-read")
(let ((result (flac-read flac-handle))) (let ((result (flac-read flac-handle)))
(if (eq? result 'end-of-stream) (if (eq? result 'end-of-stream)
(set-state! 'track-feeded) (set-state! 'track-feeded)
(displayln "Flac read stopped"))) (dbg-rktplayer "Flac read stopped")))
'worker-done 'worker-done
) )
) )
@@ -159,7 +159,7 @@
) )
(define (close-player*) (define (close-player*)
(displayln "Closing flac handle") (dbg-rktplayer "Closing flac handle")
(set! closing #t) (set! closing #t)
@@ -174,17 +174,17 @@
(unless (eq? ao-handle #f) (unless (eq? ao-handle #f)
(let ((h ao-handle)) (let ((h ao-handle))
(displayln "closing ao-handle") (dbg-rktplayer "closing ao-handle")
(set! ao-handle #f) (set! ao-handle #f)
(displayln (format "ao-handle = ~a" h)) (dbg-rktplayer "ao-handle = ~a" h)
(ao-close h) (ao-close h)
)) ))
(displayln (format "close-player*: ao-handle = ~a" ao-handle)) (dbg-rktplayer "close-player*: ao-handle = ~a" ao-handle)
(displayln "Waiting for updater to stop") (dbg-rktplayer "Waiting for updater to stop")
(while (eq? play-time-updater-state 'updating) (while (eq? play-time-updater-state 'updating)
(displayln (format "close-player*: ao-handle = ~a" ao-handle)) (dbg-rktplayer "close-player*: ao-handle = ~a" ao-handle)
(sleep 0.1)) (sleep 0.1))
(displayln "resetting tracks") (dbg-rktplayer "resetting tracks")
(set! track -1) (set! track -1)
(set! current-track -1) (set! current-track -1)
@@ -216,16 +216,16 @@
) )
(define/public (play-track i) (define/public (play-track i)
(displayln (format "play-track ~a" i)) (dbg-rktplayer "play-track ~a" i)
(set! state 'stopped) (set! state 'stopped)
(close-player*) (close-player*)
(displayln "Player closed") (dbg-rktplayer "Player closed")
(set! track i) (set! track i)
(set! ct-data (send pl track i)) (set! ct-data (send pl track i))
(set-state! 'play) (set-state! 'play)
(displayln (format "Set state to 'play, updating to track ~a" track)) (dbg-rktplayer "Set state to 'play, updating to track ~a" track)
(track-nr-updater track) (track-nr-updater track)
(displayln "track-nr-updater called") (dbg-rktplayer "track-nr-updater called")
) )
(define/public (stop) (define/public (stop)
@@ -254,7 +254,7 @@
(define/public (pause-unpause) (define/public (pause-unpause)
(set! pause (not pause)) (set! pause (not pause))
(displayln (format "pauzed: ~a" pause)) (dbg-rktplayer "pauzed: ~a" pause)
) )
(define (state-machine) (define (state-machine)

32
playlist.rkt
View File

@@ -56,8 +56,11 @@
(define/public (image->file* to-file) (define/public (image->file* to-file)
#f) #f)
(define/public (image->file to-file) (define/public (image->file to-file*)
(let ((tags (read-tags))) (let ((to-file (format "~a" to-file*))
(tags (read-tags)))
(dbg-rktplayer "image->file ~a" to-file)
(let ((image-from-tags (λ ()
(if (tags-valid? tags) (if (tags-valid? tags)
(let ((ext (tags-picture->ext tags))) (let ((ext (tags-picture->ext tags)))
(if (eq? ext #f) (if (eq? ext #f)
@@ -69,7 +72,30 @@
) )
) )
) )
#f))) #f)
)
)
)
(let ((path (image-from-tags)))
(dbg-rktplayer "image-from-tags: ~a" path)
(if (eq? path #f)
(let* ((bd (basedir file))
(files (filter
(λ (f)
(let ((file (build-path bd f)))
(file-exists? file)))
(list "cover.jpg" "cover.png" "folder.jpg" "folder.png"))))
(if (null? files)
#f
(let ((file (string-append to-file (bytes->string/utf-8 (path-get-extension (car files))))))
(copy-file (build-path bd (car files)) file #:exists-ok? #t)
(dbg-rktplayer "image from basedir: ~a" file)
(format "~a" file))
))
path))
)
)
)
(define/public (image->mimetype*) (define/public (image->mimetype*)
#f) #f)

14
rktplayer.rkt
View File

@@ -10,7 +10,7 @@
) )
(define-runtime-path rkt-gui-dir "gui") (define-runtime-path rkt-gui-dir "gui")
(ao-set-async-mode! 'ffi) ;(ao-set-async-mode! 'ffi)
(define log-file (build-path (find-system-path 'home-dir) ".rktplayer.log")) (define log-file (build-path (find-system-path 'home-dir) ".rktplayer.log"))
(sl-log-to-file log-file) (sl-log-to-file log-file)
@@ -22,15 +22,21 @@
(context (new wv-context% (context (new wv-context%
[base-path rkt-gui-dir] [base-path rkt-gui-dir]
[ini ini] [ini ini]
[file-getter (webview-standard-file-getter rkt-gui-dir [file-getter (webview-standard-file-getter
rkt-gui-dir
#:not-exist #:not-exist
(λ (file base-path path) (λ (file base-path path)
(dbg-rktplayer "FILE:~a, ~a, ~a" file base-path path) (dbg-rktplayer "FILE:~a, ~a, ~a" file base-path path)
(if (string-prefix? file "/tmp/cover-image") (let ((prefix (path->string
(build-path (find-system-path 'cache-dir)
"rktplayer-cover-image"))))
(dbg-rktplayer "prefix= ~a" prefix)
(dbg-rktplayer "is-prefix? = ~a" (string-prefix? file prefix))
(if (string-prefix? file prefix)
(begin (begin
(dbg-rktplayer "RETURNING FILE") (dbg-rktplayer "RETURNING FILE")
file) file)
path)) path)))
)] )]
)) ))
(window (new rktplayer% [wv-context context])) (window (new rktplayer% [wv-context context]))

9
utils.rkt
View File

@@ -12,6 +12,7 @@
simple-row-formatter simple-row-formatter
while while
open-file-manager open-file-manager
basedir
dbg-rktplayer dbg-rktplayer
err-rktplayer err-rktplayer
info-rktplayer info-rktplayer
@@ -93,3 +94,11 @@
[else (process (string-append "xdg-open " folder))])) [else (process (string-append "xdg-open " folder))]))
) )
(define (basedir file)
(if (string? file)
(basedir (string->path file))
(if (or (eq? (file-or-directory-type file) 'file)
(eq? (file-or-directory-type file) 'link))
(call-with-values (λ () (split-path file))
(λ (dir file d) dir))
file)))