#lang racket/base (require racket/place racket/contract racket/async-channel racket/runtime-path "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! audio-ao-buf-ms! audio-ao-buf-ms audio-known-exts? ) (define-runtime-path placed-player-module "audio-placed-player.rkt") (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 placed-player-module '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*)) ((is-event? e 'exception) (err-sound "audio-player: exception event: ~a" e)) (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? number?) (let ((result ((audio-play-rpc handle) 'open audio-file))) (when (eq? result 'error) (error "Got an error from the placed audio player")) (cadr result))) (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))) (define/contract (audio-ao-buf-ms! handle ms) (-> audio-play? integer? (or/c integer? boolean?)) ((audio-play-rpc handle) 'ao-buf-ms ms)) (define/contract (audio-ao-buf-ms handle) (-> audio-play? (or/c integer? boolean?)) ((audio-play-rpc handle) 'ao-buf-ms))