This commit is contained in:
2026-02-24 09:49:08 +01:00
parent 21162e4376
commit f54ece35f5
6 changed files with 178 additions and 31 deletions

1
.gitignore vendored
View File

@@ -18,3 +18,4 @@ compiled/
# Dependency tracking files
*.dep
/*.bak

View File

@@ -204,9 +204,11 @@
(send this close))
(define/public (select-library)
;(set! music-library "c:\\Users\\Hans")
(let ((handle (send this choose-dir
(tr "Choose the folder containing your music library")
(format "~a" music-library))))
(if (string? music-library) music-library (path->string music-library))
)))
(displayln (format "Selecting Music Library with handle: ~a" handle))
)
)

View File

@@ -1,48 +1,159 @@
#lang racket
(require racket/class
racket-audio
racket-sound
"utils.rkt"
)
(provide player%)
(define orig-current-seconds current-seconds)
(define player%
(class object%
(init-field [settings #f])
(init-field [settings #f]
[time-updater (λ (time-s length-s) #t)]
[buffer-max-seconds 10]
[buffer-min-seconds 4]
)
(define pl #f)
(define state 'stopped)
(define track 0)
(define track -1)
(define current-track -1)
(define ct-data #f)
(define (player)
(define ao-handle #f)
(define flac-handle #f)
(define (state-machine)
(cond
((eq? state 'quit)
'done)
((eq? state 'stopped)
(sleep 0.25)
(state-machine))
((eq? state 'play)
(if (eq? pl #f)
(begin
(set! state 'stopped)
(state-machine))
(begin
(play-
(define current-rate 0)
(define current-bits 0)
(define current-channels 0)
(define current-length 0)
(define current-seconds 0)
(define (check-ao-handle)
(unless ao-handle
(unless (or (= current-rate 0) (= current-bits 0) (= current-channels 0))
(let ((fmt (ao-mk-format current-bits current-rate current-channels 'big-endian)))
(set! ao-handle (ao-open-live #f fmt)))
)
)
(thread (λ ()
)
(define (update-play-time)
(unless (eq? ao-handle #f)
(let ((seconds (ao-at-second ao-handle)))
(set! current-seconds seconds)
(time-updater current-seconds current-length)
)
)
)
(define (flac-play frame buffer)
(let* ((sample (hash-ref frame 'number))
(rate (hash-ref frame 'sample-rate))
(second (/ (* sample 1.0) (* rate 1.0)))
(bits-per-sample (hash-ref frame 'bits-per-sample))
(bytes-per-sample (/ bits-per-sample 8))
(channels (hash-ref frame 'channels))
(bytes-per-sample-all-channels (* channels bytes-per-sample))
(duration (hash-ref frame 'duration))
)
(set! current-rate rate)
(set! current-bits bits-per-sample)
(set! current-channels channels)
(set! current-length duration)
(check-ao-handle)
(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 (> (buf-seconds-left) buffer-min-seconds)
(update-play-time)
(sleep 0.25))))
(ao-play ao-handle second buffer)
)
)
(define (flac-meta meta)
(displayln meta))
(define (play-track-worker)
(thread
(λ ()
(if (eq? ct-data #f)
'no-track-data
(let ((file (send ct-data get-file)))
(set! flac-handle (flac-open file flac-meta flac-play))
(flac-read flac-handle)
(set! state 'track-feeded)
'track-feeded
)
)
)
)
(set! state 'playing)
'playing
)
(define/public (next-track)
(set! track (+ track 1))
(if (>= track (send pl length))
(set! state 'stopped)
(begin
(set! ct-data (send pl track track))
(set! state 'play)
)
)
)
(define/public (play-track i)
(unless (eq? flac-handle #f)
(flac-stop flac-handle))
(set! track i)
(set! ct-data (send pl track i))
(while (eq? state 'playing)
(sleep 0.1))
(set! state 'play))
(define (state-machine)
(let ((st (orig-current-seconds))
(s (orig-current-seconds)))
(define (worker)
(if (eq? state 'quit)
'done
(begin
(cond
((eq? state 'stopped)
(sleep 0.01))
((eq? state 'play)
(if (eq? pl #f)
(set! state 'stoppped)
(play-track-worker)))
((eq? state 'playing)
(sleep 0.01))
((eq? state 'track-feeded)
(send this next-track))
)
(let ((ns (orig-current-seconds)))
(when (> (- ns 5) s)
(displayln (format "state-machine: ~a" (- ns st)))
(set! s ns)))
(worker)
)
))
(worker)))
(define/public (play playlist)
(set! state 'stopped)
(set! pl playlist)
(set! track 0)
(set! state 'play)
(send this play-track 0)
)
(define/public (quit)
@@ -51,6 +162,7 @@
(super-new)
(begin
(player))
(thread (λ () (state-machine)))
)
)
)

View File

@@ -29,6 +29,13 @@
album
length)))
(define/public (get-file) file)
(define/public (get-title) title)
(define/public (get-artist) artist)
(define/public (get-album) album)
(define/public (get-number) number)
(define/public (get-length) length)
(super-new)
(begin
(unless (eq? file #f)

View File

@@ -7,14 +7,23 @@
)
(ww-set-custom-webui-wire-command! "/home/hans/src/racket/webui-wire/build/Release/webui-wire")
(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 #t)
;(ww-tail-log)
(define (run)
(let* ((ini (new ini% [file 'rktplayer]))
(settings (new ww-simple-ini% [ini ini] [section 'player]))
(window (new rktplayer% [settings settings] [use-browser #t]))
(window (new rktplayer% [settings settings] [use-browser #f]))
)
window)
)

View File

@@ -9,8 +9,24 @@
make-delayed-reactor
mktable
simple-row-formatter
while
)
(define-syntax while
(syntax-rules ()
((_ cond body ...)
(letrec ((while-f (lambda (last-result)
(if cond
(let ((last-result (begin
body
...)))
(while-f last-result))
last-result))))
(while-f #f))
)
))
(define-syntax ww-connect
(syntax-rules (this)
((_ id method)