Make sure libao-1.2.2 is loaded in windows.

This seems much more reliable.

Makefile

@@ -0,0 +1,9 @@
+
+all:
+	@echo "make clean"
+
+clean:
+	find . -type f -name "*~" -exec rm {} \;
+	find . -type f -name "*.back" -exec rm {} \;
+	rm -f scrbl/*.html scrbl/*.js scrbl/*.css
+	DIRS=`find . -type d -name "compiled"`;rm -rf $$DIRS

flac-decoder.rkt

@@ -3,13 +3,14 @@
   (require ffi/unsafe
            "libflac-ffi.rkt"
            "flac-definitions.rkt"
-           "../utils/utils.rkt")
+           "private/utils.rkt")
 
   (provide flac-open
            flac-read
            flac-read-meta
            flac-stream-state
            flac-stop
+           flac-seek
            (all-from-out "flac-definitions.rkt")
            kinds
            last-buffer last-buf-len
@@ -47,20 +48,18 @@
            (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))
-        (hash-set! kinds type #t)
-        (when (procedure? cb-audio)
-          (cb-audio h buffers))
-        ))
-    ;(displayln "Processing frame"))
+      (set! last-buffer buffer)
+      (set! last-buf-len block-size)
+      (hash-set! kinds type #t)
+      (when (procedure? cb-audio)
+        (cb-audio h buffer block-size))
+      )
     #t
     )
   
   (define (process-meta handle meta)
     (let ((type (FLAC__StreamMetadata-type meta)))
-      (display (format "  Got metadata type: ~a\n" type))
+      (dbg-sound (format "  Got metadata type: ~a\n" type))
       (cond
         ([eq? type 'streaminfo]
          (let ((mh (flac-ffi-meta meta)))
@@ -86,20 +85,18 @@
       (letrec ((reader (lambda (frame-nr)
                          (if (flac-handle-stop-reading handle)
                              (begin
-                               (displayln (format "handling stop at: ~a" (current-milliseconds)))
+                               (dbg-sound "handling stop at: ~a" (current-milliseconds))
                                (set-flac-handle-reading! handle #f)
                                'stopped-reading)
                              (let* ((st (ffi-handler 'state)))
                                (ffi-handler 'process-single)
                                (unless (eq? state st)
                                  (set! state st)
-                                 (displayln
-                                  (format "Now in state ~a (frame-nr = ~a) (int-state = ~a)"
-                                          st frame-nr (ffi-handler 'int-state)))
+                                 (dbg-sound "Now in state ~a (frame-nr = ~a) (int-state = ~a)"
+                                            st frame-nr (ffi-handler 'int-state))
                                  )
                                (when (ffi-handler 'has-errno?)
-                                 (displayln
-                                  (format "Error in stream: ~a" (ffi-handler 'errno)))
+                                 (err-sound "Error in stream: ~a" (ffi-handler 'errno))
                                  )
                                (when (ffi-handler 'has-meta-data?)
                                  (ffi-handler 'process-meta-data
@@ -136,15 +133,28 @@
             (flac-handle-stream-info handle))
           #f)))
 
+  (define (flac-seek handle percentage)
+    (dbg-sound "seek to percentage ~a" percentage)
+    (let ((ffi-handler (flac-handle-ffi-decoder-handler handle)))
+      (let ((total-samples (flac-total-samples handle)))
+        (unless (eq? total-samples #f)
+          (let ((sample (inexact->exact (round (* (exact->inexact (/ percentage 100.0)) total-samples)))))
+            (ffi-handler 'seek-to-sample sample))
+          )
+        )
+      )
+    )
+    
+
   (define (flac-stop handle)
     (let ((ct (current-milliseconds)))
-      (displayln (format "requesting stop at: ~a" ct))
+      (dbg-sound "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))))
+        (dbg-sound "stop came back at: ~a" ct*)
+        (dbg-sound "flac-stop took: ~a ms" (- ct* ct)))
       )
     )
                          

info.rkt

@@ -1,22 +1,24 @@
 #lang info
 
 (define pkg-authors '(hnmdijkema))
-(define version "0.1.0")
+(define version "0.1.1")
 (define license 'GPL-2.0-or-later)   ; The liboa library has this license
 (define collection "racket-sound")
 (define pkg-desc "racket-sound - Integration of popular music/sound related libraries in racket")
 
 (define scribblings
   '(
-    ("scribblings/racket-sound.scrbl" () (library) "racket-sound")
-    ("scribblings/liboa.scrbl" () (library) "racket-sound/liboa/libao.rkt")
-    ("scribblings/flac-decoder.scrbl" () (library) "racket-sound/libflac/flac-decoder.rkt")
-    ("scribblings/taglib.scrbl" () (library) "racket-sound/libtag/taglib.rkt")
+    ("scrbl/flac-decoder.scrbl" () (library)) 
+    ;("scrbl/racket-sound.scrbl" () (library) "racket-sound")
+    ;("scrbl/liboa.scrbl" () (library) "racket-sound/liboa/libao.rkt")
+    ;("scrbl/flac-decoder.scrbl" () (library) "flac-decoder.rkt")
+    ;("scrbl/taglib.scrbl" () (library) "racket-sound/libtag/taglib.rkt")
     )
   )
 
 (define deps
-  '("racket/gui" "racket/base" "racket"))
+  '("racket/gui" "racket/base" "racket" "finalizer" "draw-lib" "net-lib" "simple-log")
+  )
 
 (define build-deps
   '("racket-doc"
@@ -24,3 +26,6 @@
     "rackunit-lib"
     "scribble-lib"
     ))
+
+(define test-omit-paths 'all)
+

libao-async-ffi.rkt

@@ -0,0 +1,90 @@
+#lang racket/base
+
+
+(require ffi/unsafe
+         ffi/unsafe/define
+         "private/utils.rkt"
+         ;"libao-ffi.rkt"
+         )
+
+(provide ao_create_async
+         ao_stop_async
+         ao_play_async
+         ao_is_at_music_id_async
+         ao_is_at_second_async
+         ao_music_duration_async
+         ao_bufsize_async
+         ao_clear_async
+         ao_pause_async
+         make-BufferInfo_t
+         )
+
+(define _BufferType_t
+  (_enum '(ao = 1
+           flac = 2
+           mp3 = 3
+           ogg = 4
+           )))
+
+;#define AO_FMT_LITTLE 1
+;#define AO_FMT_BIG    2
+;#define AO_FMT_NATIVE 4
+
+(define _Endian_t
+  (_enum '(little-endian = 1
+           big-endian    = 2
+           native-endian = 4
+           )
+         )
+  )
+
+(define-cstruct _BufferInfo_t
+  (
+   [type _BufferType_t]
+   [sample_bits _int]
+   [sample_rate _int]
+   [channels _int]
+   [endiannes _Endian_t]
+   ))
+
+
+(when (eq? (system-type 'os) 'windows)
+  (void (get-lib '("libao-1.2.2") '(#f))))
+
+(define lib (get-lib '("ao-play-async" "libao-play-async") '(#f)))
+;(define lib (ffi-lib "/home/hans/src/racket/racket-sound-lib/lib/linux-x86_64/libao-play-async.so"))
+(define-ffi-definer define-libao-async lib
+  #:default-make-fail make-not-available)
+
+(define _libao-async-handle-pointer (_cpointer 'ao-async-handle))
+
+;extern int ao_async_version()
+(define-libao-async ao_async_version (_fun -> _int))
+
+;extern void *ao_create_async(int bits, int rate, int channel, int byte_format);
+(define-libao-async ao_create_async(_fun _int _int _int _Endian_t -> _libao-async-handle-pointer))
+
+;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, int music_id, double at_second, double music_duration, int buf_size, void *mem, BufferInfo_t info);
+(define-libao-async ao_play_async(_fun _libao-async-handle-pointer _int _double _double _uint32 _pointer _BufferInfo_t -> _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 int ao_is_at_music_id_async(void *handle);
+(define-libao-async ao_is_at_music_id_async (_fun _libao-async-handle-pointer -> _int))
+
+;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-ffi.rkt

@@ -2,7 +2,7 @@
 
 (require ffi/unsafe
          ffi/unsafe/define
-         "../utils/utils.rkt"
+         "private/utils.rkt"
          )
 
 (provide ;_libao_pointer
@@ -27,7 +27,8 @@
 
 
 (define ao_lib (get-lib '("libao") '("5" "4" "3" #f)))
-(define-ffi-definer define-libao ao_lib)
+(define-ffi-definer define-libao ao_lib
+    #:default-make-fail make-not-available)
 
 (define _libao-pointer (_cpointer 'ao_device))
 (define-cstruct _ao_sample_format (

libao.rkt

@@ -0,0 +1,185 @@
+#lang racket/base
+
+(require (prefix-in fin: finalizer)
+         (prefix-in ffi: "libao-async-ffi.rkt")
+         ffi/unsafe
+         ffi/unsafe/custodian
+         data/queue
+         "private/utils.rkt"
+         (prefix-in rc: racket/contract)
+         )
+
+(provide ao-open-live
+         ao-play
+         ao-close
+         ao-at-second
+         ao-music-duration
+         ao-at-music-id
+         ao-bufsize-async
+         ao-clear-async
+         ao-pause
+         ao-valid?
+         ao-valid-bits?
+         ao-valid-rate?
+         ao-valid-channels?
+         ao-valid-format?
+         ao-handle?
+         ao-supported-music-format?
+         )
+
+(define device-number 1)
+
+(define-struct ao-handle (handle-num
+                          [bits #:auto #:mutable]
+                          [bytes-per-sample #:auto #:mutable]
+                          [byte-format #:auto #:mutable]
+                          [channels #:auto #:mutable]
+                          [rate #:auto #:mutable]
+                          [async-player #:auto #:mutable]
+                          [closed #:auto #:mutable]
+                          )
+  #:auto-value #f
+  )
+
+
+(define (ao-supported-music-format? f)
+  (and (symbol? f)
+       (or (eq? f 'flac)
+           (eq? f 'mp3)
+           (eq? f 'ao))))
+
+
+(define (bytes-for-bits bits)
+  (/ bits 8))
+
+(define (ao-valid-bits? bits)
+  (and (integer? bits) (or
+                        (= bits 8)
+                        (= bits 16)
+                        (= bits 24)
+                        (= bits 32))
+       )
+  )
+
+(define (ao-valid-rate? rate)
+  (and (integer? rate)
+       (not (eq? (memq rate '(8000 11025 16000 22050 44100
+                                   48000 88200 96000 1764000
+                                   192000 352800 384000)) #f))))
+
+(define (ao-valid-channels? c)
+  (and (integer? c)
+       (>= c 1)))
+
+(define (ao-valid-format? f)
+  (or (eq? f 'little-endian)
+      (eq? f 'big-endian)
+      (eq? f 'native-endian)))
+
+(rc:define/contract (ao-open-live bits rate channels byte-format)
+  (rc:-> ao-valid-bits? ao-valid-rate? ao-valid-channels? ao-valid-format? ao-handle?)
+  (let ((handle (make-ao-handle device-number)))
+
+    (fin:register-finalizer handle
+                            (lambda (handle)
+                              (ao-close handle)))
+
+    (set-ao-handle-bits! handle bits)
+    (set-ao-handle-bytes-per-sample! handle (bytes-for-bits bits))
+    (set-ao-handle-byte-format! handle byte-format)
+    (set-ao-handle-channels! handle channels)
+    (set-ao-handle-rate! handle rate)
+
+    (info-sound "ao-open-live ~a ~a ~a ~a" bits rate channels byte-format)
+    
+    (let ((player (ffi:ao_create_async bits rate channels byte-format)))
+      (set-ao-handle-async-player! handle player)
+      (if (eq? player #f)
+          (begin
+            (err-sound "ao-open-live - cannote create player")
+            (set-ao-handle-closed! handle #t)
+            handle)
+          (begin
+            (info-sound "ao-open-live - created player")
+            (set-ao-handle-closed! handle #f)
+            handle
+            )
+          )
+      )
+    )
+  )
+
+(rc:define/contract (ao-close handle)
+  (rc:-> ao-handle? void?)
+  (void
+   (unless (eq? (ao-handle-async-player handle) #f)
+     (info-sound "ao-close - closing handle")
+     (ffi:ao_stop_async (ao-handle-async-player handle))
+     (set-ao-handle-async-player! handle #f)
+     )
+   )
+  )
+
+(define (ao-valid? handle)
+  (and (ao-handle? handle)
+       (not (eq? (ao-handle-async-player handle) #f)))
+  )
+
+(define (any? x)
+  #t)
+
+(rc:define/contract (ao-play handle music-id at-time-in-s music-duration-s buffer buf-len buf-type)
+  (rc:-> ao-handle? integer? number? number? any? integer? ao-supported-music-format? void?)                    
+  (let* ((bytes-per-sample (ao-handle-bytes-per-sample handle))
+         (bits (ao-handle-bits handle))
+         (rate (ao-handle-rate handle))
+         (channels (ao-handle-channels handle))
+         (endianess (ao-handle-byte-format handle))
+         (buf-info (ffi:make-BufferInfo_t buf-type bits rate channels endianess))
+         )
+    (unless (ao-valid? handle)
+      (err-sound "Cannot play on an invalid ao-device")
+      (error "Cannot play on an invalid ao-device"))
+    (ffi:ao_play_async (ao-handle-async-player handle)
+                       music-id
+                       (exact->inexact at-time-in-s)
+                       (exact->inexact music-duration-s)
+                       buf-len
+                       buffer
+                       buf-info)
+    
+    )
+  )
+
+(rc:define/contract (ao-pause handle pause)
+  (rc:-> ao-handle? boolean? void?)
+  (dbg-sound "ao-pause ~a" pause)
+  (ffi:ao_pause_async (ao-handle-async-player handle) (if (eq? pause #f) 0 1))
+  )
+
+(rc:define/contract (ao-at-second handle)
+  (rc:-> ao-handle? number?)
+  (ffi:ao_is_at_second_async (ao-handle-async-player handle))
+  )
+
+(rc:define/contract (ao-at-music-id handle)
+  (rc:-> ao-handle? integer?)
+  (ffi:ao_is_at_music_id_async (ao-handle-async-player handle))
+  )
+  
+(rc:define/contract (ao-music-duration handle)
+  (rc:-> ao-handle? number?)
+  (ffi:ao_music_duration_async (ao-handle-async-player handle))
+  )
+
+(rc:define/contract (ao-bufsize-async handle)
+  (rc:-> ao-handle? integer?)                    
+  (ffi:ao_bufsize_async (ao-handle-async-player handle))
+  )
+
+(define (ao-clear-async handle)
+  (rc:-> ao-handle? void?)
+  (ffi:ao_clear_async (ao-handle-async-player handle))
+  )
+
+

libao/c/Makefile

@@ -1,16 +0,0 @@
-
-all:
-	mkdir -p build
-	cmake -S ao-play-async -B build
-	(cd build; make)
-
-install:
-	mkdir -p ../../lib
-	SUBDIR=`racket -e "(display (format \"~a-~a\" (system-type 'os*) (system-type 'arch)))"`; \
-	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:
-	rm -rf build

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

@@ -1,74 +0,0 @@
-# This file is used to ignore files which are generated
-# ----------------------------------------------------------------------------
-
-*~
-*.autosave
-*.a
-*.core
-*.moc
-*.o
-*.obj
-*.orig
-*.rej
-*.so
-*.so.*
-*_pch.h.cpp
-*_resource.rc
-*.qm
-.#*
-*.*#
-core
-!core/
-tags
-.DS_Store
-.directory
-*.debug
-Makefile*
-*.prl
-*.app
-moc_*.cpp
-ui_*.h
-qrc_*.cpp
-Thumbs.db
-*.res
-*.rc
-/.qmake.cache
-/.qmake.stash
-
-# qtcreator generated files
-*.pro.user*
-CMakeLists.txt.user*
-
-# xemacs temporary files
-*.flc
-
-# Vim temporary files
-.*.swp
-
-# Visual Studio generated files
-*.ib_pdb_index
-*.idb
-*.ilk
-*.pdb
-*.sln
-*.suo
-*.vcproj
-*vcproj.*.*.user
-*.ncb
-*.sdf
-*.opensdf
-*.vcxproj
-*vcxproj.*
-
-# MinGW generated files
-*.Debug
-*.Release
-
-# Python byte code
-*.pyc
-
-# Binaries
-# --------
-*.dll
-*.exe
-

libao/c/ao-play-async/CMakeLists.txt

@@ -1,13 +0,0 @@
-cmake_minimum_required(VERSION 3.14)
-
-project(ao-play-async LANGUAGES C)
-
-set(CMAKE_CXX_STANDARD 17)
-set(CMAKE_CXX_STANDARD_REQUIRED ON)
-
-add_library(ao-play-async SHARED
-    ao_playasync.c
-    ao_playasync.h
-)
-
-target_compile_definitions(ao-play-async PRIVATE AOPLAYASYNC_LIBRARY)

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

@@ -1,297 +0,0 @@
-#include "ao_playasync.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 <stdint.h>
-#include <stdio.h>
-#include <stdlib.h>
-
-typedef enum {
-    PLAY = 1,
-    STOP = 2
-} Command_t;
-
-typedef void * ao_device;
-
-typedef struct _queue_ {
-    Command_t command;
-    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;
-
-
-static Queue_t *front(AO_Handle *h)
-{
-    assert(h->play_queue != NULL);
-    return h->play_queue;
-}
-
-static Queue_t *get(AO_Handle *h)
-{
-    assert(h->play_queue != NULL);
-    Queue_t *q = h->play_queue;
-    h->play_queue = h->play_queue->next;
-    if (h->play_queue == NULL) {
-        h->last_frame = NULL;
-    } else {
-        h->play_queue->prev = NULL;
-    }
-    h->buf_size -= q->buflen;
-    return q;
-}
-
-static void add(AO_Handle *h, Queue_t *elem)
-{
-    if (h->last_frame == NULL) {
-        h->play_queue = elem;
-        elem->next = NULL;
-        elem->prev = NULL;
-        h->last_frame = h->play_queue;
-    } else {
-        h->last_frame->next = elem;
-        elem->prev = h->last_frame;
-        elem->next = NULL;
-        h->last_frame = elem;
-    }
-    h->buf_size += elem->buflen;
-}
-
-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;
-
-    if (buf_len != 0) {
-        new_buf = (void *) malloc(buf_len);
-        memcpy(new_buf, buf, buf_len);
-    } else {
-        new_buf = NULL;
-    }
-    q->at_second = at_second;
-    q->music_duration = music_duration;
-    q->buf = new_buf;
-    q->buflen = buf_len;
-    q->command = command;
-    q->next = NULL;
-    q->prev = NULL;
-    return q;
-}
-
-static void del_elem(Queue_t *q)
-{
-    if (q->buflen != 0) {
-        free(q->buf);
-    }
-    free(q);
-}
-
-static void clear(AO_Handle *h)
-{
-    while (h->play_queue != NULL) {
-        Queue_t *q = get(h);
-        del_elem(q);
-    }
-}
-
-#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) {
-        MUTEX_LOCK(handle->mutex);
-        int has_frames = (!handle->paused) && (handle->play_queue != NULL);
-
-        if (has_frames) {
-            Queue_t *q = get(handle);
-            handle->at_second = q->at_second;
-            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 {
-            MUTEX_UNLOCK(handle->mutex);
-            sleep_ms(5);   // sleep for 5ms
-        }
-    }
-
-#ifdef USE_PTHREADS
-    return NULL;
-#endif
-#ifdef USE_WINDOWS_THREADS
-    return 0;
-#endif
-}
-
-void *ao_create_async(void *ao_device_yeah, void *ao_play_f)
-{
-    //if (ao_play == NULL) { get_ao_play(); }
-
-    AO_Handle *handle = (AO_Handle *) malloc(sizeof(AO_Handle));
-
-    handle->ao_device = (ao_device *) ao_device_yeah;
-    handle->play_queue = NULL;
-    handle->last_frame = NULL;
-    handle->at_second = -1;
-
-    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;
-}
-
-void ao_stop_async(void *ao_handle)
-{
-    AO_Handle *h = (AO_Handle *) ao_handle;
-
-    MUTEX_LOCK(h->mutex);
-    clear(h);
-    Queue_t *q = new_elem(STOP, 0.0, 0.0, 0, NULL);
-    add(h, q);
-    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, double music_duration, int buf_size, void *mem)
-{
-    AO_Handle *h = (AO_Handle *) ao_handle;
-    Queue_t *q = new_elem(PLAY, at_second, music_duration, buf_size, mem);
-    MUTEX_LOCK(h->mutex);
-    add(h, q);
-    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;
-    MUTEX_LOCK(h->mutex);
-    double s = h->at_second;
-    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;
-    MUTEX_LOCK(h->mutex);
-    int s = h->buf_size;
-    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,26 +0,0 @@
-#ifndef AO_PLAYASYNC_H
-#define AO_PLAYASYNC_H
-
-#ifdef _WINDOWS
-#ifdef AOPLAYASYNC_LIBRARY
-#define AOPLAYASYNC_EXPORT __declspec(dllexport)
-#else
-#define AOPLAYASYNC_EXPORT __declspec(dllimport)
-#endif
-#else
-#define AOPLAYASYNC_EXPORT extern
-#endif
-
-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);
-
-AOPLAYASYNC_EXPORT double ao_is_at_second_async(void *handle);
-AOPLAYASYNC_EXPORT double ao_music_duration_async(void *handle);
-
-AOPLAYASYNC_EXPORT void ao_pause_async(void *ao_handle, int paused);
-
-AOPLAYASYNC_EXPORT int ao_bufsize_async(void *handle);
-
-#endif // AO_PLAYASYNC_H

libao/libao-async-ffi.rkt

@@ -1,48 +0,0 @@
-#lang racket/base
-
-
-(require ffi/unsafe
-         ffi/unsafe/define
-         "../utils/utils.rkt"
-         "libao-ffi.rkt"
-         )
-
-(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
-         )
-
-(define lib (get-lib '("ao-play-async" "libao-play-async") '(#f)))
-(define-ffi-definer define-libao-async lib)
-
-(define _libao-async-handle-pointer (_cpointer 'ao-async-handle))
-
-;extern void *ao_create_async(void *ao_device, );
-(define-libao-async ao_create_async(_fun _pointer _fpointer -> _libao-async-handle-pointer))
-
-;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, double music_duration, int buf_size, void *mem);
-(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

@@ -1,216 +0,0 @@
-#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.rkt

@@ -1,277 +0,0 @@
-#lang racket/base
-
-(define libao-async-mode 'ffi)   ; 'ffi or 'scheme
-
-(require "libao-ffi.rkt"
-         (prefix-in fin: finalizer)
-         (prefix-in ffi: "libao-async-ffi.rkt")
-         (prefix-in scm: "libao-async.rkt")
-         ffi/unsafe
-         data/queue
-         )
-
-(provide ao-open-live
-         ao-play
-         ao-mk-format
-         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]
-                          [bytes-per-sample #:auto #:mutable]
-                          [byte-format #:auto #:mutable]
-                          [channels #:auto #:mutable]
-                          [rate #:auto #:mutable]
-                          [async-player #:auto #:mutable]
-                          [closed #:auto #:mutable]
-                          )
-  #:auto-value #f
-  )
-
-(ao_initialize)
-
-(define libao-plumber-flus-handle
-  (plumber-add-flush! (current-plumber)
-                      (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)
-                        )))
-
-
-
-(define (ao-mk-format bits rate channels byte-format . matrix)
-  (let ((bf (if (eq? byte-format 'little-endian)
-                AO-FMT-LITTLE
-                (if (eq? byte-format 'big-endian)
-                    AO-FMT-BIG
-                    AO-FMT-NATIVE))))
-    (let ((format (make-ao_sample_format bits rate channels bf #f)))
-      format)))
-
-(define (ao-endianness->symbol e)
-  (if (= e AO-FMT-LITTLE)
-      'little-endian
-      (if (= e AO-FMT-BIG)
-          'big-endian
-          'native)))
-
-(define (ao-default-driver-id)
-   (ao_default_driver_id))
-
-(define (ao-open-live driver-id sample-format . options)
-  (let ((id (if (eq? driver-id #f) (ao-default-driver-id) driver-id)))
-    (let ((ao-device (ao_open_live id sample-format #f)))
-      (if (eq? ao-device #f)
-          (let ((handle (ao-handle -1)))
-            handle)
-          (let ((handle-num device-number))
-            (set! device-number (+ device-number 1))
-            (let ((handle (ao-handle handle-num)))
-              (let* ((bits (ao_sample_format-bits sample-format))
-                     (bytes-per-sample (inexact->exact (round (/ bits 8))))
-                     (channels (ao_sample_format-channels sample-format))
-                     (endianness (ao-endianness->symbol
-                                  (ao_sample_format-byte_format sample-format)))
-                     (rate (ao_sample_format-rate sample-format))
-                    )
-                (set-ao-handle-bits! handle bits)
-                (set-ao-handle-bytes-per-sample! handle bytes-per-sample)
-                (set-ao-handle-byte-format! handle endianness)
-                (set-ao-handle-rate! handle rate)
-                (set-ao-handle-channels! handle channels)
-                (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)
-                                          (ao-close handle)))
-                handle))
-            ))
-      )))
-              
-(define (ao-close handle)
-  
-  (define (close-device handle ao-device)
-    (if (eq? handle #f)
-        (begin
-          (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 (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)
-(define (abs x) (if (>= x 0) x (* x -1)))
-
-(define (make-sample-bytes sample bytes-per-sample endianess)
-  (letrec ((mk (lambda (i d)
-                 (if (< i bytes-per-sample)
-                     (cons (bitwise-and d 255)
-                           (mk (+ i 1) (arithmetic-shift d -8)))
-                     '()))))
-    (let ((bytes (mk 0 sample)))
-      (if (eq? endianess 'big-endian)
-          (reverse bytes)
-          bytes))))
-
-(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 (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))))
-         )
-    ;(displayln (format "bps: ~a, buf-len: ~a, endianess: ~a, channels: ~a, bits ~a"
-    ;                   bytes-per-sample buf-len endianess channels bits))
-    (letrec ((i 0)
-             (fill (lambda (k channel)
-                     (if (< k buf-len)
-                         (if (< channel channels)
-                             (let* ((sample (get-sample k channel))
-                                    (bytes (make-sample-bytes sample bytes-per-sample endianess))
-                                    )
-                               (for-each (lambda (byte)
-                                           (ptr-set! audio _byte i byte)
-                                           (set! i (+ i 1)))
-                                         bytes)
-                               ;; process sample
-                               (fill k (+ channel 1)))
-                             (fill (+ k 1) 0))
-                         'filled))
-                   ))
-      (fill 0 0)
-      (if (eq? libao-async-mode 'ffi)
-          (ffi:ao_play_async (ao-handle-async-player handle)
-                             (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)
-  (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)
-  (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)))
-;        (if (eq? ao-device #f)
-;            (error "No device for this handle")
-;            (ao_play ao-device audio audio-buf-len))))))
-
-
-
-

libflac-ffi.rkt

@@ -2,7 +2,7 @@
   
 (require ffi/unsafe
          ffi/unsafe/define
-         "../utils/utils.rkt"
+         "private/utils.rkt"
          )
 
 (provide flac-ffi-decoder-handler
@@ -16,7 +16,8 @@
 
 
 (define lib (get-lib '("libFLAC") '(#f)))
-(define-ffi-definer define-libflac lib)
+(define-ffi-definer define-libflac lib
+  #:default-make-fail make-not-available)
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;; Some FLAC Constants
@@ -595,7 +596,7 @@
       [(eq? cmd 'process-meta-data) (process-meta-data (car args))]
       [(eq? cmd 'process-write-data) (process-write-data (car args))]
       [(eq? cmd 'errno) error-no]
-      
+
       [(eq? cmd 'seek-to-sample) (seek-to-sample (car args))]
       [(eq? cmd 'file) flac-file]
       

main.rkt

@@ -1,12 +1,12 @@
 #lang racket/base
 
-(require "libao/libao.rkt"
-         "libflac/flac-decoder.rkt"
-         "libtag/taglib.rkt"
+(require "libao.rkt"
+         "flac-decoder.rkt"
+         "taglib.rkt"
          )
 
-(provide (all-from-out "libao/libao.rkt")
-         (all-from-out "libflac/flac-decoder.rkt")
-         (all-from-out "libtag/taglib.rkt")
+(provide (all-from-out "libao.rkt")
+         (all-from-out "flac-decoder.rkt")
+         (all-from-out "taglib.rkt")
          )
 

play-test.rkt

@@ -1,11 +1,13 @@
 #lang racket/base
-(require "libao/libao.rkt"
-         "libflac/flac-decoder.rkt"
+(require "libao.rkt"
+         "flac-decoder.rkt"
+         simple-log
          ;data/queue
   ;racket-sound
          )
 
 (define test-file3 #f)
+(define test-file3-id 3)
 (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"))
@@ -15,14 +17,15 @@
     )
   )
 
-(ao-set-async-mode! 'ffi)
 ;(define fmt (ao-mk-format 24 48000 2 'big-endian))
 ;(define ao-h (ao-open-live #f fmt))
 
 (define current-seconds 0)
 (define ao-h #f)
 
-(define (flac-play frame buffer)
+(sl-log-to-display)
+
+(define (flac-play frame buffer buf-len)
   (let* ((sample (hash-ref frame 'number))
          (rate (hash-ref frame 'sample-rate))
          (second (/ (* sample 1.0) (* rate 1.0)))
@@ -33,10 +36,11 @@
          (duration (hash-ref frame 'duration))
          )
     (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 (λ ()
+      (set! ao-h (ao-open-live bits-per-sample rate channels 'big-endian)))
+    ;(displayln 'ao-play)
+    (ao-play ao-h test-file3-id second duration buffer buf-len 'flac)
+    ;(displayln 'done)
+    (let ((second-printer (λ (buf-seconds)
                             (let ((s (inexact->exact (round (ao-at-second ao-h)))))
                               (unless (= s current-seconds)
                                 (set! current-seconds s)
@@ -45,14 +49,15 @@
                                       (tminutes (quotient duration 60))
                                       (tseconds (remainder duration 60))
                                       )
-                                (displayln (format "At time: ~a:~a (~a:~a)"
+                                (displayln (format "At time: ~a:~a (~a:~a) - ~a"
                                                    minutes seconds
                                                    tminutes tseconds
+                                                   buf-seconds
                                                    ))))))))
       (let* ((buf-size (ao-bufsize-async ao-h))
              (buf-seconds (exact->inexact (/ buf-size bytes-per-sample-all-channels rate))))
-        (second-printer)
-        (when (> buf-seconds 5)
+        (second-printer buf-seconds)
+        (when (> buf-seconds 30)
           (letrec ((waiter (λ ()
                              (let ((buf-seconds-left (exact->inexact
                                                       (/ (ao-bufsize-async ao-h)
@@ -61,8 +66,8 @@
                                (if (< buf-seconds-left 2.0)
                                    (displayln (format "Seconds in buffer left: ~a" buf-seconds-left))
                                    (begin
-                                     (sleep 0.5)
-                                     (second-printer)
+                                     (sleep 1)
+                                     (second-printer buf-seconds)
                                      (waiter)))))
                              ))
             (waiter))))

private/downloader.rkt

@@ -0,0 +1,170 @@
+#lang racket/base
+
+(require setup/dirs
+         net/sendurl
+         net/url
+         net/url-connect
+         net/dns
+         racket/file
+         racket/system
+         racket/string
+         file/unzip
+         )
+
+(provide download-soundlibs
+         soundlibs-clear-download!
+         soundlibs-version
+         soundlibs-directory
+         soundlibs-available?
+         soundlibs-downloadable?
+         soundlibs-resolves?
+         )
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; Version info of the version to download
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(define version-major 0)
+(define version-minor 1)
+(define version-patch 0)
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; Internal functions
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+
+(define download-version (format "~a-~a-~a"
+                                 version-major
+                                 version-minor
+                                 version-patch
+                                 ))
+
+(define download-site "git.dijkewijk.nl")
+(define base-path "hans/racket-sound-lib/releases/download")
+(define os (system-type 'os*))
+(define arch (system-type 'arch))
+
+(define download-url (format "https://~a/~a/~a/~a-~a.zip"
+                             download-site
+                             base-path
+                             download-version
+                             os
+                             arch))
+
+(define install-path (build-path (find-system-path 'addon-dir) "racket-sound-lib"))
+(define version-file (build-path install-path "version.txt"))
+(define ffi-path (build-path install-path (format "~a-~a" os arch)))
+
+(define (download-port link)
+  (let ((current-https-prot (current-https-protocol)))
+    (current-https-protocol 'secure)
+    (let* ((url (string->url link))
+           (port-in (get-pure-port url #:redirections 10)))
+      (current-https-protocol current-https-prot)
+      port-in)))
+
+
+(define (do-download port-in port-out)
+  (letrec ((downloader-func (λ (count next-c len)
+                              (let ((bytes (read-bytes 16384 port-in)))
+                                (if (eof-object? bytes)
+                                    count
+                                    (let ((read-len (bytes-length bytes)))
+                                      (when (> read-len 0)
+                                        (set! count (+ count read-len))
+                                        (when (> count next-c)
+                                          (display (format "~a..." count))
+                                          (set! next-c (+ count len)))
+                                        (write-bytes bytes port-out)
+                                        )
+                                      (downloader-func count next-c len)))))
+                            ))
+    (let ((count (downloader-func 0 100000 100000)))
+      (displayln (format "~a downloaded" count))
+      (close-input-port port-in)
+      (close-output-port port-out)
+      count)
+    )
+  )
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; Provided functions
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(define (soundlibs-available?)
+  (if (file-exists? version-file)
+      (with-handlers ([exn:fail? (λ (e) #f)])
+        (let ((v (file->value version-file)))
+          (and
+           (= (car v) version-major)
+           (= (cadr v) version-minor)
+           (= (caddr v) version-patch)))
+        )
+      #f))
+
+(define (soundlibs-directory)
+  (if (soundlibs-available?)
+      (build-path install-path (format "~a-~a" os arch))
+      #f))
+
+(define (soundlibs-resolves?)
+  (if (eq? (dns-find-nameserver) #f)
+    #f
+    (with-handlers ([exn:fail? (λ (e) #f)])
+      (dns-get-address (dns-find-nameserver) download-site)
+      #t)
+    )
+  )
+
+(define (soundlibs-version)
+  (if (soundlibs-available?)
+      (file->value version-file)
+      #f))
+
+(define (soundlibs-downloadable?)
+  (with-handlers ([exn:fail? (λ (e) #f)])
+    (let ((in (download-port download-url)))
+      (let ((d (input-port? in)))
+        (when d
+          (close-input-port in))
+        d))))
+
+(define (soundlibs-clear-download!)
+  (when (file-exists? version-file) 
+    (delete-file version-file)))
+
+(define (download-soundlibs)
+  (let ((in (download-port download-url)))
+    (unless (input-port? in)
+      (error (format "Cannot get a download port for '~a'" download-url)))
+    (unless (directory-exists? install-path)
+      (make-directory* install-path))
+    (let* ((file (build-path install-path "archive.zip"))
+           (out (open-output-file file #:exists 'replace))
+           )
+      (displayln (format "Downloading racket-webview-qt (~a)..." download-url))
+      (do-download in out)
+      (displayln (format "downloaded '~a'" file))
+      (when (directory-exists? ffi-path)
+        (displayln (format "Removing existing directory '~a'" ffi-path))
+        (delete-directory/files ffi-path))
+      (displayln "Unzipping...")
+      (let ((cd (current-directory)))
+        (current-directory install-path)
+        (unzip file #:preserve-attributes? #t #:preserve-timestamps? #t)
+        (current-directory cd))
+      (displayln "Removing zip archive")
+      (delete-file file)
+      (displayln "Writing version")
+      (let ((version (list version-major
+                           version-minor
+                           version-patch
+                           )))
+        (let ((out (open-output-file version-file #:exists 'replace)))
+          (write version out)
+          (close-output-port out)))
+      (displayln "Version file written; ready for FFI integration")
+      #t
+      )
+    )
+  )

private/utils.rkt

@@ -4,6 +4,8 @@
            racket/runtime-path
            ffi/unsafe
            setup/dirs
+           "downloader.rkt"
+           simple-log
            )
   
   (provide while
@@ -11,8 +13,15 @@
            build-lib-path
            get-lib
            do-for
+           dbg-sound
+           info-sound
+           err-sound
+           warn-sound
+           fatal-sound
            )
 
+  (sl-def-log racket-sound sound)
+
   (define-syntax while
     (syntax-rules ()
       ((_ cond body ...)
@@ -55,20 +64,16 @@
            (do-for-f))))))
 
 
-  (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)))))
+    (soundlibs-directory))
 
   (define (get-lib* libs-to-try orig-libs versions)
+    (unless (soundlibs-available?)
+      (download-soundlibs))
     (if (null? libs-to-try)
-        (error (format "Cannot find library, tried ~a" orig-libs)) 
+        (begin
+          (displayln (format "Warning: Cannot find library, tried ~a" orig-libs))
+          #f)
         (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))
@@ -77,4 +82,4 @@
   (define (get-lib libs-to-try versions)
     (get-lib* libs-to-try libs-to-try versions))
   
-  ) ; end of module
+) ; end of module

scrbl/.gitignore

@@ -0,0 +1,3 @@
+*.html
+*.js
+*.css

scrbl/flac-decoder.scrbl

@@ -0,0 +1,155 @@
+#lang scribble/manual
+
+@(require racket/base
+          (for-label racket/base
+                     racket/path
+                     "../flac-decoder.rkt"
+                     "../flac-definitions.rkt"))
+
+@title{flac-decoder}
+@author[@author+email["Hans Dijkema" "hans@dijkewijk.nl"]]
+
+@defmodule["racket-sound/flac-decoder"]
+
+This module provides a small decoder interface on top of the FLAC
+FFI layer. It opens a decoder for a file, reads stream metadata,
+reads audio frames, exposes the current decoder state, and allows
+an active read loop to be stopped. It also re-exports the bindings
+from @racketmodname["flac-definitions.rkt"].
+
+A decoder handle stores the native decoder handler together with
+optional callbacks for stream metadata and decoded audio.
+
+@section{Procedures}
+
+@defproc[(flac-open [flac-file* (or/c path? string?)]
+                    [cb-stream-info (or/c procedure? #f)]
+                    [cb-audio (or/c procedure? #f)])
+         (or/c flac-handle? #f)]{
+
+Opens a FLAC decoder for @racket[flac-file*]. If a path is given,
+it is converted with @racket[path->string]. If the file does not
+exist, the result is @racket[#f].
+
+Otherwise a native decoder handler is created with
+@racket[flac-ffi-decoder-handler], initialized with the file, and
+wrapped in a @racket[flac-handle]. The given callbacks are stored
+in the handle.
+
+When metadata of type @racket['streaminfo] is processed and
+@racket[cb-stream-info] is a procedure, it is called with a
+@racket[flac-stream-info] value.
+
+When decoded audio data is processed and @racket[cb-audio] is a
+procedure, it is called as
+@racket[(cb-audio header buffers)], where @racket[header] is a
+mutable hash containing the frame header fields plus
+@racket['duration], and @racket[buffers] is the decoded channel
+data returned by the FFI layer.
+}
+
+@defproc[(flac-stream-state [handle flac-handle?])
+         (or/c 'search-for-metadata
+               'read-metadata
+               'search-for-frame-sync
+               'read-frames
+               'end-of-stream
+               'ogg-error
+               'seek-error
+               'aborted
+               'memory-allocation-error
+               'uninitialized
+               'end-of-link)]{
+
+Returns the current decoder state reported by the native decoder
+handler.
+}
+
+@defproc[(flac-read [handle flac-handle?])
+         (or/c 'stopped-reading
+               'end-of-stream)]{
+
+Reads the stream by repeatedly calling the native decoder with
+@racket['process-single].
+
+Before reading starts, the handle fields @racket[stop-reading]
+and @racket[reading] are set to @racket[#f] and @racket[#t]. If a
+stop has been requested with @racket[flac-stop], reading ends
+with @racket['stopped-reading] and @racket[reading] is reset to
+@racket[#f].
+
+Whenever pending metadata is available, it is processed with
+@racket[process-meta]. For metadata of type
+@racket['streaminfo], a @racket[flac-stream-info] value is
+constructed, stored in the handle, and passed to the
+stream-info callback.
+
+Whenever pending frame data is available, it is processed with
+@racket[process-frame]. The frame header is converted to a
+mutable hash, extended with a @racket['duration] entry taken
+from @racket[flac-duration], and passed together with the
+decoded buffers to the audio callback.
+
+For each processed frame, the module also updates
+@racket[last-buffer], @racket[last-buf-len], and @racket[kinds].
+
+The procedure prints diagnostic messages for state changes,
+metadata, stream errors, and stop handling.
+}
+
+@defproc[(flac-read-meta [handle flac-handle?])
+         (or/c flac-stream-info? #f)]{
+
+Advances the decoder until the state becomes one of
+@racket['read-metadata], @racket['end-of-stream],
+@racket['aborted], @racket['memory-allocation-error], or
+@racket['uninitialized].
+
+If the resulting state is @racket['read-metadata], pending
+metadata is processed and the stored stream info is returned.
+Otherwise the result is @racket[#f].
+
+Only metadata of type @racket['streaminfo] is converted into a
+@racket[flac-stream-info] value by this module.
+}
+
+@defproc[(flac-stop [handle flac-handle?]) void?]{
+
+Requests termination of an active @racket[flac-read] loop by
+setting the handle field @racket[stop-reading] to @racket[#t].
+The procedure then waits until the handle field
+@racket[reading] becomes @racket[#f], sleeping for 10 ms between
+checks.
+
+The procedure prints timing information before and after the
+wait.
+}
+
+@section{Diagnostic bindings}
+
+@defthing[kinds hash?]{
+
+A mutable hash used to record the frame number kinds encountered
+during decoding. The keys are the values found in the
+frame-header field @racket['number-type].
+}
+
+@defthing[last-buffer (or/c #f list?)]{
+
+The most recently decoded buffer set produced by frame
+processing.
+}
+
+@defthing[last-buf-len (or/c #f exact-integer?)]{
+
+The block size of the most recently processed frame.
+}
+
+@section{Notes}
+
+The frame-header hash passed to the audio callback is produced
+by @racket[flac-ffi-frame-header]. In this module it is extended
+with a @racket['duration] field before the callback is called.
+
+All bindings from @racketmodname["flac-definitions.rkt"] are
+re-exported.

taglib-ffi.rkt

@@ -2,7 +2,8 @@
 
 (require ffi/unsafe
          ffi/unsafe/define
-         "../utils/utils.rkt"
+         "private/utils.rkt"
+         "private/downloader.rkt"
          )
 
 (provide TagLib_File_Type
@@ -64,10 +65,13 @@
 ;           #:fail (λ ()
 ;                    (error (format "Cannot find library ~a" l)))
 ;           ))
-  
+
+(define zlib (get-lib '("zlib" "libz") '(#f)))
 (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-ffi-definer define-tag-c-lib libtag_c
+  #:default-make-fail make-not-available)
 
 (define TagLib_File_Type
   (_enum '(

taglib.rkt

@@ -1,7 +1,7 @@
 (module taglib racket/base
 
   (require "taglib-ffi.rkt"
-           "../utils/utils.rkt"
+           "private/utils.rkt"
            racket/string
            racket/draw)
 
@@ -16,6 +16,9 @@
            tags-year
            tags-genre
            tags-track
+           tags-composer
+           tags-disc-number
+           tags-album-artist
            
            tags-length
            tags-sample-rate
@@ -152,6 +155,8 @@
               [(eq? v 'bit-rate) bit-rate]
               [(eq? v 'channels) channels]
               [(eq? v 'keys) (hash-keys key-store)]
+              [(eq? v 'album-artist) album-artist]
+              [(eq? v 'disc-number) disc-number]
               [(eq? v 'val)
                (if (null? args)
                    #f
@@ -207,6 +212,8 @@
     (tags-comment 'comment)
     (tags-genre 'genre)
     (tags-composer 'composer)
+    (tags-album-artist 'album-artist)
+    (tags-disc-number 'disc-number)
     (tags-year 'year)
     (tags-track 'track)
     
@@ -246,6 +253,8 @@
   (define (tags-picture->ext tags)
     (let ((mt (tags-picture->mimetype tags)))
       (cond
+        ((eq? mt #f)
+         #f)
         ((or (string-suffix? mt "/jpeg") (string-suffix? mt "/jpg"))
          'jpg)
         ((string-suffix? mt "/png")