-
This commit is contained in:
1
.gitignore
vendored
1
.gitignore
vendored
@@ -18,3 +18,4 @@ compiled/
|
||||
# Dependency tracking files
|
||||
*.dep
|
||||
|
||||
/*.bak
|
||||
|
||||
4
gui.rkt
4
gui.rkt
@@ -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))
|
||||
)
|
||||
)
|
||||
|
||||
154
player.rkt
154
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 (player)
|
||||
(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 (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)))
|
||||
)
|
||||
)
|
||||
)
|
||||
|
||||
(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 'quit)
|
||||
'done)
|
||||
((eq? state 'stopped)
|
||||
(sleep 0.25)
|
||||
(state-machine))
|
||||
(sleep 0.01))
|
||||
((eq? state 'play)
|
||||
(if (eq? pl #f)
|
||||
(begin
|
||||
(set! state 'stopped)
|
||||
(state-machine))
|
||||
(begin
|
||||
(play-
|
||||
|
||||
(set! state 'stoppped)
|
||||
(play-track-worker)))
|
||||
((eq? state 'playing)
|
||||
(sleep 0.01))
|
||||
((eq? state 'track-feeded)
|
||||
(send this next-track))
|
||||
)
|
||||
|
||||
(thread (λ ()
|
||||
|
||||
|
||||
(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)))
|
||||
)
|
||||
)
|
||||
)
|
||||
|
||||
@@ -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)
|
||||
|
||||
@@ -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)
|
||||
)
|
||||
|
||||
16
utils.rkt
16
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)
|
||||
|
||||
Reference in New Issue
Block a user