#lang racket (require racket/class racket-sound "utils.rkt" ) (provide player%) (define orig-current-seconds current-seconds) (define player% (class object% (init-field [settings #f] [time-updater (λ (time-s length-s) #t)] [track-nr-updater (λ (nr) #t)] [state-updater (λ (state) #t)] [buffer-max-seconds 10] [buffer-min-seconds 4] ) (define pl #f) (define state 'stopped) (define track -1) (define current-track -1) (define ct-data #f) (define closing #f) (define pause #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 repeat 'no-repeat) ;; no-repeat, repeat-1, repeat-all (define play-time-updater-state 'stopped) (define (set-state! st) (set! state st) (state-updater st)) (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") (let ((fmt (ao-mk-format current-bits current-rate current-channels 'big-endian))) (set! ao-handle (ao-open-live #f fmt)) (start-play-time-updater) ) ) ) ) (define (start-play-time-updater) (when (eq? play-time-updater-state 'stopped) (set! play-time-updater-state 'updating) (displayln "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") 'done) (let ((seconds (ao-at-second ao-handle)) (duration (ao-music-duration ao-handle)) ) (set! current-seconds seconds) (time-updater current-seconds duration) (sleep 0.1) (updater)))) (updater) ) ) ) ) (define (flac-play frame buffer) (unless (eq? state 'quitted) (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) (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 second duration buffer) ) ) (when pause (displayln "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...") ) ) ) ) (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))) (displayln (format "opening flac handle for file: ~a" file)) (set! flac-handle (flac-open file flac-meta flac-play)) (displayln "Starting flac-read") (let ((result (flac-read flac-handle))) (if (eq? result 'end-of-stream) (set-state! 'track-feeded) (displayln "Flac read stopped"))) 'worker-done ) ) ) ) (set-state! 'playing) 'playing ) (define (close-player*) (displayln "Closing flac handle") (set! closing #t) (unless (eq? flac-handle #f) (flac-stop flac-handle) (set! flac-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)) (displayln "closing ao-handle") (set! ao-handle #f) (displayln (format "ao-handle = ~a" h)) (ao-close h) )) (displayln (format "close-player*: ao-handle = ~a" ao-handle)) (displayln "Waiting for updater to stop") (while (eq? play-time-updater-state 'updating) (displayln (format "close-player*: ao-handle = ~a" ao-handle)) (sleep 0.1)) (displayln "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) (set! track (+ track 1)) (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) (displayln (format "play-track ~a" i)) (set! state 'stopped) (close-player*) (displayln "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)) (track-nr-updater track) (displayln "track-nr-updater called") ) (define/public (stop) (stop-and-clear) ) (define/public (next) (if (= (send pl length) 0) #f (let ((idx track)) (set! idx (+ idx 1)) (when (>= idx (send pl length)) (set! idx 0)) (send this play-track idx)) )) (define/public (previous) (if (= (send pl length) 0) #f (let ((idx track)) (set! idx (- idx 1)) (when (< idx 0) (set! idx (- (send pl length) 1))) (send this play-track idx) ))) (define/public (pause-unpause) (set! pause (not pause)) (displayln (format "pauzed: ~a" pause)) ) (define (state-machine) (let ((st (orig-current-seconds)) (s (orig-current-seconds))) (define (worker) (if (eq? state 'quit) (begin (quit-player) '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) (stop-and-clear) ;(unless (eq? pl #f) (send pl display-tracks)) (set! pl playlist) ;(unless (eq? pl #f) (send pl display-tracks)) (send this play-track 0) ) (define/public (quit) (set-state! 'quit) (while (not (eq? state 'quitted)) (sleep 0.1)) ) (super-new) (begin (thread (λ () (state-machine))) ) ) )