380 lines
13 KiB
Racket
380 lines
13 KiB
Racket
#lang racket/base
|
|
|
|
(require racket/place
|
|
racket/async-channel
|
|
"libao.rkt"
|
|
"audio-decoder.rkt"
|
|
"private/utils.rkt"
|
|
early-return
|
|
)
|
|
|
|
(provide placed-player)
|
|
|
|
(define (eq-seconds? s1 s2)
|
|
(let ((s1* (inexact->exact (round s1)))
|
|
(s2* (inexact->exact (round s2))))
|
|
(= s1 s2)))
|
|
|
|
(define (placed-player ch-in)
|
|
(let ((ch-evt #f)
|
|
(ch-out #f)
|
|
(ao-h #f)
|
|
(ao-mutex (make-mutex))
|
|
(ao-dec #f)
|
|
(current-seconds 0)
|
|
(current-deci-seconds 0)
|
|
(stored-seconds -1)
|
|
(current-file-id 0)
|
|
(files-playing '())
|
|
(current-bits -1)
|
|
(current-rate -1)
|
|
(current-channels -1)
|
|
(current-duration -1)
|
|
(current-volume 100.0)
|
|
(req-volume 100.0)
|
|
(max-buf-secs 4)
|
|
(min-buf-secs 2)
|
|
(play-thread #f)
|
|
(player-state 'stopped)
|
|
(decoder-buf-info #f)
|
|
(decoder-meta #f)
|
|
(decoder #f)
|
|
(feeding-audio #f)
|
|
(feed-interrupted #f)
|
|
)
|
|
|
|
(define-syntax with-ao-h
|
|
(syntax-rules (ao-h ao-mutex)
|
|
((_ r b1 ...)
|
|
(with-mutex ao-mutex
|
|
(if (ao-valid? ao-h)
|
|
(begin b1 ...)
|
|
r)))))
|
|
|
|
(define (put data)
|
|
(if (place-channel? ch-out)
|
|
(place-channel-put ch-out data)
|
|
(async-channel-put ch-out data)))
|
|
|
|
(define (evt data)
|
|
(if (place-channel? ch-evt)
|
|
(place-channel-put ch-evt data)
|
|
(async-channel-put ch-evt data)))
|
|
|
|
(define (get)
|
|
(if (place-channel? ch-in)
|
|
(place-channel-get ch-in)
|
|
(async-channel-get ch-in)))
|
|
|
|
(define (audio-read-worker)
|
|
(set! play-thread
|
|
(thread (λ ()
|
|
(set! feeding-audio #t)
|
|
(audio-read ao-dec)
|
|
(set! feeding-audio #f)
|
|
(state "audio-read-worker: just after audio-read" evt)
|
|
(if feed-interrupted
|
|
(set! feed-interrupted #f)
|
|
(begin
|
|
(evt '(audio-done))
|
|
(let ((bufsize #f))
|
|
(let loop ()
|
|
(let ((nbfs (with-ao-h 'done
|
|
(ao-bufsize-async ao-h))))
|
|
(if (eq? nbfs 'done)
|
|
'done
|
|
(cond
|
|
((eq? bufsize #f) (set! bufsize nbfs) (loop))
|
|
((= nbfs 0) (set! bufsize 0) 'done)
|
|
((> nbfs bufsize) (set! bufsize nbfs) 'done)
|
|
(else (set! bufsize nbfs) (sleep 0.1) (loop)))
|
|
)
|
|
)
|
|
)
|
|
(when (= bufsize 0)
|
|
(set! player-state 'stopped)
|
|
(state "audio-read-worker: after read with bufsize 0" evt))
|
|
)
|
|
)
|
|
)
|
|
)
|
|
)
|
|
)
|
|
)
|
|
|
|
(define (check-volume)
|
|
(unless (= req-volume current-volume)
|
|
(set! current-volume req-volume)
|
|
(with-ao-h 'no-op
|
|
(ao-set-volume! ao-h current-volume))
|
|
(state "check-volume: volume changed" evt)
|
|
)
|
|
)
|
|
|
|
(define (check-paused)
|
|
(if (eq? player-state 'paused)
|
|
(begin
|
|
(with-ao-h 'no-op (ao-pause ao-h #t))
|
|
(state "check-paused: player-state = paused" evt)
|
|
(let loop ()
|
|
(sleep 0.3)
|
|
(when (eq? player-state 'paused)
|
|
(loop)))
|
|
(when (eq? player-state 'playing)
|
|
(with-ao-h 'no-op (ao-pause ao-h #f))
|
|
(state "check-paused: player-stat = playing" evt)
|
|
)
|
|
#t)
|
|
#f))
|
|
|
|
(define (audio-play type ao-type handle buf-info buffer buf-len)
|
|
(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))
|
|
)
|
|
|
|
(set! decoder type)
|
|
(set! decoder-buf-info buf-info)
|
|
|
|
(with-ao-h 'no-op
|
|
(when (not (and
|
|
(= current-bits bits-per-sample)
|
|
(= current-rate rate)
|
|
(= current-channels channels)))
|
|
(ao-close ao-h)
|
|
(set! ao-h #f)))
|
|
|
|
(when (eq? ao-h #f)
|
|
(set! ao-h (ao-open-live bits-per-sample
|
|
rate channels
|
|
'native-endian))
|
|
(set! current-bits bits-per-sample)
|
|
(set! current-rate rate)
|
|
(set! current-channels channels)
|
|
)
|
|
|
|
(check-volume)
|
|
(with-ao-h 'no-op
|
|
(ao-play ao-h current-file-id second duration buffer buf-len ao-type)
|
|
)
|
|
(check-paused)
|
|
|
|
(let* ((s (inexact->exact (round (* (ao-at-second ao-h) 10)))))
|
|
(unless (= s current-deci-seconds)
|
|
(set! current-deci-seconds s)
|
|
(set! current-seconds (ao-at-second ao-h))))
|
|
|
|
(unless (eq-seconds? stored-seconds current-seconds)
|
|
(set! stored-seconds current-seconds)
|
|
(state"audio-play: seconds changed (I)" evt))
|
|
|
|
(let* ((buf-size (with-ao-h 0 (ao-bufsize-async ao-h)))
|
|
(buf-seconds (exact->inexact (/ buf-size
|
|
bytes-per-sample-all-channels
|
|
rate)))
|
|
)
|
|
(when (> buf-seconds max-buf-secs)
|
|
(let waiter ()
|
|
(when (not (check-paused))
|
|
(sleep 0.3))
|
|
(let* ((s* (with-ao-h 0 (ao-at-second ao-h)))
|
|
(s (inexact->exact (round (* s* 10)))))
|
|
|
|
(unless (= s current-deci-seconds)
|
|
(set! current-deci-seconds s)
|
|
(set! current-seconds (with-ao-h 0 (ao-at-second ao-h))))
|
|
|
|
(unless (eq-seconds? stored-seconds current-seconds)
|
|
(set! stored-seconds current-seconds)
|
|
(state "audio-play: seconds changed (II)" evt))
|
|
|
|
(let ((buf-seconds-left (exact->inexact
|
|
(/ (with-ao-h 0 (ao-bufsize-async ao-h))
|
|
bytes-per-sample-all-channels
|
|
rate))))
|
|
(when (>= buf-seconds-left min-buf-secs)
|
|
(waiter)))))
|
|
))
|
|
)
|
|
)
|
|
|
|
(define (audio-meta type ao-type handle meta)
|
|
(set! decoder-meta meta)
|
|
#t)
|
|
|
|
(define (cleanup)
|
|
(set! files-playing '())
|
|
(set! current-seconds 0)
|
|
(set! current-deci-seconds 0)
|
|
(set! stored-seconds -1)
|
|
(set! current-file-id 0)
|
|
(set! current-bits -1)
|
|
(set! current-rate -1)
|
|
(set! current-channels -1)
|
|
(set! current-duration -1)
|
|
(set! decoder-buf-info #f)
|
|
(set! decoder-meta #f)
|
|
)
|
|
|
|
(define (stop-and-cleanup)
|
|
(unless (eq? ao-dec #f)
|
|
(audio-stop ao-dec))
|
|
(with-ao-h 'no-op
|
|
(ao-clear-async ao-h)
|
|
(ao-close ao-h))
|
|
(thread-wait play-thread)
|
|
(set! ao-dec #f)
|
|
(set! ao-h #f)
|
|
(set! player-state 'stopped)
|
|
(cleanup)
|
|
(state "stop-and-cleanup: stopped/cleaned" evt)
|
|
player-state
|
|
)
|
|
|
|
(define (start file)
|
|
|
|
(when feeding-audio
|
|
(set! feed-interrupted #t)
|
|
(audio-stop ao-dec)
|
|
(let loop ()
|
|
(if feeding-audio
|
|
(begin
|
|
(sleep 0.1)
|
|
(loop))
|
|
(with-ao-h 'no-op (ao-clear-async ao-h))
|
|
)
|
|
)
|
|
)
|
|
|
|
(set! ao-dec (audio-open file audio-meta audio-play))
|
|
(set! current-file-id (+ current-file-id 1))
|
|
(let ((f (build-path file)))
|
|
(set! files-playing (cons
|
|
(cons current-file-id f)
|
|
(filter (λ (e)
|
|
(= (car e) (- current-file-id 1)))
|
|
files-playing))))
|
|
(when (eq? player-state 'stopped)
|
|
(set! player-state 'playing))
|
|
(audio-read-worker))
|
|
|
|
(define (pause paused)
|
|
(set! player-state (if paused 'paused 'playing)))
|
|
|
|
|
|
(define (seek percentage)
|
|
(with-ao-h 'no-op
|
|
(ao-clear-async ao-h))
|
|
(unless (eq? ao-dec #f)
|
|
(audio-seek ao-dec percentage)))
|
|
|
|
(define (volume percentage)
|
|
(set! req-volume percentage))
|
|
|
|
(define (state msg cb . force)
|
|
(let ((h (make-hash)))
|
|
(with-mutex ao-mutex
|
|
(let ((m-id (if (ao-valid? ao-h) (ao-at-music-id ao-h) #f)))
|
|
(hash-set! h 'decoder (if (audio-handle? ao-dec) (audio-kind ao-dec) #f))
|
|
(hash-set! h 'msg msg)
|
|
(hash-set! h 'file (let ((r (filter (λ (e)
|
|
(eq? (car e) m-id))
|
|
files-playing)))
|
|
(if (null? r) #f (cdar r))))
|
|
(hash-set! h 'state player-state)
|
|
(hash-set! h 'valid-ao-handle (ao-valid? ao-h))
|
|
(hash-set! h 'duration (if (ao-valid? ao-h) (ao-music-duration ao-h) #f))
|
|
(hash-set! h 'at-second (if (ao-valid? ao-h) (ao-at-second ao-h) #f))
|
|
(hash-set! h 'at-music-id m-id)
|
|
(hash-set! h 'volume current-volume)
|
|
(hash-set! h 'buf-size (if (ao-valid? ao-h) (ao-bufsize-async ao-h) 0))
|
|
(hash-set! h 'reuse-buf-len (if (ao-valid? ao-h)
|
|
(ao-reuse-buf-len-async ao-h)
|
|
#f))
|
|
(hash-set! h 'sample-queue-len (if (ao-valid? ao-h)
|
|
(ao-sample-queue-len-async ao-h)
|
|
#f))
|
|
(hash-set! h 'bits current-bits)
|
|
(hash-set! h 'rate current-rate)
|
|
(hash-set! h 'channels current-channels)
|
|
(hash-set! h 'decoder-meta decoder-meta)
|
|
(hash-set! h 'decoder-buf-info decoder-buf-info)
|
|
)
|
|
)
|
|
|
|
(let ((m-id (hash-ref h 'at-music-id)))
|
|
(unless (or (eq? m-id #f) (= m-id 0) )
|
|
(cb (list 'state h))))
|
|
)
|
|
)
|
|
|
|
(let loop ()
|
|
(let* ((data (get))
|
|
(cmd (car data)))
|
|
|
|
(early-return
|
|
((? (eq? cmd 'quit) => (stop-and-cleanup)
|
|
~ (begin
|
|
(state "quit" evt 'force)
|
|
(put '(quit)))))
|
|
|
|
(with-handlers ([exn:fail? (λ (e)
|
|
(if (eq? ch-evt #f)
|
|
(raise e)
|
|
(evt (list 'exception e))))])
|
|
(if (eq? cmd 'init)
|
|
(begin
|
|
(set! ch-out (cadr data))
|
|
(set! ch-evt (caddr data))
|
|
(put '(initialized)))
|
|
(begin
|
|
(when (or (eq? ch-out #f) (eq? ch-evt #f))
|
|
(error "placed player not initialized"))
|
|
(cond
|
|
((eq? cmd 'buf-seconds)
|
|
(set! min-buf-secs (if (< (cadr data) 2) 2 (cadr data)))
|
|
(set! max-buf-secs (if (> (caddr data) 30) 30 (caddr data)))
|
|
(put '(ok))
|
|
)
|
|
((eq? cmd 'open)
|
|
(let ((file (cadr data)))
|
|
(start file)
|
|
(put '(ok))
|
|
))
|
|
((eq? cmd 'seek)
|
|
(let ((percentage (cadr data)))
|
|
(seek percentage)
|
|
(put '(ok))))
|
|
((eq? cmd 'pause)
|
|
(let ((paused (cadr data)))
|
|
(pause paused)
|
|
(put '(ok))))
|
|
((eq? cmd 'paused)
|
|
(put (list (eq? player-state 'paused))))
|
|
((eq? cmd 'volume)
|
|
(let ((percentage (cadr data)))
|
|
(volume percentage)
|
|
(put '(ok))))
|
|
((eq? cmd 'get-volume)
|
|
(put (list current-volume)))
|
|
((eq? cmd 'stop)
|
|
(stop-and-cleanup)
|
|
(put '(ok)))
|
|
((eq? cmd 'state)
|
|
(state "'state command" put))
|
|
(else
|
|
(error (format "Unknown command ~a" cmd)))
|
|
)
|
|
)
|
|
)
|
|
)
|
|
(loop)))
|
|
)
|
|
)
|
|
)
|