-

libao/libao-async.rkt

@@ -0,0 +1,138 @@
+#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]
+   )
+  #: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
+                    ;(displayln "stopping")
+                    '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))))
+    (ao-player* shm)
+    shm
+    )
+  )
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; External interface
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(define (ao_create_async ao_device)
+  (ao-player ao_device))
+
+(define (ao_stop_async shm)
+  (displayln "Stopping")
+  (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))
+  )
+
+(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)))
+              

libao/libao.rkt

@@ -1,7 +1,8 @@
 #lang racket/base
 
 (require "libao-ffi.rkt"
-         "libao-async-ffi.rkt"
+         ;"libao-async-ffi.rkt"
+         "libao-async.rkt"
          (prefix-in fin: finalizer)
          ffi/unsafe
          data/queue
@@ -87,7 +88,7 @@
                 (set-ao-handle-byte-format! handle endianness)
                 (set-ao-handle-rate! handle rate)
                 (set-ao-handle-channels! handle channels)
-                (set-ao-handle-async-player! handle (ao_create_async ao-device ao_play_ptr))
+                (set-ao-handle-async-player! handle (ao_create_async ao-device)) ; ao_play_ptr))
                 (hash-set! devices handle-num ao-device)
                 (fin:register-finalizer handle
                                         (lambda (handle)
@@ -97,6 +98,7 @@
       )))
               
 (define (ao-close handle)
+  (displayln handle)
   (if (number? handle)
       (let ((ao-device (hash-ref devices handle #f)))
         (unless (eq? ao-device #f)

play-test.rkt

@@ -1,8 +1,8 @@
 #lang racket/base
-(require ;"libao/libao.rkt"
-         ;"libflac/flac-decoder.rkt"
+(require "libao/libao.rkt"
+         "libflac/flac-decoder.rkt"
          ;data/queue
-  racket-sound
+  ;racket-sound
          )
 
 (define test-file3 #f)
@@ -37,7 +37,7 @@
     (ao-play ao-h second buffer)
     (let ((second-printer (λ ()
                             (let ((s (inexact->exact (round (ao-at-second ao-h)))))
-                              (when (> s current-seconds)
+                              (unless (= s current-seconds)
                                 (set! current-seconds s)
                                 (let ((minutes (quotient s 60))
                                       (seconds (remainder s 60))
@@ -72,8 +72,14 @@
 (define (flac-meta meta)
   (displayln meta))
 
-(define flac-h
-  (flac-open test-file3 flac-meta flac-play))
+(define (play)
+  (let ((flac-h (flac-open test-file3 flac-meta flac-play)))
+    (flac-read flac-h)
+    (ao-close ao-h)))
+    ;(sleep 1.0)
+    ;(play)))
 
-(flac-read flac-h)
+;(flac-read flac-h)
+
+(play)