155 lines
4.4 KiB
Racket
155 lines
4.4 KiB
Racket
#lang racket/base
|
|
|
|
(require ffi/unsafe/os-thread
|
|
"../utils/utils.rkt"
|
|
"libao-ffi.rkt"
|
|
data/queue
|
|
)
|
|
|
|
(provide ao_create_async
|
|
ao_stop_async
|
|
ao_play_async
|
|
ao_is_at_second_async
|
|
ao_bufsize_async
|
|
ao_clear_async
|
|
)
|
|
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
;; Mutex
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
|
|
(define (make-mutex)
|
|
(let ((sem (make-os-semaphore)))
|
|
(os-semaphore-post sem)
|
|
sem))
|
|
|
|
(define (mutex-lock mutex)
|
|
(os-semaphore-wait mutex))
|
|
|
|
(define (mutex-unlock mutex)
|
|
(os-semaphore-post mutex))
|
|
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
;; ao-player in os thread
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
|
|
(define-struct ao-shm
|
|
(mutex
|
|
device
|
|
[at-second #:mutable]
|
|
[bufsize #:mutable]
|
|
queue-sem
|
|
[queue #:mutable]
|
|
[stopped #:mutable]
|
|
)
|
|
#:transparent
|
|
)
|
|
|
|
(define (ao-player* shm)
|
|
(call-in-os-thread
|
|
;(thread
|
|
(λ ()
|
|
(let ((ao-device (ao-shm-device shm)))
|
|
(define (player)
|
|
(os-semaphore-wait (ao-shm-queue-sem shm))
|
|
(mutex-lock (ao-shm-mutex shm))
|
|
(if (= (queue-length (ao-shm-queue shm)) 0)
|
|
(begin
|
|
(mutex-unlock (ao-shm-mutex shm))
|
|
(player))
|
|
(let* ((elem (dequeue! (ao-shm-queue shm)))
|
|
(command (car elem))
|
|
)
|
|
(mutex-unlock (ao-shm-mutex shm))
|
|
(cond
|
|
[(eq? command 'stop)
|
|
(begin
|
|
(mutex-lock (ao-shm-mutex shm))
|
|
(set-ao-shm-stopped! shm #t)
|
|
(mutex-unlock (ao-shm-mutex shm))
|
|
'done)]
|
|
[(eq? command 'play)
|
|
(let ((at-second (cadr elem))
|
|
(buf-len (caddr elem))
|
|
(buf (cadddr elem))
|
|
)
|
|
(mutex-lock (ao-shm-mutex shm))
|
|
(set-ao-shm-at-second! shm at-second)
|
|
(let ((bs (ao-shm-bufsize shm)))
|
|
(set-ao-shm-bufsize! shm (- bs buf-len)))
|
|
(mutex-unlock (ao-shm-mutex shm))
|
|
(ao_play ao-device buf buf-len) ; Play this buffer part
|
|
)]
|
|
)
|
|
(player)
|
|
)
|
|
)
|
|
)
|
|
(player)
|
|
)
|
|
)
|
|
)
|
|
)
|
|
|
|
(define (ao-player ao_device)
|
|
(let ((shm (make-ao-shm (make-mutex) ao_device 0.0 0 (make-os-semaphore) (make-queue) #f)))
|
|
(ao-player* shm)
|
|
shm
|
|
)
|
|
)
|
|
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
;; External interface
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
|
|
(define (ao_create_async ao_device)
|
|
(ao-player ao_device))
|
|
|
|
(define (ao_stop_async shm)
|
|
(mutex-lock (ao-shm-mutex shm))
|
|
(enqueue! (ao-shm-queue shm) (list 'stop 0 #f #f))
|
|
(os-semaphore-post (ao-shm-queue-sem shm))
|
|
(mutex-unlock (ao-shm-mutex shm))
|
|
(let ((stopped (λ ()
|
|
(mutex-lock (ao-shm-mutex shm))
|
|
(let ((w (ao-shm-stopped shm)))
|
|
(mutex-unlock (ao-shm-mutex shm))
|
|
w))))
|
|
(letrec ((loop (λ ()
|
|
(if (eq? (stopped) #t)
|
|
'stopped
|
|
(begin
|
|
(sleep 0.01)
|
|
(loop))))))
|
|
(loop)
|
|
'stopped)
|
|
)
|
|
)
|
|
|
|
(define (ao_play_async shm at-second buf-size buf)
|
|
(let ((item (list 'play at-second buf-size buf)))
|
|
(mutex-lock (ao-shm-mutex shm))
|
|
(let ((bs (ao-shm-bufsize shm)))
|
|
(set-ao-shm-bufsize! shm (+ bs buf-size)))
|
|
(enqueue! (ao-shm-queue shm) item)
|
|
(os-semaphore-post (ao-shm-queue-sem shm))
|
|
(mutex-unlock (ao-shm-mutex shm))))
|
|
|
|
(define (ao_is_at_second_async shm)
|
|
(mutex-lock (ao-shm-mutex shm))
|
|
(let ((at-second (ao-shm-at-second shm)))
|
|
(mutex-unlock (ao-shm-mutex shm))
|
|
at-second))
|
|
|
|
(define (ao_bufsize_async shm)
|
|
(mutex-lock (ao-shm-mutex shm))
|
|
(let ((buf-size (ao-shm-bufsize shm)))
|
|
(mutex-unlock (ao-shm-mutex shm))
|
|
buf-size))
|
|
|
|
(define (ao_clear_async shm)
|
|
(mutex-lock (ao-shm-mutex shm))
|
|
(set-ao-shm-queue! shm (make-queue))
|
|
(mutex-unlock (ao-shm-mutex shm)))
|
|
|