-

.gitignore

@@ -6,3 +6,4 @@ compiled/
 \#*
 .\#*
 libao/c/build
+libao/c/ao-play-async/build

libao/c/Makefile

@@ -5,9 +5,11 @@ all:
 	(cd build; make)
 
 install:
-	mkdir -p ../lib
+	mkdir -p ../../lib
-	FILES=`ls build/*.so` 2>/dev/null; if [ "$$FILES" != "" ]; then cp $$FILES ../lib; fi
+	SUBDIR=`racket -e "(display (format \"~a-~a\" (system-type 'os*) (system-type 'arch)))"`; \
-	FILES=`ls build/*.dll` 2>/dev/null; if [ "$$FILES" != "" ]; then cp $$FILES ../lib; fi
+	FILES=`ls build/*.so` 2>/dev/null; if [ "$$FILES" != "" ]; then cp $$FILES ../../lib/$$SUBDIR; fi
+	SUBDIR=`racket -e "(display (format \"~a-~a\" (system-type 'os*) (system-type 'arch)))"`; \
+	FILES=`ls build/*.dll` 2>/dev/null; if [ "$$FILES" != "" ]; then cp $$FILES ../../lib/$$SUBDIR; fi
 
 
 clean:

libao/c/ao-play-async/ao_playasync.c

@@ -1,10 +1,32 @@
 #include "ao_playasync.h"
-#include <pthread.h>
+
+#ifdef WIN32
+#include <windows.h>
+#define USE_WINDOWS_THREADS
+#define sleep_ms(ms) Sleep(ms)
+#else
+#define USE_PTHREADS
+#define sleep_ms(ms) usleep(ms * 1000)
+#endif
+
+#ifdef USE_WINDOWS_THREADS
+  #define MUTEX_LOCK(m) WaitForSingleObject(m, INFINITE)
+  #define MUTEX_UNLOCK(m) ReleaseMutex(m)
+#endif
+
+#ifdef USE_PTHREADS
+  #include <pthread.h>
+  #define MUTEX_LOCK(m) pthread_mutex_lock(&m)
+  #define MUTEX_UNLOCK(m) pthread_mutex_unlock(&m)
+#endif
+
+#ifndef WIN32
 #include <unistd.h>
+#endif
+
 #include <assert.h>
 #include <malloc.h>
 #include <string.h>
-//#include <dlfcn.h>
 #include <stdint.h>
 #include <stdio.h>
 #include <stdlib.h>
@@ -21,19 +43,31 @@ typedef struct _queue_ {
     void *buf;
     int buflen;
     double at_second;
+    double music_duration;
     struct _queue_ *next;
     struct _queue_ *prev;
 } Queue_t;
 
+typedef int(*ao_play_func_t)(void *, char *, uint32_t);
+
 typedef struct {
     Queue_t        *play_queue;
     Queue_t        *last_frame;
     ao_device      *ao_device;
+#ifdef USE_WINDOWS_THREADS
+    HANDLE          mutex;
+    HANDLE          thread;
+    DWORD           thread_id;
+#endif
+#ifdef USE_PTHREADS
     pthread_mutex_t mutex;
     pthread_t       thread;
+#endif
     double          at_second;
+    double          music_duration;
     ao_play_func_t  ao_play_f;
     int             buf_size;
+    int             paused;
 } AO_Handle;
 
 //static int(*ao_play)(void *device, char *samples, uint32_t n) = NULL;
@@ -75,7 +109,7 @@ static void add(AO_Handle *h, Queue_t *elem)
     h->buf_size += elem->buflen;
 }
 
-static Queue_t *new_elem(int command, double at_second, int buf_len, void *buf)
+static Queue_t *new_elem(int command, double at_second, double music_duration, int buf_len, void *buf)
 {
     Queue_t *q = (Queue_t *) malloc(sizeof(Queue_t));
     void *new_buf;
@@ -87,6 +121,7 @@ static Queue_t *new_elem(int command, double at_second, int buf_len, void *buf)
         new_buf = NULL;
     }
     q->at_second = at_second;
+    q->music_duration = music_duration;
     q->buf = new_buf;
     q->buflen = buf_len;
     q->command = command;
@@ -111,58 +146,49 @@ static void clear(AO_Handle *h)
     }
 }
 
+#ifdef USE_PTHREADS
 static void *run(void *arg)
+#endif
+#ifdef USE_WINDOWS_THREADS
+static DWORD run(LPVOID arg)
+#endif
 {
     AO_Handle *handle = (AO_Handle *) arg;
 
     int go_on = (1 == 1);
 
     while(go_on) {
-        pthread_mutex_lock(&handle->mutex);
+        MUTEX_LOCK(handle->mutex);
-        int has_frames = (handle->play_queue != NULL);
+        int has_frames = (!handle->paused) && (handle->play_queue != NULL);
 
         if (has_frames) {
             Queue_t *q = get(handle);
             handle->at_second = q->at_second;
-            pthread_mutex_unlock(&handle->mutex);
+            handle->music_duration = q->music_duration;
+            MUTEX_UNLOCK(handle->mutex);
 
             if (q->command == STOP) {
                 go_on = (1 == 0);
             } else {
+                //fprintf(stderr, "playing buf at %lf\n", handle->at_second);
                 handle->ao_play_f(handle->ao_device, q->buf, q->buflen);
             }
 
             del_elem(q);
         } else {
-            pthread_mutex_unlock(&handle->mutex);
+            MUTEX_UNLOCK(handle->mutex);
-            usleep(5000);   // sleep for 5ms
+            sleep_ms(5);   // sleep for 5ms
         }
     }
 
+#ifdef USE_PTHREADS
     return NULL;
+#endif
+#ifdef USE_WINDOWS_THREADS
+    return 0;
+#endif
 }
 
-/*
-static void get_ao_play(void)
-{
-    char *lib = "libao.so";
-    void *handle = dlopen(lib, RTLD_LAZY);
-    if (!handle) {
-        fprintf(stderr, "Cannot open library %s: %s\n", lib, dlerror());
-        exit(EXIT_FAILURE);
-    }
-
-    ao_play = dlsym(handle, "ao_play");
-    char *err;
-    err = dlerror();
-    if (err != NULL) {
-        fprintf(stderr, "Cannot get function ao_play: %s\n", err);
-        exit(EXIT_FAILURE);
-    }
-}
-*/
-
-
 void *ao_create_async(void *ao_device_yeah, void *ao_play_f)
 {
     //if (ao_play == NULL) { get_ao_play(); }
@@ -173,12 +199,23 @@ void *ao_create_async(void *ao_device_yeah, void *ao_play_f)
     handle->play_queue = NULL;
     handle->last_frame = NULL;
     handle->at_second = -1;
-    pthread_mutex_t m = PTHREAD_MUTEX_INITIALIZER;
+
-    handle->mutex = m;
     handle->ao_play_f = ao_play_f;
     handle->buf_size = 0;
+    handle->paused = (1 == 0);
 
+#ifdef USE_PTHREADS
+    pthread_mutex_t m = PTHREAD_MUTEX_INITIALIZER;
+    handle->mutex = m;
     pthread_create(&handle->thread, NULL, run, handle);
+#endif
+
+#ifdef USE_WINDOWS_THREADS
+    handle->mutex = CreateMutex(NULL,              // default security attributes
+                                FALSE,             // initially not owned
+                                NULL);
+    handle->thread = CreateThread(NULL, 0, (LPTHREAD_START_ROUTINE) run, handle, 0, &handle->thread_id);
+#endif
 
     return (void *) handle;
 }
@@ -187,42 +224,74 @@ void ao_stop_async(void *ao_handle)
 {
     AO_Handle *h = (AO_Handle *) ao_handle;
 
-    pthread_mutex_lock(&h->mutex);
+    MUTEX_LOCK(h->mutex);
     clear(h);
-    Queue_t *q = new_elem(STOP, 0.0, 0, NULL);
+    Queue_t *q = new_elem(STOP, 0.0, 0.0, 0, NULL);
     add(h, q);
-    pthread_mutex_unlock(&h->mutex);
+    MUTEX_UNLOCK(h->mutex);
 
+#ifdef USE_PTHREADS
     void *retval;
     pthread_join(h->thread, &retval);
+#endif
+#ifdef USE_WINDOWS_THREADS
+    WaitForSingleObject(h->thread, INFINITE);
+    CloseHandle(h->thread);
+    CloseHandle(h->mutex);
+#endif
     free(h);
 }
 
-void ao_play_async(void *ao_handle, double at_second, int buf_size, void *mem)
+void ao_play_async(void *ao_handle, double at_second, double music_duration, int buf_size, void *mem)
 {
     AO_Handle *h = (AO_Handle *) ao_handle;
-    Queue_t *q = new_elem(PLAY, at_second, buf_size, mem);
+    Queue_t *q = new_elem(PLAY, at_second, music_duration, buf_size, mem);
-    pthread_mutex_lock(&h->mutex);
+    MUTEX_LOCK(h->mutex);
     add(h, q);
-    pthread_mutex_unlock(&h->mutex);
+    MUTEX_UNLOCK(h->mutex);
+}
+
+void ao_clear_async(void *ao_handle)
+{
+    AO_Handle *h = (AO_Handle *) ao_handle;
+    MUTEX_LOCK(h->mutex);
+    clear(h);
+    MUTEX_UNLOCK(h->mutex);
 }
 
 double ao_is_at_second_async(void *ao_handle)
 {
     AO_Handle *h = (AO_Handle *) ao_handle;
-    pthread_mutex_lock(&h->mutex);
+    MUTEX_LOCK(h->mutex);
     double s = h->at_second;
-    pthread_mutex_unlock(&h->mutex);
+    MUTEX_UNLOCK(h->mutex);
     return s;
 }
 
+double ao_music_duration_async(void *ao_handle)
+{
+    AO_Handle *h = (AO_Handle *) ao_handle;
+    MUTEX_LOCK(h->mutex);
+    double duration = h->music_duration;
+    MUTEX_UNLOCK(h->mutex);
+    return duration;
+}
+
 int ao_bufsize_async(void *ao_handle)
 {
     AO_Handle *h = (AO_Handle *) ao_handle;
-    pthread_mutex_lock(&h->mutex);
+    MUTEX_LOCK(h->mutex);
     int s = h->buf_size;
-    pthread_mutex_unlock(&h->mutex);
+    MUTEX_UNLOCK(h->mutex);
     return s;
 }
 
+void ao_pause_async(void *ao_handle, int paused)
+{
+    AO_Handle *h = (AO_Handle *) ao_handle;
+    MUTEX_LOCK(h->mutex);
+    h->paused = paused;
+    MUTEX_UNLOCK(h->mutex);
+}
+
 

libao/c/ao-play-async/ao_playasync.h

@@ -1,14 +1,26 @@
 #ifndef AO_PLAYASYNC_H
 #define AO_PLAYASYNC_H
 
-#include <stdint.h>
+#ifdef _WINDOWS
+#ifdef AOPLAYASYNC_LIBRARY
+#define AOPLAYASYNC_EXPORT __declspec(dllexport)
+#else
+#define AOPLAYASYNC_EXPORT __declspec(dllimport)
+#endif
+#else
+#define AOPLAYASYNC_EXPORT extern
+#endif
 
-typedef int(*ao_play_func_t)(void *, char *, uint32_t);
+AOPLAYASYNC_EXPORT void *ao_create_async(void *ao_handle, void *ao_play_f);
+AOPLAYASYNC_EXPORT void ao_stop_async(void *handle);
+AOPLAYASYNC_EXPORT void ao_play_async(void *handle, double at_second, double music_duration, int buf_size, void *mem);
+AOPLAYASYNC_EXPORT void ao_clear_async(void *handle);
 
-extern void *ao_create_async(void *ao_handle, void *ao_play_f);
+AOPLAYASYNC_EXPORT double ao_is_at_second_async(void *handle);
-extern void ao_stop_async(void *handle);
+AOPLAYASYNC_EXPORT double ao_music_duration_async(void *handle);
-extern void ao_play_async(void *handle, double at_second, int buf_size, void *mem);
+
-extern double ao_is_at_second_async(void *handle);
+AOPLAYASYNC_EXPORT void ao_pause_async(void *ao_handle, int paused);
-extern int ao_bufsize_async(void *handle);
+
+AOPLAYASYNC_EXPORT int ao_bufsize_async(void *handle);
 
 #endif // AO_PLAYASYNC_H

libao/libao-async-ffi.rkt

@@ -3,9 +3,7 @@
 
 (require ffi/unsafe
          ffi/unsafe/define
-         setup/dirs
          "../utils/utils.rkt"
-         racket/runtime-path
          "libao-ffi.rkt"
          )
 
@@ -13,19 +11,14 @@
          ao_stop_async
          ao_play_async
          ao_is_at_second_async
+         ao_music_duration_async
          ao_bufsize_async
+         ao_clear_async
+         ao_pause_async
          )
 
-(define-runtime-path libao-async-path "./lib/libao-play-async")
+(define lib (get-lib '("ao-play-async" "libao-play-async") '(#f)))
-
+(define-ffi-definer define-libao-async lib)
-(define-ffi-definer define-libao-async
-  (ffi-lib libao-async-path '("0" #f)
-           #:get-lib-dirs (λ ()
-                            (let ((sp (cons (build-path ".") (get-lib-search-dirs))))
-                              (displayln sp)
-                              sp))
-           #:fail (λ () (error "Cannot load libao-play-async"))
-           ))
 
 (define _libao-async-handle-pointer (_cpointer 'ao-async-handle))
 
@@ -35,11 +28,21 @@
 ;extern void ao_stop_async(void *handle);
 (define-libao-async ao_stop_async(_fun _libao-async-handle-pointer -> _void))
 
-;extern void ao_play_async(void *handle, double at_second, int buf_size, void *mem);
+;extern void ao_play_async(void *handle, double at_second, double music_duration, int buf_size, void *mem);
-(define-libao-async ao_play_async(_fun _libao-async-handle-pointer _double _uint32 _pointer -> _void))
+(define-libao-async ao_play_async(_fun _libao-async-handle-pointer _double _double _uint32 _pointer -> _void))
 
 ;extern double ao_is_at_second_async(void *handle);
 (define-libao-async ao_is_at_second_async(_fun _libao-async-handle-pointer -> _double))
 
+;extern double ao_music_duration_async(void *handle);
+(define-libao-async ao_music_duration_async(_fun _libao-async-handle-pointer -> _double))
+
 ;extern int ao_bufsize_async(void *handle);
 (define-libao-async ao_bufsize_async(_fun _libao-async-handle-pointer -> _int))
+
+;extern void ao_clear_async(void *handle);
+(define-libao-async ao_clear_async(_fun _libao-async-handle-pointer -> _void))
+
+;extern void ao_pause_async(void *handle, int pause);
+(define-libao-async ao_pause_async(_fun _libao-async-handle-pointer _int -> _void))
+

libao/libao-async.rkt

@@ -0,0 +1,216 @@
+#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_music_duration_async
+         ao_bufsize_async
+         ao_clear_async
+         ao_pause_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]
+   [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)))
+                        )
+                    (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))
+  (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)
+  (let ((item (list 'play at-second music-duration 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_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)
+           ;(displayln (format "queue-length: ~a" (queue-length q)))
+           ;(let* ((elem (dequeue! q))
+                  ;(buf (car (cddddr elem))))
+             ;(free buf))))
+	   (dequeue! q)))
+  (set-ao-shm-queue! shm (make-queue))
+  (set-ao-shm-bufsize! shm 0)
+  )
+
+(define (ao_pause_async shm pause)
+  (if pause
+      (begin
+        (displayln "Pausing ao play thread")
+        (os-semaphore-wait (ao-shm-pause-sem shm))
+        (displayln (format "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
+        (displayln (format "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))
+        (displayln "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))
+        )
+      )
+  )
+  

libao/libao-ffi.rkt

@@ -2,7 +2,6 @@
 
 (require ffi/unsafe
          ffi/unsafe/define
-         setup/dirs
          "../utils/utils.rkt"
          )
 
@@ -27,16 +26,7 @@
          )
 
 
-(define ao_lib (ffi-lib "libao" '("3" "4" "5" #f)
+(define ao_lib (get-lib '("libao") '("5" "4" "3" #f)))
-                        #:get-lib-dirs (λ ()
-                                         (let ((sp (cons (build-path ".") (get-lib-search-dirs))))
-                                           (displayln sp)
-                              sp))
-                        #:fail (λ ()
-                                 (ffi-lib (get-lib-path "libao-4.dll")))
-                        ))
-
-
 (define-ffi-definer define-libao ao_lib)
 
 (define _libao-pointer (_cpointer 'ao_device))
@@ -78,7 +68,7 @@
 (define-libao ao_close (_fun _libao-pointer -> _int))
 
 ; void ao_shutdown();
-(define-libao ao_shutdown (_fun -> _int))
+(define-libao ao_shutdown (_fun -> _void))
 
 ; int ao_append_option(ao_option **options, const char *key, const char *value);
 (define-libao ao_append_option (_fun _pointer _pointer _pointer -> _int))

libao/libao.rkt

@@ -1,8 +1,11 @@
 #lang racket/base
 
+(define libao-async-mode 'ffi)   ; 'ffi or 'scheme
+
 (require "libao-ffi.rkt"
-         "libao-async-ffi.rkt"
          (prefix-in fin: finalizer)
+         (prefix-in ffi: "libao-async-ffi.rkt")
+         (prefix-in scm: "libao-async.rkt")
          ffi/unsafe
          data/queue
          )
@@ -13,12 +16,25 @@
          ao-close
          ao-default-driver-id
          ao-at-second
+         ao-music-duration
          ao-bufsize-async
+         ao-clear-async
+         ao-set-async-mode!
+         ao-async-mode
+         ao-pause
          )
 
 (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]
@@ -27,6 +43,7 @@
                           [channels #:auto #:mutable]
                           [rate #:auto #:mutable]
                           [async-player #:auto #:mutable]
+                          [closed #:auto #:mutable]
                           )
   #:auto-value #f
   )
@@ -38,8 +55,10 @@
                       (lambda (my-handle)
                         (hash-for-each devices
                                        (lambda (handle-num device)
+                                         (displayln (format "closing ao handle ~a" handle-num))
                                          (ao-close handle-num)))
                         (set! devices (make-hash))
+                        (displayln "shutting down ao")
                         (ao_shutdown)
                         (plumber-flush-handle-remove! my-handle)
                         )))
@@ -86,7 +105,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)
@@ -96,23 +117,58 @@
       )))
               
 (define (ao-close handle)
-  (if (number? handle)
+  
-      (let ((ao-device (hash-ref devices handle #f)))
+  (define (close-device handle ao-device)
-        (unless (eq? ao-device #f)
+    (if (eq? handle #f)
-          (let ((r (ao_close ao-device)))
+        (begin
-            (when (= r 0)
-              (printf "Unexpected: cannot close ao-device"))))
-        'internally-closed)
-      (let ((handle-num (ao-handle-handle-num handle)))
-        (ao_stop_async (ao-handle-async-player handle))
-        (let ((ao-device (hash-ref devices handle-num #f)))
           (if (eq? ao-device #f)
               'error-ao-device-non-existent
               (let ((r (ao_close ao-device)))
-                (hash-remove! devices handle-num)
                 (if (= r 0)
                     'error-closing-ao-device
-                    'ok)))))))
+                    'ok
+                    )
+                )
+              )
+          )
+        (if (ao-handle-closed handle)
+            'warning-ao-device-already-closed
+            (begin
+              (set-ao-handle-closed! handle #t)
+              (if (eq? libao-async-mode 'ffi)
+                  (begin
+                    (ffi:ao_clear_async (ao-handle-async-player handle))
+                    (ffi:ao_stop_async (ao-handle-async-player handle))
+                    )
+                  (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)))
+                    (if (= r 0)
+                        'error-closing-ao-device
+                        'ok)))
+              )
+            )
+        ))
+
+    (if (number? handle)
+        (let ((ao-device (hash-ref devices handle #f)))
+          (unless (eq? ao-device #f)
+            (displayln (format "Closing ao device ~a" ao-device))
+            (close-device #f ao-device)
+            (hash-remove! devices handle)))
+        (let ((handle-num (ao-handle-handle-num handle)))
+          (let ((ao-device (hash-ref devices handle-num #f)))
+            (unless (eq? ao-device #f)
+              (displayln (format "ao-device = ~a" ao-device))
+              (close-device handle ao-device)
+              (hash-remove! devices handle-num)))
+          )
+        )
+  )
 
 
 (define count 0)
@@ -129,14 +185,16 @@
           (reverse bytes)
           bytes))))
 
-(define (ao-play handle at-time-in-s buffer)
+(define (ao-play handle at-time-in-s music-duration-s buffer)
   (let* ((bytes-per-sample (ao-handle-bytes-per-sample handle))
          (bits (ao-handle-bits handle))
          (channels (ao-handle-channels handle))
          (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 'atomic audio-buf-len)))   ; was: 'raw
          (get-sample (lambda (k channel)
                        (let ((chan-buf (list-ref buffer channel)))
                          (vector-ref chan-buf k))))
@@ -160,18 +218,53 @@
                          '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)
+                             (exact->inexact music-duration-s)
+                             audio-buf-len
+                             audio)
+          (scm:ao_play_async (ao-handle-async-player handle)
+                             (exact->inexact at-time-in-s)
+                             (exact->inexact music-duration-s)
+                             audio-buf-len
+                             audio)
+          )
       )
+      ;(let* ((handle-num (ao-handle-handle-num handle))
+      ;       (ao-device (hash-ref devices handle-num #f)))
+      ;  (if (eq? ao-device #f)
+      ;      (error "No device for this handle")
+      ;      (ao_play ao-device audio audio-buf-len)))      )
     )
   )
 
+(define (ao-pause handle pause)
+  (if (eq? libao-async-mode 'ffi)
+      (ffi:ao_pause_async (ao-handle-async-player handle) (if (eq? pause #f) 0 1))
+      (scm:ao_pause_async (ao-handle-async-player handle) pause)
+      ))
+
 (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-music-duration handle)
+  (if (eq? libao-async-mode 'ffi)
+      (ffi:ao_music_duration_async (ao-handle-async-player handle))
+      (scm:ao_music_duration_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)
+  (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)))

libflac/flac-decoder.rkt

@@ -9,6 +9,7 @@
            flac-read
            flac-read-meta
            flac-stream-state
+           flac-stop
            (all-from-out "flac-definitions.rkt")
            kinds
            last-buffer last-buf-len
@@ -18,16 +19,17 @@
 ;; Functions to do the good stuff  
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 
-  (define (flac-open flac-file cb-stream-info cb-audio)
+  (define (flac-open flac-file* cb-stream-info cb-audio)
-    (if (file-exists? flac-file)
+    (let ((flac-file (if (path? flac-file*) (path->string flac-file*) flac-file*)))
-        (let ((handler (flac-ffi-decoder-handler)))
+      (if (file-exists? flac-file)
-          (handler 'new)
+          (let ((handler (flac-ffi-decoder-handler)))
-          (handler 'init flac-file)
+            (handler 'new)
-          (let ((h (make-flac-handle handler)))
+            (handler 'init flac-file)
-            (set-flac-handle-cb-stream-info! h cb-stream-info)
+            (let ((h (make-flac-handle handler)))
-            (set-flac-handle-cb-audio! h cb-audio)
+              (set-flac-handle-cb-stream-info! h cb-stream-info)
-            h))
+              (set-flac-handle-cb-audio! h cb-audio)
-        #f))
+              h))
+          #f)))
 
   (define (flac-stream-state handle)
     ((flac-handle-ffi-decoder-handler handle) 'state))
@@ -36,6 +38,7 @@
   (define kinds (make-hash))
   (define last-buffer #f)
   (define last-buf-len #f)
+  
   (define (process-frame handle frame buffer)
     (let* ((h (flac-ffi-frame-header frame))
            (cb-audio (flac-handle-cb-audio handle))
@@ -43,6 +46,7 @@
            (type (hash-ref h 'number-type))
            (channels (hash-ref h 'channels))
            (block-size (hash-ref h 'blocksize)))
+      (hash-set! h 'duration (flac-duration handle))
       (let ((buffers (ffi 'get-buffers buffer channels block-size)))
         (set! last-buffer buffers)
         (set! last-buf-len (hash-ref h 'blocksize))
@@ -77,31 +81,40 @@
   (define (flac-read handle)
     (let* ((ffi-handler (flac-handle-ffi-decoder-handler handle))
            (state (ffi-handler 'state)))
+      (set-flac-handle-stop-reading! handle #f)
+      (set-flac-handle-reading! handle #t)
       (letrec ((reader (lambda (frame-nr)
-                         (let* ((st (ffi-handler 'state)))
+                         (if (flac-handle-stop-reading handle)
-                           (ffi-handler 'process-single)
+                             (begin
-                           (unless (eq? state st)
+                               (displayln (format "handling stop at: ~a" (current-milliseconds)))
-                             (set! state st)
+                               (set-flac-handle-reading! handle #f)
-                             (displayln
+                               'stopped-reading)
-                              (format "Now in state ~a (frame-nr = ~a) (int-state = ~a)"
+                             (let* ((st (ffi-handler 'state)))
-                                      st frame-nr (ffi-handler 'int-state)))
+                               (ffi-handler 'process-single)
-                             )
+                               (unless (eq? state st)
-                           (when (ffi-handler 'has-errno?)
+                                 (set! state st)
-                             (displayln
+                                 (displayln
-                              (format "Error in stream: ~a" (ffi-handler 'errno)))
+                                  (format "Now in state ~a (frame-nr = ~a) (int-state = ~a)"
-                             )
+                                          st frame-nr (ffi-handler 'int-state)))
-                           (when (ffi-handler 'has-meta-data?)
+                                 )
-                             (ffi-handler 'process-meta-data
+                               (when (ffi-handler 'has-errno?)
-                                          (lambda (meta) (process-meta handle meta)))
+                                 (displayln
-                             )
+                                  (format "Error in stream: ~a" (ffi-handler 'errno)))
-                           (when (ffi-handler 'has-write-data?)
+                                 )
-                             (ffi-handler 'process-write-data
+                               (when (ffi-handler 'has-meta-data?)
-                                          (lambda (frame buffer)
+                                 (ffi-handler 'process-meta-data
-                                            (process-frame handle frame buffer)))
+                                              (lambda (meta) (process-meta handle meta)))
-                             )
+                                 )
-                           (if (eq? st 'end-of-stream)
+                               (when (ffi-handler 'has-write-data?)
-                             'end-of-stream
+                                 (ffi-handler 'process-write-data
-                             (reader (+ frame-nr 1)))))
+                                              (lambda (frame buffer)
+                                                (process-frame handle frame buffer)))
+                                 )
+                               (if (eq? st 'end-of-stream)
+                                   (begin
+                                     (set-flac-handle-reading! handle #f)
+                                     st)
+                                   (reader (+ frame-nr 1))))))
                        ))
         (reader 0))))
 
@@ -123,4 +136,16 @@
             (flac-handle-stream-info handle))
           #f)))
 
+  (define (flac-stop handle)
+    (let ((ct (current-milliseconds)))
+      (displayln (format "requesting stop at: ~a" ct))
+      (set-flac-handle-stop-reading! handle #t)
+      (while (flac-handle-reading handle)
+             (sleep 0.01))
+      (let ((ct* (current-milliseconds)))
+        (displayln (format "stop came back at: ~a" ct*))
+        (displayln (format "flac-stop took: ~a ms" (- ct* ct))))
+      )
+    )
+                         
   ); end of module

libflac/flac-definitions.rkt

@@ -13,6 +13,10 @@
            set-flac-handle-cb-stream-info!
            flac-handle-cb-audio
            set-flac-handle-cb-audio!
+           flac-handle-stop-reading
+           set-flac-handle-stop-reading!
+           flac-handle-reading
+           set-flac-handle-reading!
 
            flac-handle->string
 
@@ -94,8 +98,11 @@
      [cb-stream-info #:auto #:mutable]
      [cb-audio #:auto #:mutable]
      [stream-info #:auto #:mutable]
+     [stop-reading #:auto #:mutable]
+     [reading #:auto #:mutable]
      )
      #:auto-value #f
+     ;#:transparent
     )
 
   ); end of module

libflac/libflac-ffi.rkt

@@ -2,7 +2,6 @@
   
 (require ffi/unsafe
          ffi/unsafe/define
-         setup/dirs
          "../utils/utils.rkt"
          )
 
@@ -15,14 +14,9 @@
          FLAC__int32**
          )
 
-(define-ffi-definer define-libflac
-  (ffi-lib "libFLAC" '(#f)
-           #:get-lib-dirs (lambda ()
-                            (cons (build-path ".") (get-lib-search-dirs)))
-           #:fail (lambda ()
-                    (ffi-lib (get-lib-path "libFLAC.dll")))
-           ))
 
+(define lib (get-lib '("libFLAC") '(#f)))
+(define-ffi-definer define-libflac lib)
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;; Some FLAC Constants
@@ -408,7 +402,8 @@
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 
 (define _FLAC__StreamDecoder-pointer (_cpointer 'flac-streamdecoder))
-(define _FLAC__Data-pointer (_cpointer 'flac-client-data))
+(define _FLAC__Data-pointer (_cpointer/null 'flac-client-data))
+;(define _FLAC__StreamMetadata-pointer (_cpointer/null 'flac-stream-metadata))
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;; FLAC Callback function definitions
@@ -420,18 +415,21 @@
   (_fun _FLAC__StreamDecoder-pointer
         _FLAC__Frame-pointer
         FLAC__int32** 
-        _FLAC__Data-pointer -> _int))
+        _FLAC__Data-pointer
+        -> _int))
 
 ;typedef void(* FLAC__StreamDecoderMetadataCallback) (const FLAC__StreamDecoder *decoder, const FLAC__StreamMetadata *metadata, void *client_data)
 (define _FLAC__StreamDecoderMetadataCallback
   (_fun _FLAC__StreamDecoder-pointer
         _FLAC__StreamMetadata-pointer
-        _FLAC__Data-pointer -> _void))
+        _FLAC__Data-pointer
+        -> _void))
 
 (define _FLAC__StreamDecoderErrorCallback
   (_fun _FLAC__StreamDecoder-pointer
         _int
-        _FLAC__Data-pointer -> _void))
+        _FLAC__Data-pointer
+        -> _void))
 
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
@@ -470,6 +468,7 @@
         _FLAC__StreamDecoderWriteCallback
         _FLAC__StreamDecoderMetadataCallback
         _FLAC__StreamDecoderErrorCallback
+        _FLAC__Data-pointer  ; Seen by Jens Axel Søgaard - Is already present in FLAC 1.4.3 
         -> _int))
 
 (define-libflac FLAC__stream_decoder_process_single
@@ -484,6 +483,16 @@
   (_fun _FLAC__StreamDecoder-pointer FLAC__uint64
           -> _bool))
 
+;FLAC_API FLAC__StreamMetadata *FLAC__metadata_object_clone(const FLAC__StreamMetadata *object);
+(define-libflac FLAC__metadata_object_clone
+  (_fun _FLAC__StreamMetadata-pointer
+        -> _FLAC__StreamMetadata-pointer))
+  
+;FLAC_API void FLAC__metadata_object_delete(FLAC__StreamMetadata *object);
+(define-libflac FLAC__metadata_object_delete
+  (_fun _FLAC__StreamMetadata-pointer
+        -> _void))
+
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;; Our interface for decoding to racket
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
@@ -494,15 +503,18 @@
   (define error-no -1)
   (define fl #f)
   (define flac-file #f)
+  (define client-data #f)
   
-  (define (write-callback fl frame buffer data)
+  (define (write-callback fl frame buffer client-data)
     (set! write-data (append write-data (list (cons frame buffer))))
     0)
 
-  (define (meta-callback fl meta data)
+  (define (meta-callback fl meta client-data)
-    (set! meta-data (append meta-data (list meta))))
+    (let ((meta-clone (FLAC__metadata_object_clone meta)))
+      (unless (eq? meta-clone #f)
+        (set! meta-data (append meta-data (list meta-clone))))))
 
-  (define (error-callback fl errno data)
+  (define (error-callback fl errno client-data)
     (set! error-no errno)
     )
 
@@ -512,11 +524,12 @@
 
   (define (init file)
     (let ((r (FLAC__stream_decoder_init_file
-             fl
+              fl
-             file
+              file
-             write-callback
+              write-callback
-             meta-callback
+              meta-callback
-             error-callback)))
+              error-callback
+              client-data)))
       (set! flac-file file)
       r))
 
@@ -530,7 +543,10 @@
     (decoder-state (int-state)))
 
   (define (process-meta-data cb)
-    (for-each cb meta-data)
+    (for-each (λ (meta-entry)
+                (cb meta-entry)
+                (FLAC__metadata_object_delete meta-entry))
+              meta-data)
     (set! meta-data '()))
 
   (define (process-write-data cb)

libtag/taglib-ffi.rkt

@@ -2,7 +2,6 @@
 
 (require ffi/unsafe
          ffi/unsafe/define
-         setup/dirs
          "../utils/utils.rkt"
          )
 
@@ -45,22 +44,30 @@
          )
 
 
-;(define-ffi-definer define-tag-lib
+;(define-runtime-path lib-path "..");
-;  (ffi-lib "tag" '("0" #f)
+;
-;           #:get-lib-dirs (lambda ()
+;(define libs (let ((os-type (system-type 'os*)))
-;                            (cons (build-path ".") (get-lib-search-dirs)))
+;              (if (eq? os-type 'windows)
-;           #:fail (lambda ()
+;                  (list
-;                    (ffi-lib (get-lib-path "tag.dll")))
+;                   (build-path lib-path "lib" "dll" "tag")
-;           ))d
+;                   (build-path lib-path "lib" "dll" "tag_c"))
+;                  (let* ((arch (symbol->string (system-type 'arch)))
+;                         (subdir (string-append (symbol->string os-type) "-" arch)))
+;                    (list
+;                     (build-path lib-path "lib" subdir "libtag")
+;                     (build-path lib-path "lib" subdir "libtag_c"))))))
 
-(define-ffi-definer define-tag-c-lib
+;(define (get-lib l)
-  (ffi-lib "libtag_c" '("2" #f)
+;  (ffi-lib l '("2" #f)
-           #:get-lib-dirs (lambda ()
+;           #:get-lib-dirs (λ ()
-                            (cons (build-path ".") (get-lib-search-dirs)))
+;                            (cons (build-path ".") (get-lib-search-dirs)))
-           #:fail (lambda ()
+;           #:fail (λ ()
-                    (let ((path (get-lib-path "tag_c.dll")))
+;                    (error (format "Cannot find library ~a" l)))
-                      (ffi-lib path)))
+;           ))
-           ))
+  
+(define libtag (get-lib '("tag" "libtag") '("2" #f)))
+(define libtag_c (get-lib '("tag_c" "libtag_c") '("#2" #f)))
+(define-ffi-definer define-tag-c-lib libtag_c)
 
 (define TagLib_File_Type
   (_enum '(

libtag/taglib.rkt

@@ -2,6 +2,7 @@
 
   (require "taglib-ffi.rkt"
            "../utils/utils.rkt"
+           racket/string
            racket/draw)
 
   (provide id3-tags
@@ -26,6 +27,11 @@
 
            tags-picture
            tags-picture->bitmap
+           tags-picture->file
+           tags-picture->kind
+           tags-picture->mimetype
+           tags-picture->size
+           tags-picture->ext
 
            tags->hash
 
@@ -41,8 +47,9 @@
   (define-struct id3-picture
     (mimetype kind size bytes))
 
-  (define (id3-tags file)
+  (define (id3-tags file*)
-    (let ((valid? #f)
+    (let ((file (if (path? file*) (path->string file*) file*))
+          (valid? #f)
           (title "")
           (album "")
           (artist "")
@@ -60,7 +67,9 @@
           (disc-number -1)
           (picture #f))
       (let ((tag-file (taglib_file_new file)))
-        (set! valid? (taglib_file_is_valid tag-file))
+        (if (eq? tag-file #f)
+            (set! valid? #f)
+            (set! valid? (taglib_file_is_valid tag-file)))
         (when valid?
           (let ((tag (taglib_file_tag tag-file))
                 (ap (taglib_file_audioproperties tag-file))
@@ -222,6 +231,48 @@
             (close-input-port in)
             btm))))
 
+  (define (tags-picture->kind tags)
+    (let ((p (tags-picture tags)))
+      (if (eq? p #f)
+          #f
+          (id3-picture-kind p))))
+
+  (define (tags-picture->mimetype tags)
+    (let ((p (tags-picture tags)))
+      (if (eq? p #f)
+          #f
+          (id3-picture-mimetype p))))
+
+  (define (tags-picture->ext tags)
+    (let ((mt (tags-picture->mimetype tags)))
+      (cond
+        ((or (string-suffix? mt "/jpeg") (string-suffix? mt "/jpg"))
+         'jpg)
+        ((string-suffix? mt "/png")
+         'png)
+        (else #f)
+        )
+      ))
+
+  (define (tags-picture->size tags)
+    (let ((p (tags-picture tags)))
+      (if (eq? p #f)
+          #f
+          (id3-picture-size p))))
+
+  (define (tags-picture->file tags path)
+    (let ((p (tags-picture tags)))
+      (if (eq? p #f)
+          #f
+          (let* ((in (open-input-bytes (id3-picture-bytes p)))
+                 (fh (open-output-file path #:mode 'binary #:exists 'replace)))
+            (let ((bytes (read-bytes 16384 in)))
+              (while (and (not (eof-object? bytes)) (> (bytes-length bytes) 0))
+                     (write-bytes bytes fh)
+                     (set! bytes (read-bytes 16384 in))))
+            (close-output-port fh)
+            (close-input-port in)
+            #t))))
             
 
   ); end of module

play-test.rkt

@@ -1,16 +1,26 @@
 #lang racket/base
 (require "libao/libao.rkt"
          "libflac/flac-decoder.rkt"
-         data/queue
+         ;data/queue
+  ;racket-sound
          )
 
+(define test-file3 #f)
+(let ((os (system-type 'os)))
+  (when (eq? os 'unix)
+    (set! test-file3 "/muziek/Klassiek-Viool/Alina Ibragimova/Paganini_24 Caprices (2021)/24. 24 Caprices, Op 1 - No. 24 in A minor- Tema con variazioni. Quasi presto.flac"))
+  (when (eq? os 'windows)
+    (set! test-file3 "C:\\Muziek\\Klassiek-Strijkkwartet\\Quatuor Zaïde\\Franz\\01 Erlkönig, D. 328 (Arr. For String Quartet by Eric Mouret).flac")
+    ;(set! test-file3 "C:\\Muziek\\Klassiek-Viool\\Janine Jansen\\Janine Jansen - Sibelius en Prokovief 1 (2024)\\02 - Violin Concerto in D Minor, Op. 47 II. Adagio di molto.flac")
+    )
+  )
 
-
+(ao-set-async-mode! 'ffi)
-(define test-file3 "/muziek/Klassiek-Viool/Alina Ibragimova/Paganini_24 Caprices (2021)/24. 24 Caprices, Op 1 - No. 24 in A minor- Tema con variazioni. Quasi presto.flac")
+;(define fmt (ao-mk-format 24 48000 2 'big-endian))
-(define fmt (ao-mk-format 24 48000 2 'big-endian))
+;(define ao-h (ao-open-live #f fmt))
-(define ao-h (ao-open-live #f fmt))
 
 (define current-seconds 0)
+(define ao-h #f)
 
 (define (flac-play frame buffer)
   (let* ((sample (hash-ref frame 'number))
@@ -20,13 +30,25 @@
          (bytes-per-sample (/ bits-per-sample 8))
          (channels (hash-ref frame 'channels))
          (bytes-per-sample-all-channels (* channels bytes-per-sample))
+         (duration (hash-ref frame 'duration))
          )
-    (ao-play ao-h second buffer)
+    (when (eq? ao-h #f)
+      (let ((fmt (ao-mk-format bits-per-sample rate channels 'big-endian)))
+        (set! ao-h (ao-open-live #f fmt))))
+    (ao-play ao-h second duration 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)
-                                (displayln (format "At second: ~a" s)))))))
+                                (let ((minutes (quotient s 60))
+                                      (seconds (remainder s 60))
+                                      (tminutes (quotient duration 60))
+                                      (tseconds (remainder duration 60))
+                                      )
+                                (displayln (format "At time: ~a:~a (~a:~a)"
+                                                   minutes seconds
+                                                   tminutes tseconds
+                                                   ))))))))
       (let* ((buf-size (ao-bufsize-async ao-h))
              (buf-seconds (exact->inexact (/ buf-size bytes-per-sample-all-channels rate))))
         (second-printer)
@@ -51,8 +73,16 @@
 (define (flac-meta meta)
   (displayln meta))
 
-(define flac-h
+(define (play)
-  (flac-open test-file3 flac-meta flac-play))
+  (set! ao-h #f)
+  (let ((flac-h (flac-open test-file3 flac-meta flac-play)))
+    (flac-read flac-h)
+    (ao-close ao-h)
+    (set! ao-h #f)))
+    ;(sleep 1.0)
+    ;(play)))
 
-(flac-read flac-h)
+;(flac-read flac-h)
+
+(play)
 

utils/utils.rkt

@@ -1,8 +1,15 @@
 (module utils racket/base
 
+  (require racket/path
+           racket/runtime-path
+           ffi/unsafe
+           setup/dirs
+           )
+  
   (provide while
            until
-           get-lib-path
+           build-lib-path
+           get-lib
            do-for
            )
 
@@ -47,23 +54,27 @@
                                          (do-for-f))))))
            (do-for-f))))))
 
-  (define (get-lib-path lib)
-    (let ((platform (system-type)))
-      (cond
-        [(eq? platform 'windows) 
-         (let ((try1 (build-path (current-directory) ".." "lib" "dll" lib))
-               (try2 (build-path (current-directory) "lib" "dll" lib)))
-           (if (file-exists? try1)
-               try1
-               try2)
-           )]
-        [(eq? platform 'unix)
-         (let ((try1 (build-path (current-directory) "lib" lib)))
-           (when (file-exists? try1)
-             try1))]
-        [else
-         (error (format "Install the shared library: ~a" lib))]
-        )))
 
+  (define-runtime-path lib-path "..")
+
+  (define (build-lib-path)
+    (let ((os-type (system-type 'os*)))
+      (if (eq? os-type 'windows)
+          (build-path lib-path "lib" "dll")
+          (let* ((arch (symbol->string (system-type 'arch)))
+                 (subdir (string-append (symbol->string os-type) "-" arch)))
+            (let ((path (build-path lib-path "lib" subdir)))
+              path)))))
+
+  (define (get-lib* libs-to-try orig-libs versions)
+    (if (null? libs-to-try)
+        (error (format "Cannot find library, tried ~a" orig-libs)) 
+        (ffi-lib (car libs-to-try) versions
+                 #:get-lib-dirs (λ () (cons (build-lib-path) (get-lib-search-dirs)))
+                 #:fail (λ () (get-lib* (cdr libs-to-try) orig-libs versions))
+                 )))
+
+  (define (get-lib libs-to-try versions)
+    (get-lib* libs-to-try libs-to-try versions))
   
   ) ; end of module