audio player with place/threads and channels
This commit is contained in:
@@ -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)))
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
Reference in New Issue
Block a user