-

libao/libao-async.rkt

@@ -79,6 +79,7 @@
                       (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)
@@ -107,6 +108,7 @@
 
 (define (ao_stop_async shm)
   (mutex-lock (ao-shm-mutex shm))
+  (ao_clear_async* 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))
@@ -149,6 +151,16 @@
 
 (define (ao_clear_async shm)
   (mutex-lock (ao-shm-mutex shm))
-  (set-ao-shm-queue! shm (make-queue))
+  (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)
+           (let* ((elem (dequeue! q))
+                  (buf (cadddr elem)))
+             (free buf))))
+  (set-ao-shm-queue! shm (make-queue))
+  (set-ao-shm-bufsize! shm 0)
+  )
+  

libao/libao.rkt

@@ -1,9 +1,11 @@
 #lang racket/base
 
+(define libao-async-mode 'ffi)   ; 'ffi or 'scheme
+
 (require "libao-ffi.rkt"
-         "libao-async-ffi.rkt"
-         ;"libao-async.rkt"
          (prefix-in fin: finalizer)
+         (prefix-in ffi: "libao-async-ffi.rkt")
+         (prefix-in scm: "libao-async.rkt")
          ffi/unsafe
          data/queue
          )
@@ -16,11 +18,21 @@
          ao-at-second
          ao-bufsize-async
          ao-clear-async
+         ao-set-async-mode!
+         ao-async-mode
          )
 
 (define devices (make-hash))
 (define device-number 1)
 
+(define (ao-set-async-mode! mode)
+  (if (or (eq? mode 'ffi) (eq? mode 'scheme))
+      (set! libao-async-mode mode)
+      (error "mode must be 'ffi or 'scheme"))
+  mode)
+
+(define (ao-async-mode)
+  libao-async-mode)
 
 (define-struct ao-handle (handle-num
                           [bits #:auto #:mutable]
@@ -89,7 +101,9 @@
                 (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))
+                (if (eq? libao-async-mode 'ffi)
+                    (set-ao-handle-async-player! handle (ffi:ao_create_async ao-device ao_play_ptr))
+                    (set-ao-handle-async-player! handle (scm:ao_create_async ao-device)))
                 (hash-set! devices handle-num ao-device)
                 (fin:register-finalizer handle
                                         (lambda (handle)
@@ -117,11 +131,15 @@
             'warning-ao-device-already-closed
             (begin
               (set-ao-handle-closed! handle #t)
-              ;(displayln "clear-async")(sleep 1.0)
+              (if (eq? libao-async-mode 'ffi)
-              (ao_clear_async (ao-handle-async-player handle))
+                  (begin
-              ;(displayln "stop-async")(sleep 1.0)
+                    (ffi:ao_clear_async (ao-handle-async-player handle))
-              (ao_stop_async (ao-handle-async-player handle))
+                    (ffi:ao_stop_async (ao-handle-async-player handle))
-              ;(displayln "closing")(sleep 1.0)
+                    )
+                  (begin
+                    (scm:ao_clear_async (ao-handle-async-player handle))
+                    (scm:ao_stop_async (ao-handle-async-player handle))
+                    ))
               (if (eq? ao-device #f)
                   'error-ao-device-non-existent
                   (let ((r (ao_close ao-device)))
@@ -132,12 +150,10 @@
             )
         ))
 
-    ;(displayln handle)(sleep 1.0)
     (if (number? handle)
         (let ((ao-device (hash-ref devices handle #f)))
           (close-device #f ao-device))
         (let ((handle-num (ao-handle-handle-num handle)))
-          ;(displayln (ao-handle-closed handle))(sleep 1.0)
           (let ((ao-device (hash-ref devices handle-num #f)))
             (close-device handle ao-device))
           )
@@ -166,7 +182,9 @@
          (endianess (ao-handle-byte-format handle))
          (buf-len (vector-length (car buffer)))
          (audio-buf-len (* channels bytes-per-sample buf-len))
-         (audio (malloc 'atomic audio-buf-len))
+         (audio (if (eq? libao-async-mode 'ffi)
+                    (malloc 'atomic audio-buf-len)
+                    (malloc 'raw audio-buf-len)))
          (get-sample (lambda (k channel)
                        (let ((chan-buf (list-ref buffer channel)))
                          (vector-ref chan-buf k))))
@@ -190,9 +208,16 @@
                          'filled))
                    ))
       (fill 0 0)
-      (ao_play_async (ao-handle-async-player handle) (exact->inexact at-time-in-s)
+      (if (eq? libao-async-mode 'ffi)
-                     audio-buf-len
+          (ffi:ao_play_async (ao-handle-async-player handle)
-                     audio)
+                             (exact->inexact at-time-in-s)
+                             audio-buf-len
+                             audio)
+          (scm:ao_play_async (ao-handle-async-player handle)
+                             (exact->inexact at-time-in-s)
+                             audio-buf-len
+                             audio)
+          )
       )
       ;(let* ((handle-num (ao-handle-handle-num handle))
       ;       (ao-device (hash-ref devices handle-num #f)))
@@ -203,13 +228,20 @@
   )
 
 (define (ao-at-second handle)
-  (ao_is_at_second_async (ao-handle-async-player handle)))
+  (if (eq? libao-async-mode 'ffi)
+      (ffi:ao_is_at_second_async (ao-handle-async-player handle))
+      (scm:ao_is_at_second_async (ao-handle-async-player handle))))
 
 (define (ao-bufsize-async handle)
-  (ao_bufsize_async (ao-handle-async-player handle)))
+  (if (eq? libao-async-mode 'ffi)
+      (ffi:ao_bufsize_async (ao-handle-async-player handle))
+      (scm:ao_bufsize_async (ao-handle-async-player handle))))
 
 (define (ao-clear-async handle)
-  (ao_clear_async (ao-handle-async-player handle)))
+  (if (eq? libao-async-mode 'ffi)
+      (ffi:ao_clear_async (ao-handle-async-player handle))
+      (scm:ao_clear_async (ao-handle-async-player handle))))
+      
 
 ;(let* ((handle-num (ao-handle-handle-num handle))
 ;             (ao-device (hash-ref devices handle-num #f)))