504 lines
18 KiB
Racket
504 lines
18 KiB
Racket
#lang racket/base
|
|
|
|
(require racket/place
|
|
racket/async-channel
|
|
"libao.rkt"
|
|
"audio-decoder.rkt"
|
|
"private/utils.rkt"
|
|
early-return
|
|
)
|
|
|
|
(provide placed-player
|
|
audio-known-exts?
|
|
)
|
|
|
|
(define get-current-seconds current-seconds)
|
|
|
|
(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-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)
|
|
(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 ao-dec file-id)
|
|
(set! feeding-audio #t)
|
|
(set! play-thread
|
|
(thread (λ ()
|
|
(with-handlers ([exn:fail?
|
|
(λ (e)
|
|
(dbg-sound "Exception in audio-read-worker: ~a" e)
|
|
(set! feeding-audio #f)
|
|
(set! feed-interrupted #f)
|
|
(set! player-state 'stopped)
|
|
(evt (list 'exception (exn-message e))))])
|
|
(dynamic-wind
|
|
void
|
|
(λ ()
|
|
(dbg-sound "audio-read start")
|
|
(audio-read ao-dec)
|
|
(dbg-sound "audio-read end")
|
|
)
|
|
(λ () (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)
|
|
(begin
|
|
(set! bufsize 0)
|
|
'done)
|
|
(cond
|
|
((eq? bufsize #f) (set! bufsize nbfs) (loop))
|
|
((= nbfs 0) (set! bufsize 0) 'done)
|
|
((> nbfs bufsize) (set! bufsize nbfs) 'done)
|
|
(else
|
|
(check-paused)
|
|
(set! bufsize nbfs)
|
|
(sleep 0.1)
|
|
(loop)))
|
|
)
|
|
)
|
|
)
|
|
;; Alleen de actuele worker mag de globale spelerstatus beëindigen.
|
|
;; Een oude drain-worker mag hoogstens zichzelf opruimen.
|
|
(when (and (= bufsize 0) (= file-id current-file-id))
|
|
(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.1)
|
|
(when (eq? player-state 'paused)
|
|
(loop)))
|
|
; If the player is no longer paused, we unpause the ao stream,
|
|
; also if the player is no longer playing (i.e. player-state = stopped)
|
|
; in which case, we expect ao-clear-async to have been executed, which
|
|
; means the playing queue is empty.
|
|
(with-ao-h 'no-op (ao-pause ao-h #f))
|
|
(state (format "check-paused: player-state = ~a" player-state) 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-buf-info buf-info)
|
|
|
|
(when (not (and
|
|
(= current-bits bits-per-sample)
|
|
(= current-rate rate)
|
|
(= current-channels channels)))
|
|
; If we need to reopen the ao device with different bit-rates,
|
|
; we need to wait until the ao sample queue is empty
|
|
(let loop ()
|
|
(let* ((s (with-ao-h -1 (ao-at-second ao-h))))
|
|
(unless (or (= s -1) (eq-seconds? stored-seconds s))
|
|
(set! stored-seconds s)
|
|
(state "audio-play: seconds changes (III)" evt)))
|
|
(let ((bufsize (with-ao-h 0 (ao-bufsize-async ao-h))))
|
|
(if (= bufsize 0)
|
|
(with-mutex ao-mutex
|
|
(when (ao-valid? ao-h)
|
|
(ao-close ao-h))
|
|
(set! ao-h #f))
|
|
(begin (sleep 0.1) (loop)))))
|
|
)
|
|
|
|
(with-mutex ao-mutex
|
|
(when (eq? ao-h #f)
|
|
(dbg-sound "opening ao-h for ~a ~a" current-file-id files-playing)
|
|
(set! ao-h (ao-open-live bits-per-sample
|
|
rate channels
|
|
'native-endian))
|
|
)
|
|
(with-ao-h 'no-op
|
|
(ao-set-volume! ao-h current-volume)
|
|
(set! current-bits bits-per-sample)
|
|
(set! current-rate rate)
|
|
(set! current-channels channels)
|
|
)
|
|
)
|
|
|
|
(check-volume)
|
|
(with-ao-h 'no-op
|
|
(when (not (eq? player-state 'stopped))
|
|
(ao-play ao-h current-file-id second duration buffer buf-len ao-type)
|
|
))
|
|
(check-paused)
|
|
|
|
(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 s*)))
|
|
|
|
(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 s*))
|
|
|
|
(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! decoder-buf-info #f)
|
|
(set! decoder-meta #f)
|
|
)
|
|
|
|
(define (stop-and-cleanup)
|
|
(dbg-sound "stop and cleanup called")
|
|
(set! feed-interrupted #t)
|
|
|
|
(with-ao-h 'no-op (ao-clear-async ao-h))
|
|
(set! player-state 'stopped)
|
|
(unless (eq? ao-dec #f)
|
|
(audio-stop ao-dec))
|
|
(set! ao-dec #f)
|
|
|
|
(with-ao-h 'no-op (ao-clear-async ao-h))
|
|
|
|
(when (thread? play-thread) (thread-wait play-thread))
|
|
(set! play-thread #f)
|
|
|
|
(with-mutex ao-mutex
|
|
(when (ao-valid? ao-h)
|
|
(ao-close ao-h)
|
|
)
|
|
(set! ao-h #f))
|
|
|
|
(set! feed-interrupted #f)
|
|
(set! feeding-audio #f)
|
|
|
|
(cleanup)
|
|
|
|
(state "stop-and-cleanup: stopped/cleaned" evt 'force)
|
|
|
|
player-state
|
|
)
|
|
|
|
(define (start file)
|
|
(dbg-sound "starting ~a" file)
|
|
(when feeding-audio
|
|
(dbg-sound "interrupting feed")
|
|
(set! feed-interrupted #t)
|
|
(with-ao-h 'no-op (ao-clear-async ao-h))
|
|
(set! player-state 'stopped)
|
|
(when (audio-handle? ao-dec)
|
|
(audio-stop ao-dec))
|
|
(dbg-sound "clearing ao-h queue")
|
|
(with-ao-h 'no-op (ao-clear-async ao-h))
|
|
(dbg-sound "waiting for feed to stop")
|
|
(let loop ()
|
|
(if feeding-audio
|
|
(begin
|
|
(sleep 0.1)
|
|
(loop))
|
|
(with-ao-h 'no-op (ao-clear-async ao-h))
|
|
)
|
|
)
|
|
(dbg-sound "waiting for play thread")
|
|
(when (thread? play-thread) (thread-wait play-thread))
|
|
(dbg-sound "oke done")
|
|
)
|
|
|
|
|
|
;(set! current-file-id (+ current-file-id 1))
|
|
(set! current-file-id (+ (* (get-current-seconds) 10000) (random 1000)))
|
|
(let ((f (build-path file)))
|
|
(set! files-playing (cons
|
|
(cons current-file-id f)
|
|
(filter (λ (e)
|
|
(= (car e) (- current-file-id 1)))
|
|
files-playing))))
|
|
(set! ao-dec (audio-open file audio-meta audio-play))
|
|
|
|
(when (eq? player-state 'stopped)
|
|
(set! player-state 'playing))
|
|
(audio-read-worker ao-dec current-file-id)
|
|
current-file-id)
|
|
|
|
(define (pause paused)
|
|
(when (or (eq? player-state 'paused)
|
|
(eq? player-state 'playing))
|
|
(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 (ao-buf-ms)
|
|
(ao-playback-buf-ms))
|
|
|
|
(define (ao-buf-ms! ms)
|
|
(let ((the-ms (if (< ms 50) 50 (if (> ms 1000) 1000 ms))))
|
|
(ao-set-playback-buf-ms! the-ms)
|
|
(ao-buf-ms)))
|
|
|
|
(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)
|
|
(and (not (eq? m-id #f)) (= (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 (and (null? force) (or (eq? m-id #f) (= m-id 0)))
|
|
(cb (list 'state h))))
|
|
)
|
|
)
|
|
|
|
(let loop ()
|
|
(let* ((data (get))
|
|
(cmd (car data))
|
|
(in-rpc #f))
|
|
|
|
(define-syntax do-rpc
|
|
(syntax-rules (in-rpc)
|
|
((_ b1 ...)
|
|
(begin
|
|
(set! in-rpc #t)
|
|
(let ((r (begin b1 ...)))
|
|
(set! in-rpc #f)
|
|
(put r))))))
|
|
|
|
(with-handlers ([exn:fail? (λ (e)
|
|
(if (eq? ch-evt #f)
|
|
(raise e)
|
|
(begin
|
|
(evt (list 'exception
|
|
(exn-message e)))
|
|
(when in-rpc
|
|
(put (list 'error
|
|
(exn-message e)))
|
|
(set! in-rpc #f))
|
|
(loop))
|
|
))])
|
|
|
|
(cond
|
|
((eq? cmd 'quit) (do-rpc
|
|
(stop-and-cleanup)
|
|
(set! player-state 'quit)
|
|
(state "quit" evt 'force)
|
|
'(quit)))
|
|
((eq? cmd 'init) (do-rpc
|
|
(set! ch-out (cadr data))
|
|
(set! ch-evt (caddr data))
|
|
'(initialized))
|
|
(loop))
|
|
(else
|
|
(when (or (eq? ch-out #f) (eq? ch-evt #f))
|
|
(error "placed player not initialized"))
|
|
|
|
(unless (eq? cmd 'quit)
|
|
(cond
|
|
((eq? cmd 'buf-seconds)
|
|
(do-rpc
|
|
(let* ((clamp (λ (x) (min 30 (max 2 x))))
|
|
(a (clamp (cadr data)))
|
|
(b (clamp (caddr data))))
|
|
(set! min-buf-secs (min a b))
|
|
(set! max-buf-secs (max a b))
|
|
'(ok))))
|
|
((eq? cmd 'open)
|
|
(do-rpc
|
|
(let ((file (cadr data)))
|
|
(let ((id (start file)))
|
|
(list (list 'ok id))))))
|
|
((eq? cmd 'seek)
|
|
(do-rpc
|
|
(let ((percentage (cadr data)))
|
|
(seek percentage)
|
|
'(ok))))
|
|
((eq? cmd 'pause)
|
|
(do-rpc
|
|
(let ((paused (cadr data)))
|
|
(pause paused)
|
|
'(ok))))
|
|
((eq? cmd 'paused)
|
|
(do-rpc
|
|
(list (eq? player-state 'paused))))
|
|
((eq? cmd 'volume)
|
|
(do-rpc
|
|
(let ((percentage (cadr data)))
|
|
(volume (exact->inexact percentage))
|
|
'(ok))))
|
|
((eq? cmd 'get-volume)
|
|
(do-rpc
|
|
(list current-volume)))
|
|
((eq? cmd 'stop)
|
|
(do-rpc
|
|
(stop-and-cleanup)
|
|
'(ok)))
|
|
((eq? cmd 'state)
|
|
(do-rpc
|
|
(let ((st #f))
|
|
(state "'state command" (λ (s) (set! st s)) 'force)
|
|
st)))
|
|
((eq? cmd 'ao-buf-ms)
|
|
(do-rpc
|
|
(if (null? (cdr data))
|
|
(list (ao-buf-ms))
|
|
(list (ao-buf-ms! (cadr data))))
|
|
))
|
|
(else
|
|
(do-rpc
|
|
(list 'error (format "Unknown command ~a" cmd))))
|
|
)
|
|
(loop)
|
|
)
|
|
)
|
|
)
|
|
)
|
|
)
|
|
)
|
|
)
|
|
) |