audio player with place/threads and channels
This commit is contained in:
@@ -112,6 +112,7 @@
|
|||||||
(driver #:mutable)
|
(driver #:mutable)
|
||||||
(driver-handle #:mutable)
|
(driver-handle #:mutable)
|
||||||
)
|
)
|
||||||
|
#:transparent
|
||||||
)
|
)
|
||||||
|
|
||||||
(define (audio-known-exts?)
|
(define (audio-known-exts?)
|
||||||
|
|||||||
@@ -0,0 +1,379 @@
|
|||||||
|
#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)))
|
||||||
|
)
|
||||||
|
)
|
||||||
|
)
|
||||||
@@ -0,0 +1,267 @@
|
|||||||
|
#lang racket/base
|
||||||
|
|
||||||
|
(require racket/place
|
||||||
|
racket/contract
|
||||||
|
racket/async-channel
|
||||||
|
"audio-placed-player.rkt"
|
||||||
|
"private/utils.rkt"
|
||||||
|
(prefix-in ffi: ffi/unsafe)
|
||||||
|
)
|
||||||
|
|
||||||
|
(provide make-audio-player
|
||||||
|
audio-play!
|
||||||
|
audio-pause!
|
||||||
|
audio-paused?
|
||||||
|
audio-stop!
|
||||||
|
audio-quit!
|
||||||
|
audio-seek!
|
||||||
|
audio-volume!
|
||||||
|
audio-volume
|
||||||
|
audio-at-second
|
||||||
|
audio-duration
|
||||||
|
audio-state
|
||||||
|
audio-bits
|
||||||
|
audio-channels
|
||||||
|
audio-decoder
|
||||||
|
audio-music-id
|
||||||
|
audio-rate
|
||||||
|
audio-full-state
|
||||||
|
audio-file
|
||||||
|
audio-play?
|
||||||
|
audio-buf-seconds!
|
||||||
|
)
|
||||||
|
|
||||||
|
(define-struct audio-play
|
||||||
|
(valid? cb-state cb-eof-stream rpc au-place evt-thread state)
|
||||||
|
#:mutable
|
||||||
|
#:transparent
|
||||||
|
)
|
||||||
|
|
||||||
|
(define audio-play-struct? audio-play?)
|
||||||
|
(set! audio-play? (λ (h)
|
||||||
|
(and (audio-play-struct? h)
|
||||||
|
(audio-play-valid? h))))
|
||||||
|
|
||||||
|
|
||||||
|
(define (percentage? p)
|
||||||
|
(and (number? p) (>= p 0)))
|
||||||
|
|
||||||
|
(define (max-percentage? n)
|
||||||
|
(λ (p) (and (percentage? p)
|
||||||
|
(<= p n))))
|
||||||
|
|
||||||
|
(define (is-return? retval sym)
|
||||||
|
;(displayln retval)
|
||||||
|
(if (list? retval)
|
||||||
|
(if (null? retval)
|
||||||
|
#f
|
||||||
|
(eq? (car retval) sym))
|
||||||
|
#f))
|
||||||
|
|
||||||
|
(define (to-ret-value ret)
|
||||||
|
(if (list? ret)
|
||||||
|
(if (null? ret)
|
||||||
|
(error (format "audio-player: no return value in ~a" ret))
|
||||||
|
(car ret))
|
||||||
|
ret))
|
||||||
|
|
||||||
|
(define (is-event? evt sym)
|
||||||
|
(is-return? evt sym))
|
||||||
|
|
||||||
|
(define (evt-data evt)
|
||||||
|
(cadr evt))
|
||||||
|
|
||||||
|
(define-syntax assert
|
||||||
|
(syntax-rules ()
|
||||||
|
((_ cond message ...)
|
||||||
|
(unless cond (error (format message ...))))))
|
||||||
|
|
||||||
|
(define/contract (make-audio-player cb-state cb-eof-stream
|
||||||
|
#:use-place [use-place (place-enabled?)])
|
||||||
|
(->* (procedure? procedure?) (#:use-place boolean?) audio-play?)
|
||||||
|
(let ((cmd-ch #f)
|
||||||
|
(ret-ch #f)
|
||||||
|
(evt-ch #f)
|
||||||
|
(cmd-put #f)
|
||||||
|
(ret-get #f)
|
||||||
|
(evt-get #f)
|
||||||
|
(au-pl #f)
|
||||||
|
(dead-guard #f)
|
||||||
|
(rpc #f)
|
||||||
|
(rpc-mutex (make-mutex))
|
||||||
|
)
|
||||||
|
(if use-place
|
||||||
|
(begin
|
||||||
|
(set! cmd-ch (dynamic-place "audio-placed-player.rkt" 'placed-player))
|
||||||
|
(set! cmd-put (λ (data) (place-channel-put cmd-ch data)))
|
||||||
|
(set! au-pl cmd-ch)
|
||||||
|
(set! dead-guard (λ () (let ((evt (place-dead-evt au-pl)))
|
||||||
|
(sync evt))))
|
||||||
|
(let-values (((ret-ch-in ret-ch-out) (place-channel))
|
||||||
|
((evt-ch-in evt-ch-out) (place-channel)))
|
||||||
|
(place-channel-put cmd-ch (list 'init ret-ch-out evt-ch-out))
|
||||||
|
(set! evt-ch evt-ch-in)
|
||||||
|
(set! ret-ch ret-ch-in)
|
||||||
|
(assert (is-return? (place-channel-get ret-ch-in) 'initialized)
|
||||||
|
"Unexpected: not 'initialized returnd from 'init command"))
|
||||||
|
)
|
||||||
|
(begin
|
||||||
|
(set! cmd-ch (make-async-channel))
|
||||||
|
(set! cmd-put (λ (data) (async-channel-put cmd-ch data)))
|
||||||
|
(set! au-pl (thread (λ () (placed-player cmd-ch))))
|
||||||
|
(set! dead-guard (λ () (let ((evt (thread-dead-evt au-pl)))
|
||||||
|
(sync evt))))
|
||||||
|
(set! ret-ch (make-async-channel))
|
||||||
|
(set! evt-ch (make-async-channel))
|
||||||
|
(async-channel-put cmd-ch (list 'init ret-ch evt-ch))
|
||||||
|
(assert (is-return? (async-channel-get ret-ch) 'initialized)
|
||||||
|
"Unexpected: not 'initialized returnd from 'init command")
|
||||||
|
)
|
||||||
|
)
|
||||||
|
(set! ret-get (λ () (to-ret-value (sync ret-ch))))
|
||||||
|
(set! evt-get (λ (timeout-ms) (sync/timeout (/ timeout-ms 1000) evt-ch)))
|
||||||
|
(set! rpc (λ (cmd . args) (with-mutex rpc-mutex
|
||||||
|
(cmd-put (cons cmd args)) (ret-get))))
|
||||||
|
|
||||||
|
(let* ((handle #f)
|
||||||
|
(cb-state* (λ (st) (cb-state handle st)))
|
||||||
|
(cb-eof* (λ () (cb-eof-stream handle))))
|
||||||
|
(set! handle (make-audio-play #t
|
||||||
|
cb-state* cb-eof*
|
||||||
|
rpc
|
||||||
|
au-pl
|
||||||
|
#f
|
||||||
|
(make-hash)))
|
||||||
|
(set-audio-play-evt-thread! handle
|
||||||
|
(thread
|
||||||
|
(λ ()
|
||||||
|
(let loop ()
|
||||||
|
(if (audio-play-valid? handle)
|
||||||
|
(let ((e (evt-get 500)))
|
||||||
|
(cond ((eq? e #f) (loop))
|
||||||
|
((is-event? e 'state)
|
||||||
|
(set-audio-play-state! handle (evt-data e))
|
||||||
|
(cb-state* (evt-data e)))
|
||||||
|
((is-event? e 'audio-done) (cb-eof*))
|
||||||
|
(else (warn-sound "audio-player: unknown event ~a" e))
|
||||||
|
)
|
||||||
|
(loop))
|
||||||
|
'done)))))
|
||||||
|
|
||||||
|
(thread (λ ()
|
||||||
|
(dbg-sound "guarding audio-placed-player")
|
||||||
|
(dead-guard)
|
||||||
|
(dbg-sound "audio-placed-player has stopped")
|
||||||
|
(set-audio-play-valid?! handle #f)
|
||||||
|
(set-audio-play-rpc! handle #f)
|
||||||
|
(set-audio-play-au-place! handle #f)
|
||||||
|
(set-audio-play-evt-thread! handle #f)
|
||||||
|
(set-audio-play-cb-state! handle #f)
|
||||||
|
(set-audio-play-cb-eof-stream! handle #f)
|
||||||
|
(when (hash? (audio-play-state handle))
|
||||||
|
(let ((h (hash-copy (audio-play-state handle))))
|
||||||
|
(hash-set! h 'state 'invalid)
|
||||||
|
(set-audio-play-state! handle h)))
|
||||||
|
(dbg-sound "audio-play handle invalidated and cleaned of references")
|
||||||
|
))
|
||||||
|
|
||||||
|
(ffi:register-finalizer handle
|
||||||
|
(λ (h)
|
||||||
|
(when (audio-play? h)
|
||||||
|
(rpc 'quit))))
|
||||||
|
|
||||||
|
handle)
|
||||||
|
)
|
||||||
|
)
|
||||||
|
|
||||||
|
(define/contract (audio-play! handle audio-file)
|
||||||
|
(-> audio-play? path-string? symbol?)
|
||||||
|
((audio-play-rpc handle) 'open audio-file))
|
||||||
|
|
||||||
|
(define/contract (audio-pause! handle paused)
|
||||||
|
(-> audio-play? boolean? symbol?)
|
||||||
|
((audio-play-rpc handle) 'pause paused))
|
||||||
|
|
||||||
|
(define/contract (audio-paused? handle)
|
||||||
|
(-> audio-play? boolean?)
|
||||||
|
((audio-play-rpc handle) 'paused))
|
||||||
|
|
||||||
|
(define/contract (audio-stop! handle)
|
||||||
|
(-> audio-play? symbol?)
|
||||||
|
((audio-play-rpc handle) 'stop))
|
||||||
|
|
||||||
|
(define/contract (audio-quit! handle)
|
||||||
|
(-> audio-play? (or/c number? boolean? symbol?))
|
||||||
|
(let ((r ((audio-play-rpc handle) 'quit)))
|
||||||
|
(set-audio-play-valid?! handle #f)
|
||||||
|
r))
|
||||||
|
|
||||||
|
(define/contract (audio-seek! handle percentage)
|
||||||
|
(-> audio-play? (max-percentage? 100) symbol?)
|
||||||
|
((audio-play-rpc handle) 'seek percentage))
|
||||||
|
|
||||||
|
(define/contract (audio-volume! handle percentage)
|
||||||
|
(-> audio-play? percentage? symbol?)
|
||||||
|
((audio-play-rpc handle) 'volume percentage))
|
||||||
|
|
||||||
|
(define/contract (audio-volume handle)
|
||||||
|
(-> audio-play? percentage?)
|
||||||
|
((audio-play-rpc handle) 'get-volume))
|
||||||
|
|
||||||
|
(define/contract (audio-full-state handle)
|
||||||
|
(-> audio-play? hash?)
|
||||||
|
(audio-play-state handle))
|
||||||
|
|
||||||
|
(define-syntax get-state
|
||||||
|
(syntax-rules ()
|
||||||
|
((_ handle id def)
|
||||||
|
(hash-ref (audio-play-state handle) id def))))
|
||||||
|
|
||||||
|
(define/contract (audio-at-second handle)
|
||||||
|
(-> audio-play? (or/c number? boolean?))
|
||||||
|
(get-state handle 'at-second #f))
|
||||||
|
|
||||||
|
(define/contract (audio-duration handle)
|
||||||
|
(-> audio-play? (or/c number? boolean?))
|
||||||
|
(get-state handle 'duration #f))
|
||||||
|
|
||||||
|
(define/contract (audio-channels handle)
|
||||||
|
(-> audio-play? (or/c number? boolean?))
|
||||||
|
(get-state handle 'channels #f))
|
||||||
|
|
||||||
|
(define/contract (audio-state handle)
|
||||||
|
(-> audio-play-struct? symbol?)
|
||||||
|
(if (audio-play-valid? handle)
|
||||||
|
(get-state handle 'state 'initialized)
|
||||||
|
'invalid))
|
||||||
|
|
||||||
|
(define/contract (audio-bits handle)
|
||||||
|
(-> audio-play? (or/c number? boolean?))
|
||||||
|
(get-state handle 'bits #f))
|
||||||
|
|
||||||
|
(define/contract (audio-rate handle)
|
||||||
|
(-> audio-play? (or/c number? boolean?))
|
||||||
|
(get-state handle 'rate #f))
|
||||||
|
|
||||||
|
(define/contract (audio-decoder handle)
|
||||||
|
(-> audio-play? (or/c symbol? boolean?))
|
||||||
|
(get-state handle 'decoder #f))
|
||||||
|
|
||||||
|
(define/contract (audio-music-id handle)
|
||||||
|
(-> audio-play? (or/c number? boolean?))
|
||||||
|
(get-state handle 'at-music-id #f))
|
||||||
|
|
||||||
|
(define/contract (audio-file handle)
|
||||||
|
(-> audio-play? (or/c path-string? boolean?))
|
||||||
|
(get-state handle 'file #f))
|
||||||
|
|
||||||
|
(define/contract (audio-buf-seconds! handle min max)
|
||||||
|
(-> audio-play? number? number? (or/c symbol? boolean?))
|
||||||
|
(let ((from (if (< min 1) 1 (if (> min 10) 10 min)))
|
||||||
|
(until (if (< max min) (+ min 1) (if (> max 30) 30 max))))
|
||||||
|
((audio-play-rpc handle) 'buf-seconds from until)))
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
@@ -197,7 +197,7 @@
|
|||||||
;; Playback buffer to send to libao in milliseconds
|
;; Playback buffer to send to libao in milliseconds
|
||||||
;; -------------------------------------------------------------------------
|
;; -------------------------------------------------------------------------
|
||||||
|
|
||||||
(define ao-buf-ms 350) ;; Playback buffer of 0.35s
|
(define ao-buf-ms 150) ;; Playback buffer of 0.15s
|
||||||
|
|
||||||
(define (ao-playback-buf-ms)
|
(define (ao-playback-buf-ms)
|
||||||
ao-buf-ms)
|
ao-buf-ms)
|
||||||
|
|||||||
+55
-158
@@ -1,174 +1,71 @@
|
|||||||
#lang racket/base
|
#lang racket/base
|
||||||
(require "libao.rkt"
|
(require "audio-player.rkt"
|
||||||
"audio-decoder.rkt"
|
|
||||||
simple-log
|
simple-log
|
||||||
"private/utils.rkt"
|
"private/utils.rkt"
|
||||||
racket-sprintf
|
racket-sprintf
|
||||||
racket/runtime-path
|
racket/runtime-path
|
||||||
;data/queue
|
racket/path
|
||||||
;racket-sound
|
early-return
|
||||||
)
|
)
|
||||||
|
|
||||||
|
(define place-mode #t)
|
||||||
|
|
||||||
(define-runtime-path tests "../racket-audio-test")
|
(define-runtime-path tests "../racket-audio-test")
|
||||||
|
(define test-file2 (build-path tests "idyll.flac"))
|
||||||
|
(define test-file3 (build-path tests "mahler-1.mp3"))
|
||||||
|
(define test-file4 (build-path tests "mahler-2.mp3"))
|
||||||
|
(define play-queue (list test-file2 test-file3 test-file4))
|
||||||
|
(define current-sec -1)
|
||||||
|
|
||||||
(define test-file3 #f)
|
(define (to-time-str s*)
|
||||||
(define test-file4 #f)
|
(let* ((s (round s*))
|
||||||
(define test-file3-id 3)
|
(minutes (quotient s 60))
|
||||||
(define test-file4-id 4)
|
(seconds (remainder s 60))
|
||||||
|
|
||||||
(set! test-file3 (build-path tests "idyll.flac"))
|
|
||||||
(set! test-file4 (build-path tests "mahler-2.mp3"))
|
|
||||||
|
|
||||||
;(define fmt (ao-mk-format 24 48000 2 'big-endian))
|
|
||||||
;(define ao-h (ao-open-live #f fmt))
|
|
||||||
|
|
||||||
(define current-seconds 0)
|
|
||||||
(define ao-h #f)
|
|
||||||
(define current-file-id -1)
|
|
||||||
(define current-audio-h #f)
|
|
||||||
|
|
||||||
(define current-bits -1)
|
|
||||||
(define current-rate -1)
|
|
||||||
(define current-channels -1)
|
|
||||||
|
|
||||||
(sl-log-to-display)
|
|
||||||
(define wav-output-file #f)
|
|
||||||
(define seeked #f)
|
|
||||||
|
|
||||||
(define (audio-play type ao-type handle buf-info buffer buf-len)
|
|
||||||
;(dbg-sound "~a ~a ~a ~a ~a" type ao-type handle buf-info 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))
|
|
||||||
(cond-seek (λ ()
|
|
||||||
(when (>= (round current-seconds) 10)
|
|
||||||
(when (and (= current-file-id 3) (not seeked))
|
|
||||||
(set! seeked #t)
|
|
||||||
(let ((perc (exact->inexact (* (/ (- duration 15) duration) 100.0))))
|
|
||||||
(info-sound "Seeking to ~a%" perc)
|
|
||||||
(audio-seek current-audio-h perc))))))
|
|
||||||
(cond-volume (λ ()
|
|
||||||
(when (= (round current-seconds) 20)
|
|
||||||
(ao-set-volume! ao-h 70.0))
|
|
||||||
(when (= (round current-seconds) 25)
|
|
||||||
(ao-set-volume! ao-h 30))
|
|
||||||
(when (= (round current-seconds) 30)
|
|
||||||
(ao-set-volume! ao-h 100))
|
|
||||||
(when (= (round current-seconds) 35)
|
|
||||||
(ao-set-volume! ao-h 150))
|
|
||||||
(when (= (round current-seconds) 40)
|
|
||||||
(ao-set-volume! ao-h 100))))
|
|
||||||
)
|
)
|
||||||
|
(sprintf "%02d:%02d" minutes seconds)))
|
||||||
|
|
||||||
(when (not (eq? ao-h #f))
|
(define (audio-player-state h st)
|
||||||
(when (not (and
|
(early-return
|
||||||
(= current-bits bits-per-sample)
|
((? (not (audio-play? h)) => 'done))
|
||||||
(= current-rate rate)
|
(let* ((f (audio-file h))
|
||||||
(= current-channels channels)))
|
(name (if (eq? f #f) "none" (file-name-from-path f)))
|
||||||
(ao-close ao-h)
|
(sec* (audio-at-second h))
|
||||||
(set! ao-h #f)))
|
(sec (if (eq? sec* #f) 0 (round sec*)))
|
||||||
|
(msg (hash-ref st 'msg "none"))
|
||||||
;(displayln buf-info)
|
(bs (hash-ref st 'buf-size 0))
|
||||||
(when (eq? ao-h #f)
|
(dur* (audio-duration h))
|
||||||
|
(dur (if (eq? dur* #f) 0 (round dur*)))
|
||||||
(info-sound "Opening ao handle")
|
)
|
||||||
(info-sound "bits-per-sample: ~a" bits-per-sample)
|
(unless (= current-sec sec)
|
||||||
(info-sound "rate : ~a" rate)
|
(displayln (format "~a (~a): ~a - ~a - ~a - ~a - ~a - ~a"
|
||||||
(info-sound "channels : ~a" channels)
|
name
|
||||||
(info-sound "endian : ~a" 'native-endian)
|
(audio-music-id h)
|
||||||
(info-sound "(optional) file: ~a" wav-output-file)
|
(to-time-str sec)
|
||||||
(sync-log-sound)
|
(to-time-str dur)
|
||||||
|
(audio-state h)
|
||||||
(set! ao-h (ao-open-file bits-per-sample rate channels 'native-endian wav-output-file))
|
(audio-volume h)
|
||||||
|
bs
|
||||||
(set! current-bits bits-per-sample)
|
msg))
|
||||||
(set! current-rate rate)
|
(set! current-sec sec)
|
||||||
(set! current-channels channels)
|
)
|
||||||
(info-sound "ao bits per sample: ~a" (ao-device-bits ao-h))
|
)
|
||||||
(sync-log-sound)
|
)
|
||||||
)
|
|
||||||
|
|
||||||
;(displayln 'ao-play)
|
|
||||||
;(dbg-sound "Playing audio at ~a" second)
|
|
||||||
;(sync-log-sound)
|
|
||||||
|
|
||||||
(ao-play ao-h current-file-id second duration buffer buf-len ao-type)
|
|
||||||
(set! duration (inexact->exact (round duration)))
|
|
||||||
;(displayln 'done)
|
|
||||||
(let ((second-printer (λ (buf-seconds)
|
|
||||||
(let ((s (inexact->exact (round (ao-at-second ao-h)))))
|
|
||||||
(unless (= s current-seconds)
|
|
||||||
(set! current-seconds s)
|
|
||||||
(let ((minutes (quotient s 60))
|
|
||||||
(seconds (remainder s 60))
|
|
||||||
(tminutes (quotient duration 60))
|
|
||||||
(tseconds (remainder duration 60))
|
|
||||||
(volume (ao-volume ao-h))
|
|
||||||
)
|
|
||||||
(info-sound
|
|
||||||
(sprintf "At time: %02d:%02d (%02d:%02d) - %d - volume: %d"
|
|
||||||
minutes seconds
|
|
||||||
tminutes tseconds
|
|
||||||
buf-seconds
|
|
||||||
volume
|
|
||||||
))))))))
|
|
||||||
(let* ((buf-size (ao-bufsize-async ao-h))
|
|
||||||
(buf-seconds (exact->inexact (/ buf-size bytes-per-sample-all-channels rate))))
|
|
||||||
(second-printer buf-seconds)
|
|
||||||
(cond-seek)
|
|
||||||
(cond-volume)
|
|
||||||
(when (> buf-seconds 10)
|
|
||||||
(info-sound "Reuse buf/Sample queue: ~a/~a"
|
|
||||||
(ao-reuse-buf-len-async ao-h)
|
|
||||||
(ao-sample-queue-len-async ao-h))
|
|
||||||
(letrec ((waiter (λ ()
|
|
||||||
(let ((buf-seconds-left (exact->inexact
|
|
||||||
(/ (ao-bufsize-async ao-h)
|
|
||||||
bytes-per-sample-all-channels
|
|
||||||
rate))))
|
|
||||||
(if (< buf-seconds-left 3.0)
|
|
||||||
(info-sound "Seconds in buffer left: ~a" buf-seconds-left)
|
|
||||||
(begin
|
|
||||||
(sleep 0.5)
|
|
||||||
(second-printer buf-seconds)
|
|
||||||
(cond-volume)
|
|
||||||
(cond-seek)
|
|
||||||
(waiter)))))
|
|
||||||
))
|
|
||||||
(waiter)
|
|
||||||
(info-sound "Reuse buf/Sample queue: ~a/~a"
|
|
||||||
(ao-reuse-buf-len-async ao-h)
|
|
||||||
(ao-sample-queue-len-async ao-h))
|
|
||||||
)))
|
|
||||||
)
|
|
||||||
)
|
|
||||||
)
|
)
|
||||||
|
|
||||||
(define (audio-meta type ao-type handle meta)
|
(define (audio-player-eof h)
|
||||||
(dbg-sound "type: ~a" type)
|
(if (null? play-queue)
|
||||||
(dbg-sound "ao-type: ~a" ao-type)
|
(audio-quit! h)
|
||||||
(dbg-sound "meta: ~a" meta))
|
(begin
|
||||||
|
(audio-play! h (car play-queue))
|
||||||
|
(set! play-queue (cdr play-queue))
|
||||||
|
)
|
||||||
|
)
|
||||||
|
)
|
||||||
|
|
||||||
(define (play)
|
(define h (make-audio-player audio-player-state
|
||||||
(set! ao-h #f)
|
audio-player-eof
|
||||||
(let ((audio-h (audio-open test-file3 audio-meta audio-play)))
|
#:use-place place-mode))
|
||||||
(set! current-file-id test-file3-id)
|
|
||||||
(set! current-audio-h audio-h)
|
(audio-player-eof h)
|
||||||
(audio-read audio-h)
|
|
||||||
)
|
|
||||||
(info-sound "Opening next file: ~a" test-file4)
|
|
||||||
(let ((audio-h (audio-open test-file4 audio-meta audio-play)))
|
|
||||||
(set! current-file-id test-file4-id)
|
|
||||||
(set! current-audio-h audio-h)
|
|
||||||
(audio-read audio-h)
|
|
||||||
)
|
|
||||||
(ao-close ao-h)
|
|
||||||
(set! ao-h #f))
|
|
||||||
|
|
||||||
(play)
|
|
||||||
|
|
||||||
|
|||||||
@@ -22,6 +22,10 @@
|
|||||||
integer->int-bytes
|
integer->int-bytes
|
||||||
int-bytes->integer
|
int-bytes->integer
|
||||||
valid-ffmpeg-versions
|
valid-ffmpeg-versions
|
||||||
|
make-mutex
|
||||||
|
mutex-lock
|
||||||
|
mutex-unlock
|
||||||
|
with-mutex
|
||||||
)
|
)
|
||||||
|
|
||||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||||
@@ -30,6 +34,29 @@
|
|||||||
|
|
||||||
(sl-def-log racket-sound sound)
|
(sl-def-log racket-sound sound)
|
||||||
|
|
||||||
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||||
|
;; Mutex definitions
|
||||||
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||||
|
|
||||||
|
(define (make-mutex)
|
||||||
|
(make-semaphore 1))
|
||||||
|
|
||||||
|
(define (mutex-lock m)
|
||||||
|
(semaphore-wait m))
|
||||||
|
|
||||||
|
(define (mutex-unlock m)
|
||||||
|
(semaphore-post m))
|
||||||
|
|
||||||
|
(define-syntax with-mutex
|
||||||
|
(syntax-rules ()
|
||||||
|
((_ m b1 ...)
|
||||||
|
(begin
|
||||||
|
(semaphore-wait m)
|
||||||
|
(let ((r (begin b1 ...)))
|
||||||
|
(semaphore-post m)
|
||||||
|
r)))))
|
||||||
|
|
||||||
|
|
||||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||||
;; Provide some loop constructions
|
;; Provide some loop constructions
|
||||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||||
|
|||||||
Reference in New Issue
Block a user