From f54ece35f5a449e417105158d4964db4ed34a04d Mon Sep 17 00:00:00 2001 From: Hans Dijkema Date: Tue, 24 Feb 2026 09:49:08 +0100 Subject: [PATCH] - --- .gitignore | 1 + gui.rkt | 6 +- player.rkt | 166 ++++++++++++++++++++++++++++++++++++++++++-------- playlist.rkt | 7 +++ rktplayer.rkt | 13 +++- utils.rkt | 16 +++++ 6 files changed, 178 insertions(+), 31 deletions(-) diff --git a/.gitignore b/.gitignore index 099f327..0151183 100644 --- a/.gitignore +++ b/.gitignore @@ -18,3 +18,4 @@ compiled/ # Dependency tracking files *.dep +/*.bak diff --git a/gui.rkt b/gui.rkt index 49df656..92bbee1 100644 --- a/gui.rkt +++ b/gui.rkt @@ -9,7 +9,7 @@ "playlist.rkt" "player.rkt" ) - + (provide (all-from-out web-racket) rktplayer% @@ -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)) ) ) diff --git a/player.rkt b/player.rkt index 4544a47..eaba1f9 100644 --- a/player.rkt +++ b/player.rkt @@ -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 ao-handle #f) + (define flac-handle #f) + + (define current-rate 0) + (define current-bits 0) + (define current-channels 0) + + (define current-length 0) + (define current-seconds 0) - (define (player) - - (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 (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))) + ) ) ) diff --git a/playlist.rkt b/playlist.rkt index c9369ac..23540b4 100644 --- a/playlist.rkt +++ b/playlist.rkt @@ -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) diff --git a/rktplayer.rkt b/rktplayer.rkt index 4ddb105..a4e0ea3 100644 --- a/rktplayer.rkt +++ b/rktplayer.rkt @@ -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) ) diff --git a/utils.rkt b/utils.rkt index ea97986..7660f6b 100644 --- a/utils.rkt +++ b/utils.rkt @@ -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)