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")
(let* ((track (send playlist track current-track-nr))
(img-file (if (eq? (system-type 'os) 'windows)
"c:/tmp/cover-image"
"/tmp/cover-image"))
(img-file (build-path (find-system-path 'cache-dir) "rktplayer-cover-image"))
(stored-file (send track image->file img-file))
)
(dbg-rktplayer "image mimetype: ~a" (send track image->mimetype))
(dbg-rktplayer "stored-file = ~a" stored-file)
(unless (eq? stored-file #f)
(dbg-rktplayer "Setting 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))))
(dbg-rktplayer "Html = ~a" html)
(send el set-innerHTML! html))))
;(send el set-attr! 'src stored-file))))
)
)
(dbg-rktplayer "Done updating track")

50
player.rkt
View File

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

52
playlist.rkt
View File

@@ -56,20 +56,46 @@
(define/public (image->file* to-file)
#f)
(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)
)
)
(define/public (image->file to-file*)
(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)
(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)
)
)
)
#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*)
#f)

28
rktplayer.rkt
View File

@@ -10,7 +10,7 @@
)
(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"))
(sl-log-to-file log-file)
@@ -22,16 +22,22 @@
(context (new wv-context%
[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))
)]
[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)
(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
(dbg-rktplayer "RETURNING FILE")
file)
path)))
)]
))
(window (new rktplayer% [wv-context context]))
)

9
utils.rkt
View File

@@ -12,6 +12,7 @@
simple-row-formatter
while
open-file-manager
basedir
dbg-rktplayer
err-rktplayer
info-rktplayer
@@ -93,3 +94,11 @@
[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)))