info

libao-async will adjust the volume of the samples.

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

@@ -10,6 +10,7 @@
            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))
+      (set! last-buffer buffer)
+      (set! last-buf-len block-size)
       (hash-set! kinds type #t)
       (when (procedure? cb-audio)
-          (cb-audio h buffers))
-        ))
-    ;(displayln "Processing frame"))
+        (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,25 @@
 #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/libao.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 +27,6 @@
     "rackunit-lib"
     "scribble-lib"
     ))
+
+(define test-omit-paths 'all)
+

libao-async-ffi.rkt

@@ -4,36 +4,80 @@
 (require ffi/unsafe
          ffi/unsafe/define
          "private/utils.rkt"
-         "libao-ffi.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
+         ao_set_volume_async
+         ao_volume_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-ffi-definer define-libao-async lib)
+;(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 void *ao_create_async(void *ao_device, );
-(define-libao-async ao_create_async(_fun _pointer _fpointer -> _libao-async-handle-pointer))
+;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, 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 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))
 
@@ -46,3 +90,8 @@
 ;extern void ao_pause_async(void *handle, int pause);
 (define-libao-async ao_pause_async(_fun _libao-async-handle-pointer _int -> _void))
 
+;extern void ao_set_volume_async(void *handle, double percentage)
+(define-libao-async ao_set_volume_async (_fun _libao-async-handle-pointer _double -> _void))
+
+;extern double ao_volume_async(void *handle)
+(define-libao-async ao_volume_async (_fun _libao-async-handle-pointer -> _double))

libao-async.rkt

@@ -1,216 +0,0 @@
-#lang racket/base
-
-(require ffi/unsafe/os-thread
-         "private/utils.rkt"
-         "libao-ffi.rkt"
-         data/queue
-         )
-
-(provide ao_create_async
-         ao_stop_async
-         ao_play_async
-         ao_is_at_second_async
-         ao_music_duration_async
-         ao_bufsize_async
-         ao_clear_async
-         ao_pause_async
-         )
-
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;; 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-ffi.rkt

@@ -1,80 +0,0 @@
-#lang racket/base
-
-(require ffi/unsafe
-         ffi/unsafe/define
-         "private/utils.rkt"
-         )
-
-(provide ;_libao_pointer
-         AO-FMT-LITTLE AO-FMT-BIG AO-FMT-NATIVE
-         ao_initialize
-         ao_default_driver_id
-         ao_driver_id
-         ao_open_live
-         ao_play
-         ao_play_ptr
-         ao_close
-         ao_shutdown
-         ao_append_option
-         make-ao_sample_format
-         ao_sample_format-bits
-         ao_sample_format-rate
-         ao_sample_format-channels
-         ao_sample_format-byte_format
-         ao_sample_format-matrix
-         (all-from-out ffi/unsafe)
-         )
-
-
-(define ao_lib (get-lib '("libao") '("5" "4" "3" #f)))
-(define-ffi-definer define-libao ao_lib)
-
-(define _libao-pointer (_cpointer 'ao_device))
-(define-cstruct _ao_sample_format (
-                                   [bits _int]        ; bits per sample
-                                   [rate _int]        ; samples per second in a single channel
-                                   [channels _int]    ; number of audio channels
-                                   [byte_format _int] ; byte ordering in sample, see "constants" below
-                                   [matrix _pointer]  ; channel input matrix
-                                   ))
-
-(define-cstruct _ao_option (
-                            [key _pointer]
-                            [value _pointer]
-                            [next _pointer]   ; number of audio channels (list)
-                            ))
-
-(define AO-FMT-LITTLE  1)
-(define AO-FMT-BIG     2)
-(define AO-FMT-NATIVE  4)
-
-; void ao_initialize();
-(define-libao ao_initialize (_fun -> _void))
-
-; int ao_default_driver_id();
-(define-libao ao_default_driver_id (_fun -> _int))
-
-; ao_device* ao_open_live(int driver_id, ao_sample_format *format, ao_option *options);
-(define-libao ao_open_live (_fun _int _pointer _pointer -> _libao-pointer)) 
-
-; int ao_play(ao_device *device, char *output_samples, uint_32 num_bytes);
-(define-libao ao_play (_fun _libao-pointer _pointer _uint32 -> _int))
-
-(define ao_play_ptr (get-ffi-obj "ao_play" ao_lib _fpointer
-                                 (λ () (error 'ao_lib "libao does not provide 'ao_play'"))
-                                 ))
-
-; int ao_close(ao_device *device);
-(define-libao ao_close (_fun _libao-pointer -> _int))
-
-; void ao_shutdown();
-(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))
-
-; int ao_driver_id(char *short_name);
-(define-libao ao_driver_id (_fun _pointer -> _int))
-
-
-

libao.rkt

@@ -1,41 +1,36 @@
 #lang racket/base
 
-(define libao-async-mode 'ffi)   ; 'ffi or 'scheme
-
-(require "libao-ffi.rkt"
-         (prefix-in fin: finalizer)
+(require (prefix-in fin: finalizer)
          (prefix-in ffi: "libao-async-ffi.rkt")
-         (prefix-in scm: "libao-async.rkt")
          ffi/unsafe
+         ffi/unsafe/custodian
          data/queue
+         "private/utils.rkt"
+         (prefix-in rc: racket/contract)
          )
 
 (provide ao-open-live
          ao-play
-         ao-mk-format
          ao-close
-         ao-default-driver-id
          ao-at-second
          ao-music-duration
+         ao-at-music-id
          ao-bufsize-async
          ao-clear-async
-         ao-set-async-mode!
-         ao-async-mode
          ao-pause
+         ao-set-volume!
+         ao-volume
+         ao-valid?
+         ao-valid-bits?
+         ao-valid-rate?
+         ao-valid-channels?
+         ao-valid-format?
+         ao-handle?
+         ao-supported-music-format?
          )
 
-(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]
@@ -48,230 +43,159 @@
   #: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-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-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))
+(define (ao-valid-bits? bits)
+  (and (integer? bits) (or
+                        (= bits 8)
+                        (= bits 16)
+                        (= bits 24)
+                        (= bits 32))
        )
-                (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)
+  )
+
+(define (ao-valid-rate? rate)
+  (and (integer? rate)
+       (> rate 0)
+       (not (eq? (memq rate '(8000 11025 16000 22050 44100
+                                   48000 88200 96000 176400
+                                   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)))
-                handle))
-            ))
-      )))
 
-(define (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)
 
-  (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
+    (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)
-              (if (eq? libao-async-mode 'ffi)
+            handle)
           (begin
-                    (ffi:ao_clear_async (ao-handle-async-player handle))
+            (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))
-                    )
-                  (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)))
+     (set-ao-handle-async-player! handle #f)
      )
    )
   )
 
+(define (ao-valid? handle)
+  (and (ao-handle? handle)
+       (not (eq? (ao-handle-async-player handle) #f)))
+  )
 
-(define count 0)
-(define (abs x) (if (>= x 0) x (* x -1)))
+(define (any? x)
+  #t)
 
-(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)
+(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-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))))
+         (buf-info (ffi:make-BufferInfo_t buf-type bits rate channels endianess))
          )
-    ;(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)
+    (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)
-                             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)))      )
+                       buf-len
+                       buffer
+                       buf-info)
+    
     )
   )
 
-(define (ao-pause handle pause)
-  (if (eq? libao-async-mode 'ffi)
+(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))
-      (scm:ao_pause_async (ao-handle-async-player handle) pause)
-      ))
+  )
 
-(define (ao-at-second handle)
-  (if (eq? libao-async-mode 'ffi)
+(rc:define/contract (ao-at-second handle)
+  (rc:-> ao-handle? number?)
   (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)
+(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))
-      (scm:ao_music_duration_async (ao-handle-async-player handle))))
+  )
 
-(define (ao-bufsize-async handle)
-  (if (eq? libao-async-mode 'ffi)
+(rc:define/contract (ao-bufsize-async handle)
+  (rc:-> ao-handle? integer?)                    
   (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)
+(rc:define/contract (ao-set-volume! handle percentage)
+  (rc:-> ao-handle? number? void?)
+  (ffi:ao_set_volume_async (ao-handle-async-player handle)
+                           (if (integer? percentage)
+                               (exact->inexact percentage)
+                               percentage))
+  )
+
+(rc:define/contract (ao-volume handle)
+  (rc:-> ao-handle? number?)
+  (ffi:ao_volume_async (ao-handle-async-player handle))
+  )
+
+(rc:define/contract (ao-clear-async handle)
+  (rc:-> ao-handle? void?)
   (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

@@ -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

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)
@@ -44,15 +48,18 @@
                                       (seconds (remainder s 60))
                                       (tminutes (quotient duration 60))
                                       (tseconds (remainder duration 60))
+                                      (volume (ao-volume ao-h))
                                       )
-                                (displayln (format "At time: ~a:~a (~a:~a)"
+                                (displayln (format "At time: ~a:~a (~a:~a) - ~a - volume: ~a"
                                                    minutes seconds
                                                    tminutes tseconds
+                                                   buf-seconds
+                                                   volume
                                                    ))))))))
       (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 10)
           (letrec ((waiter (λ ()
                              (let ((buf-seconds-left (exact->inexact
                                                       (/ (ao-bufsize-async ao-h)
@@ -62,7 +69,17 @@
                                    (displayln (format "Seconds in buffer left: ~a" buf-seconds-left))
                                    (begin
                                      (sleep 0.5)
-                                     (second-printer)
+                                     (second-printer buf-seconds)
+                                     (when (= (round current-seconds) 20)
+                                       (ao-set-volume! ao-h 70.0))
+                                     (when (= (round current-seconds) 25)
+                                       (ao-set-volume! ao-h 30))
+                                     (when (= (round current-seconds) 30)
+                                       (ao-set-volume! ao-h 100))
+                                     (when (= (round current-seconds) 35)
+                                       (ao-set-volume! ao-h 150))
+                                     (when (= (round current-seconds) 40)
+                                       (ao-set-volume! ao-h 100))
                                      (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 1)
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; 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))

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.

scrbl/libao.scrbl

@@ -0,0 +1,211 @@
+#lang scribble/manual
+
+@(require racket/base
+          (for-label racket/base
+                     "../libao.rkt"))
+
+@title{libao}
+@author[@author+email["Hans Dijkema" "hans@dijkewijk.nl"]]
+
+@defmodule["libao.rkt"]
+
+This module provides a small high-level interface to an asynchronous
+audio output backend. It opens a live output device, queues audio
+buffers for playback, reports playback position, supports pause and
+buffer clearing, and exposes a small set of validation predicates.
+
+The central value is an @racket[ao-handle], created by
+@racket[ao-open-live]. An @racket[ao-handle] stores the playback
+configuration together with a native asynchronous player handle.
+
+@section{Audio handles}
+
+@defproc[(ao-handle? [v any/c]) boolean?]{
+
+Returns @racket[#t] if @racket[v] is an @racket[ao-handle] value, and
+@racket[#f] otherwise.
+}
+
+@defproc[(ao-valid? [handle ao-handle?]) boolean?]{
+
+Returns @racket[#t] if @racket[handle] still has a native asynchronous
+player, and @racket[#f] otherwise.
+
+A handle becomes invalid after @racket[ao-close], or when
+@racket[ao-open-live] failed to create the native player.
+}
+
+@section{Validation predicates}
+
+@defproc[(ao-valid-bits? [bits any/c]) boolean?]{
+
+Returns @racket[#t] if @racket[bits] is one of @racket[8],
+@racket[16], @racket[24], or @racket[32], and @racket[#f] otherwise.
+}
+
+@defproc[(ao-valid-rate? [rate any/c]) boolean?]{
+
+Returns @racket[#t] if @racket[rate] is one of the sample rates
+accepted by this module, and @racket[#f] otherwise.
+
+The accepted rates are:
+
+@itemlist[#:style 'compact
+ @item{@racket[8000], @racket[11025], @racket[16000], @racket[22050],}
+ @item{@racket[44100], @racket[48000], @racket[88200], @racket[96000],}
+ @item{@racket[176400], @racket[192000], @racket[352800], and}
+ @item{@racket[384000].}]
+}
+
+@defproc[(ao-valid-channels? [channels any/c]) boolean?]{
+
+Returns @racket[#t] if @racket[channels] is an integer greater than or
+equal to @racket[1], and @racket[#f] otherwise.
+}
+
+@defproc[(ao-valid-format? [format any/c]) boolean?]{
+
+Returns @racket[#t] if @racket[format] is one of
+@racket['little-endian], @racket['big-endian], or
+@racket['native-endian], and @racket[#f] otherwise.
+}
+
+@defproc[(ao-supported-music-format? [format any/c]) boolean?]{
+
+Returns @racket[#t] if @racket[format] is one of @racket['flac],
+@racket['mp3], or @racket['ao], and @racket[#f] otherwise.
+
+This value is used by @racket[ao-play] to describe the format of the
+buffer being queued.
+}
+
+@section{Opening and closing}
+
+@defproc[(ao-open-live [bits ao-valid-bits?]
+                       [rate ao-valid-rate?]
+                       [channels ao-valid-channels?]
+                       [byte-format ao-valid-format?])
+         ao-handle?]{
+
+Creates an audio output handle for live playback.
+
+The handle stores the given sample size, sample rate, channel count,
+and byte format. It then tries to create a native asynchronous player.
+
+If the native player is created successfully, the returned handle is
+valid. If player creation fails, the function still returns an
+@racket[ao-handle], but that handle is marked closed and is not valid
+for playback.
+
+A finalizer is registered for the handle and calls @racket[ao-close]
+when the handle is reclaimed.
+}
+
+@defproc[(ao-close [handle ao-handle?]) void?]{
+
+Stops playback for @racket[handle] and releases the native player
+reference stored in the handle.
+
+If the handle already has no native player, this procedure has no
+effect.
+}
+
+@section{Playback}
+
+@defproc[(ao-play [handle ao-handle?]
+                  [music-id integer?]
+                  [at-time-in-s number?]
+                  [music-duration-s number?]
+                  [buffer any/c]
+                  [buf-len integer?]
+                  [buf-type ao-supported-music-format?])
+         void?]{
+
+Queues audio data for asynchronous playback.
+
+The @racket[music-id] argument identifies the music stream associated
+with the buffer. The arguments @racket[at-time-in-s] and
+@racket[music-duration-s] describe the position and duration, in
+seconds, associated with the buffer. The arguments @racket[buffer] and
+@racket[buf-len] provide the audio data and its length. The
+@racket[buf-type] argument specifies the buffer format.
+
+The buffer description passed to the native layer is completed with the
+sample size, sample rate, channel count, and byte format stored in
+@racket[handle].
+
+If @racket[handle] is not valid, this procedure raises an exception.
+}
+
+@defproc[(ao-pause [handle ao-handle?]
+                   [pause boolean?])
+         void?]{
+
+Pauses or resumes asynchronous playback for @racket[handle].
+
+A true value pauses playback. @racket[#f] resumes playback.
+}
+
+@defproc[(ao-clear-async [handle ao-handle?]) void?]{
+
+Clears buffered asynchronous playback data for @racket[handle].
+}
+
+@section{Playback state}
+
+@defproc[(ao-at-second [handle ao-handle?]) number?]{
+
+Returns the current playback position, in seconds, as reported by the
+native asynchronous player.
+}
+
+@defproc[(ao-at-music-id [handle ao-handle?]) integer?]{
+
+Returns the music identifier currently reported by the native
+asynchronous player.
+}
+
+@defproc[(ao-music-duration [handle ao-handle?]) number?]{
+
+Returns the duration of the current music stream, in seconds, as
+reported by the native asynchronous player.
+}
+
+@defproc[(ao-bufsize-async [handle ao-handle?]) integer?]{
+
+Returns the current buffered size in bytes for the asynchronous player.
+}
+
+@section{Volume control}
+
+@defproc[(ao-set-volume! [handle ao-handle?]
+                         [percentage number?])
+         void?]{
+
+Sets the playback volume for @racket[handle].
+
+If @racket[percentage] is an exact integer, it is converted to an
+inexact number before it is passed to the native layer.
+}
+
+@defproc[(ao-volume [handle ao-handle?]) number?]{
+
+Returns the current playback volume as reported by the native
+asynchronous player.
+}
+
+@section{Notes}
+
+This module is a higher-level wrapper around the asynchronous FFI layer.
+It stores the playback configuration in the handle, and reuses that
+configuration for each call to @racket[ao-play].
+
+The module does not expose the handle fields directly. The public API
+is intentionally small: create a handle, queue buffers, inspect
+position and buffer state, pause or clear playback, adjust volume, and
+close the handle.
+
+A typical usage pattern is to open one live handle for a given stream
+format, queue decoded buffers with @racket[ao-play], and query the
+playback position with @racket[ao-at-second] while playback proceeds
+asynchronously.

taglib-ffi.rkt

@@ -3,6 +3,7 @@
 (require ffi/unsafe
          ffi/unsafe/define
          "private/utils.rkt"
+         "private/downloader.rkt"
          )
 
 (provide TagLib_File_Type
@@ -65,9 +66,12 @@
 ;                    (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

@@ -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")