Compare commits

...

7 Commits

Author SHA1 Message Date
hans 2f04cf2ff4 adjustment to the new audio-player module of racket-audio 2026-05-19 15:01:32 +02:00
hans e60ecaeaef change to audio-player.rkt 2026-05-18 10:35:14 +02:00
hans fccf019fe7 small gui changes 2026-05-12 16:15:24 +02:00
hans a6318d7a2f pause functionality 2026-05-11 09:21:37 +02:00
hans 788af0f7aa pause handling 2026-05-07 15:12:27 +02:00
hans 120fdc2be7 handle minimize -> hide 2026-05-04 16:05:34 +02:00
hans 167ef6d8ac drag/drop 2026-05-04 15:41:24 +02:00
8 changed files with 386 additions and 369 deletions
+97 -15
View File
@@ -43,6 +43,7 @@
[html-path "rktplayer.html"] [html-path "rktplayer.html"]
[title "Racket Music Player"] [title "Racket Music Player"]
[icon (build-path rkt-gui-dir "rktplayer.png")] [icon (build-path rkt-gui-dir "rktplayer.png")]
[quit-on-close #f]
) )
(define initialized (make-semaphore 0)) (define initialized (make-semaphore 0))
@@ -146,11 +147,21 @@
(unless (eq? stored-file #f) (unless (eq? stored-file #f)
(dbg-rktplayer "Setting album art") (dbg-rktplayer "Setting album art")
(let ((el (send this element 'album-art))) (let ((el (send this element 'album-art)))
(let ((html (format "<img src=\"/get-image?~a&~a\" />" (let ((html (format "<img id=\"album-image\" src=\"/get-image?~a&~a\" />"
(format "~a" stored-file) (format "~a" stored-file)
(current-milliseconds)))) (current-milliseconds))))
(dbg-rktplayer "Html = ~a" html) (dbg-rktplayer "Html = ~a" html)
(send el set-innerHTML! html) (send el set-innerHTML! html)
(when (send track has-booklet?)
(let ((booklet-file (send track booklet-file)))
(send this bind! 'album-image 'contextmenu
(λ (el evt data)
(let ((mnu (wv-menu 'image-menu
(wv-menu-item 'm-booklet (tr "Open booklet")
#:callback (λ () (send this open-booklet booklet-file #t)))))
(clientX (hash-ref data 'clientX 60))
(clientY (hash-ref data 'clientY 60)))
(send this popup-menu! mnu clientX clientY))))))
))) )))
) )
) )
@@ -172,15 +183,26 @@
) )
(define (update-state st) (define (update-state st)
(dbg-rktplayer "state: ~a" st)
(unless (eq? st state) (unless (eq? st state)
(dbg-rktplayer "Changing to state ~a" st) (dbg-rktplayer "Changing to state ~a" st)
(unless (eq? state #f) ; Prevent setting src twice very fast (let ((el (send this element 'paused)))
(if (eq? st 'playing) (cond ((or (eq? st 'playing) (eq? st 'play))
(set-play-button "buttons/pause.svg") (set-play-button "buttons/pause.svg")
(send el set-innerHTML! '(span (tr "playing"))))
((eq? st 'stopped)
(set-play-button "buttons/play.svg") (set-play-button "buttons/play.svg")
) (send el set-innerHTML! '(span (tr "stopped"))))
) ((eq? st 'paused)
(set-play-button "buttons/play.svg")
(send el set-innerHTML! '(span ((class "blink")) (tr "paused"))))
((eq? st 'quit)
(void))
(else
(warn-rktplayer "Unkown state for update-state ~a" st)
(send el set-innerHTML! (list 'span
'((class "blink"))
(format "~a: ~a" (tr "Unknown state") st))))
))
(set! state st) (set! state st)
) )
) )
@@ -296,11 +318,14 @@
(send playlist add-tab!) (send playlist add-tab!)
(send this update-tabs)) (send this update-tabs))
(define (update-audio-info samples rate channels bits audio-format) (define (update-audio-info rate channels bits audio-format)
(send el-bits set-innerHTML! (format "~a ~a" bits (tr "bits"))) (let ((format-num (λ (x) (if (= x 0) "-" x)))
(send el-channels set-innerHTML! (format "~a ~a" channels (tr "channels"))) (format-dec (λ (x) (if (eq? x 'none) "-" x))))
(send el-rate set-innerHTML! (format "~a Hz" rate)) (send el-bits set-innerHTML! (format "~a ~a" (format-num bits) (tr "bits")))
(send el-format set-innerHTML! (format "~a" audio-format)) (send el-channels set-innerHTML! (format "~a ~a" (format-num channels) (tr "channels")))
(send el-rate set-innerHTML! (format "~a Hz" (format-num rate)))
(send el-format set-innerHTML! (format "~a" (format-dec audio-format)))
)
) )
(define (update-repeat state) (define (update-repeat state)
@@ -384,14 +409,20 @@
(send this update-tabs) (send this update-tabs)
(send this update-library) (send this update-library)
(send this update-playlist) (send this update-playlist)
(when (eq? state #f)
(update-audio-info 0 0 0 'none)
(update-state 'stopped))
) )
(define el-dragged #f)
(define/public (update-playlist) (define/public (update-playlist)
(let* ((html (send playlist to-html)) (let* ((html (send playlist to-html))
(result (send el-playlist set-innerHTML! html)) (result (send el-playlist set-innerHTML! html))
) )
(dbg-rktplayer "result: ~a" result) (dbg-rktplayer "result: ~a" result)
(send this set-attr! "table.tracks tr" '(draggable "true"))
(send this bind! "table.tracks tr" 'click (send this bind! "table.tracks tr" 'click
(λ (el evt data) (λ (el evt data)
(let* ((track-id (send el attr/symbol 'id)) (let* ((track-id (send el attr/symbol 'id))
@@ -401,6 +432,46 @@
) )
) )
) )
(send this bind! "table.tracks tr" 'contextmenu
(λ (el evt data)
(let ((mnu (wv-menu 'track-menu
(wv-menu-item 'm-drop-track "Drop track"
#:callback (λ ()
(send playlist drop-id (send el id))
(update-playlist))
)
)
)
(clientX (hash-ref data 'clientX 60))
(clientY (hash-ref data 'clientY 60))
)
(send this popup-menu! mnu clientX clientY))))
(let ((from-idx #f)
(to-idx #f))
(send this bind! "table.tracks tr" 'dragstart
(λ (el evt data)
(set! el-dragged el)
(dbg-rktplayer "Dragging element ~a" (send el id))
(set! from-idx (send playlist index (send el id)))
)
#t)
(send this bind! "table.tracks tr" 'dragover
(λ (el evt data)
#t)
)
(send this bind! "table.tracks tr" 'drop
(λ (el evt data)
(dbg-rktplayer "Element dropped on ~a" (send el id))
(set! to-idx (send playlist index (send el id)))
(when (and (integer? from-idx) (integer? to-idx)
(not (= from-idx to-idx)))
(send playlist move-track from-idx to-idx)
(update-playlist)
)
)
)
)
(update-track-nr current-track-nr) (update-track-nr current-track-nr)
) )
(send this update-volume) (send this update-volume)
@@ -510,9 +581,10 @@
(send this update-playlist) (send this update-playlist)
) )
(define/public (open-booklet path) (define/public (open-booklet path . is-file*)
(let ((booklet (build-path path "booklet.pdf"))) (let* ((is-file (if (null? is-file*) #f (eq? (car is-file*) #t)))
(dbg-rktplayer "Open booklet ~a" path) (booklet (if is-file path (build-path path "booklet.pdf"))))
(dbg-rktplayer "Open booklet ~a" booklet)
(open-app booklet))) (open-app booklet)))
(define/public (open-folder path) (define/public (open-folder path)
@@ -525,7 +597,7 @@
(cond (cond
((eq? state 'playing) ((eq? state 'playing)
(send player pause!)) (send player pause!))
((eq? state 'pauzed) ((eq? state 'paused)
(send player play!)) (send player play!))
(else (else
(play-track 0)) (play-track 0))
@@ -594,6 +666,7 @@
(send player quit) (send player quit)
(set! closed #t) (set! closed #t)
(send this close) (send this close)
(dbg-rktplayer "Calling super -> quit")
(super quit) (super quit)
) )
@@ -623,6 +696,14 @@
) )
) )
(define window-state-change-callback (λ () #t))
(define/public (set-window-state-change-callback! f)
(set! window-state-change-callback f))
(define/override (window-state-changed st)
(window-state-change-callback))
(define/override (can-close?) (define/override (can-close?)
(show-hide) (show-hide)
#f) #f)
@@ -635,6 +716,7 @@
(set! playlist (new playlist% [settings (send settings clone 'playlists)])) (set! playlist (new playlist% [settings (send settings clone 'playlists)]))
(send player set-list! playlist) (send player set-list! playlist)
(dbg-rktplayer "playlist = ~a" playlist) (dbg-rktplayer "playlist = ~a" playlist)
(semaphore-post initialized) (semaphore-post initialized)
) )
) )
+4 -1
View File
@@ -49,8 +49,11 @@
</div> </div>
</div> </div>
<div class="status"> <div class="status">
<span class="info" id="bits"></span><span class="info" id="rate"></span><span class="info" id="channels"></span> <span class="info" id="bits"></span>
<span class="info" id="rate"></span>
<span class="info" id="channels"></span>
<span class="info" id="format"></span> <span class="info" id="format"></span>
<span class="info" id="paused"></span>
<div class="right"> <div class="right">
<span class="info" id="volume-percentage"></span> <span class="info" id="volume-percentage"></span>
<span class="info" id="log-file"></span> <span class="info" id="log-file"></span>
+15
View File
@@ -336,5 +336,20 @@ input.v-slider {
} }
.blink {
animation: blink 3s infinite both;
}
@keyframes blink {
0%,
50%,
100% {
opacity: 1;
}
25%,
75% {
opacity: 0;
}
}
+2 -2
View File
@@ -1,6 +1,6 @@
#lang racket #lang racket
(require racket-sound) (require racket-audio)
(provide music-lib-relevant? (provide music-lib-relevant?
is-music-dir? is-music-dir?
@@ -16,7 +16,7 @@
(not (string-prefix? name "."))) (not (string-prefix? name ".")))
(if (eq? type 'file) (if (eq? type 'file)
(let* ((fn (string-downcase (format "~a" f))) (let* ((fn (string-downcase (format "~a" f)))
(exts (audio-supported-extensions))) (exts (audio-known-exts?)))
(let ((l (filter (λ (e) (string-suffix? fn (string-append "." e))) exts))) (let ((l (filter (λ (e) (string-suffix? fn (string-append "." e))) exts)))
(not (null? l)))) (not (null? l))))
#f)))) #f))))
+145 -334
View File
@@ -1,14 +1,13 @@
#lang racket #lang racket
(require racket/class (require racket/class
racket-sound racket-audio
"utils.rkt" "utils.rkt"
lru-cache
) )
(provide player%) (provide player%)
(define orig-current-seconds current-seconds)
(define player% (define player%
(class object% (class object%
(init-field [settings #f] (init-field [settings #f]
@@ -20,375 +19,187 @@
[buffer-max-seconds 10] [buffer-max-seconds 10]
[buffer-min-seconds 4] [buffer-min-seconds 4]
) )
(define use-ao #t)
(define pl #f) (define player #f)
(define playlist #f)
(define state 'stopped) (define state 'stopped)
(define track -1) (define repeat 'no-repeat)
(define current-track -1)
(define ct-data #f)
(define closing #f)
(define pause #f)
(define repeat-state 'no-repeat)
(define volume (send settings get 'volume 100.0))
(define ao-handle #f) (define full-state (make-hash))
(define audio-handle #f) (define music-id -1)
(define track-cache (make-lru 10
#:cmp (λ (a b) (= (car a) (car b)))))
(define current-music-id -1)
(define current-track-id -1)
(define current-rate 0) (define (music-id->track-nr id)
(define current-bits 0) (let ((item (lru-use track-cache (list music-id) #f)))
(define current-channels 0) (if (eq? item #f)
(define current-audio-format 'none) #f
(cadr item))))
(define current-length 0) (define (register-music-id&track-nr id track-nr)
(define current-seconds 0) (lru-add! track-cache (list id track-nr)))
(define repeat 'no-repeat) ;; no-repeat, repeat-1, repeat-all (define (clear-music-ids!)
(lru-clear track-cache))
(define play-time-updater-state 'stopped)
(define (set-state! st) (define (audio-state-cb handle player-state st*)
(set! state st) (set! full-state st*)
(state-updater st)) (let ((st (audio-state player)))
(when (or (eq? st 'paused) (eq? st 'playing))
(define (check-ao-handle) (time-updater (audio-at-second player)
(when (eq? ao-handle #f) (audio-duration player))
(unless (or (= current-rate 0) (= current-bits 0) (= current-channels 0)) (when (not (= music-id (audio-music-id player)))
(dbg-rktplayer "current-rate = ~a, current-bits = ~a, current-channels = ~a, ao-handle = ~a" (set! music-id (audio-music-id player))
current-rate current-bits current-channels ao-handle) (let ((track-nr (music-id->track-nr music-id)))
(dbg-rktplayer "Opening ao-handle") (if (eq? track-nr #f)
(when use-ao (error "Unexpected: no track-nr for given music-id")
(set! ao-handle (ao-open-live current-bits current-rate current-channels 'native-endian)) (track-nr-updater track-nr))))
(start-play-time-updater)
)
)
)
(when (not (= (ao-volume ao-handle) volume))
(ao-set-volume! ao-handle volume))
)
(define (start-play-time-updater)
(when (eq? play-time-updater-state 'stopped)
(set! play-time-updater-state 'updating)
(dbg-rktplayer "Starting play-time-updater")
(thread (λ ()
(define (updater)
(if (or (eq? ao-handle #f) closing)
(begin
(set! play-time-updater-state 'stopped)
(dbg-rktplayer "Terminating play-time-updater")
'done)
(let ((seconds (ao-at-second ao-handle))
(duration (ao-music-duration ao-handle))
(music-id (ao-at-music-id ao-handle))
)
(set! current-seconds seconds)
(time-updater current-seconds duration)
(unless (= music-id current-music-id)
(dbg-rktplayer "a ~a ~a ~a" music-id current-track-id seconds)
(set! current-music-id music-id)
(track-nr-updater track))
(sleep 0.2)
(updater))))
(updater)
)
) )
(state-updater st)
(repeat-updater repeat)
(if (or (eq? player-state 'quit) (eq? player-state 'stopped))
(audio-info-cb 0 0 0 'none)
(audio-info-cb (audio-rate player) (audio-channels player)
(audio-bits player) (audio-decoder player)))
) )
) )
(define (on-eof-stream-cb handle)
(let ((track-nr (music-id->track-nr music-id)))
(send this next)))
(define (stream-equal? rate bits channels) (define (check-player)
(and (= current-rate rate) (when (eq? player #f)
(= current-bits bits) (set! player (make-audio-player audio-state-cb on-eof-stream-cb))
(= current-channels channels))) (audio-ao-buf-ms! player 500)
(audio-buf-seconds! player buffer-min-seconds buffer-max-seconds)
(define (audio-play type ao-type handle buf-info buffer buf-len)
(unless (eq? state 'quitted)
(let* ((sample (hash-ref buf-info 'sample))
(rate (hash-ref buf-info 'sample-rate))
(second (/ (* sample 1.0) (* rate 1.0)))
(bits-per-sample (hash-ref buf-info 'bits-per-sample))
(bytes-per-sample (/ bits-per-sample 8))
(channels (hash-ref buf-info 'channels))
(bytes-per-sample-all-channels (* channels bytes-per-sample))
(duration (hash-ref buf-info 'duration))
)
(unless (stream-equal? rate bits-per-sample channels)
(dbg-rktplayer "Stream has changed to ~a ~a ~a" rate bits-per-sample channels)
(unless (eq? ao-handle #f)
(dbg-rktplayer "Waiting for play buffer to reach empty state")
(while (> (ao-bufsize-async ao-handle) 0)
(sleep 0.25)
)
(dbg-rktplayer "Closing ao-handle")
(ao-close ao-handle)
(set! ao-handle #f))
)
(set! current-rate rate)
(set! current-bits bits-per-sample)
(set! current-channels channels)
(set! current-length duration)
(when (eq? ao-handle #f)
(audio-info-cb sample current-rate current-channels current-bits current-audio-format)
)
(check-ao-handle)
(when (not (eq? ao-handle #f))
(let ((buf-seconds-left (λ () (exact->inexact
(/ (ao-bufsize-async ao-handle)
bytes-per-sample-all-channels
rate)))))
(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 current-track-id second duration buffer buf-len ao-type)
)
)
(when pause
(dbg-rktplayer "Pausing now...")
(set-state! 'pauzed)
(ao-pause ao-handle #t)
(while (and (not (eq? ao-handle #f))
(not closing)
pause)
(sleep 0.5))
(ao-pause ao-handle #f)
(dbg-rktplayer "Playing on...")
(set-state! 'playing)
)
)
)
)
(define (audio-meta type ao-type handle meta)
(set! current-audio-format type)
(dbg-rktplayer "type: ~a" type)
(dbg-rktplayer "ao-type: ~a" ao-type)
(dbg-rktplayer "meta: ~a" meta))
(define (play-track-worker)
(thread
(λ ()
(if (eq? ct-data #f)
'no-track-data
(let ((file (send ct-data get-file)))
(dbg-rktplayer "opening audios handle for file: ~a" file)
(set! audio-handle (audio-open file audio-meta audio-play))
(set! current-track-id (send ct-data get-id))
(dbg-rktplayer "Starting audio-read")
(audio-read audio-handle)
(unless (eq? state 'stopped)
(set-state! 'track-feeded)
(dbg-rktplayer "Audio read done")
)
'worker-done
)
)
)
)
(set-state! 'playing)
'playing
)
(define (close-player*)
(dbg-rktplayer "Closing audio handle")
(set! closing #t)
(unless (eq? audio-handle #f)
(audio-stop audio-handle)
(set! audio-handle #f))
(set! current-rate 0)
(set! current-channels 0)
(set! current-bits 0)
(set! ct-data #f)
(unless (eq? ao-handle #f)
(let ((h ao-handle))
(dbg-rktplayer "closing ao-handle")
(set! ao-handle #f)
(dbg-rktplayer "ao-handle = ~a" h)
(ao-close h)
)) ))
(dbg-rktplayer "close-player*: ao-handle = ~a" ao-handle)
(dbg-rktplayer "Waiting for updater to stop")
(while (eq? play-time-updater-state 'updating)
(dbg-rktplayer "close-player*: ao-handle = ~a" ao-handle)
(sleep 0.1))
(dbg-rktplayer "resetting tracks")
(set! track -1)
(set! current-track -1)
(set! closing #f)
)
(define (quit-player)
(close-player*)
(set-state! 'quitted)
)
(define (stop-and-clear)
(set-state! 'stopped)
(close-player*)
)
(define/public (next-track)
(unless (eq? repeat-state 'repeat-one)
(set! track (+ track 1)))
(when (eq? repeat-state 'repeat-all)
(when (>= track (send pl length))
(set! track 0)))
(if (>= track (send pl length))
(begin
(set-state! 'stopped)
(track-nr-updater #f))
(begin
(set! ct-data (send pl track track))
(set-state! 'play)
;(track-nr-updater track)
)
)
)
(define/public (play-track i)
(unless (= (send pl length) 0)
(dbg-rktplayer "play-track ~a" i)
(set! state 'stopped)
(close-player*)
(dbg-rktplayer "Player closed")
(set! track i)
(set! ct-data (send pl track i))
(set-state! 'play)
(dbg-rktplayer "Set state to 'play, updating to track ~a" track)
(track-nr-updater track)
(dbg-rktplayer "track-nr-updater called")
)
)
(define/public (stop)
(stop-and-clear)
)
(define/public (set-volume! percentage)
(set! volume percentage)
(send settings set! 'volume percentage)
(unless (eq? ao-handle #f)
(ao-set-volume! ao-handle volume))
)
(define/public (get-volume) (define/public (get-volume)
volume) (check-player)
(audio-volume player))
(define/public (set-volume! percentage)
(check-player)
(audio-volume! player percentage))
(define/public (set-list! playlist*)
;; if the player exists and is playing, stop it.
(unless (eq? player #f)
(audio-stop! player))
;; Set the playlist to the new one.
(set! playlist playlist*)
;; reset music-id to -1, because the playlist has been reset.
(set! music-id -1)
;; clear lru cache, because the playlist has been reset.
(clear-music-ids!)
)
(define/public (play playlist*)
(check-player)
(set-list! playlist*)
(send this play-track 0))
(define/public (play-track nr)
(check-player)
(when (and (>= nr 0) (< nr (send playlist length)))
(let ((track (send playlist track nr)))
(let ((id (audio-play! player (send track get-file))))
(register-music-id&track-nr id nr)))))
(define/public (next) (define/public (next)
(if (= (send pl length) 0) (check-player)
#f (if (= music-id -1)
(let ((idx track)) (warn-rktplayer "No music-id set (yet), so can't play anything next")
(set! idx (+ idx 1)) (let ((track-nr (music-id->track-nr music-id)))
(when (>= idx (send pl length)) (if (eq? track-nr #f)
(set! idx 0)) (error "Unexpected: no track-nr for given music-id")
(send this play-track idx)) (begin
)) (cond
((eq? repeat 'repeat-one) (play-track track-nr))
((eq? repeat 'repeat-all)
(set! track-nr (+ track-nr 1))
(when (>= track-nr (send playlist length))
(set! track-nr 0))
(play-track track-nr))
(else
(set! track-nr (+ track-nr 1))
(if (>= track-nr (send playlist length))
(stop)
(play-track track-nr)))
)
)
)
)
)
)
(define/public (previous) (define/public (previous)
(if (= (send pl length) 0) (check-player)
#f (if (= music-id -1)
(let ((idx track)) (warn-rktplayer "No music-id set (yet), so can't play anything previous")
(set! idx (- idx 1)) (let ((track-nr (music-id->track-nr music-id)))
(when (< idx 0) (if (eq? track-nr #f)
(set! idx (- (send pl length) 1))) (error "Unexpected: no track-nr for given music-id")
(send this play-track idx) (begin
))) (cond
((eq? repeat 'repeat-one) (play-track track-nr))
(define/public (pause-unpause) ((eq? repeat 'repeat-all)
(set! pause (not pause)) (set! track-nr (- track-nr 1))
(dbg-rktplayer "pauzed: ~a" pause) (when (< track-nr 0)
(set! track-nr (- (send playlist length) 1)))
(play-track track-nr))
(else
(set! track-nr (- track-nr 1))
(when (< track-nr 0) (set! track-nr 0))
(play-track track-nr))
)
)
)
)
)
) )
(define/public (pause!) (define/public (pause!)
(set! pause #t)) (check-player)
(audio-pause! player #t))
(define/public (play!) (define/public (play!)
(set! pause #f)) (check-player)
(audio-pause! player #f))
(define/public (get-repeat) (define/public (pause-unpause)
repeat-state) (check-player)
(if (audio-paused? player)
(send this pause!)
(send this play!)))
(define/public (repeat! state) ; no-repeat, repeat-all, repeat-one (define/public (stop)
(set! repeat-state state) (check-player)
(repeat-updater state) (audio-stop! player))
)
(define/public (seek percentage) (define/public (seek percentage)
(ao-clear-async ao-handle) (check-player)
(audio-seek audio-handle percentage)) (audio-seek! player percentage))
(define (state-machine) (define/public (get-repeat)
(let ((st (orig-current-seconds)) (check-player)
(s (orig-current-seconds))) repeat)
(define (worker)
(if (eq? state 'quit)
(begin
(quit-player)
'done)
(begin
(cond
((eq? state 'stopped)
(sleep 0.1))
((eq? state 'play)
(if (eq? pl #f)
(set-state! 'stoppped)
(play-track-worker)))
((eq? state 'playing)
(sleep 0.1))
((eq? state 'track-feeded)
(send this next-track))
(else
(sleep 0.1))
)
;(let ((ns (orig-current-seconds)))
; (when (> (- ns 5) s)
; (displayln (format "state-machine: ~a" (- ns st)))
; (set! s ns)))
(worker)
)
))
(worker)))
(define/public (set-list! playlist) (define/public (repeat! r)
(stop-and-clear) (check-player)
(set! pl playlist) (set! repeat r))
)
(define/public (play playlist)
(send this set-list! playlist)
(send this play-track 0)
)
(define/public (quit) (define/public (quit)
(set-state! 'quit) (unless (eq? player #f)
(while (not (eq? state 'quitted)) (audio-quit! player)))
(sleep 0.1))
)
(super-new) (super-new)
(begin (begin
(thread (λ () (state-machine))) (dbg-rktplayer "player% initialized")
) )
) )
) )
+46 -1
View File
@@ -2,10 +2,11 @@
(require racket/class (require racket/class
"music-library.rkt" "music-library.rkt"
racket-sound racket-audio
"utils.rkt" "utils.rkt"
racket-sprintf racket-sprintf
keystore/class keystore/class
racket/list
) )
(provide track% (provide track%
@@ -50,6 +51,14 @@
(define/public (get-length) length) (define/public (get-length) length)
(define/public (get-id) my-id) (define/public (get-id) my-id)
(define/public (booklet-file)
(let* ((dir (path-only file))
(booklet-file (build-path dir "booklet.pdf")))
booklet-file))
(define/public (has-booklet?)
(file-exists? (send this booklet-file)))
(define/public (track< t2) (define/public (track< t2)
(if (string-ci<? album (send t2 get-album)) (if (string-ci<? album (send t2 get-album))
#t #t
@@ -331,6 +340,42 @@
(send this save-tab!)) (send this save-tab!))
) )
(define/public (move-track from-idx to-idx)
(let ((tr (list-ref tracks from-idx))
(idx 0))
(if (= from-idx to-idx)
#t
(begin
(when (< from-idx to-idx)
(set! to-idx (- to-idx 1)))
(let* ((l1 (if (= from-idx 0)
'()
(take tracks from-idx)))
(l2 (drop tracks (+ from-idx 1)))
(l (append l1 l2))
)
(set! tracks (append
(if (= to-idx 0) '() (take l to-idx))
(list tr)
(drop l to-idx)))
)
(send this save-tab!)
)
)
)
)
(define/public (drop-id track-id)
(let ((idx (send this index track-id)))
(let* ((l1 (if (= idx 0) '() (take tracks idx)))
(l2 (drop tracks (+ idx 1)))
(l (append l1 l2)))
(set! tracks l)
(send this save-tab!)
)
)
)
(define/public (track i) (define/public (track i)
(list-ref tracks i)) (list-ref tracks i))
+48 -1
View File
@@ -4,7 +4,7 @@
"gui.rkt" "gui.rkt"
"tray.rkt" "tray.rkt"
simple-ini/class simple-ini/class
racket-sound racket-audio
racket-webview racket-webview
racket/runtime-path racket/runtime-path
"utils.rkt" "utils.rkt"
@@ -39,6 +39,18 @@
(define rktplayer-window #f) (define rktplayer-window #f)
(define rktplayer-tray #f) (define rktplayer-tray #f)
(define (close-off)
(send rktplayer-tray close)
(send rktplayer-window close)
(exit)
)
(define-syntax ignore
(syntax-rules ()
((_ body)
#t)))
(define (run . no-exit) (define (run . no-exit)
(let* ((ini (new ini% [file 'rktplayer])) (let* ((ini (new ini% [file 'rktplayer]))
(context (new wv-context% (context (new wv-context%
@@ -52,9 +64,44 @@
) )
(set! rktplayer-window window) (set! rktplayer-window window)
(set! rktplayer-tray tray) (set! rktplayer-tray tray)
(ignore
(thread (λ ()
(sleep 5)
(let ((prg (string-append "let f_evt_info = window.rkt_event_info;\n"
"window.rkt_event_info = function(e, id, evt) {\n"
" if (evt.dataTransfer) {\n"
" for(const item of evt.dataTransfer.items) {\n"
" if (item.kind == 'file') {\n"
" console.log(item.getAsFile());\n"
" }\n"
" }\n"
" }\n"
" return f_evt_info(e, id, evt);\n"
"}; return 42;")))
#|(js (let* ((f_evt_info window.rkt_event_info))
(send console log "Setting new window.rkt_event_info")
(set! window.rkt_event_info
(λ (e id evt)
(if evt.dataTransfer
(let* ((items evt.dataTransfer.items)
(fitems (send items filter (λ (item)
(return (== item.kind "file")))))
)
(send fitems forEach (λ (item)
(console.log item)))
)
42)
(return (f_evt_info e id evt))))
(return 42)))))|#
(displayln prg)
(displayln (send window call-js prg)))))
)
(when (or (null? no-exit) (when (or (null? no-exit)
(not (eq? (car no-exit) #t))) (not (eq? (car no-exit) #t)))
(webview-wait-for-quit) (webview-wait-for-quit)
(send rktplayer-tray close)
(webview-exit) (webview-exit)
(exit)) (exit))
) )
+14
View File
@@ -3,6 +3,7 @@
(require racket-webview (require racket-webview
racket/runtime-path racket/runtime-path
"translate.rkt" "translate.rkt"
"utils.rkt"
) )
(provide rktplayer-tray%) (provide rktplayer-tray%)
@@ -15,6 +16,7 @@
) )
(define (adjust-menu) (define (adjust-menu)
(dbg-rktplayer "adjust menu called, window state = ~a" (send rktplayer-gui window-state))
(let ((mnu (wv-menu 'tray-menu (let ((mnu (wv-menu 'tray-menu
(wv-menu-item 'm-hide-show (wv-menu-item 'm-hide-show
(if (eq? (send rktplayer-gui window-state) 'hidden) (if (eq? (send rktplayer-gui window-state) 'hidden)
@@ -50,6 +52,18 @@
[tooltip (tr "Racket Music Player")]) [tooltip (tr "Racket Music Player")])
(begin (begin
(send rktplayer-gui set-window-state-change-callback!
(λ ()
(let ((st (send rktplayer-gui window-state)))
(if (eq? st 'minimized)
(begin
(dbg-rktplayer "state = ~a, hiding window" st)
(send rktplayer-gui present)
(send rktplayer-gui hide))
(adjust-menu))
)
)
)
(adjust-menu) (adjust-menu)
) )