removed scheme implementation of libao-async
This commit is contained in:
227
libao-async.rkt
227
libao-async.rkt
@@ -1,227 +0,0 @@
|
|||||||
#lang racket/base
|
|
||||||
|
|
||||||
(require ffi/unsafe/os-thread
|
|
||||||
"private/utils.rkt"
|
|
||||||
"libao-ffi.rkt"
|
|
||||||
data/queue
|
|
||||||
)
|
|
||||||
|
|
||||||
(provide ao_create_async
|
|
||||||
ao_stop_async
|
|
||||||
ao_play_async
|
|
||||||
ao_is_at_second_async
|
|
||||||
ao_music_duration_async
|
|
||||||
ao_bufsize_async
|
|
||||||
ao_clear_async
|
|
||||||
ao_pause_async
|
|
||||||
make-ao_buf_info
|
|
||||||
ao_buf_info-type
|
|
||||||
ao_buf_info-sample-bits
|
|
||||||
ao_buf_info-sample-rate
|
|
||||||
ao_buf_info-channels
|
|
||||||
)
|
|
||||||
|
|
||||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
||||||
;; 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_buffer_info
|
|
||||||
(type
|
|
||||||
sample-bits
|
|
||||||
sample-rate
|
|
||||||
channels
|
|
||||||
)
|
|
||||||
#:transparent
|
|
||||||
)
|
|
||||||
|
|
||||||
(define-struct ao-shm
|
|
||||||
(mutex
|
|
||||||
device
|
|
||||||
[at-second #:mutable]
|
|
||||||
[music-duration #:mutable]
|
|
||||||
[bufsize #:mutable]
|
|
||||||
queue-sem
|
|
||||||
[queue #:mutable]
|
|
||||||
[stopped #:mutable]
|
|
||||||
[paused #:mutable]
|
|
||||||
pause-sem
|
|
||||||
)
|
|
||||||
#:transparent
|
|
||||||
)
|
|
||||||
|
|
||||||
(define (ao-player* shm)
|
|
||||||
(call-in-os-thread
|
|
||||||
;(thread
|
|
||||||
(λ ()
|
|
||||||
(let ((ao-device (ao-shm-device shm)))
|
|
||||||
(define (player)
|
|
||||||
|
|
||||||
(mutex-lock (ao-shm-mutex shm))
|
|
||||||
(let ((p (ao-shm-paused shm)))
|
|
||||||
(mutex-unlock (ao-shm-mutex shm))
|
|
||||||
(when p
|
|
||||||
(os-semaphore-wait (ao-shm-pause-sem shm)))
|
|
||||||
)
|
|
||||||
|
|
||||||
(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))
|
|
||||||
(duration (caddr elem))
|
|
||||||
(buf-len (cadddr elem))
|
|
||||||
(buf (car (cddddr elem)))
|
|
||||||
(buf-info (cadr (cddddr elem)))
|
|
||||||
)
|
|
||||||
(mutex-lock (ao-shm-mutex shm))
|
|
||||||
(set-ao-shm-at-second! shm at-second)
|
|
||||||
(set-ao-shm-music-duration! shm duration)
|
|
||||||
(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
|
|
||||||
;(free buf) ; Free the previously malloc 'raw (see libao.rkt)
|
|
||||||
)]
|
|
||||||
)
|
|
||||||
(player)
|
|
||||||
)
|
|
||||||
)
|
|
||||||
)
|
|
||||||
(player)
|
|
||||||
)
|
|
||||||
)
|
|
||||||
)
|
|
||||||
)
|
|
||||||
|
|
||||||
(define (ao-player ao_device)
|
|
||||||
(let ((shm (make-ao-shm (make-mutex)
|
|
||||||
ao_device
|
|
||||||
0.0 0.0 0
|
|
||||||
(make-os-semaphore) (make-queue)
|
|
||||||
#f
|
|
||||||
#f (make-os-semaphore))))
|
|
||||||
(os-semaphore-post (ao-shm-pause-sem shm))
|
|
||||||
(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))
|
|
||||||
(ao_clear_async* shm)
|
|
||||||
(enqueue! (ao-shm-queue shm) (list 'stop 0 0 #f #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 music-duration buf-size buf buf-info)
|
|
||||||
(let ((item (list 'play at-second music-duration buf-size buf buf-info)))
|
|
||||||
(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_music_duration_async shm)
|
|
||||||
(mutex-lock (ao-shm-mutex shm))
|
|
||||||
(let ((music-duration (ao-shm-music-duration shm)))
|
|
||||||
(mutex-unlock (ao-shm-mutex shm))
|
|
||||||
music-duration))
|
|
||||||
|
|
||||||
(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))
|
|
||||||
(ao_clear_async* shm)
|
|
||||||
(mutex-unlock (ao-shm-mutex shm)))
|
|
||||||
|
|
||||||
(define (ao_clear_async* shm)
|
|
||||||
(let ((q (ao-shm-queue shm)))
|
|
||||||
(while (> (queue-length q) 0)
|
|
||||||
(dequeue! q)))
|
|
||||||
(set-ao-shm-queue! shm (make-queue))
|
|
||||||
(set-ao-shm-bufsize! shm 0)
|
|
||||||
)
|
|
||||||
|
|
||||||
(define (ao_pause_async shm pause)
|
|
||||||
(if pause
|
|
||||||
(begin
|
|
||||||
(dbg-sound "Pausing ao play thread")
|
|
||||||
(os-semaphore-wait (ao-shm-pause-sem shm))
|
|
||||||
(dbg-sound "Setting pause now to ~a" pause)
|
|
||||||
(mutex-lock (ao-shm-mutex shm))
|
|
||||||
(set-ao-shm-paused! shm pause)
|
|
||||||
(mutex-unlock (ao-shm-mutex shm)))
|
|
||||||
(begin
|
|
||||||
(dbg-sound "Continuing ao play thread, now setting pause to ~a" pause)
|
|
||||||
(mutex-lock (ao-shm-mutex shm))
|
|
||||||
(set-ao-shm-paused! shm pause)
|
|
||||||
(mutex-unlock (ao-shm-mutex shm))
|
|
||||||
(dbg-sound "Posting semaphore twice, one to let play thread continue, one for own use")
|
|
||||||
(os-semaphore-post (ao-shm-pause-sem shm))
|
|
||||||
(os-semaphore-post (ao-shm-pause-sem shm))
|
|
||||||
)
|
|
||||||
)
|
|
||||||
)
|
|
||||||
|
|
||||||
Reference in New Issue
Block a user