index

The file id is now a randomized number

Makefile

@@ -0,0 +1,7 @@
+
+
+all:
+	@echo "make clean to cleanup bak/~ files"
+
+clean:
+	rm -f *~ *.bak scrbl/*~ scrbl/*.bak private/*~ private/*.bak

README.md

@@ -1,14 +1,169 @@
 # racket-audio
 
-Integration of common audio libraries in racket.
+Integration of common audio libraries in Racket.
 
-## Mac OS X
+The package contains decoder, player and encoder bindings.  Playback uses the
+existing audio player modules.  Encoding is provided by `audio-encoder.rkt` with
+Opus and FLAC backends.
 
-Make sure you have libao, libFLAC, mpg123 and ffmpeg-full installed using brew.
+## Native dependencies
 
-% brew install libao
+For playback and decoding, install the native libraries used by the selected
-% brew install flac
+backends:
-% brew install mpg123
+
-% brew install ffmpeg-full
+- libao
+- libFLAC
+- mpg123
+- FFmpeg libraries, including libavutil, libavcodec and libavformat
+
+For encoding, also install:
+
+- libopusenc
+- libopus
+- libogg
+- TagLib with the C binding, usually provided as `taglib` / `taglib_c`
+- libsoxr, used by `resampler.rkt` and encoder-side PCM sample-rate conversion
+
+The Opus encoder backend uses libopusenc directly.  The FLAC encoder backend
+uses libFLAC directly.  FLAC sample-rate conversion uses `resampler.rkt`, backed by libsoxr.  Metadata and cover-art copying use the TagLib wrapper; the
+public `taglib.rkt` API also supports read-write tag editing.
 
 
+## Debian / Ubuntu
+
+On Debian-like systems, install the runtime and development packages for the
+selected backends.  A typical full setup is:
+
+```sh
+sudo apt install \
+  libao-dev \
+  libflac-dev \
+  libmpg123-dev \
+  ffmpeg \
+  libavutil-dev libavcodec-dev libavformat-dev libswresample-dev \
+  libogg-dev libopus-dev libopusenc-dev libopusfile-dev \
+  libsoxr-dev libtag1-dev
+```
+
+For Opus encoding, `libopusenc-dev` is required.  For Opus decoding through
+`opusfile-decoder.rkt`, install `libopusfile-dev` as well.
+
+## macOS
+
+Using Homebrew, install the native libraries before using the package:
+
+```sh
+brew install libao
+brew install flac
+brew install mpg123
+brew install ffmpeg
+brew install opus
+brew install libopusenc
+brew install libsoxr
+brew install taglib
+```
+
+Some Homebrew installations provide FFmpeg as `ffmpeg`; older local setups may
+use `ffmpeg-full`.
+
+
+## Windows
+
+On Windows, the package downloader fetches the native DLL bundle from the
+Codeberg `racket-sound-lib` release area.  The current bundle URL pattern is:
+
+```text
+https://codeberg.org/hnmdijkema/racket-sound-lib/releases/download/1-1-2/windows-x86_64.zip
+```
+
+The archive is installed below Racket's addon directory by
+`download-soundlibs`.
+
+## Encoder examples
+
+Encode to Opus:
+
+```racket
+(require "audio-encoder.rkt")
+
+(audio-encode "input.flac"
+              "output.opus"
+              (hash 'bitrate 224000
+                    'vbr? #t
+                    'complexity 10)
+              #:encoder 'opus)
+```
+
+Encode 96 kHz FLAC to 48 kHz FLAC:
+
+```racket
+(audio-encode "input-96k.flac"
+              "output-48k.flac"
+              (hash 'sample-rate 48000
+                    'bits-per-sample 24
+                    'compression-level 8)
+              #:encoder 'flac)
+```
+
+A small test wrapper is available in `encoder-test.rkt`:
+
+```sh
+racket encoder-test.rkt --encoder opus --input input.flac --output output.opus --bitrate-kbps 224
+racket encoder-test.rkt --encoder flac --input input-96k.flac --output output-48k.flac --sample-rate 48000
+```
+
+## Placed player stdio mode
+
+The placed player can also run as a standard-port worker.  In that mode the
+three existing logical channels are mapped to standard streams:
+
+```text
+stdin   command channel
+stdout  reply channel
+stderr  event channel
+```
+
+Because stdout and stderr are protocol streams in this mode, ordinary display
+and log output is redirected.  By default, `placed-player/stdio` appends such
+output to a log file below Racket's standard cache directory, for example
+`~/.cache/racket/racket-audio/placed-audio-player-stdio.log` on many Unix-like
+systems.  Pass `#:log-file #f` to discard ordinary output, or pass a path to
+choose a different log file.
+
+## Remote placed player over SSH
+
+The placed player can also be started as a remote subprocess over SSH.  In this
+mode the existing three logical player channels are kept separate:
+
+```text
+stdin   command channel
+stdout  reply channel
+stderr  event channel
+```
+
+The remote worker is normally started as:
+
+```sh
+racket -l racket-audio/audio-placed-player -- --stdio
+```
+
+The worker redirects ordinary logging to a cache log file so that stdout and
+stderr remain serialized protocol streams.  SSH, the remote Racket command and
+the remote module are configured in `racket-audio.ini`.  The public
+`make-audio-player` API only needs the remote host and, when necessary, base
+path replacements.
+
+Example:
+
+```racket
+(define player
+  (make-audio-player cb-state cb-eof
+                     #:remote-host "nas"
+                     #:replace-base-paths
+                     (list (cons "/muziek" "/volume1/music"))))
+
+(audio-play! player "/muziek/klassiek/track.flac")
+```
+
+The remote host must be able to read the translated path.  In the example above,
+the remote worker receives `/volume1/music/klassiek/track.flac`.

audio-decoder.rkt

@@ -2,12 +2,15 @@
 
   (require "flac-decoder.rkt"
            "mp3-decoder.rkt"
+           "opusfile-decoder.rkt"
            "ffmpeg-decoder.rkt"
            "audio-sniffer.rkt"
            "private/utils.rkt"
+           "audio-errors.rkt"
            racket/contract
            racket/string
            racket/path
+           racket-mimetypes
            )
 
   (provide audio-open
@@ -22,6 +25,10 @@
            make-audio-reader
            audio-handle?
            audio-supported-extensions
+           audio-supported-formats
+           audio-decoder-for-extension
+           current-opusfile-output-format
+           opusfile-output-format?
            )
 
   ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
@@ -56,7 +63,18 @@
                                 mp3-stop
                                 'ao))
 
-  ;; FFmpeg decodere
+  ;; Opus, via Xiph libopusfile
+  (hash-set! audio-readers
+             'opusfile
+             (make-audio-reader '("opus")
+                                opusfile-valid?
+                                opusfile-open
+                                opusfile-read
+                                opusfile-seek
+                                opusfile-stop
+                                'ao))
+
+  ;; FFmpeg decoder
   (hash-set! audio-readers
              'ffmpeg
              (make-audio-reader '("ogg" "oga" "opus"
@@ -92,6 +110,20 @@
   (define (audio-supported-extensions)
     known-extensions)
 
+  (define/contract (audio-supported-formats)
+    (-> (listof
+         (cons/c string?
+                 string?)))
+    (for/list ((extension
+                (in-list known-extensions)))
+      (cons
+       extension
+       (mimetype-for-ext
+        (string-append "audio."
+                       extension)
+        #:default
+        "application/octet-stream"))))
+
   ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
   ;; Register audio reader
   ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
@@ -112,6 +144,7 @@
      (driver #:mutable)
      (driver-handle #:mutable)
      )
+    #:transparent
     )
 
   (define (audio-known-exts?)
@@ -178,13 +211,20 @@
     (let ((file (if (path? audio-file)
                     (path->string audio-file)
                     audio-file)))
-      (unless (audio-file-valid? audio-file)
+
-        (error (format "Not a valid audio file '~a'" audio-file)))
       (unless (file-exists? audio-file)
-        (error (format "File '~a' does not exist" audio-file)))
+        (raise-audio-error 'file-not-found
+                           "File not found: '~a'" audio-file))
+
+      (unless (audio-file-valid? audio-file)
+        (raise-audio-error 'invalid-audio-file
+                           "Not a valid audio file: '~a'" audio-file))
+      
       (let ((reader* (find-reader audio-file)))
         (when (eq? reader* #f)
-          (error (format "Cannot find reader for '~a'" audio-file)))
+          (raise-audio-error 'no-audio-reader
+                             "Cannot find reader for '~a'" audio-file))
+
         (let* ((reader-type (car reader*))
                (reader (cadr reader*))
                (ao-type (audio-reader-ao-type reader))
@@ -216,6 +256,7 @@
 
   (define/contract (audio-stop handle)
     (-> audio-handle? void?)
+    (dbg-sound "audio-stop called")
     (let ((stopper (audio-reader-stopper (audio-handle-driver handle))))
       (void (stopper (audio-handle-driver-handle handle)))))
       
@@ -227,21 +268,31 @@
     (not (null? (filter (λ (e) (string-ci=? ext e)) (audio-reader-exts reader)))))
 
   (define reader-for-kind
-    (make-hash '((mp3 . ffmpeg)            ; ffmpeg does a better job on gapless playback...
+    (make-hash
-                 (flac . flac)
+     (list (cons 'mp3 'ffmpeg)            ; ffmpeg does a better job on gapless playback...
-                 (ogg . ffmpeg)
+           (cons 'flac 'flac)
-                 (vorbis . ffmpeg)
+           (cons 'ogg 'ffmpeg)
-                 (opus . ffmpeg)
+           (cons 'vorbis 'ffmpeg)
-                 (wav . ffmpeg)
+           (cons 'opus (if (opusfile-available?) 'opusfile 'ffmpeg))
-                 (aiff . ffmpeg)
+           (cons 'wav 'ffmpeg)
-                 (mp4 . ffmpeg)
+           (cons 'aiff 'ffmpeg)
-                 (aac . ffmpeg)
+           (cons 'mp4 'ffmpeg)
-                 (alac . ffmpeg)
+           (cons 'aac 'ffmpeg)
-                 (ac3 . ffmpeg)
+           (cons 'alac 'ffmpeg)
-                 (ape . ffmpeg)
+           (cons 'ac3 'ffmpeg)
-                 (wavpack . ffmpeg)
+           (cons 'ape 'ffmpeg)
-                 (wma . ffmpeg)
+           (cons 'wavpack 'ffmpeg)
-                 (matroska . ffmpeg))))
+           (cons 'wma 'ffmpeg)
+           (cons 'matroska 'ffmpeg))))
+
+  (define/contract (audio-decoder-for-extension extension)
+    (-> (or/c string? symbol?)
+        (or/c #f symbol?))
+    (hash-ref
+     reader-for-kind
+     (audio-format-for-extension extension)
+     #f))
+
 
 
   (define (find-reader audio-file)
@@ -260,4 +311,4 @@
 ) ; end of module
           
 
-           
+           

audio-encoder.rkt

@@ -0,0 +1,287 @@
+(module audio-encoder racket/base
+
+  (require racket/path
+           racket/string
+           racket/contract
+           racket/runtime-path
+           "flac-encoder.rkt"
+           "opus-encoder.rkt"
+           "taglib.rkt"
+           "private/pcm-converter.rkt"
+           "private/utils.rkt")
+
+  (provide audio-encode
+           audio-supported-encoder-extensions
+           audio-register-encoder!
+           make-audio-encoder
+           audio-encoder?)
+
+  (define-struct audio-encoder (exts open write finish settings))
+
+  (define-runtime-module-path-index audio-decoder-module "audio-decoder.rkt")
+
+  (define audio-encoders (make-hash))
+
+  (define (audio-register-encoder! type encoder)
+    (hash-set! audio-encoders type encoder))
+
+  (audio-register-encoder!
+   'flac
+   (make-audio-encoder '("flac")
+                       flac-encoder-open
+                       flac-encoder-write
+                       flac-encoder-finish
+                       flac-encoder-prepare-settings))
+
+  (audio-register-encoder!
+   'opus
+   (make-audio-encoder '("opus" "oga")
+                       opus-encoder-open
+                       opus-encoder-write
+                       opus-encoder-finish
+                       opus-encoder-prepare-settings))
+
+  (define (audio-supported-encoder-extensions)
+    (apply append (map audio-encoder-exts (hash-values audio-encoders))))
+
+  (define (path-extension-symbol file)
+    (let ((ext (path-get-extension (build-path file))))
+      (and ext (string->symbol (string-downcase (substring (bytes->string/utf-8 ext) 1))))))
+
+  (define (encoder-for-output output-file explicit-kind)
+    (let ((kind (or explicit-kind (path-extension-symbol output-file))))
+      (cond [(and kind (hash-ref audio-encoders kind #f)) (values kind (hash-ref audio-encoders kind))]
+            [else (error 'audio-encode "cannot infer encoder from output file ~a" output-file)])))
+
+  (define (tag-value-copy! src dst getter setter empty?)
+    (let ((v (getter src)))
+      (unless (empty? v) (setter dst v))))
+
+  (define (empty-string? v) (or (eq? v #f) (and (string? v) (string=? v ""))))
+  (define (empty-number? v) (or (eq? v #f) (and (number? v) (< v 0))))
+
+  (define (merge-hash a b)
+    (let ((out (make-hash)))
+      (when (hash? a)
+        (for-each (lambda (k) (hash-set! out k (hash-ref a k))) (hash-keys a)))
+      (when (hash? b)
+        (for-each (lambda (k) (hash-set! out k (hash-ref b k))) (hash-keys b)))
+      out))
+
+  (define (copy-hash h)
+    (let ((out (make-hash)))
+      (when (hash? h)
+        (for-each (lambda (k) (hash-set! out k (hash-ref h k))) (hash-keys h)))
+      out))
+
+  (define (maybe-string s) (and (string? s) (not (string=? s "")) s))
+  (define (maybe-number n) (and (number? n) (>= n 0) (number->string n)))
+
+  (define (source-tags->opus-settings input-file settings)
+    ;; For Opus, embedded pictures must be written into the OpusTags packet
+    ;; before the encoder starts.  TagLib post-processing is not reliable for
+    ;; this path, so transfer the regular comments and cover art through
+    ;; libopusenc comments instead.
+    (with-handlers ([exn:fail? (lambda (e)
+                                 (warn-sound "Could not read source tags from ~a for Opus comments: ~a"
+                                             input-file (exn-message e))
+                                 settings)])
+      (call-with-id3-tags
+       input-file
+       (lambda (src)
+         (if (not (tags-valid? src))
+             settings
+             (let ((out (copy-hash settings))
+                   (comments (make-hash)))
+               (let ((title (maybe-string (tags-title src)))) (when title (hash-set! comments 'title title)))
+               (let ((album (maybe-string (tags-album src)))) (when album (hash-set! comments 'album album)))
+               (let ((artist (maybe-string (tags-artist src)))) (when artist (hash-set! comments 'artist artist)))
+               (let ((comment (maybe-string (tags-comment src)))) (when comment (hash-set! comments 'comment comment)))
+               (let ((genre (maybe-string (tags-genre src)))) (when genre (hash-set! comments 'genre genre)))
+               (let ((composer (maybe-string (tags-composer src)))) (when composer (hash-set! comments 'composer composer)))
+               (let ((album-artist (maybe-string (tags-album-artist src)))) (when album-artist (hash-set! comments 'albumartist album-artist)))
+               (let ((year (maybe-number (tags-year src)))) (when year (hash-set! comments 'date year)))
+               (let ((track (maybe-number (tags-track src)))) (when track (hash-set! comments 'tracknumber track)))
+               (let ((disc (tags-disc-number src)))
+                 (cond [(string? disc) (unless (string=? disc "") (hash-set! comments 'discnumber disc))]
+                       [(and (number? disc) (>= disc 0)) (hash-set! comments 'discnumber (number->string disc))]
+                       [else (void)]))
+               (unless (null? (hash-keys comments)) (hash-set! out 'comments comments))
+               (let ((picture (tags-picture src)))
+                 (unless (eq? picture #f) (hash-set! out 'picture picture)))
+               out)))
+       #:mode 'read)))
+
+  (define (make-tag-result method success? picture note)
+    (let ((h (make-hash)))
+      (hash-set! h 'method method)
+      (hash-set! h 'success? success?)
+      (hash-set! h 'picture? (not (eq? picture #f)))
+      (when (id3-picture? picture)
+        (hash-set! h 'picture-size (id3-picture-size picture))
+        (hash-set! h 'picture-mimetype (id3-picture-mimetype picture)))
+      (when note (hash-set! h 'note note))
+      h))
+
+  (define (copy-tags! input-file output-file)
+    (with-handlers ([exn:fail? (lambda (e)
+                                 (warn-sound "Could not copy tags from ~a to ~a: ~a"
+                                             input-file output-file (exn-message e))
+                                 (make-tag-result 'taglib-post-copy #f #f (exn-message e)))])
+      (call-with-id3-tags
+       input-file
+       (lambda (src)
+         (call-with-id3-tags
+          output-file
+          (lambda (dst)
+            (if (and (tags-valid? src) (tags-valid? dst))
+                (begin
+                  (tag-value-copy! src dst tags-title tags-title! empty-string?)
+                  (tag-value-copy! src dst tags-album tags-album! empty-string?)
+                  (tag-value-copy! src dst tags-artist tags-artist! empty-string?)
+                  (tag-value-copy! src dst tags-comment tags-comment! empty-string?)
+                  (tag-value-copy! src dst tags-genre tags-genre! empty-string?)
+                  (tag-value-copy! src dst tags-composer tags-composer! empty-string?)
+                  (tag-value-copy! src dst tags-album-artist tags-album-artist! empty-string?)
+                  (tag-value-copy! src dst tags-year tags-year! empty-number?)
+                  (tag-value-copy! src dst tags-track tags-track! empty-number?)
+                  (tag-value-copy! src dst tags-disc-number tags-disc-number! empty-number?)
+                  (let ((picture (tags-picture src)))
+                    (unless (eq? picture #f) (tags-picture! dst picture))
+                    (tags-save! dst)
+                    (make-tag-result 'taglib-post-copy #t picture #f)))
+                (make-tag-result 'taglib-post-copy #f #f "source or destination tags invalid")))
+          #:mode 'read-write))
+       #:mode 'read)))
+
+  (define (input-frames-in-buffer fmt buf-len)
+    (let* ((channels (hash-ref fmt 'channels 1))
+           (bits (hash-ref fmt 'bits-per-sample (hash-ref fmt 'pcm-bits-per-sample 16)))
+           (bytes-per-sample (max 1 (quotient bits 8)))
+           (frame-bytes (* channels bytes-per-sample)))
+      (if (> frame-bytes 0) (quotient buf-len frame-bytes) 0)))
+
+  (define (total-input-frames fmt)
+    (and (hash? fmt)
+         (or (hash-ref fmt 'total-samples #f)
+             (hash-ref fmt 'total-frames #f)
+             (hash-ref fmt 'frames #f))))
+
+  (define (audio-encode input-file output-file settings
+                        #:encoder [explicit-kind #f]
+                        #:copy-tags? [copy-tags? #t]
+                        #:progress-callback [progress-callback #f])
+    (define-values (kind encoder) (encoder-for-output output-file explicit-kind))
+    (define effective-settings (if (and copy-tags? (eq? kind 'opus))
+                                   (source-tags->opus-settings input-file settings)
+                                   settings))
+    (define backend-handle #f)
+    (define format #f)
+    (define output-format #f)
+    (define converter #f)
+    (define frames-written 0)
+    (define frames-read 0)
+    (define last-progress -1.0)
+    (define tags-result #f)
+
+    (define (progress! phase input-format)
+      (when progress-callback
+        (let* ((total (total-input-frames input-format))
+               (progress (and (integer? total) (> total 0)
+                              (min 1.0 (/ frames-read total))))
+               (h (make-hash)))
+          (hash-set! h 'phase phase)
+          (hash-set! h 'encoder kind)
+          (hash-set! h 'input input-file)
+          (hash-set! h 'output output-file)
+          (hash-set! h 'frames-read frames-read)
+          (hash-set! h 'frames-written frames-written)
+          (hash-set! h 'total-frames total)
+          (hash-set! h 'progress progress)
+          (hash-set! h 'input-format input-format)
+          (when output-format (hash-set! h 'output-format output-format))
+          (progress-callback h)
+          (when (number? progress) (set! last-progress progress)))))
+
+    (define (ensure-open! fmt)
+      (when (eq? backend-handle #f)
+        ;; Record the resolved output format, not merely the incoming PCM format.
+        ;; This matters when only FLAC bit depth changes, because no swresample
+        ;; converter is needed but the resulting FLAC stream metadata still differs.
+        (set! output-format ((audio-encoder-settings encoder) effective-settings fmt))
+        (set! backend-handle ((audio-encoder-open encoder) output-file effective-settings fmt))))
+
+    (define (write-backend! fmt buffer buf-len)
+      (ensure-open! fmt)
+      (set! frames-written (+ frames-written ((audio-encoder-write encoder) backend-handle fmt buffer buf-len))))
+
+    (define (ensure-converter! input-format)
+      ;; FLAC may need conversion because the caller requested a target sample
+      ;; rate or bit depth.  Opus is deliberately not routed through this
+      ;; converter by default: libopusenc accepts the source input rate and has
+      ;; its own resampler, and opus-encoder.rkt feeds it float PCM directly.
+      (when (and (eq? kind 'flac) (eq? converter #f))
+        (when (pcm-conversion-needed? input-format effective-settings)
+          (set! converter (make-pcm-converter input-format effective-settings)))))
+
+    (define (write-converted! input-format buffer buf-len)
+      (ensure-converter! input-format)
+      (cond [converter
+             (let-values (((out out-samples) (pcm-converter-convert converter buffer buf-len input-format)))
+               (when (> out-samples 0)
+                 (write-backend! (pcm-converter-output-format converter) out (bytes-length out))))]
+            [else (write-backend! input-format buffer buf-len)]))
+
+    (define (drain-converter!)
+      (when converter
+        (let loop ()
+          (let-values (((out out-samples) (pcm-converter-drain converter)))
+            (when (> out-samples 0)
+              (write-backend! (pcm-converter-output-format converter) out (bytes-length out))
+              (loop))))))
+
+    (define (on-format audio-kind ao-kind handle fmt)
+      ;; Keep stream metadata, but delay encoder creation until the first audio
+      ;; buffer.  Some decoders report an output-oriented stream format first
+      ;; and then the exact PCM frame format in buf-info.
+      (set! format fmt)
+      (progress! 'format fmt))
+
+    (define (on-audio audio-kind ao-kind handle buf-info buffer buf-len)
+      (let ((effective-format (merge-hash format buf-info)))
+        (set! format effective-format)
+        (set! frames-read (+ frames-read (input-frames-in-buffer effective-format buf-len)))
+        (write-converted! effective-format buffer buf-len)
+        (progress! 'audio effective-format)))
+
+    (let* ((audio-open-proc (dynamic-require audio-decoder-module 'audio-open))
+           (audio-read-proc (dynamic-require audio-decoder-module 'audio-read))
+           (decoder (audio-open-proc input-file on-format on-audio)))
+      (dynamic-wind
+       void
+       (lambda () (audio-read-proc decoder))
+       (lambda ()
+         (dynamic-wind
+          drain-converter!
+          (lambda () (when backend-handle ((audio-encoder-finish encoder) backend-handle)))
+          (lambda () (when converter (pcm-converter-close! converter)))))))
+
+    (progress! 'finished-encoding format)
+    (set! tags-result
+          (cond [(not copy-tags?) (make-tag-result 'none #t #f "tag copy disabled")]
+                [(eq? kind 'opus)
+                 (make-tag-result 'libopusenc-comments #t (hash-ref effective-settings 'picture #f) #f)]
+                [else (copy-tags! input-file output-file)]))
+    (progress! 'finished format)
+    (let ((r (make-hash)))
+      (hash-set! r 'encoder kind)
+      (hash-set! r 'input input-file)
+      (hash-set! r 'output output-file)
+      (hash-set! r 'input-format format)
+      (hash-set! r 'output-format output-format)
+      (hash-set! r 'frames-read frames-read)
+      (hash-set! r 'frames-written frames-written)
+      (hash-set! r 'tag-copy tags-result)
+      r))
+
+  ) ; end of module

audio-errors.rkt

@@ -0,0 +1,61 @@
+#lang racket/base
+
+(require (for-syntax racket/base)
+         racket/path)
+
+
+(provide exn:fail:audio
+         exn:fail:audio?
+         exn:fail:audio-code
+         raise-audio-error
+         make-audio-error-code
+         exn-audio-code
+         )
+
+(struct exn:fail:audio exn:fail
+  (code source line)
+  #:transparent)
+
+(define exn-audio-code exn:fail:audio-code)
+
+(define (audio-codes)
+  '(no-decoder no-encoder
+    file-not-found
+    invalid-audio-file
+    no-audio-reader
+    audio-file-corrupt
+    audio-error))
+
+(define (make-audio-code code)
+  (if (symbol? code)
+      (letrec ((f (λ (l)
+                    (if (null? (cdr l))
+                        (car l)
+                        (if (eq? (car l) code)
+                            code
+                            (f (cdr l)))))))
+        (f (audio-codes)))
+      (make-audio-code (string->symbol (format "~a" code)))))
+
+(define (make-audio-error-code c)
+  (make-audio-code c))
+
+
+(define (raise-audio-error* code source line message . args)
+  (let* ((msg (apply format (cons message args)))
+         (src* (file-name-from-path (build-path source)))
+         (msg* (format "~a at ~a, line ~a" msg src* line)))
+      (raise (exn:fail:audio msg*
+                             (current-continuation-marks)
+                             (make-audio-code code)
+                             source
+                             line))))
+
+(define-syntax (raise-audio-error stx)
+  (syntax-case stx ()
+    ((_ code message ...)
+     (let ((src (syntax-source stx))
+           (line (syntax-line stx)))
+       #`(raise-audio-error* code '#,src '#,line message ...)))))
+
+

audio-placed-player.rkt

@@ -0,0 +1,595 @@
+#lang racket/base
+
+(require racket/port
+         port-channel
+         uni-channel
+         "libao.rkt"
+         "audio-decoder.rkt"
+         "audio-errors.rkt"
+         "private/utils.rkt"
+         early-return
+         )
+
+(provide placed-player
+         placed-player/stdio
+         audio-known-exts?
+         )
+
+(define get-current-seconds current-seconds)
+
+(define (placed-player/stdio #:log-file [log-file (racket-sound-log-file 'placed-audio-player-stdio)])
+  (define stdin-ch
+    (make-uni-channel
+     (make-port-channel (current-input-port) #:direction 'input #:source 'stdin #:close? #f)))
+  (define stdout-ch
+    (make-uni-channel
+     (make-port-channel (current-output-port) #:direction 'output #:source 'stdout #:close? #f)))
+  (define stderr-ch
+    (make-uni-channel
+     (make-port-channel (current-error-port) #:direction 'output #:source 'stderr #:close? #f)))
+  (define log-port (if log-file (open-racket-sound-log-file log-file) (open-output-nowhere)))
+  (dynamic-wind
+   void
+   (lambda ()
+     ;; stdout and stderr are protocol channels in this mode.  Redirect ordinary
+     ;; output so that display/log output cannot corrupt the serialized channel
+     ;; streams.
+     (parameterize ([current-output-port log-port]
+                    [current-error-port log-port])
+       (placed-player stdin-ch stdout-ch stderr-ch)))
+   (lambda ()
+     (with-handlers ([exn:fail? void]) (close-output-port log-port)))))
+
+(define (eq-seconds? s1 s2)
+  (let ((s1* (inexact->exact (round s1)))
+        (s2* (inexact->exact (round s2))))
+    (= s1* s2*)))
+
+(define (placed-player ch-in [initial-ch-out #f] [initial-ch-evt #f])
+  (let ((ch-evt initial-ch-evt)
+        (ch-out initial-ch-out)
+        (ao-h #f)
+        (ao-mutex (make-mutex))
+        (ao-dec #f)
+        (current-seconds 0)
+        (current-deci-seconds 0)
+        (stored-seconds -1)
+        (current-file-id 0)
+        (files-playing '())
+        (current-bits -1)
+        (current-rate -1)
+        (current-channels -1)
+        (current-volume 100.0)
+        (req-volume 100.0)
+        (max-buf-secs 4)
+        (min-buf-secs 2)
+        (play-thread #f)
+        (player-state 'stopped)
+        (decoder-buf-info #f)
+        (decoder-meta #f)
+        (feeding-audio #f)
+        (feed-interrupted #f)
+        )
+    
+    (define-syntax with-ao-h
+      (syntax-rules (ao-h ao-mutex)
+        ((_ r b1 ...)
+         (with-mutex ao-mutex
+           (if (ao-valid? ao-h)
+               (begin b1 ...)
+               r)))))
+
+    (define (->uni-channel ch)
+      (if (uni-channel? ch) ch (make-uni-channel ch)))
+
+    ;; ch-in is supplied by dynamic-place or by the async/thread launcher.
+    ;; ch-out and ch-evt are supplied by the init command.  Each logical
+    ;; channel is wrapped as a uni-channel on the side where it is used; raw
+    ;; place channels must not be wrapped before they are sent through init.
+    (set! ch-in (->uni-channel ch-in))
+    (when ch-out (set! ch-out (->uni-channel ch-out)))
+    (when ch-evt (set! ch-evt (->uni-channel ch-evt)))
+
+    (define (put data)
+      (uni-channel-put ch-out data))
+
+    (define (evt data)
+      (uni-channel-put ch-evt data))
+
+    (define (get)
+      (uni-channel-get ch-in))
+
+    (define (close-and-wait ch)
+      (when ch
+        (uni-channel-close ch)
+        (uni-channel-wait ch)))
+          
+    (define (audio-read-worker ao-dec file-id)
+      (set! feeding-audio #t)
+      (set! play-thread
+            (thread (λ ()
+                      (with-handlers ([exn:fail?
+                                       (λ (e)
+                                         (dbg-sound "Exception in audio-read-worker: ~a" e)
+                                         (set! feeding-audio #f)
+                                         (set! feed-interrupted #f)
+                                         (set! player-state 'stopped)
+                                         (let ((code (if (exn:fail:audio? e) (exn:fail:audio-code e) 'no-audio-error)))
+                                           (state (format "audio-read-worker: exception ~a" code) evt)
+                                           (evt (list 'exception (exn-message e) code)))
+                                       )])
+                        (dynamic-wind
+                         void
+                         (λ ()
+                           (dbg-sound "audio-read start")
+                           (audio-read ao-dec)
+                           (dbg-sound "audio-read end")
+                           )
+                         (λ () (set! feeding-audio #f)))
+                        (state "audio-read-worker: just after audio-read" evt)
+                        (if feed-interrupted
+                            (set! feed-interrupted #f)
+                            (begin
+                              (evt '(audio-done))
+                              (let ((bufsize #f))
+                                (let loop ()
+                                  (let ((nbfs (with-ao-h 'done
+                                                (ao-bufsize-async ao-h))))
+                                    (if (eq? nbfs 'done)
+                                        (begin
+                                          (set! bufsize 0)
+                                          'done)
+                                        (cond
+                                          ((eq? bufsize #f) (set! bufsize nbfs) (loop))
+                                          ((= nbfs 0) (set! bufsize 0) 'done)
+                                          ((> nbfs bufsize) (set! bufsize nbfs) 'done)
+                                          (else
+                                           (check-paused)
+                                           (set! bufsize nbfs)
+                                           (sleep 0.1)
+                                           (loop)))
+                                        )
+                                    )
+                                  )
+                                ;; Alleen de actuele worker mag de globale spelerstatus beëindigen.
+                                ;; Een oude drain-worker mag hoogstens zichzelf opruimen.
+                                (when (and (= bufsize 0) (= file-id current-file-id))
+                                  (set! player-state 'stopped)
+                                  (state "audio-read-worker: after read with bufsize 0" evt))
+                                )
+                              )
+                            )
+                        )
+                      )
+                    )
+            )
+      )
+
+    (define (check-volume)
+      (unless (= req-volume current-volume)
+        (set! current-volume req-volume)
+        (with-ao-h 'no-op
+            (ao-set-volume! ao-h current-volume))
+        (state "check-volume: volume changed" evt)
+        )
+      )
+    
+    (define (check-paused)
+      (if (eq? player-state 'paused)
+          (begin
+            (with-ao-h 'no-op (ao-pause ao-h #t))
+            (state "check-paused: player-state = paused" evt)
+            (let loop ()
+              (sleep 0.1)
+              (when (eq? player-state 'paused)
+                (loop)))
+            ; If the player is no longer paused, we unpause the ao stream,
+            ; also if the player is no longer playing (i.e. player-state = stopped)
+            ; in which case, we expect ao-clear-async to have been executed, which
+            ; means the playing queue is empty. 
+            (with-ao-h 'no-op (ao-pause ao-h #f))
+            (state (format "check-paused: player-state = ~a" player-state) evt)
+            #t)
+          #f))
+
+    (define (audio-play type ao-type handle buf-info buffer buf-len)
+      (let* ((sample (hash-ref buf-info 'sample))
+             (rate (hash-ref buf-info 'sample-rate))
+             (second (/ (* sample 1.0) (* rate 1.0)))
+             (bits-per-sample (hash-ref buf-info 'bits-per-sample))
+             (bytes-per-sample (/ bits-per-sample 8))
+             (channels (hash-ref buf-info 'channels))
+             (bytes-per-sample-all-channels (* channels bytes-per-sample))
+             (duration (hash-ref buf-info 'duration))
+             )
+
+        (set! decoder-buf-info buf-info)
+
+        (when (not (and
+                    (= current-bits bits-per-sample)
+                    (= current-rate rate)
+                    (= current-channels channels)))
+          ; If we need to reopen the ao device with different bit-rates,
+          ; we need to wait until the ao sample queue is empty
+          (let loop ()
+            (let* ((s (with-ao-h -1 (ao-at-second ao-h))))
+              (unless (or (= s -1) (eq-seconds? stored-seconds s))
+                (set! stored-seconds s)
+                (state "audio-play: seconds changes (III)" evt)))
+            (let ((bufsize (with-ao-h 0 (ao-bufsize-async ao-h))))
+              (if (= bufsize 0)
+                  (with-mutex ao-mutex
+                    (when (ao-valid? ao-h)
+                      (ao-close ao-h))
+                    (set! ao-h #f))
+                  (begin (sleep 0.1) (loop)))))
+          )
+        
+        (with-mutex ao-mutex
+          (when (eq? ao-h #f)
+            (dbg-sound "opening ao-h for ~a ~a" current-file-id files-playing) 
+            (set! ao-h (ao-open-live bits-per-sample
+                                     rate channels
+                                     'native-endian))
+            )
+          (with-ao-h 'no-op
+            (ao-set-volume! ao-h current-volume)
+            (set! current-bits bits-per-sample)
+            (set! current-rate rate)
+            (set! current-channels channels)
+            )
+          )
+
+        (check-volume)
+        (with-ao-h 'no-op
+          (when (not (eq? player-state 'stopped))
+            (ao-play ao-h current-file-id second duration buffer buf-len ao-type)
+            ))
+        (check-paused)
+
+        (let* ((s* (with-ao-h 0 (ao-at-second ao-h)))
+               (s (inexact->exact (round (* s* 10)))))
+          (unless (= s current-deci-seconds)
+            (set! current-deci-seconds s)
+            (set! current-seconds s*))) 
+
+        (unless (eq-seconds? stored-seconds current-seconds)
+          (set! stored-seconds current-seconds)
+          (state "audio-play: seconds changed (I)" evt))
+
+        (let* ((buf-size (with-ao-h 0 (ao-bufsize-async ao-h)))
+               (buf-seconds (exact->inexact (/ buf-size
+                                               bytes-per-sample-all-channels
+                                               rate)))
+               )
+          (when (> buf-seconds max-buf-secs)
+            (let waiter ()
+              (when (not (check-paused))
+                (sleep 0.3))
+              (let* ((s* (with-ao-h 0 (ao-at-second ao-h)))
+                     (s (inexact->exact (round (*  s* 10)))))
+
+                (unless (= s current-deci-seconds)
+                  (set! current-deci-seconds s)
+                  (set! current-seconds s*))
+                
+                (unless (eq-seconds? stored-seconds current-seconds)
+                  (set! stored-seconds current-seconds)
+                  (state "audio-play: seconds changed (II)" evt))
+                
+                (let ((buf-seconds-left (exact->inexact
+                                         (/ (with-ao-h 0 (ao-bufsize-async ao-h))
+                                            bytes-per-sample-all-channels
+                                            rate))))
+                  (when (>= buf-seconds-left min-buf-secs)
+                    (waiter)))))
+            ))
+        )
+      )
+
+    (define (audio-meta type ao-type handle meta)
+      (set! decoder-meta meta)
+      #t)
+
+    (define (cleanup)
+      (set! files-playing '())
+      (set! current-seconds 0)
+      (set! current-deci-seconds 0)
+      (set! stored-seconds -1)
+      (set! current-file-id 0)
+      (set! current-bits -1)
+      (set! current-rate -1)
+      (set! current-channels -1)
+      (set! decoder-buf-info #f)
+      (set! decoder-meta #f)
+      )
+    
+    (define (stop-and-cleanup)
+      (dbg-sound "stop and cleanup called")
+      (set! feed-interrupted #t)
+
+      (with-ao-h 'no-op (ao-clear-async ao-h))
+      (set! player-state 'stopped)
+      (unless (eq? ao-dec #f)
+        (audio-stop ao-dec))
+      (set! ao-dec #f)
+
+      (with-ao-h 'no-op (ao-clear-async ao-h))
+      
+      (when (thread? play-thread) (thread-wait play-thread))
+      (set! play-thread #f)
+
+      (with-mutex ao-mutex
+        (when (ao-valid? ao-h)
+          (ao-close ao-h)
+          )
+        (set! ao-h #f))
+
+      (set! feed-interrupted #f)
+      (set! feeding-audio #f)
+      
+      (cleanup)
+      
+      (state "stop-and-cleanup: stopped/cleaned" evt 'force)
+      
+      player-state
+      )
+
+    (define (start file)
+      (dbg-sound "starting ~a" file)
+      (when feeding-audio
+        (dbg-sound "interrupting feed")
+        (set! feed-interrupted #t)
+        (with-ao-h 'no-op (ao-clear-async ao-h))
+        (set! player-state 'stopped)
+        (when (audio-handle? ao-dec)
+          (audio-stop ao-dec))
+        (dbg-sound "clearing ao-h queue")
+        (with-ao-h 'no-op (ao-clear-async ao-h))
+        (dbg-sound "waiting for feed to stop")
+        (let loop ()
+          (if feeding-audio
+              (begin
+                (sleep 0.1)
+                (loop))
+              (with-ao-h 'no-op (ao-clear-async ao-h))
+              )
+          )
+        (dbg-sound "waiting for play thread")
+        (when (thread? play-thread) (thread-wait play-thread))
+        (dbg-sound "oke done")
+        )
+
+      
+      ;(set! current-file-id (+ current-file-id 1))
+      (set! current-file-id (+ (* (get-current-seconds) 10000) (random 1000)))
+      (let ((f (build-path file)))
+        (set! files-playing (cons
+                             (cons current-file-id f)
+                             (filter (λ (e)
+                                    (= (car e) (- current-file-id 1)))
+                                  files-playing))))
+      (set! ao-dec (audio-open file audio-meta audio-play))
+      
+      (when (eq? player-state 'stopped)
+        (set! player-state 'playing))
+      (audio-read-worker ao-dec current-file-id)
+      current-file-id)
+
+    (define (param! par val)
+      (cond
+        ((eq? par 'opus-bits)
+         (if (integer? val)
+             (cond
+               ((= val 16)
+                (current-opusfile-output-format 's16)
+                16
+                )
+               ((= val 24)
+                (current-opusfile-output-format 's24)
+                24)
+               (else 'error-unsupported-value)
+               )
+             'error-wrong-value-type)
+         )
+        (else 'error-unknown-param)))
+
+    (define (param par)
+      (cond
+        ((eq? par 'opus-bits)
+         (if (eq? (current-opusfile-output-format) 's16)
+             16
+             24))
+        (else 'error-unknown-param)))
+
+    (define (pause paused)
+      (when (or (eq? player-state 'paused)
+                (eq? player-state 'playing))
+        (set! player-state (if paused 'paused 'playing))))
+      
+    (define (seek percentage)
+      (with-ao-h 'no-op
+          (ao-clear-async ao-h))
+      (unless (eq? ao-dec #f)
+        (audio-seek ao-dec percentage)))
+
+    (define (volume percentage)
+      (set! req-volume percentage)
+      (check-volume))
+
+    (define (ao-buf-ms)
+      (ao-playback-buf-ms))
+
+    (define (ao-buf-ms! ms)
+      (let ((the-ms (if (< ms 50) 50 (if (> ms 1000) 1000 ms))))
+        (ao-set-playback-buf-ms! the-ms)
+        (ao-buf-ms)))
+
+    (define (state msg cb . force)
+      (let ((h (make-hash)))
+        (with-mutex ao-mutex
+          (let ((m-id (if (ao-valid? ao-h) (ao-at-music-id ao-h) #f)))
+            (hash-set! h 'decoder (if (audio-handle? ao-dec) (audio-kind ao-dec) #f))
+            (hash-set! h 'msg msg)
+            (hash-set! h 'file (let ((r (filter (λ (e)
+                                                  (and (not (eq? m-id #f)) (= (car e) m-id)))
+                                                files-playing)))
+                                 (if (null? r) #f (cdar r))))
+            (hash-set! h 'state player-state)
+            (hash-set! h 'valid-ao-handle (ao-valid? ao-h))
+            (hash-set! h 'ao-device-bits (if (ao-valid? ao-h) (ao-device-bits ao-h) #f))
+            (hash-set! h 'duration (if (ao-valid? ao-h) (ao-music-duration ao-h) #f))
+            (hash-set! h 'at-second (if (ao-valid? ao-h) (ao-at-second ao-h) #f))
+            (hash-set! h 'at-music-id m-id)
+            (hash-set! h 'volume current-volume)
+            (hash-set! h 'buf-size (if (ao-valid? ao-h) (ao-bufsize-async ao-h) 0))
+            (hash-set! h 'reuse-buf-len (if (ao-valid? ao-h)
+                                            (ao-reuse-buf-len-async ao-h)
+                                            #f))
+            (hash-set! h 'sample-queue-len (if (ao-valid? ao-h)
+                                               (ao-sample-queue-len-async ao-h)
+                                               #f))
+            (hash-set! h 'bits current-bits)
+            (hash-set! h 'rate current-rate)
+            (hash-set! h 'channels current-channels)
+            (hash-set! h 'decoder-meta decoder-meta)
+            (hash-set! h 'decoder-buf-info decoder-buf-info)
+            )
+          )
+
+        (let ((m-id (hash-ref h 'at-music-id)))
+          (unless (and (null? force) (or (eq? m-id #f) (= m-id 0)))
+            (cb (list 'state (list h player-state)))))
+        )
+      )
+
+    (let loop ()
+      (let* ((data (get))
+             (cmd (car data))
+             (in-rpc #f))
+
+        (define-syntax do-rpc
+          (syntax-rules (in-rpc)
+            ((_ b1 ...)
+             (begin
+               (set! in-rpc #t)
+               (let ((r (begin b1 ...)))
+                 (set! in-rpc #f)
+                 (put r))))))
+        
+        (with-handlers ([exn:fail? (λ (e)
+                                     (if (eq? ch-evt #f)
+                                         (raise e)
+                                         (let ((code (if (exn:fail:audio? e) (exn:fail:audio-code e) 'no-audio-error)))
+                                           (evt (list 'exception (exn-message e) code))
+                                           (when in-rpc
+                                             (put (list 'error (exn-message e) code))
+                                             (set! in-rpc #f))
+                                           (loop))
+                                         ))])
+
+           (cond
+             ((eq? cmd 'quit)
+              ;; Quit is the one RPC where the acknowledgement must be written
+              ;; before the worker starts tearing down its audio state and stdio
+              ;; transport.  For port-based uni-channels, put is asynchronous:
+              ;; close-and-wait makes sure the queued '(quit) has actually been
+              ;; written and flushed before the process exits.
+              (put '(quit))
+              (close-and-wait ch-out)
+              (stop-and-cleanup)
+              (set! player-state 'quit)
+              (close-and-wait ch-evt))
+             ((eq?  cmd 'init) (do-rpc
+                                (set! ch-out (->uni-channel (cadr data)))
+                                (set! ch-evt (->uni-channel (caddr data)))
+                                '(initialized))
+                               (loop))
+             (else 
+              (when (or (eq? ch-out #f) (eq? ch-evt #f))
+                (error "placed player not initialized"))
+          
+              (unless (eq? cmd 'quit)
+                (cond
+                  ((eq? cmd 'buf-seconds)
+                   (do-rpc
+                    (let* ((clamp (λ (x) (min 30 (max 2 x))))
+                           (a (clamp (cadr data)))
+                           (b (clamp (caddr data))))
+                      (set! min-buf-secs (min a b))
+                      (set! max-buf-secs (max a b))
+                      '(ok))))
+                  ((eq? cmd 'open)
+                   (do-rpc 
+                    (let ((file (cadr data)))
+                      (let ((id (start file)))
+                        (list (list 'ok id))))))
+                  ((eq? cmd 'seek)
+                   (do-rpc 
+                    (let ((percentage (cadr data)))
+                      (seek percentage)
+                      '(ok))))
+                  ((eq? cmd 'pause)
+                   (do-rpc
+                    (let ((paused (cadr data)))
+                      (pause paused)
+                      '(ok))))
+                  ((eq? cmd 'paused)
+                   (do-rpc
+                    (list (eq? player-state 'paused))))
+                  ((eq? cmd 'volume)
+                   (do-rpc
+                    (let ((percentage (cadr data)))
+                      (volume (exact->inexact percentage))
+                      '(ok))))
+                  ((eq? cmd 'get-volume)
+                   (do-rpc
+                    (list current-volume)))
+                  ((eq? cmd 'stop)
+                   (do-rpc
+                    (stop-and-cleanup)
+                    '(ok)))
+                  ((eq? cmd 'param!)
+                   (do-rpc
+                    (let ((par (cadr data))
+                          (value (caddr data)))
+                      (list (param! par value)))))
+                  ((eq? cmd 'param)
+                   (do-rpc
+                    (let ((par (cadr data)))
+                      (list (param par)))))
+                  ((eq? cmd 'state)
+                   (do-rpc
+                    (let ((st #f))
+                      (state "'state command" (λ (s) (set! st s)) 'force)
+                      st)))
+                  ((eq? cmd 'ao-buf-ms)
+                   (do-rpc
+                    (if (null? (cdr data))
+                        (list (ao-buf-ms))
+                        (list (ao-buf-ms! (cadr data))))
+                    ))
+                  (else
+                   (do-rpc
+                    (list 'error (format "Unknown command ~a" cmd)  'error-unknown-command)))
+                  )
+                (loop)
+                )
+              )
+             )
+          )
+        )
+      )
+    )
+  )
+(module+ main
+  (require racket/cmdline)
+  (define log-file 'default)
+  (command-line
+   #:once-each
+   [("--stdio") "Run the placed audio player over stdin/stdout/stderr." (void)]
+   [("--log-file") file "Write ordinary worker logging to file." (set! log-file file)]
+   [("--no-log-file") "Discard ordinary worker logging." (set! log-file #f)])
+  (placed-player/stdio #:log-file (if (eq? log-file 'default)
+                                      (racket-sound-log-file 'placed-audio-player-stdio)
+                                      log-file)))

audio-player.rkt

@@ -0,0 +1,395 @@
+#lang racket/base
+
+(require racket/place
+         racket/contract
+         racket/async-channel
+         racket/runtime-path
+         racket/string
+         "audio-errors.rkt"
+         uni-channel
+         "audio-placed-player.rkt"
+         "opusfile-decoder.rkt"
+         "private/utils.rkt"
+         "private/remote-utils.rkt"
+         (prefix-in ffi: ffi/unsafe)
+         )
+
+(provide make-audio-player
+         audio-play!
+         audio-pause!
+         audio-paused?
+         audio-stop!
+         audio-quit!
+         audio-seek!
+         audio-volume!
+         audio-volume
+         audio-at-second
+         audio-duration
+         audio-state
+         audio-bits
+         audio-channels
+         audio-decoder
+         audio-music-id
+         audio-rate
+         audio-full-state
+         audio-file
+         audio-play?
+         audio-buf-seconds!
+         audio-ao-buf-ms!
+         audio-ao-buf-ms
+         audio-known-exts?
+         audio-parameterize!
+         audio-param!
+         audio-param
+         replace-base-path
+         )
+
+(define-runtime-path placed-player-module "audio-placed-player.rkt")
+
+
+(define-struct audio-play
+  (valid? cb-state cb-eof-stream rpc au-place evt-thread state replace-base-paths)
+  #:mutable
+  #:transparent
+  )
+
+(define audio-play-struct? audio-play?)
+(set! audio-play? (λ (h)
+                    (and (audio-play-struct? h)
+                         (audio-play-valid? h))))
+
+
+(define (percentage? p)
+  (and (number? p) (>= p 0)))
+
+(define (any? x)
+  #t)
+
+(define (max-percentage? n)
+  (λ (p) (and (percentage? p)
+              (<= p n))))
+
+(define (is-return? retval sym)
+  (if (list? retval)
+      (if (null? retval)
+          #f
+          (eq? (car retval) sym))
+      #f))
+
+(define-struct internal-audio-retval
+  (kind code info retval)
+  #:transparent
+  )
+
+(define (to-ret-value ret)
+  (if (list? ret)
+      (if (null? ret)
+          (raise-audio-error 'audio-error "audio-player: no return value, empty list returned")
+          (let ((r (car ret)))
+            (if (eq? r 'error)
+              (let ((msg (cadr ret))
+                    (code (caddr ret)))
+                (err-sound "Got an error: ~a - ~a" code msg)
+                (make-internal-audio-retval 'error code msg 'error))
+              (make-internal-audio-retval 'retval #f #f r))))
+      (if (eq? ret 'error)
+        (make-internal-audio-retval 'error 'audio-error "An undefined error was raised in the audio-player" 'error)
+        (make-internal-audio-retval 'retval #f #f ret))))
+
+(define (is-event? evt sym)
+  (is-return? evt sym))
+
+(define (evt-data evt)
+  (cadr evt))
+
+(define (correct-to-os-path h replacements)
+  (let ((file (hash-ref h 'file #f)))
+    (letrec ((f (λ (l fl)
+                  (if (null? l)
+                      fl
+                      (let ((bp-remote (cdar l))
+                            (bp-local (caar l)))
+                        (f (cdr l) (string-replace fl bp-remote bp-local)))))))
+      (unless (eq? file #f)
+        (let* ((delim (if (eq? (system-type 'os) 'windows) "\\" "/"))
+               (file* (string-replace
+                       (string-replace
+                        (f replacements (format "~a" file)) "/" delim)
+                       "\\" delim)))
+          (hash-set! h 'file (build-path file*))))
+    h)))
+
+(define-syntax assert
+  (syntax-rules ()
+    ((_ cond message ...)
+     (unless cond (error (format message ...))))))
+
+(define/contract (make-audio-player cb-state cb-eof-stream
+                                    #:use-place [use-place (place-enabled?)]
+                                    #:remote-host [remote-host #f]
+                                    #:replace-base-paths [replace-base-paths '()])
+  (->* (procedure? procedure?)
+       (#:use-place boolean?
+        #:remote-host (or/c #f string?)
+        #:replace-base-paths replace-base-paths?)
+       audio-play?)
+  (let ((cmd-ch #f)
+        (ret-ch #f)
+        (evt-ch #f)
+        (cmd-put #f)
+        (ret-get #f)
+        (evt-get #f)
+        (au-pl #f)
+        (dead-guard #f)
+        (rpc #f)
+        (rpc-mutex (make-mutex))
+        )
+    (cond
+      [remote-host
+       ;; Remote mode is deliberately narrow: make-audio-player only needs
+       ;; a host and optional base-path replacements.  SSH, Racket and module
+       ;; details are encapsulated in private/remote-utils.rkt and its config.
+       (let-values (((cmd-ch* ret-ch* evt-ch* proc dead-guard*)
+                     (start-remote-placed-player remote-host)))
+         (set! cmd-ch cmd-ch*)
+         (set! ret-ch ret-ch*)
+         (set! evt-ch evt-ch*)
+         (set! au-pl proc)
+         (set! dead-guard dead-guard*))]
+      [use-place
+       ;; dynamic-place returns the command place-channel.  The raw channel
+       ;; is kept for place-dead-evt, while normal traffic is sent through
+       ;; a uni-channel wrapper.
+       (let ((raw-cmd-ch (dynamic-place placed-player-module 'placed-player)))
+         (set! cmd-ch (make-uni-channel raw-cmd-ch))
+         (set! au-pl raw-cmd-ch)
+         (set! dead-guard (lambda () (let ((evt (place-dead-evt au-pl)))
+                                       (sync evt))))
+         (let-values (((ret-ch-in ret-ch-out) (place-channel))
+                      ((evt-ch-in evt-ch-out) (place-channel)))
+           ;; Do not send uni-channel structs through a place-channel: they
+           ;; contain procedures and are not place-message values.  Send the
+           ;; raw channels and let the worker wrap them on its own side.
+           (set! ret-ch (make-uni-channel ret-ch-in))
+           (set! evt-ch (make-uni-channel evt-ch-in))
+           (uni-channel-put cmd-ch (list 'init ret-ch-out evt-ch-out))
+           (assert (is-return? (uni-channel-get ret-ch) 'initialized)
+                   "Unexpected: not 'initialized returned from 'init command")))]
+      [else
+       (let ((raw-cmd-ch (make-async-channel)))
+         (set! cmd-ch (make-uni-channel raw-cmd-ch))
+         (set! au-pl (thread (lambda () (placed-player raw-cmd-ch))))
+         (set! dead-guard (lambda () (let ((evt (thread-dead-evt au-pl)))
+                                       (sync evt))))
+         (let ((raw-ret-ch (make-async-channel))
+               (raw-evt-ch (make-async-channel)))
+           ;; As in place mode, pass raw channels during init and keep
+           ;; uni-channel wrappers on each side for all subsequent traffic.
+           (set! ret-ch (make-uni-channel raw-ret-ch))
+           (set! evt-ch (make-uni-channel raw-evt-ch))
+           (uni-channel-put cmd-ch (list 'init raw-ret-ch raw-evt-ch))
+           (assert (is-return? (uni-channel-get ret-ch) 'initialized)
+                   "Unexpected: not 'initialized returned from 'init command")))])
+    (set! cmd-put (λ (data) (uni-channel-put cmd-ch data)))
+    (set! ret-get (λ () (to-ret-value (uni-channel-get ret-ch))))
+    (set! evt-get (λ (timeout-ms) (sync/timeout (/ timeout-ms 1000)
+                                                (uni-channel-get-evt evt-ch))))
+    (set! rpc (lambda (cmd . args)
+                (with-mutex rpc-mutex
+                  (define args*
+                    (if (and (eq? cmd 'open) (pair? args))
+                        (cons (replace-base-path (car args) replace-base-paths) (cdr args))
+                        args))
+                  (cmd-put (cons cmd args*))
+                  (ret-get))))
+
+    (let* ((handle #f)
+           (cb-state* (λ (st st-hash) (cb-state handle st st-hash)))
+           (cb-eof*   (λ () (cb-eof-stream handle))))
+      (set! handle (make-audio-play #t
+                                   cb-state* cb-eof*
+                                   rpc
+                                   au-pl
+                                   #f
+                                   (make-hash)
+                                   replace-base-paths))
+      (set-audio-play-evt-thread! handle
+            (thread
+             (λ ()
+               (let loop ()
+                 (if (audio-play-valid? handle)
+                     (let ((e (evt-get 500)))
+                       (cond ((eq? e #f) (void))
+                             ((is-event? e 'state)
+                              (let* ((data (evt-data e))
+                                     (h (hash-copy (car data))))
+                                (correct-to-os-path h replace-base-paths)
+                                (set-audio-play-state! handle h)
+                                (cb-state* (cadr data) h)))
+                             ((is-event? e 'audio-done) (cb-eof*))
+                             ((is-event? e 'exception)
+                              (err-sound "audio-player: exception event: ~a" e))
+                             (else (warn-sound "audio-player: unknown event ~a" e))
+                             )
+                       (loop))
+                     'done)))))
+
+      (thread (λ ()
+                (dbg-sound "guarding audio-placed-player")
+                (dead-guard)
+                (dbg-sound "audio-placed-player has stopped")
+                (set-audio-play-valid?! handle #f)
+                (set-audio-play-rpc! handle #f)
+                (set-audio-play-au-place! handle #f)
+                (set-audio-play-evt-thread! handle #f)
+                (set-audio-play-cb-state! handle #f)
+                (set-audio-play-cb-eof-stream! handle #f)
+                (when (hash? (audio-play-state handle))
+                  (let ((h (hash-copy (audio-play-state handle))))
+                    (hash-set! h 'state 'invalid)
+                    (correct-to-os-path h replace-base-paths)
+                    (set-audio-play-state! handle h)))
+                (dbg-sound "audio-play handle invalidated and cleaned of references")
+                ))
+
+      (ffi:register-finalizer handle
+                          (λ (h)
+                            (when (audio-play? h)
+                              (rpc 'quit))))
+
+      (audio-parameterize! handle)
+      handle)
+    )
+  )
+
+(define-syntax ap-rpc 
+  (syntax-rules ()
+    ((_ handle cmd args ...)
+     (let ((rv ((audio-play-rpc handle) cmd args ...)))
+        (if (eq? (internal-audio-retval-kind rv) 'error)
+          (raise-audio-error (internal-audio-retval-code rv) (internal-audio-retval-info rv))
+          (internal-audio-retval-retval rv))))
+    )
+  )
+
+(define/contract (audio-play! handle audio-file)
+  (->  audio-play? path-string? number?)
+  (let ((r (ap-rpc handle 'open audio-file)))
+    (if (eq? (car r) 'ok)
+        (cadr r)
+        (raise-audio-error 'audio-error "audio-play!: unexpected return value from 'open command: ~a" r))))
+
+(define/contract (audio-pause! handle paused)
+  (-> audio-play? boolean? symbol?)
+  (ap-rpc handle 'pause paused))
+
+(define/contract (audio-paused? handle)
+  (-> audio-play? boolean?)
+  (ap-rpc handle 'paused))
+
+(define/contract (audio-stop! handle)
+  (-> audio-play? symbol?)
+  (ap-rpc handle 'stop))
+
+(define/contract (audio-quit! handle)
+  (-> audio-play? (or/c number? boolean? symbol?))
+  (let ((r (ap-rpc handle 'quit)))
+    (set-audio-play-valid?! handle #f)
+    r))
+
+(define/contract (audio-seek! handle percentage)
+  (-> audio-play? (max-percentage? 100) symbol?)
+  (ap-rpc handle 'seek percentage))
+
+(define/contract (audio-volume! handle percentage)
+  (-> audio-play? percentage? symbol?)
+  (ap-rpc handle 'volume percentage))
+
+(define/contract (audio-volume handle)
+  (-> audio-play? percentage?)
+  (ap-rpc handle 'get-volume))
+
+(define/contract (audio-full-state handle)
+  (-> audio-play? hash?)
+  (audio-play-state handle))
+
+(define-syntax get-state
+  (syntax-rules ()
+    ((_ handle id def)
+     (hash-ref (audio-play-state handle) id def))))
+
+(define/contract (audio-at-second handle)
+  (-> audio-play? (or/c number? boolean?))
+  (get-state handle 'at-second #f))
+
+(define/contract (audio-duration handle)
+  (-> audio-play? (or/c number? boolean?))
+  (get-state handle 'duration #f))
+
+(define/contract (audio-channels handle)
+  (-> audio-play? (or/c number? boolean?))
+  (get-state handle 'channels #f))
+
+(define/contract (audio-state handle)
+  (-> audio-play-struct? symbol?)
+  (if (audio-play-valid? handle)
+      (get-state handle 'state 'initialized)
+      'invalid))
+
+(define/contract (audio-bits handle)
+  (-> audio-play? (or/c number? boolean?))
+  (get-state handle 'bits #f))
+
+(define/contract (audio-rate handle)
+  (-> audio-play? (or/c number? boolean?))
+  (get-state handle 'rate #f))
+
+(define/contract (audio-decoder handle)
+  (-> audio-play? (or/c symbol? boolean?))
+  (get-state handle 'decoder #f))
+
+(define/contract (audio-music-id handle)
+  (-> audio-play? (or/c number? boolean?))
+  (get-state handle 'at-music-id #f))
+
+(define/contract (audio-file handle)
+  (-> audio-play? (or/c path-string? boolean?))
+  (get-state handle 'file #f))
+
+(define/contract (audio-buf-seconds! handle min max)
+  (-> audio-play? number? number? (or/c symbol? boolean?))
+  (let ((from (if (< min 1) 1 (if (> min 10) 10 min)))
+        (until (if (< max min) (+ min 1) (if (> max 30) 30 max))))
+    (ap-rpc handle 'buf-seconds from until)))
+
+(define/contract (audio-ao-buf-ms! handle ms)
+  (-> audio-play? integer? (or/c integer? boolean?))
+  (ap-rpc handle 'ao-buf-ms ms))
+
+(define/contract (audio-ao-buf-ms handle)
+  (-> audio-play? (or/c integer? boolean?))
+  (ap-rpc handle 'ao-buf-ms))
+
+(define/contract (audio-param! handle param value)
+  (-> audio-play? symbol? any? any?)
+  (ap-rpc handle 'param! param value))
+
+(define/contract (audio-param handle param)
+  (-> audio-play? symbol? any?)
+  (ap-rpc handle 'param param))
+
+(define/contract (audio-parameterize! handle)
+  (-> audio-play? void?)
+  (void
+   (let* ((opus-fmt (current-opusfile-output-format))
+          (opus-bits (if (eq? opus-fmt 's24) 24 16))
+          )
+     (audio-param! handle 'opus-bits opus-bits)
+     )
+   )
+  )
+   
+  
+    
+    
+         

audio-sniffer.rkt

@@ -10,6 +10,7 @@
          audio-sniff-format
          audio-sniff-format/extension
          audio-sniff-extension
+         audio-format-for-extension
          audio-format-matches?
          audio-format-known?)
 
@@ -46,6 +47,30 @@
              (substring s 1)
              s))])))
 
+(define (audio-format-for-extension* extension)
+  (let* ((text (string-downcase
+                (format "~a" extension)))
+         (normalized
+          (if (string-prefix? text ".")
+              (substring text 1)
+              text)))
+    (case (string->symbol normalized)
+      [(mp3 mp2 mp1) 'mp3]
+      [(flac) 'flac]
+      [(ogg oga) 'ogg]
+      [(opus) 'opus]
+      [(wav wave) 'wav]
+      [(aif aiff aifc) 'aiff]
+      [(m4a mp4 m4b m4p) 'mp4]
+      [(aac) 'aac]
+      [(alac) 'alac]
+      [(ac3) 'ac3]
+      [(ape) 'ape]
+      [(wv wvp wvpk wavpack) 'wavpack]
+      [(wma asf) 'wma]
+      [(webm mka mkv) 'matroska]
+      [else 'unknown])))
+
 (define (file-readable-status file)
   (cond
     [(not (file-exists? file)) 'file-not-found]
@@ -294,22 +319,9 @@
        fmt]
       [(not (eq? fmt 'unknown)) fmt]
       [else
-       (case (string->symbol (or (audio-sniff-extension* file) ""))
+       (audio-format-for-extension*
-         [(mp3 mp2 mp1) 'mp3]
+        (or (audio-sniff-extension* file)
-         [(flac) 'flac]
+            ""))])))
-         [(ogg oga) 'ogg]
-         [(opus) 'opus]
-         [(wav wave) 'wav]
-         [(aif aiff aifc) 'aiff]
-         [(m4a mp4 m4b m4p) 'mp4]
-         [(aac) 'aac]
-         [(alac) 'alac]
-         [(ac3) 'ac3]
-         [(ape) 'ape]
-         [(wv wvp wvpk wavpack) 'wavpack]
-         [(wma asf) 'wma]
-         [(webm mka mkv) 'matroska]
-         [else 'unknown])])))
 
 (define (audio-format-known?* fmt)
   (not (eq? (memq fmt audio-formats) #f)))
@@ -321,6 +333,10 @@
   (-> path-string? (or/c string? #f))
   (audio-sniff-extension* file))
 
+(define/contract (audio-format-for-extension extension)
+  (-> (or/c string? symbol?) audio-format?)
+  (audio-format-for-extension* extension))
+
 (define/contract (audio-sniff-format file)
   (-> path-string? audio-format?)
   (audio-sniff-format* file))

encoder-test.rkt

@@ -0,0 +1,187 @@
+#lang racket/base
+
+(require "audio-encoder.rkt"
+         "tests.rkt"
+         simple-log
+         racket/cmdline
+         racket/file
+         racket/path
+         racket/string)
+
+(provide encoder-test
+         encoder-test-opus
+         encoder-test-flac)
+
+(define (setting-value v)
+  (cond ((or (eq? v #f) (eq? v 'source)) 'source)
+        ((string? v)
+         (let ((s (string-downcase v)))
+           (if (string=? s "source")
+               'source
+               (let ((n (string->number v)))
+                 (if n n (raise-argument-error 'encoder-test "number or source" v))))))
+        (else v)))
+
+(define (encoder-symbol v)
+  (cond ((symbol? v) v)
+        ((string? v) (string->symbol (string-downcase v)))
+        (else (raise-argument-error 'encoder-test "encoder name" v))))
+
+(define (default-output-file encoder)
+  (build-path (find-system-path 'temp-dir)
+              (format "racket-audio-encoder-test.~a"
+                      (case encoder
+                        ((opus) "opus")
+                        ((flac) "flac")
+                        (else (raise-argument-error 'encoder-test "opus or flac" encoder))))))
+
+(define (opus-settings bitrate-kbps sample-rate)
+  (if (eq? sample-rate 'source)
+      (hash 'bitrate (* bitrate-kbps 1000)
+            'vbr? #t
+            'complexity 10)
+      (hash 'bitrate (* bitrate-kbps 1000)
+            'vbr? #t
+            'complexity 10
+            'sample-rate sample-rate)))
+
+(define (flac-settings compression-level sample-rate bits-per-sample)
+  (let ((h (make-hash)))
+    (hash-set! h 'compression-level compression-level)
+    (unless (eq? sample-rate 'source) (hash-set! h 'sample-rate sample-rate))
+    (unless (eq? bits-per-sample 'source) (hash-set! h 'bits-per-sample bits-per-sample))
+    h))
+
+(define (format-summary fmt)
+  (if (hash? fmt)
+      (format "rate=~a, channels=~a, bits=~a, frames=~a"
+              (hash-ref fmt 'sample-rate "?")
+              (hash-ref fmt 'channels "?")
+              (hash-ref fmt 'bits-per-sample "?")
+              (hash-ref fmt 'total-frames (hash-ref fmt 'total-samples "?")))
+      "unknown"))
+
+(define (tag-summary tag-copy)
+  (if (hash? tag-copy)
+      (format "method=~a, success=~a, picture=~a~a"
+              (hash-ref tag-copy 'method "?")
+              (hash-ref tag-copy 'success? "?")
+              (hash-ref tag-copy 'picture? #f)
+              (let ((size (hash-ref tag-copy 'picture-size #f))
+                    (mt (hash-ref tag-copy 'picture-mimetype #f)))
+                (if size (format ", ~a bytes, ~a" size mt) "")))
+      "unknown"))
+
+(define (display-result result)
+  (displayln "")
+  (displayln "Encoder result")
+  (displayln "--------------")
+  (displayln (format "encoder        : ~a" (hash-ref result 'encoder '?)))
+  (displayln (format "input          : ~a" (hash-ref result 'input '?)))
+  (displayln (format "output         : ~a" (hash-ref result 'output '?)))
+  (displayln (format "frames read    : ~a" (hash-ref result 'frames-read '?)))
+  (displayln (format "frames written : ~a" (hash-ref result 'frames-written '?)))
+  (displayln (format "input format   : ~a" (format-summary (hash-ref result 'input-format #f))))
+  (displayln (format "output format  : ~a" (format-summary (hash-ref result 'output-format #f))))
+  (displayln (format "tag copy       : ~a" (tag-summary (hash-ref result 'tag-copy #f))))
+  result)
+
+(define (make-progress-callback)
+  (define last-pct -1)
+  (lambda (h)
+    (let ((p (hash-ref h 'progress #f)))
+      (when (number? p)
+        (let ((pct (inexact->exact (round (* 100 p)))))
+          (when (not (= pct last-pct))
+            (set! last-pct pct)
+            (printf "\rprogress : ~a%" pct)
+            (flush-output))
+          (when (or (>= pct 100) (eq? (hash-ref h 'phase #f) 'finished))
+            (newline)))))))
+
+(define (encoder-test input-file output-file encoder settings #:copy-tags? [copy-tags? #t])
+  (let* ((enc (encoder-symbol encoder))
+         (out (if output-file output-file (default-output-file enc))))
+    (when (file-exists? out) (delete-file out))
+    (displayln (format "Encoding ~a" input-file))
+    (displayln (format "      -> ~a" out))
+    (displayln (format "encoder : ~a" enc))
+    (displayln (format "settings: ~a" settings))
+    (display-result (audio-encode input-file out settings
+                                  #:encoder enc
+                                  #:copy-tags? copy-tags?
+                                  #:progress-callback (make-progress-callback)))))
+
+(define (encoder-test-opus [input-file test-file3]
+                           [output-file #f]
+                           #:bitrate-kbps [bitrate-kbps 160]
+                           #:sample-rate [sample-rate 'source]
+                           #:copy-tags? [copy-tags? #t])
+  (encoder-test input-file output-file 'opus
+                (opus-settings bitrate-kbps (setting-value sample-rate))
+                #:copy-tags? copy-tags?))
+
+(define (encoder-test-flac [input-file test-file3]
+                           [output-file #f]
+                           #:compression-level [compression-level 8]
+                           #:sample-rate [sample-rate 'source]
+                           #:bits-per-sample [bits-per-sample 'source]
+                           #:copy-tags? [copy-tags? #t])
+  (encoder-test input-file output-file 'flac
+                (flac-settings compression-level
+                               (setting-value sample-rate)
+                               (setting-value bits-per-sample))
+                #:copy-tags? copy-tags?))
+
+(module+ main
+  (sl-log-to-display)
+
+  (define encoder 'opus)
+  (define input-file test-file3)
+  (define output-file #f)
+  (define copy-tags? #t)
+  (define bitrate-kbps 160)
+  (define compression-level 8)
+  (define sample-rate 'source)
+  (define bits-per-sample 'source)
+
+  (command-line
+   #:program "encoder-test.rkt"
+   #:once-each
+   (("-e" "--encoder") e "Encoder: opus or flac. Default: opus."
+    (set! encoder (encoder-symbol e)))
+   (("-i" "--input") f "Input audio file. Default: tests.rkt test-file3."
+    (set! input-file f))
+   (("-o" "--output") f "Output audio file. Default: temp test file."
+    (set! output-file f))
+   (("--sample-rate") r "Target sample rate, e.g. 48000, or source. Default: source."
+    (set! sample-rate (setting-value r)))
+   (("--bits-per-sample") b "Target FLAC bits per sample, e.g. 16/24, or source. Default: source."
+    (set! bits-per-sample (setting-value b)))
+   (("--bitrate-kbps") b "Opus bitrate in kbps. Default: 160."
+    (set! bitrate-kbps (or (string->number b)
+                           (raise-argument-error 'encoder-test "number" b))))
+   (("--compression-level") n "FLAC compression level. Default: 8."
+    (set! compression-level (or (string->number n)
+                                (raise-argument-error 'encoder-test "number" n))))
+   (("--no-tags") "Do not copy tags/pictures to the output file."
+    (set! copy-tags? #f))
+   #:args rest
+   (cond ((null? rest) (void))
+         ((null? (cdr rest)) (set! input-file (car rest)))
+         ((null? (cddr rest)) (set! input-file (car rest)) (set! output-file (cadr rest)))
+         (else (raise-user-error 'encoder-test "too many positional arguments: ~a" rest))))
+
+  (case encoder
+    ((opus)
+     (encoder-test-opus input-file output-file
+                        #:bitrate-kbps bitrate-kbps
+                        #:sample-rate sample-rate
+                        #:copy-tags? copy-tags?))
+    ((flac)
+     (encoder-test-flac input-file output-file
+                        #:compression-level compression-level
+                        #:sample-rate sample-rate
+                        #:bits-per-sample bits-per-sample
+                        #:copy-tags? copy-tags?))
+    (else (raise-argument-error 'encoder-test "opus or flac" encoder))))

ffmpeg-decoder.rkt

@@ -128,7 +128,9 @@
               (ffi-handler 'read
                            (lambda (info pos buffer size)
                              (if (eq? info 'done)
-                                 (set-ffmpeg-handle-stop! handle #t)
+                                 (begin
+                                   (dbg-sound "ffmpeg read: ~a ~a ~a" info pos size)
+                                   (set-ffmpeg-handle-stop! handle #t))
                                  (give-audio handle info pos buffer size)))
                            (lambda (pcm-pos rate channels sample-bits sample-bytes pcm-length)
                              (handle-format handle pcm-pos rate channels sample-bits sample-bytes pcm-length)))
@@ -138,6 +140,7 @@
       (ffi-handler 'delete)))
 
   (define (ffmpeg-seek handle percentage)
+    (dbg-sound "ffmpeg-seek ~a" percentage)
     (let ((fmt (ffmpeg-handle-format handle)))
       (let ((total-samples (hash-ref fmt 'total-samples 0)))
         (unless (or
@@ -149,6 +152,7 @@
             (set-ffmpeg-handle-seek! handle sample))))))
 
   (define (ffmpeg-stop handle)
+    (dbg-sound "ffmpeg-stop called")
     (set-ffmpeg-handle-stop! handle #t)
     (while (ffmpeg-handle-reading handle)
            (sleep 0.01)))

ffmpeg-ffi.rkt

@@ -16,8 +16,17 @@
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 
   (define (ok? r)
-    (not (= r 0)))
+    (> r 0))
+  
+  (define (decode-ok? r)
+    (= r 1))
 
+  (define (decode-eof? r)
+    (= r 0))
+
+  (define (decode-error? r)
+    (< r 0))
+  
   (define (filename->string filename)
     (cond
       [(path? filename) (path->string filename)]
@@ -149,18 +158,45 @@
         (reset!)
         #t))
 
+    #|
     (define (read cb format-cb)
       (when (= current-pcm-pos 0)
         (ffmpeg-format format-cb))
-      (if (ok? (fmpg-decode-next! fh))
+      (let ((dec-val (fmpg-decode-next! fh)))
-          (let-values ([(buffer size) (copy-current-buffer fh)])
+        (unless (ok? dec-val)
-            (cond
+          (err-sound "return value of fmpg-decode-next = ~a" dec-val))
-              [(or (eq? buffer #f) (<= size 0)) (read cb format-cb)]
+        (if (ok? dec-val)
-              [else
+            (let-values ([(buffer size) (copy-current-buffer fh)])
-               (let ((pcm-pos (fmpg-buffer-start-sample fh)))
+              (cond
-                 (set! current-pcm-pos (fmpg-buffer-end-sample fh))
+                [(or (eq? buffer #f) (<= size 0)) (read cb format-cb)]
-                 (cb 'data pcm-pos buffer size))]))
+                [else
-          (cb 'done -1 #f 0))
+                 (let ((pcm-pos (fmpg-buffer-start-sample fh)))
+                   (set! current-pcm-pos (fmpg-buffer-end-sample fh))
+                   (cb 'data pcm-pos buffer size))]))
+            (cb 'done -1 #f 0))
+        #t))
+    |#
+    (define (read cb format-cb)
+      (when (= current-pcm-pos 0)
+        (ffmpeg-format format-cb))
+      (let ((dec-val (fmpg-decode-next! fh)))
+        (cond
+          [(decode-ok? dec-val)
+           (let-values ([(buffer size) (copy-current-buffer fh)])
+             (cond
+               [(or (eq? buffer #f) (<= size 0))
+                (read cb format-cb)]
+               [else
+                (let ((pcm-pos (fmpg-buffer-start-sample fh)))
+                  (set! current-pcm-pos (fmpg-buffer-end-sample fh))
+                  (cb 'data pcm-pos buffer size))]))]
+
+          [(decode-eof? dec-val)
+           (cb 'done -1 #f 0)]
+
+          [else
+           (err-sound "fmpg-decode-next failed: ~a" dec-val)
+           (cb 'done -1 #f 0)]))
       #t)
 
     (define (seek pcm-pos)

flac-decoder.rkt

@@ -3,7 +3,9 @@
   (require ffi/unsafe
            "libflac-ffi.rkt"
            "flac-definitions.rkt"
-           "private/utils.rkt")
+           "private/utils.rkt"
+           let-assert
+           )
 
   (provide flac-open
            flac-valid?
@@ -13,8 +15,6 @@
            flac-stop
            flac-seek
            (all-from-out "flac-definitions.rkt")
-           kinds
-           last-buffer last-buf-len
            )
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
@@ -26,112 +26,31 @@
 
   (define (flac-open flac-file* cb-stream-info cb-audio)
     (let ((flac-file (if (path? flac-file*) (path->string flac-file*) flac-file*)))
-      (if (file-exists? flac-file)
+      (and (string? flac-file)
-          (let ((handler (flac-ffi-decoder-handler)))
+           (file-exists? flac-file)
-            (handler 'new)
+           (let ((handler (flac-ffi-decoder-handler)))
-            (handler 'init flac-file)
+             (let/assert
-            (let ((h (make-flac-handle handler)))
+              ((dec (handler 'new) a-!nullptr? #f)
-              (set-flac-handle-cb-stream-info! h cb-stream-info)
+               (ret (handler 'init flac-file) zero? (begin (handler 'delete) #f)))
-              (set-flac-handle-cb-audio! h cb-audio)
+              (let ((h (make-flac-handle handler)))
-              h))
+                (set-flac-handle-cb-stream-info! h cb-stream-info)
-          #f)))
+                (set-flac-handle-cb-audio! h cb-audio)
+                h))))))
 
   (define (flac-stream-state handle)
     ((flac-handle-ffi-decoder-handler handle) 'state))
 
+  (define (process-frame handle h mem-out)
+     (let* ([cb-audio (flac-handle-cb-audio handle)]
+            [type     (hash-ref h 'number-type)]
+            [buf-size (bytes-length mem-out)])
 
-  (define kinds (make-hash))
+       (hash-set! h 'duration (flac-duration handle))
-  (define last-buffer #f)
-  (define last-buf-len #f)
 
- (define (endian-little? e)
+       (when (procedure? cb-audio)
-  (cond [(eq? e 'little-endian) #t]
+         (cb-audio h mem-out buf-size))
-        [(eq? e 'big-endian) #f]
-        [(eq? e 'native-endian) (not (system-big-endian?))]
-        [else (error (format "unknown endian value: ~a" e))]))
 
-  #|
+       #t))
-  (define (flac-channels->interleaved-buffer buffer block-size channels bits endianness)
-    (let* ([bytes   (quotient bits 8)]
-           [little? (endian-little? endianness)]
-           [buf-size (* block-size channels bytes)]
-           [mem-out  (malloc buf-size 'atomic)]
-           [out-pos  0])
-
-      (for ([k (in-range block-size)])
-        (for ([channel (in-range channels)])
-          (let* ([channel-ptr (ptr-ref buffer _pointer channel)]
-                 [sample      (ptr-ref channel-ptr _int32 k)])
-
-            (if little?
-                (for ([j (in-range bytes)])
-                  (ptr-set! mem-out _uint8 (+ out-pos j)
-                            (bitwise-and
-                             (arithmetic-shift sample (* -8 j))
-                             #xff)))
-                (for ([j (in-range bytes)])
-                  (ptr-set! mem-out _uint8 (+ out-pos j)
-                            (bitwise-and
-                             (arithmetic-shift sample
-                                               (* -8 (- bytes j 1)))
-                             #xff))))
-
-            (set! out-pos (+ out-pos bytes)))))
-
-      (list mem-out buf-size)))
-|#
-
-(define (flac-channels->interleaved-buffer buffer block-size channels bits endianness)
-  ;; buffer    = FLAC__int32 * const buffer[]
-  ;; block-size = samples per channel
-
-  (let* ([bytes    (quotient bits 8)]
-         [big?     (not (endian-little? endianness))]
-         [buf-size (* block-size channels bytes)]
-         [bs       (make-bytes buf-size)]
-         ;[out      (malloc buf-size 'atomic-interior)]
-         [out-pos  0])
-
-    (for ([k (in-range block-size)])
-      (for ([channel (in-range channels)])
-        (let* ([chan   (ptr-ref buffer _pointer channel)]
-               [sample (ptr-ref chan _int32 k)])
-          (integer->int-bytes sample bytes #t big? bs out-pos)
-          (set! out-pos (+ out-pos bytes)))))
-
-    ;(memcpy out bs buf-size)
-    ;(list out buf-size)
-    (list bs buf-size)
-    ))
-  
-  (define (process-frame handle frame buffer)
-    (let* ([h          (flac-ffi-frame-header frame)]
-           [cb-audio   (flac-handle-cb-audio handle)]
-           [type       (hash-ref h 'number-type)]
-           [channels   (hash-ref h 'channels)]
-           [block-size (hash-ref h 'blocksize)]
-           [bits       (hash-ref h 'bits-per-sample)]
-           [endianness 'native-endian]
-           [result     (flac-channels->interleaved-buffer
-                        buffer block-size channels bits endianness)]
-           [mem-out    (car result)]
-           [buf-size   (cadr result)])
-
-      (hash-set! h 'duration (flac-duration handle))
-      (hash-set! h 'sample (hash-ref h 'number))
-      (hash-set! h 'type 'interleaved)
-      (hash-set! h 'endianness endianness)
-      (hash-set! h 'bits-per-sample bits)
-
-      (set! last-buffer mem-out)
-      (set! last-buf-len buf-size)
-
-      (hash-set! kinds type #t)
-
-      (when (procedure? cb-audio)
-        (cb-audio h mem-out buf-size))
-
-      #t))
   
   (define (process-meta handle meta)
     (let ((type (FLAC__StreamMetadata-type meta)))
@@ -151,6 +70,7 @@
                                  (hash-ref mh 'sample-rate)))))
                (hash-set! mh 'duration duration))
              (set-flac-handle-stream-info! handle si)
+             (hash-set! mh 'audio-bits-per-sample (hash-ref mh 'bits-per-sample))
              (hash-set! mh 'bits-per-sample 32)  ; Flac works internally 32 bits.
              (let ((cb (flac-handle-cb-stream-info handle)))
                (when (procedure? cb)
@@ -159,9 +79,24 @@
       )
     )
 
+  (define (flac-err->str nr)
+    (cond
+      ((= nr 0) "0 = Lost Sync: An error in the stream caused the decoder to lose synchronization.")
+      ((= nr 1) "1 = Bad Header: The decoder encountered a corrupted frame header.")
+      ((= nr 2) "2 = CRC Mismatch: The frame's data did not match the CRC in the footer.")
+      ((= nr 3) "3 = Unparseable Stream: The decoder encountered reserved fields in use in the stream.")
+      ((= nr 4) "4 = Bad Metadata: The decoder encountered a corrupted metadata block.")
+      ((= nr 5) "5 = Out of bounds: The decoder encountered a otherwise valid frame in which the decoded samples exceeded the range offered by the stated bit depth.")
+      ((= nr 6) "6 = Missing Frame: Two adjacent frames had frame numbers increasing by more than 1 or sample numbers increasing by more than the blocksize, indicating that one or more frame/frames was missing between them.")
+      (else (format "~a = Unknown: Unknown status code." nr))
+      )
+    )
+
   (define (flac-read handle)
     (let* ((ffi-handler (flac-handle-ffi-decoder-handler handle))
-           (state (ffi-handler 'state)))
+           (state (ffi-handler 'state))
+           (err-hash (make-hash))
+           )
       (set-flac-handle-stop-reading! handle #f)
       (set-flac-handle-reading! handle #t)
       (letrec ((reader (lambda (frame-nr)
@@ -178,7 +113,12 @@
                                             st frame-nr (ffi-handler 'int-state))
                                  )
                                (when (ffi-handler 'has-errno?)
-                                 (err-sound "Error in stream: ~a" (ffi-handler 'errno))
+                                 (let ((errno (ffi-handler 'errno)))
+                                   (unless (eq? (hash-ref err-hash errno #f) #f)
+                                     (hash-set! err-hash errno #t)
+                                     (warn-sound "Error in stream: ~a (frame-nr = ~a) (int-state = ~a)"
+                                                 (flac-err->str errno)
+                                                 frame-nr (ffi-handler 'int-state))))
                                  )
                                (when (ffi-handler 'has-meta-data?)
                                  (ffi-handler 'process-meta-data
@@ -186,9 +126,10 @@
                                  )
                                (when (ffi-handler 'has-write-data?)
                                  (ffi-handler 'process-write-data
-                                              (lambda (frame buffer)
+                                              (lambda (h mem-out)
-                                                (process-frame handle frame buffer)))
+                                                (process-frame handle h mem-out)))
                                  )
+                               
                                (if (eq? st 'end-of-stream)
                                    (begin
                                      (set-flac-handle-reading! handle #f)
@@ -220,25 +161,34 @@
             (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* ((ffi-handler (flac-handle-ffi-decoder-handler handle))
-      (let ((total-samples (flac-total-samples handle)))
+           (total-samples (flac-total-samples handle)))
-        (unless (eq? total-samples #f)
+      (and total-samples
-          (let ((sample (inexact->exact (round (* (exact->inexact (/ percentage 100.0)) total-samples)))))
+           (> total-samples 0)
-            (ffi-handler 'seek-to-sample sample))
+           (let* ((percentage (max 0 (min 100 percentage)))
-          )
+                  (sample (inexact->exact
-        )
+                           (round (* (/ percentage 100.0) total-samples))))
-      )
+                  (sample (min sample (- total-samples 1))))
-    )
+             (ffi-handler 'seek-to-sample sample)))))
-    
 
+  
   (define (flac-stop handle)
     (let ((ct (current-milliseconds)))
       (dbg-sound "requesting stop at: ~a" ct)
-      (set-flac-handle-stop-reading! handle #t)
+      (if (flac-handle-reading handle)
-      (while (flac-handle-reading handle)
+          (begin ; in reading
-             (sleep 0.01))
+            (set-flac-handle-stop-reading! handle #t)
+            (while (flac-handle-reading handle)
+                   (sleep 0.01)))
+          (begin ; never starte reading, or reading finished
+            (dbg-sound "not reading flac, need to finish flac")
+            (let ((ffi-handler (flac-handle-ffi-decoder-handler handle)))
+              (unless (eq? ffi-handler #f)
+                (ffi-handler 'delete))))
+          )
       (let ((ct* (current-milliseconds)))
         (dbg-sound "stop came back at: ~a" ct*)
         (dbg-sound "flac-stop took: ~a ms" (- ct* ct)))

flac-definitions.rkt

@@ -25,6 +25,13 @@
            flac-bits-per-sample
            flac-total-samples
            flac-duration
+
+           flac-encoder-handle
+           make-flac-encoder-handle
+           flac-encoder-handle-ffi-encoder-handler
+           flac-encoder-handle-settings
+           flac-encoder-handle-format
+           flac-encoder-handle-file
            )
 
   (define-struct flac-stream-info 
@@ -105,4 +112,12 @@
      ;#:transparent
     )
 
+
+  ;; A high level FLAC encoder handle.  The actual native encoder pointer
+  ;; remains encapsulated in the FFI command handler, matching the existing
+  ;; decoder-side style in this package.
+  (define-struct flac-encoder-handle
+    (ffi-encoder-handler settings format file)
+    #:transparent)
+
   ); end of module

flac-encoder.rkt

@@ -0,0 +1,90 @@
+(module flac-encoder racket/base
+
+  (require "libflac-ffi.rkt"
+           "flac-definitions.rkt")
+
+  (provide flac-encoder-available?
+           flac-encoder-default-settings
+           flac-encoder-prepare-settings
+           flac-encoder-open
+           flac-encoder-write
+           flac-encoder-finish)
+
+  (define (flac-encoder-available?) #t)
+
+  (define (copy-hash h)
+    (let ((out (make-hash)))
+      (for-each (lambda (k) (hash-set! out k (hash-ref h k))) (hash-keys h))
+      out))
+
+  (define (hash-ref/default h k default)
+    (if (hash-has-key? h k) (hash-ref h k) default))
+
+  (define (hash-merge base override)
+    (let ((out (copy-hash base)))
+      (when (hash? override)
+        (for-each (lambda (k) (hash-set! out k (hash-ref override k))) (hash-keys override)))
+      out))
+
+  (define (flac-encoder-default-settings)
+    (make-hash '((compression-level . 5)
+                 (verify? . #f)
+                 (blocksize . 0))))
+
+  (define (source-value v source)
+    (if (eq? v 'source) source v))
+
+  (define (safe-flac-bits bits)
+    (cond [(and (integer? bits) (or (= bits 8) (= bits 12) (= bits 16) (= bits 20) (= bits 24))) bits]
+          [(and (integer? bits) (< bits 16)) 16]
+          [else 24]))
+
+  (define (flac-encoder-prepare-settings settings format)
+    (let* ((base (flac-encoder-default-settings))
+           (h (hash-merge base settings))
+           ;; In encoder settings, 'sample-rate means the requested output rate.
+           ;; 'target-sample-rate is accepted as an explicit alias for readability.
+           (source-rate (hash-ref format 'sample-rate))
+           (source-channels (hash-ref format 'channels))
+           (source-bits (hash-ref/default format 'bits-per-sample 24))
+           (rate (source-value (hash-ref/default h 'target-sample-rate
+                                                (hash-ref/default h 'sample-rate source-rate))
+                               source-rate))
+           (channels (source-value (hash-ref/default h 'target-channels
+                                                    (hash-ref/default h 'channels source-channels))
+                                   source-channels))
+           (bits0 (source-value (hash-ref/default h 'target-bits-per-sample
+                                                 (hash-ref/default h 'bits-per-sample source-bits))
+                                source-bits))
+           (bits (safe-flac-bits bits0))
+           (total (hash-ref/default h 'total-samples (hash-ref/default format 'total-samples #f))))
+      (hash-set! h 'sample-rate rate)
+      (hash-set! h 'channels channels)
+      (hash-set! h 'bits-per-sample bits)
+      (when (hash-has-key? h 'target-sample-rate) (hash-remove! h 'target-sample-rate))
+      (when (hash-has-key? h 'target-channels) (hash-remove! h 'target-channels))
+      (when (hash-has-key? h 'target-bits-per-sample) (hash-remove! h 'target-bits-per-sample))
+      (when (and total (integer? total) (>= total 0)) (hash-set! h 'total-samples total))
+      (unless (hash-has-key? h 'streamable-subset?) (hash-set! h 'streamable-subset? (<= bits 24)))
+      h))
+
+  (define (flac-encoder-open output-file settings format)
+    (let* ((file (if (path? output-file) (path->string output-file) output-file))
+           (resolved (flac-encoder-prepare-settings settings format))
+           (handler (flac-ffi-encoder-handler)))
+      (handler 'new)
+      (handler 'configure resolved)
+      (handler 'init file)
+      (make-flac-encoder-handle handler resolved format file)))
+
+  (define (flac-encoder-write handle buf-info buffer buf-len)
+    ((flac-encoder-handle-ffi-encoder-handler handle) 'write buffer buf-len buf-info))
+
+  (define (flac-encoder-finish handle)
+    (let ((handler (flac-encoder-handle-ffi-encoder-handler handle)))
+      (dynamic-wind
+       void
+       (lambda () (handler 'finish))
+       (lambda () (handler 'delete)))))
+
+  ) ; end of module

info.rkt

@@ -8,19 +8,18 @@
 
 (define scribblings
   '(
-    ("scrbl/libao.scrbl" () (library))
+    ("scrbl/racket-audio.scrbl" (multi-page) (library 0))
-    ("scrbl/audio-decoder.scrbl" () (library))
+    ))
-    ("scrbl/flac-decoder.scrbl" () (library))
-    ("scrbl/mp3-decoder.scrbl" () (library))
-    ("scrbl/audio-sniffer.scrbl" () (library))
-    ("scrbl/ffmpeg-ffi.scrbl" () (library))
-    ("scrbl/ffmpeg-decoder.scrbl" () (library))
-    ("scrbl/ffmpeg-c-backend.scrbl" () (library))
-    )
-  )
 
 (define deps
-  '("racket/gui" "racket/base" "racket" "finalizer" "draw-lib" "net-lib" "simple-log" "racket-sprintf" "define-return" "let-assert")
+  '("racket/gui" "racket/base" "racket"
+                 "finalizer" "draw-lib" "net-lib"
+                 "simple-log" "simple-ini" "racket-sprintf"
+                 "racket-mimetypes"
+                 "early-return" "let-assert"
+                 "uni-channel" "port-channel"
+                 "rackunit-lib"
+                 )
   )
 
 (define build-deps

libao-async-ffi-racket.rkt

@@ -14,7 +14,8 @@
          racket/async-channel
          data/queue
          racket/list
-         "private/utils.rkt")
+         "private/utils.rkt"
+         racket/place)
 
 (provide ao_version_async
          ao_create_async
@@ -33,6 +34,8 @@
          ao_sample_queue_len
          make-buffer-info
          make-BufferInfo_t
+         ao-playback-buf-ms
+         ao-set-playback-buf-ms!
          )
 
 ;; -------------------------------------------------------------------------
@@ -61,10 +64,12 @@
 
 (define libao
   (get-lib (list (case (system-type 'os)
-             [(windows) "libao-1.2.2"]
+                   [(windows) "libao-1.2.2"]
-             [else      "libao"])) '(#f)))
+                   [else      "libao"]))
+           (linux-lib-versions '("4" #f))))
 
-(define-ffi-definer define-ao libao)
+(define-ffi-definer define-ao libao
+  #:default-make-fail make-not-available)
 
 (define _ao-device (_cpointer/null 'ao-device))
 (define _ao-option (_cpointer/null 'ao-option))
@@ -194,7 +199,13 @@
 ;; Playback buffer to send to libao in milliseconds
 ;; -------------------------------------------------------------------------
 
-(define ao-buf-ms 250)  ;; Playback buffer of 0.25s
+(define ao-buf-ms 350)  ;; Playback buffer of 0.35s
+
+(define (ao-playback-buf-ms)
+  ao-buf-ms)
+
+(define (ao-set-playback-buf-ms! ms)
+  (set! ao-buf-ms ms))
 
 ;; -------------------------------------------------------------------------
 ;; Sample queue handling
@@ -216,12 +227,13 @@
   )
 
 
-(define (needed-bytes h)
+(define (needed-bytes h elem-buflen)
   (let ((req-bytes (/ (ao-handle-dev-bits-per-sample h) 8))
         (rate-s (ao-handle-dev-rate h))
         (channels (ao-handle-dev-channels h))
         )
-    (/ (* req-bytes rate-s channels ao-buf-ms) 1000)
+    (let ((needed-for-ao (/ (* req-bytes rate-s channels ao-buf-ms) 1000)))
+      (max needed-for-ao elem-buflen))
     )
   )
 
@@ -247,7 +259,7 @@
             (begin
               (set-ao-handle-current-elem! h elem)
               (set! cb elem)
-              (let* ((ns (needed-bytes h))
+              (let* ((ns (needed-bytes h (queue-elem-buflen elem)))
                      (new-buf (alloc-buf h ns)))
                 (m-memcpy new-buf (queue-elem-buf cb) (queue-elem-buflen cb))
                 (reuse-buf h (queue-elem-buf cb))
@@ -272,7 +284,7 @@
                   (reuse-buf h (queue-elem-buf elem))
                   (when (= (ao-handle-bytes-left h) 0)
                     (async-channel-put (ao-handle-queue h) cb)
-                    (set-ao-handle-in-queue! h (+ ao-handle-in-queue h) 1)
+                    (set-ao-handle-in-queue! h (+ (ao-handle-in-queue h) 1))
                     (set-ao-handle-current-elem! h #f))
                   )
                 )
@@ -423,8 +435,8 @@
 
 
 (define (planar-to-interleaved h in-buf info)
-  ;; mem: bytes
+  ;; in-buf: mem
-  ;; result: (list bytes output-size)
+  ;; result: mem
 
   (let* ([in-bytes   (mem-bytes in-buf)]
          [buf-size   (mem-size in-buf)]
@@ -456,7 +468,7 @@
                              bytes)])
             (bytes-copy! out-bytes out-pos in-bytes in-pos (+ in-pos bytes)))))
 
-      out out-size)))
+      out)))
 
 ;;; requested bits to device bits
 
@@ -503,6 +515,7 @@
 ;; ASync player
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 
+
 (define (run h)
   (thread
    (λ ()

libao-async-ffi.rkt

@@ -1,115 +0,0 @@
-#lang racket/base
-
-
-(require ffi/unsafe
-         ffi/unsafe/define
-         "private/utils.rkt"
-         ;"libao-ffi.rkt"
-         )
-
-(provide ao_create_async
-         ao_real_output_bits_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_reuse_buf_len
-         ao_clear_async
-         ao_pause_async
-         ao_set_volume_async
-         ao_volume_async
-         make-BufferInfo_t
-         ao_version
-         )
-
-(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]
-   ))
-
-(define (ao_version)
-  (let* ((v (ao_async_version))
-         (patch (remainder v 256))
-         (minor (remainder (quotient v 256) 256))
-         (major (quotient v 65536))
-         )
-    (list major minor patch)))
-
-
-(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 _string/utf-8 -> _libao-async-handle-pointer))
-
-;extern int ao_real_output_bits(void *handle)
-(define-libao-async ao_real_output_bits_async
-  (_fun _libao-async-handle-pointer -> _int))
-
-;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))
-
-;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))
-
-(define (ao_reuse_buf_len h) -1)
-  

libao.rkt

@@ -31,8 +31,11 @@
          ao-valid-format?
          ao-handle?
          ao-supported-music-format?
+         ao-playback-buf-ms
+         ao-set-playback-buf-ms!
          )
 
+
 (define device-number 1)
 
 (define-struct ao-handle (handle-num
@@ -50,6 +53,10 @@
   )
 
 
+(define ao-playback-buf-ms ffi:ao-playback-buf-ms)
+(define ao-set-playback-buf-ms! ffi:ao-set-playback-buf-ms!)
+
+
 (define (ao-supported-music-format? f)
   (and (symbol? f)
        (or (eq? f 'flac)

libflac-ffi.rkt

@@ -6,6 +6,7 @@
          )
 
 (provide flac-ffi-decoder-handler
+         flac-ffi-encoder-handler
          _FLAC__StreamMetadata
          FLAC__StreamMetadata-type
          flac-ffi-meta
@@ -15,7 +16,7 @@
          )
 
 
-(define lib (get-lib '("libFLAC") '(#f)))
+(define lib (get-lib '("FLAC" "libFLAC") (linux-lib-versions '("14" "12" "8" #f))))
 (define-ffi-definer define-libflac lib
   #:default-make-fail make-not-available)
 
@@ -108,21 +109,6 @@
            undefined
            )))
 
-
-;typedef enum {
-;    FLAC__STREAM_DECODER_SEARCH_FOR_METADATA = 0,
-;    FLAC__STREAM_DECODER_READ_METADATA,
-;    FLAC__STREAM_DECODER_SEARCH_FOR_FRAME_SYNC,
-;    FLAC__STREAM_DECODER_READ_FRAME,
-;    FLAC__STREAM_DECODER_END_OF_STREAM,
-;    FLAC__STREAM_DECODER_OGG_ERROR,
-;    FLAC__STREAM_DECODER_SEEK_ERROR,
-;    FLAC__STREAM_DECODER_ABORTED,
-;    FLAC__STREAM_DECODER_MEMORY_ALLOCATION_ERROR,
-;    FLAC__STREAM_DECODER_UNINITIALIZED,
-;    FLAC__STREAM_DECODER_END_OF_LINK
-;} FLAC__StreamDecoderState;
-
 (define _FLAC_StreamDecoderState
   (_enum '(search-for-metadata = 0
            read-metadata
@@ -247,23 +233,6 @@
 ;; FLAC Metadata 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 
-;typedef struct FLAC__StreamMetadata {
-;    FLAC__MetadataType type;
-;    FLAC__bool is_last;
-;    uint32_t length;
-;    union {
-;        FLAC__StreamMetadata_StreamInfo stream_info;
-;        FLAC__StreamMetadata_Padding padding;
-;        FLAC__StreamMetadata_Application application;
-;        FLAC__StreamMetadata_SeekTable seek_table;
-;        FLAC__StreamMetadata_VorbisComment vorbis_comment;
-;        FLAC__StreamMetadata_CueSheet cue_sheet;
-;        FLAC__StreamMetadata_Picture picture;
-;        FLAC__StreamMetadata_Unknown unknown;
-;    } data;
-;} FLAC__StreamMetadata;
-
-
 (define-cstruct _FLAC__StreamMetadata_StreamInfo
   (
    [min_blocksize _uint32_t]
@@ -403,6 +372,7 @@
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 
 (define _FLAC__StreamDecoder-pointer (_cpointer 'flac-streamdecoder))
+(define _FLAC__StreamEncoder-pointer (_cpointer 'flac-streamencoder))
 (define _FLAC__Data-pointer (_cpointer/null 'flac-client-data))
 ;(define _FLAC__StreamMetadata-pointer (_cpointer/null 'flac-stream-metadata))
 
@@ -410,27 +380,46 @@
 ;; FLAC Callback function definitions
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 
-  
+;; libFLAC keeps the C callback pointers that are passed to
+;; FLAC__stream_decoder_init_file and calls them later from
+;; FLAC__stream_decoder_process_single. When process_single runs in a
+;; Racket thread with #:pool 'own, those callbacks can arrive from a
+;; different OS thread than the ordinary Racket coroutine-thread OS
+;; thread. Use #:async-apply so Racket can transfer such callback
+;; invocations safely, and use a per-decoder #:keep box so the generated
+;; callback stubs stay reachable as long as the decoder can call them.
+(define (flac-callback-async-apply thunk)
+  (thunk))
+
 ;typedef FLAC__StreamDecoderWriteStatus(* FLAC__StreamDecoderWriteCallback) (const FLAC__StreamDecoder *decoder, const FLAC__Frame *frame, const FLAC__int32 *const buffer[], void *client_data)
-(define _FLAC__StreamDecoderWriteCallback
+(define (make-FLAC__StreamDecoderWriteCallback keep-box)
-  (_fun _FLAC__StreamDecoder-pointer
+  (_cprocedure
-        _FLAC__Frame-pointer
+   (list _FLAC__StreamDecoder-pointer
-        FLAC__int32** 
+         _FLAC__Frame-pointer
-        _FLAC__Data-pointer
+         FLAC__int32**
-        -> _int))
+         _FLAC__Data-pointer)
+   _int
+   #:async-apply flac-callback-async-apply
+   #:keep keep-box))
 
 ;typedef void(* FLAC__StreamDecoderMetadataCallback) (const FLAC__StreamDecoder *decoder, const FLAC__StreamMetadata *metadata, void *client_data)
-(define _FLAC__StreamDecoderMetadataCallback
+(define (make-FLAC__StreamDecoderMetadataCallback keep-box)
-  (_fun _FLAC__StreamDecoder-pointer
+  (_cprocedure
-        _FLAC__StreamMetadata-pointer
+   (list _FLAC__StreamDecoder-pointer
-        _FLAC__Data-pointer
+         _FLAC__StreamMetadata-pointer
-        -> _void))
+         _FLAC__Data-pointer)
+   _void
+   #:async-apply flac-callback-async-apply
+   #:keep keep-box))
 
-(define _FLAC__StreamDecoderErrorCallback
+(define (make-FLAC__StreamDecoderErrorCallback keep-box)
-  (_fun _FLAC__StreamDecoder-pointer
+  (_cprocedure
-        _int
+   (list _FLAC__StreamDecoder-pointer
-        _FLAC__Data-pointer
+         _int
-        -> _void))
+         _FLAC__Data-pointer)
+   _void
+   #:async-apply flac-callback-async-apply
+   #:keep keep-box))
 
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
@@ -443,6 +432,9 @@
 (define-libflac FLAC__stream_decoder_delete
   (_fun _FLAC__StreamDecoder-pointer -> _void))
 
+(define-libflac FLAC__stream_decoder_finish
+  (_fun _FLAC__StreamDecoder-pointer -> _int))
+
 (define-libflac FLAC__stream_decoder_get_state
   (_fun _FLAC__StreamDecoder-pointer -> _int))
 
@@ -466,10 +458,10 @@
 (define-libflac FLAC__stream_decoder_init_file
   (_fun _FLAC__StreamDecoder-pointer
         _string/utf-8
-        _FLAC__StreamDecoderWriteCallback
+        _pointer
-        _FLAC__StreamDecoderMetadataCallback
+        _pointer
-        _FLAC__StreamDecoderErrorCallback
+        _pointer
-        _FLAC__Data-pointer  ; Seen by Jens Axel Søgaard - Is already present in FLAC 1.4.3 
+        _FLAC__Data-pointer  ; Seen by Jens Axel Søgaard - Is already present in FLAC 1.4.3
         -> _int))
 
 (define-libflac FLAC__stream_decoder_process_single
@@ -498,6 +490,52 @@
 ;; Our interface for decoding to racket
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 
+(define (endian-little? e)
+  (cond [(eq? e 'little-endian) #t]
+        [(eq? e 'big-endian) #f]
+        [(eq? e 'native-endian) (not (system-big-endian?))]
+        [else (error (format "unknown endian value: ~a" e))]))
+
+(define (flac-channels->interleaved-buffer buffer block-size channels bits endianness)
+  ;; buffer    = FLAC__int32 * const buffer[]
+  ;; block-size = samples per channel
+
+  (let* ([bytes    (quotient bits 8)]
+         [big?     (not (endian-little? endianness))]
+         [buf-size (* block-size channels bytes)]
+         [bs       (make-bytes buf-size)]
+         ;[out      (malloc buf-size 'atomic-interior)]
+         [out-pos  0])
+
+    (for ([k (in-range block-size)])
+      (for ([channel (in-range channels)])
+        (let* ([chan   (ptr-ref buffer _pointer channel)]
+               [sample (ptr-ref chan _int32 k)])
+          (integer->int-bytes sample bytes #t big? bs out-pos)
+          (set! out-pos (+ out-pos bytes)))))
+
+    ;(memcpy out bs buf-size)
+    ;(list out buf-size)
+    (list bs buf-size)
+    ))
+  
+(define (copy-flac-frame frame buffer)
+  (let* ((h          (flac-ffi-frame-header frame))
+         (channels   (hash-ref h 'channels))
+         (block-size (hash-ref h 'blocksize))
+         (bits       (hash-ref h 'bits-per-sample))
+         (endianness 'native-endian)
+         (result     (flac-channels->interleaved-buffer
+                      buffer block-size channels bits endianness))
+         (bs         (car result))
+         (buf-size   (cadr result)))
+    (hash-set! h 'type 'interleaved)
+    (hash-set! h 'endianness endianness)
+    (hash-set! h 'bits-per-sample bits)
+    (hash-set! h 'sample (hash-ref h 'number))
+    (cons h bs)))
+  
+
 (define (flac-ffi-decoder-handler)
   (define write-data '())
   (define meta-data '())
@@ -505,19 +543,46 @@
   (define fl #f)
   (define flac-file #f)
   (define client-data #f)
-  
+  (define callback-keepers (box null))
-  (define (write-callback fl frame buffer client-data)
-    (set! write-data (append write-data (list (cons frame buffer))))
-    0)
 
+  (define (make-decoder-callback proc type)
+    ;; Convert the Racket procedure to a C function pointer with a type
+    ;; that uses callback-keepers as #:keep. The raw pointer is passed to
+    ;; libFLAC, while the keeper box retains the generated callback stub
+    ;; until delete releases it after FLAC__stream_decoder_finish/delete.
+    (cast proc type _pointer))
+
+  ;(define (write-callback fl frame buffer client-data)
+  ;  (set! write-data (append write-data (list (cons frame buffer))))
+  ;  0)
+  (define (write-callback fl frame buffer client-data)
+    (with-handlers ([exn:fail?
+                     (lambda (e)
+                       ;; Never let a Racket exception escape through a C
+                       ;; callback. Return FLAC__STREAM_DECODER_WRITE_STATUS_ABORT.
+                       (set! error-no -2)
+                       1)])
+      (set! write-data (cons (copy-flac-frame frame buffer) write-data))
+      0))
+
+  ;(define (meta-callback fl meta client-data)
+  ;  (let ((meta-clone (FLAC__metadata_object_clone meta)))
+  ;    (unless (eq? meta-clone #f)
+  ;      (set! meta-data (append meta-data (list meta-clone))))))
   (define (meta-callback fl meta client-data)
-    (let ((meta-clone (FLAC__metadata_object_clone meta)))
+    (with-handlers ([exn:fail?
-      (unless (eq? meta-clone #f)
+                     (lambda (e)
-        (set! meta-data (append meta-data (list meta-clone))))))
+                       ;; Metadata callbacks return void; remember failure and
+                       ;; let the decoder state/error path report it.
+                       (set! error-no -3)
+                       (void))])
+      (let ((meta-clone (FLAC__metadata_object_clone meta)))
+        (unless (eq? meta-clone #f)
+          (set! meta-data (cons meta-clone meta-data))))))
 
   (define (error-callback fl errno client-data)
     (set! error-no errno)
-    )
+    (void))
 
   (define (new)
     (dbg-sound "flac-ffi 'new")
@@ -528,13 +593,25 @@
 
   (define (init file)
     (dbg-sound "flac-ffi 'init")
-    (let ((r (FLAC__stream_decoder_init_file
+    (let* ((write-callback-ptr
-              fl
+            (make-decoder-callback
-              file
+             write-callback
-              write-callback
+             (make-FLAC__StreamDecoderWriteCallback callback-keepers)))
-              meta-callback
+           (meta-callback-ptr
-              error-callback
+            (make-decoder-callback
-              client-data)))
+             meta-callback
+             (make-FLAC__StreamDecoderMetadataCallback callback-keepers)))
+           (error-callback-ptr
+            (make-decoder-callback
+             error-callback
+             (make-FLAC__StreamDecoderErrorCallback callback-keepers)))
+           (r (FLAC__stream_decoder_init_file
+               fl
+               file
+               write-callback-ptr
+               meta-callback-ptr
+               error-callback-ptr
+               client-data)))
       (set! flac-file file)
       r))
 
@@ -543,9 +620,12 @@
     (if (eq? fl #f)
         (error "flac handler has already been deleted")
         (begin
+          (FLAC__stream_decoder_finish fl)
           (FLAC__stream_decoder_delete fl)
-          (set! fl #f)))
+          (set! fl #f)
-    )
+          ;; libFLAC cannot call the callbacks anymore after finish/delete,
+          ;; so the generated callback stubs can now be released.
+          (set-box! callback-keepers null))))
 
   (define (process-single)
     (FLAC__stream_decoder_process_single fl))
@@ -557,16 +637,16 @@
     (decoder-state (int-state)))
 
   (define (process-meta-data cb)
-    (for-each (λ (meta-entry)
+    (for-each (lambda (meta-entry)
                 (cb meta-entry)
                 (FLAC__metadata_object_delete meta-entry))
-              meta-data)
+              (reverse meta-data))
     (set! meta-data '()))
 
   (define (process-write-data cb)
-    (for-each (lambda (d)
+  (for-each (lambda (d)
-                (cb (car d) (cdr d)))
+              (cb (car d) (cdr d)))
-              write-data)
+            (reverse write-data))
     (set! write-data '()))
 
   (define (buffer->vectorlist buffer channels size)
@@ -618,4 +698,164 @@
       ))
   )
 
-); end of module
+
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; Direct FLAC encoder interface
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(define FLAC__StreamEncoderInitStatus-ok 0)
+
+(define _FLAC__StreamEncoderProgressCallback _pointer)
+
+(define-libflac FLAC__stream_encoder_new
+  (_fun -> _FLAC__StreamEncoder-pointer))
+
+(define-libflac FLAC__stream_encoder_delete
+  (_fun _FLAC__StreamEncoder-pointer -> _void))
+
+(define-libflac FLAC__stream_encoder_finish
+  (_fun _FLAC__StreamEncoder-pointer -> FLAC__bool))
+
+(define-libflac FLAC__stream_encoder_get_state
+  (_fun _FLAC__StreamEncoder-pointer -> _int))
+
+(define-libflac FLAC__stream_encoder_set_verify
+  (_fun _FLAC__StreamEncoder-pointer FLAC__bool -> FLAC__bool))
+
+(define-libflac FLAC__stream_encoder_set_streamable_subset
+  (_fun _FLAC__StreamEncoder-pointer FLAC__bool -> FLAC__bool))
+
+(define-libflac FLAC__stream_encoder_set_channels
+  (_fun _FLAC__StreamEncoder-pointer _uint32_t -> FLAC__bool))
+
+(define-libflac FLAC__stream_encoder_set_bits_per_sample
+  (_fun _FLAC__StreamEncoder-pointer _uint32_t -> FLAC__bool))
+
+(define-libflac FLAC__stream_encoder_set_sample_rate
+  (_fun _FLAC__StreamEncoder-pointer _uint32_t -> FLAC__bool))
+
+(define-libflac FLAC__stream_encoder_set_compression_level
+  (_fun _FLAC__StreamEncoder-pointer _uint32_t -> FLAC__bool))
+
+(define-libflac FLAC__stream_encoder_set_blocksize
+  (_fun _FLAC__StreamEncoder-pointer _uint32_t -> FLAC__bool))
+
+(define-libflac FLAC__stream_encoder_set_total_samples_estimate
+  (_fun _FLAC__StreamEncoder-pointer FLAC__uint64 -> FLAC__bool))
+
+(define-libflac FLAC__stream_encoder_init_file
+  (_fun _FLAC__StreamEncoder-pointer
+        _string/utf-8
+        _FLAC__StreamEncoderProgressCallback
+        _FLAC__Data-pointer
+        -> _int))
+
+(define-libflac FLAC__stream_encoder_process_interleaved
+  (_fun _FLAC__StreamEncoder-pointer _pointer _uint32_t -> FLAC__bool))
+
+(define (hash-ref/default h k default)
+  (if (hash-has-key? h k) (hash-ref h k) default))
+
+(define (bool->flac-bool v) (if v 1 0))
+
+(define (native-signed-ref bs start bytes)
+  (int-bytes->integer bs #t (system-big-endian?) start (+ start bytes)))
+
+(define (scale-sample sample in-bits out-bits)
+  (cond [(> in-bits out-bits) (arithmetic-shift sample (- out-bits in-bits))]
+        [(< in-bits out-bits) (arithmetic-shift sample (- out-bits in-bits))]
+        [else sample]))
+
+(define (pcm-bytes->flac-int32-pointer buffer size channels in-bits out-bits)
+  (let* ((in-bytes (quotient in-bits 8))
+         (sample-count (quotient size in-bytes))
+         (frame-count (quotient sample-count channels))
+         (ptr (malloc _int32 sample-count 'atomic-interior)))
+    (for ([i (in-range sample-count)])
+      (let* ((off (* i in-bytes))
+             (sample (native-signed-ref buffer off in-bytes)))
+        (ptr-set! ptr _int32 i (scale-sample sample in-bits out-bits))))
+    (values ptr frame-count)))
+
+(define (flac-ffi-encoder-handler)
+  (define enc #f)
+  (define flac-file #f)
+  (define settings #f)
+
+  (define (require-encoder who)
+    (when (eq? enc #f) (error who "FLAC encoder is not initialized")))
+
+  (define (new)
+    (if (eq? enc #f)
+        (begin (set! enc (FLAC__stream_encoder_new)) enc)
+        (error 'flac-ffi-encoder-handler "FLAC encoder already initialized")))
+
+  (define (configure h)
+    (require-encoder 'flac-encoder-configure)
+    (set! settings h)
+    (let ((channels (hash-ref h 'channels))
+          (sample-rate (hash-ref h 'sample-rate))
+          (bits (hash-ref h 'bits-per-sample))
+          (compression-level (hash-ref/default h 'compression-level 5))
+          (verify? (hash-ref/default h 'verify? #f))
+          (streamable-subset? (hash-ref/default h 'streamable-subset? (<= (hash-ref h 'bits-per-sample) 24)))
+          (blocksize (hash-ref/default h 'blocksize 0))
+          (total-samples (hash-ref/default h 'total-samples #f)))
+      (unless (FLAC__stream_encoder_set_channels enc channels) (error 'flac-encoder-configure "could not set channels"))
+      (unless (FLAC__stream_encoder_set_sample_rate enc sample-rate) (error 'flac-encoder-configure "could not set sample rate"))
+      (unless (FLAC__stream_encoder_set_bits_per_sample enc bits) (error 'flac-encoder-configure "could not set bits per sample"))
+      (unless (FLAC__stream_encoder_set_compression_level enc compression-level) (error 'flac-encoder-configure "could not set compression level"))
+      (unless (FLAC__stream_encoder_set_verify enc (bool->flac-bool verify?)) (error 'flac-encoder-configure "could not set verify"))
+      (unless (FLAC__stream_encoder_set_streamable_subset enc (bool->flac-bool streamable-subset?)) (error 'flac-encoder-configure "could not set streamable subset"))
+      (when (and (integer? blocksize) (> blocksize 0))
+        (unless (FLAC__stream_encoder_set_blocksize enc blocksize) (error 'flac-encoder-configure "could not set blocksize")))
+      (when (and (integer? total-samples) (>= total-samples 0))
+        (unless (FLAC__stream_encoder_set_total_samples_estimate enc total-samples) (error 'flac-encoder-configure "could not set total samples estimate")))
+      #t))
+
+  (define (init file)
+    (require-encoder 'flac-encoder-init)
+    (let ((r (FLAC__stream_encoder_init_file enc file #f #f)))
+      (set! flac-file file)
+      (unless (= r FLAC__StreamEncoderInitStatus-ok)
+        (error 'flac-encoder-init "FLAC encoder init failed with status ~a, state = ~a" r (FLAC__stream_encoder_get_state enc)))
+      #t))
+
+  (define (write buffer size buf-info)
+    (require-encoder 'flac-encoder-write)
+    (let* ((channels (hash-ref settings 'channels))
+           (in-bits (hash-ref/default buf-info 'pcm-bits-per-sample
+                                      (hash-ref/default buf-info 'bits-per-sample
+                                                        (hash-ref settings 'bits-per-sample))))
+           (out-bits (hash-ref settings 'bits-per-sample)))
+      (let-values (((ptr frames) (pcm-bytes->flac-int32-pointer buffer size channels in-bits out-bits)))
+        (unless (FLAC__stream_encoder_process_interleaved enc ptr frames)
+          (error 'flac-encoder-write "FLAC encoder process_interleaved failed, state ~a" (FLAC__stream_encoder_get_state enc)))
+        frames)))
+
+  (define (finish)
+    (require-encoder 'flac-encoder-finish)
+    (FLAC__stream_encoder_finish enc))
+
+  (define (delete)
+    (unless (eq? enc #f)
+      (FLAC__stream_encoder_delete enc)
+      (set! enc #f))
+    #t)
+
+  (lambda (cmd . args)
+    (cond [(eq? cmd 'new) (new)]
+          [(eq? cmd 'configure) (configure (car args))]
+          [(eq? cmd 'init) (init (car args))]
+          [(eq? cmd 'write) (write (car args) (cadr args) (caddr args))]
+          [(eq? cmd 'finish) (finish)]
+          [(eq? cmd 'delete) (delete)]
+          [(eq? cmd 'state) (and enc (FLAC__stream_encoder_get_state enc))]
+          [(eq? cmd 'file) flac-file]
+          [(eq? cmd 'settings) settings]
+          [else (error (format "unknown FLAC encoder command ~a" cmd))])))
+
+
+); end of module
+

libmpg123-ffi.rkt

@@ -10,7 +10,7 @@
 
 
   ;(define lib (ffi-lib "/home/hans/tmp/lib/libmpg123.so")) ;(get-lib '("libmpg123") '("0" #f)))
-  (define lib (get-lib '("libmpg123") '("0" #f)))
+  (define lib (get-lib '("mpg123" "libmpg123") (linux-lib-versions '("0" #f) '("0" #f))))
   (define-ffi-definer define-libmpg123 lib
     #:default-make-fail make-not-available)
 
@@ -405,7 +405,7 @@ int main(int argc, char *argv[])
       )
 
     (define (init file)
-      (let ((r (mpg123_open mh file)))
+      (let ((r (mpg123_open mh (format "~a" file))))
         (unless (eq? r 'MPG123_OK)
           (error (format "mpg123_open: ~a" (mpg123_plain_strerror r))))
         )

main.rkt

@@ -1,14 +1,22 @@
 #lang racket/base
 
-(require "libao.rkt"
+(require "taglib.rkt"
-         "audio-decoder.rkt"
-         "taglib.rkt"
          "audio-sniffer.rkt"
+         "audio-player.rkt"
+         (only-in "audio-decoder.rkt"
+                  audio-supported-extensions
+                  audio-supported-formats
+                  audio-decoder-for-extension)
+         "opusfile-decoder.rkt"
          )
 
-(provide (all-from-out "libao.rkt")
+(provide (all-from-out "taglib.rkt")
-         (all-from-out "audio-decoder.rkt")
-         (all-from-out "taglib.rkt")
          (all-from-out "audio-sniffer.rkt")
+         (all-from-out "audio-player.rkt")
+         audio-supported-extensions
+         audio-supported-formats
+         audio-decoder-for-extension
+         current-opusfile-output-format
+         opusfile-output-format?
          )
 

opus-encoder.rkt

@@ -0,0 +1,267 @@
+(module opus-encoder racket/base
+
+  (require ffi/unsafe
+           racket/string
+           "private/utils.rkt"
+           "taglib.rkt")
+
+  (provide opus-encoder-available?
+           opus-encoder-default-settings
+           opus-encoder-prepare-settings
+           opus-encoder-open
+           opus-encoder-write
+           opus-encoder-finish)
+
+  ;; libopusenc handles the Ogg container, OpusHead and OpusTags.  The Racket
+  ;; side feeds interleaved floating-point PCM to ope_encoder_write_float().
+  ;; The input rate passed to ope_encoder_create_file is the source PCM rate;
+  ;; libopusenc performs the required Opus resampling internally.
+
+  ;; Load libogg and libopus explicitly before libopusenc.  This matters on
+  ;; Windows, where libopusenc.dll may not reliably find its dependent DLLs
+  ;; unless they have already been resolved through the same search path.
+  (define libogg
+    (get-lib (case (system-type 'os)
+               [(windows) '("ogg")]
+               [else      '("ogg" "libogg")])
+             (linux-lib-versions '("0" #f))))
+
+  (define libopus
+    (get-lib (case (system-type 'os)
+               [(windows) '("opus")]
+               [else      '("opus" "libopus")])
+             (linux-lib-versions '("0" #f))))
+
+  (define libopusenc
+    (get-lib (case (system-type 'os)
+               [(windows) '("libopusenc")]
+               [else      '("opusenc" "libopusenc")])
+             (linux-lib-versions '("0" #f))))
+
+  (define _OggOpusComments (_cpointer/null 'ogg-opus-comments))
+  (define _OggOpusEnc (_cpointer/null 'ogg-opus-enc))
+
+  (define (ffi-proc name type)
+    (and libopusenc
+         (with-handlers ([exn:fail? (lambda (_) #f)])
+           (get-ffi-obj name libopusenc type))))
+
+  (define ope_comments_create (ffi-proc "ope_comments_create" (_fun -> _OggOpusComments)))
+  (define ope_comments_destroy (ffi-proc "ope_comments_destroy" (_fun _OggOpusComments -> _void)))
+  (define ope_comments_add (ffi-proc "ope_comments_add" (_fun _OggOpusComments _string/utf-8 _string/utf-8 -> _int)))
+  (define ope_comments_add_picture_from_memory
+    (ffi-proc "ope_comments_add_picture_from_memory" (_fun _OggOpusComments _bytes _size _int _string/utf-8 -> _int)))
+  (define ope_encoder_create_file
+    (ffi-proc "ope_encoder_create_file"
+              (_fun _string/utf-8 _OggOpusComments _int32 _int _int (err : (_ptr o _int))
+                    -> (enc : _OggOpusEnc)
+                    -> (values enc err))))
+  (define ope_encoder_write_float (ffi-proc "ope_encoder_write_float" (_fun _OggOpusEnc _pointer _int -> _int)))
+  (define ope_encoder_drain (ffi-proc "ope_encoder_drain" (_fun _OggOpusEnc -> _int)))
+  (define ope_encoder_destroy (ffi-proc "ope_encoder_destroy" (_fun _OggOpusEnc -> _void)))
+  (define ope_strerror (ffi-proc "ope_strerror" (_fun _int -> _string/utf-8)))
+  (define ope_encoder_ctl/int (ffi-proc "ope_encoder_ctl" (_fun #:varargs-after 2 _OggOpusEnc _int _int -> _int)))
+
+  (define OPUS_SET_BITRATE_REQUEST 4002)
+  (define OPUS_SET_VBR_REQUEST 4006)
+  (define OPUS_SET_COMPLEXITY_REQUEST 4010)
+  (define OPUS_SET_VBR_CONSTRAINT_REQUEST 4020)
+  (define OPUS_SET_SIGNAL_REQUEST 4024)
+  (define OPUS_SET_LSB_DEPTH_REQUEST 4036)
+  (define OPE_SET_COMMENT_PADDING_REQUEST 14004)
+
+  (define OPUS_AUTO -1000)
+  (define OPUS_SIGNAL_VOICE 3001)
+  (define OPUS_SIGNAL_MUSIC 3002)
+
+  (define (opus-encoder-available?)
+    (and libogg libopus libopusenc ope_comments_create ope_comments_destroy ope_encoder_create_file
+         ope_encoder_write_float ope_encoder_drain ope_encoder_destroy ope_strerror #t))
+
+  (define-struct opus-encoder-handle (enc comments settings format file) #:transparent)
+
+  (define (hash-ref/default h k default)
+    (if (hash-has-key? h k) (hash-ref h k) default))
+
+  (define (copy-hash h)
+    (let ((out (make-hash)))
+      (for-each (lambda (k) (hash-set! out k (hash-ref h k))) (hash-keys h))
+      out))
+
+  (define (hash-merge base override)
+    (let ((out (copy-hash base)))
+      (when (hash? override)
+        (for-each (lambda (k) (hash-set! out k (hash-ref override k))) (hash-keys override)))
+      out))
+
+  (define (opus-error-message code)
+    (if ope_strerror (ope_strerror code) (format "libopusenc error ~a" code)))
+
+  (define (check-ope who r)
+    (when (negative? r) (error who "~a" (opus-error-message r)))
+    r)
+
+  (define (opus-encoder-default-settings)
+    (make-hash '((bitrate . 160000)
+                 (vbr? . #t)
+                 (constrained-vbr? . #f)
+                 (complexity . 10)
+                 (comment-padding . 512))))
+
+  (define (signal->int v)
+    (cond [(or (eq? v 'auto) (eq? v #f)) OPUS_AUTO]
+          [(eq? v 'voice) OPUS_SIGNAL_VOICE]
+          [(eq? v 'music) OPUS_SIGNAL_MUSIC]
+          [else (raise-argument-error 'opus-signal "(or/c 'auto 'voice 'music)" v)]))
+
+  (define (source-value v source)
+    (if (eq? v 'source) source v))
+
+  (define (opus-encoder-prepare-settings settings format)
+    (let* ((h (hash-merge (opus-encoder-default-settings) settings))
+           (rate (source-value (hash-ref/default h 'sample-rate (hash-ref format 'sample-rate))
+                               (hash-ref format 'sample-rate)))
+           (channels (source-value (hash-ref/default h 'channels (hash-ref format 'channels))
+                                   (hash-ref format 'channels))))
+      ;; Do not apply the low-level libopus sample-rate restriction here.
+      ;; libopusenc accepts the input rate and performs the required resampling
+      ;; internally; 44100 Hz input is therefore valid.
+      (when (> channels 2)
+        (error 'opus-encoder-open "this first direct libopusenc backend only supports mono/stereo input; got ~a channels" channels))
+      (hash-set! h 'sample-rate rate)
+      (hash-set! h 'channels channels)
+      (hash-set! h 'family 0)
+      h))
+
+  (define (apply-ctl! enc request value who)
+    (when ope_encoder_ctl/int
+      (check-ope who (ope_encoder_ctl/int enc request value))))
+
+  (define (apply-settings! enc settings)
+    (apply-ctl! enc OPUS_SET_BITRATE_REQUEST (hash-ref settings 'bitrate) 'opus-bitrate)
+    (apply-ctl! enc OPUS_SET_VBR_REQUEST (if (hash-ref/default settings 'vbr? #t) 1 0) 'opus-vbr)
+    (apply-ctl! enc OPUS_SET_VBR_CONSTRAINT_REQUEST (if (hash-ref/default settings 'constrained-vbr? #f) 1 0) 'opus-constrained-vbr)
+    (apply-ctl! enc OPUS_SET_COMPLEXITY_REQUEST (hash-ref/default settings 'complexity 10) 'opus-complexity)
+    (apply-ctl! enc OPE_SET_COMMENT_PADDING_REQUEST (hash-ref/default settings 'comment-padding 512) 'opus-comment-padding)
+    (when (hash-has-key? settings 'signal)
+      (apply-ctl! enc OPUS_SET_SIGNAL_REQUEST (signal->int (hash-ref settings 'signal)) 'opus-signal))
+    (when (hash-has-key? settings 'lsb-depth)
+      (apply-ctl! enc OPUS_SET_LSB_DEPTH_REQUEST (hash-ref settings 'lsb-depth) 'opus-lsb-depth)))
+
+  (define (add-comments! comments settings)
+    (when (hash-has-key? settings 'comments)
+      (let ((ch (hash-ref settings 'comments)))
+        (when (hash? ch)
+          (for-each (lambda (k)
+                      (let ((v (hash-ref ch k)))
+                        (when (string? v)
+                          (check-ope 'opus-comment (ope_comments_add comments (string-upcase (symbol->string k)) v)))))
+                    (hash-keys ch))))))
+
+  (define (picture-kind->opus-int kind)
+    (define s
+      (cond [(number? kind) (number->string kind)]
+            [(symbol? kind) (string-replace (string-downcase (symbol->string kind)) "-" " ")]
+            [(string? kind) (string-downcase kind)]
+            [else ""]))
+    (cond [(or (string=? s "0") (string=? s "other")) 0]
+          [(or (string=? s "1") (string=? s "file icon") (string=? s "32x32 icon")) 1]
+          [(or (string=? s "2") (string=? s "other file icon")) 2]
+          [(or (string=? s "3") (string=? s "front cover") (string=? s "cover front")
+               (string=? s "cover (front)") (string=? s "front")) 3]
+          [(or (string=? s "4") (string=? s "back cover") (string=? s "cover back")
+               (string=? s "cover (back)") (string=? s "back")) 4]
+          [(or (string=? s "5") (string=? s "leaflet page")) 5]
+          [(or (string=? s "6") (string=? s "media") (string=? s "label side of media")) 6]
+          [(or (string=? s "7") (string=? s "lead artist") (string=? s "lead performer")
+               (string=? s "soloist")) 7]
+          [(or (string=? s "8") (string=? s "artist") (string=? s "performer")) 8]
+          [(or (string=? s "9") (string=? s "conductor")) 9]
+          [(or (string=? s "10") (string=? s "band") (string=? s "orchestra")) 10]
+          [(or (string=? s "11") (string=? s "composer")) 11]
+          [(or (string=? s "12") (string=? s "lyricist") (string=? s "text writer")) 12]
+          [(or (string=? s "13") (string=? s "recording location")) 13]
+          [(or (string=? s "14") (string=? s "during recording")) 14]
+          [(or (string=? s "15") (string=? s "during performance")) 15]
+          [(or (string=? s "16") (string=? s "movie screen capture")) 16]
+          [(or (string=? s "17") (string=? s "a bright coloured fish")
+               (string=? s "bright coloured fish")) 17]
+          [(or (string=? s "18") (string=? s "illustration")) 18]
+          [(or (string=? s "19") (string=? s "band logo") (string=? s "artist logotype")) 19]
+          [(or (string=? s "20") (string=? s "publisher logo") (string=? s "publisher logotype")) 20]
+          [else 3]))
+
+  (define (add-picture! comments settings)
+    (when (hash-has-key? settings 'picture)
+      (unless ope_comments_add_picture_from_memory
+        (error 'opus-picture "libopusenc does not provide ope_comments_add_picture_from_memory"))
+      (let ((picture (hash-ref settings 'picture)))
+        (when (id3-picture? picture)
+          (let ((data (id3-picture-bytes picture)))
+            (check-ope 'opus-picture
+                       (ope_comments_add_picture_from_memory
+                        comments
+                        data
+                        (bytes-length data)
+                        (picture-kind->opus-int (id3-picture-kind picture))
+                        (id3-picture-description picture))))))))
+
+  (define (opus-encoder-open output-file settings format)
+    (unless (opus-encoder-available?)
+      (error 'opus-encoder-open "libopusenc or one of its dependent libraries (ogg/opus) could not be loaded"))
+    (let* ((file (if (path? output-file) (path->string output-file) output-file))
+           (resolved (opus-encoder-prepare-settings settings format))
+           (comments (ope_comments_create)))
+      (add-comments! comments resolved)
+      (add-picture! comments resolved)
+      (let-values (((enc err) (ope_encoder_create_file file comments
+                                                       (hash-ref resolved 'sample-rate)
+                                                       (hash-ref resolved 'channels)
+                                                       (hash-ref resolved 'family))))
+        (unless enc (error 'opus-encoder-open "could not create Opus file ~a: ~a" file (opus-error-message err)))
+        (apply-settings! enc resolved)
+        (make-opus-encoder-handle enc comments resolved format file))))
+
+  (define (native-signed-ref bs start bytes)
+    ;; Racket's integer-bytes->integer only supports 1, 2, 4 and 8 bytes.
+    ;; The FLAC decoder legitimately produces 24-bit PCM as three bytes per
+    ;; sample, so use the package helper that handles that case.
+    (int-bytes->integer bs #t (system-big-endian?) start (+ start bytes)))
+
+  (define (sample->float sample in-bits)
+    (let* ((scale (expt 2 (sub1 in-bits)))
+           (v (/ sample scale)))
+      (cond [(< v -1.0) -1.0]
+            [(> v 1.0) 1.0]
+            [else (exact->inexact v)])))
+
+  (define (pcm-bytes->float-pointer buffer size in-bits)
+    (let* ((in-bytes (quotient in-bits 8))
+           (sample-count (quotient size in-bytes))
+           (ptr (malloc _float sample-count 'atomic-interior)))
+      (for ([i (in-range sample-count)])
+        (let* ((in-off (* i in-bytes))
+               (sample (native-signed-ref buffer in-off in-bytes)))
+          (ptr-set! ptr _float i (sample->float sample in-bits))))
+      (values ptr sample-count)))
+
+  (define (opus-encoder-write handle buf-info buffer buf-len)
+    (let* ((settings (opus-encoder-handle-settings handle))
+           (channels (hash-ref settings 'channels))
+           (in-bits (hash-ref/default buf-info 'pcm-bits-per-sample
+                                      (hash-ref/default buf-info 'bits-per-sample 16))))
+      (let-values (((pcm sample-count) (pcm-bytes->float-pointer buffer buf-len in-bits)))
+        (let ((frames (quotient sample-count channels)))
+          (check-ope 'opus-encoder-write
+                     (ope_encoder_write_float (opus-encoder-handle-enc handle) pcm frames))
+          frames))))
+
+  (define (opus-encoder-finish handle)
+    (dynamic-wind
+     void
+     (lambda () (check-ope 'opus-encoder-finish (ope_encoder_drain (opus-encoder-handle-enc handle))))
+     (lambda ()
+       (ope_encoder_destroy (opus-encoder-handle-enc handle))
+       (ope_comments_destroy (opus-encoder-handle-comments handle)))))
+
+  ) ; end of module

opusfile-decoder.rkt

@@ -0,0 +1,316 @@
+(module opusfile-decoder racket/base
+
+  (require ffi/unsafe
+           "private/utils.rkt")
+
+  (provide opusfile-open
+           opusfile-valid?
+           opusfile-read
+           opusfile-stop
+           opusfile-seek
+           opusfile-available?
+           current-opusfile-output-format
+           opusfile-output-format?)
+
+  ;; Xiph libopusfile backend for Ogg Opus streams.
+  ;;
+  ;; By default this backend uses op_read(), which returns signed 16-bit
+  ;; interleaved PCM.  That is the most efficient path for direct libao
+  ;; playback.  For users who prefer the wider decoder output path, set
+  ;; current-opusfile-output-format to 's24.  In that mode the backend uses
+  ;; op_read_float() and converts the interleaved float output to packed signed
+  ;; 24-bit PCM in native byte order.
+  ;;
+  ;; Opus decode output is always 48 kHz PCM.  The original input rate, if
+  ;; present in metadata, is not the actual decoder output rate.
+
+
+  (define libogg (get-lib (case (system-type 'os)
+                                 [(windows) '("ogg")]
+                                 [else      '("ogg" "libogg")])
+                               (linux-lib-versions '("0" #f))))
+
+  (define libopus (get-lib (case (system-type 'os)
+                             [(windows) '("opus")]
+                             [else      '("opus" "libopus")])
+                           (linux-lib-versions '("0" #f))))
+  
+  (define libopusfile (get-lib (case (system-type 'os)
+                                 [(windows) '("opusfile")]
+                                 [else      '("opusfile" "libopusfile")])
+                               (linux-lib-versions '("0" #f))))
+
+  (define _OggOpusFile _pointer)
+
+  (define default-frames-per-read 4096)
+  (define opus-sample-rate 48000)
+
+  (define (opusfile-output-format? v)
+    (or (eq? v 's16) (eq? v 's24)))
+
+  (define cur-output-format 's16)
+
+  (define (current-opusfile-output-format . args)
+    (unless (null? args)
+      (if (or (> (length args) 1)
+              (not (opusfile-output-format? (car args))))
+          (raise-argument-error 'current-opusfile-output-format
+                                "(or/c 's16 's24)")
+          (set! cur-output-format (car args))))
+    cur-output-format)
+
+  (define (opus-bits-per-sample)
+    (case (current-opusfile-output-format)
+      [(s16) 16]
+      [(s24) 24]))
+
+  (define (opus-bytes-per-sample)
+    (case (current-opusfile-output-format)
+      [(s16) 2]
+      [(s24) 3]))
+
+  (define (ffi-proc name type)
+    (and libopusfile
+         (with-handlers ([exn:fail? (lambda (_) #f)])
+           (get-ffi-obj name libopusfile type))))
+
+  (define op_open_file
+    (ffi-proc "op_open_file"
+              (_fun _path (err : (_ptr o _int))
+                    -> (r : _OggOpusFile)
+                    -> (values r err))))
+
+  (define op_free
+    (ffi-proc "op_free"
+              (_fun _OggOpusFile -> _void)))
+
+  (define op_channel_count
+    (ffi-proc "op_channel_count"
+              (_fun _OggOpusFile _int -> _int)))
+
+  (define op_pcm_total
+    (ffi-proc "op_pcm_total"
+              (_fun _OggOpusFile _int -> _int64)))
+
+  (define op_pcm_seek
+    (ffi-proc "op_pcm_seek"
+              (_fun _OggOpusFile _int64 -> _int)))
+
+  (define op_read
+    (ffi-proc "op_read"
+              (_fun _OggOpusFile _bytes _int (li : (_ptr o _int))
+                    -> (r : _int)
+                    -> (values r li))))
+
+  (define op_read_float
+    (ffi-proc "op_read_float"
+              (_fun _OggOpusFile _pointer _int (li : (_ptr o _int))
+                    -> (r : _int)
+                    -> (values r li))))
+
+  (define (opusfile-available?)
+    (and libopusfile
+         op_open_file
+         op_free
+         op_channel_count
+         op_pcm_total
+         op_pcm_seek
+         op_read
+         op_read_float
+         #t))
+
+  (define-struct opusfile-handle
+    (of cb-info cb-audio
+        (stop #:mutable)
+        (seek #:mutable)
+        (reading #:mutable)
+        (format #:mutable)
+        (pcm-pos #:mutable))
+    #:transparent)
+
+  (define (raise-opus who fmt . args)
+    (apply error who fmt args))
+
+  (define (check-libopusfile who)
+    (unless (opusfile-available?)
+      (raise-opus who "libopusfile could not be loaded")))
+
+  (define (correct-format-hash h)
+    (unless (hash-ref h 'sample-rate #f)
+      (hash-set! h 'sample-rate opus-sample-rate))
+    (unless (hash-ref h 'bits-per-sample #f)
+      (hash-set! h 'bits-per-sample (opus-bits-per-sample)))
+    (unless (hash-ref h 'bytes-per-sample #f)
+      (hash-set! h 'bytes-per-sample (opus-bytes-per-sample)))
+    (unless (hash-ref h 'sample-format #f)
+      (hash-set! h 'sample-format (current-opusfile-output-format)))
+    (unless (hash-ref h 'total-samples #f)
+      (hash-set! h 'total-samples 0)
+      (hash-set! h 'duration 0)))
+
+  (define (report-format handle)
+    (let ((cb (opusfile-handle-cb-info handle)))
+      (when (procedure? cb)
+        (cb (opusfile-handle-format handle)))))
+
+  (define (make-format channels total-samples)
+    (let ((h (make-hash)))
+      (hash-set! h 'duration (if (and (integer? total-samples) (>= total-samples 0))
+                                 (exact->inexact (/ total-samples opus-sample-rate))
+                                 0.0))
+      (hash-set! h 'sample-rate opus-sample-rate)
+      (hash-set! h 'channels channels)
+      (hash-set! h 'bits-per-sample (opus-bits-per-sample))
+      (hash-set! h 'bytes-per-sample (opus-bytes-per-sample))
+      (hash-set! h 'sample-format (current-opusfile-output-format))
+      (hash-set! h 'total-samples total-samples)
+      h))
+
+  (define (give-audio handle buffer size)
+    (let ((h (opusfile-handle-format handle)))
+      (correct-format-hash h)
+      (hash-set! h 'sample (opusfile-handle-pcm-pos handle))
+      (hash-set! h 'current-time (exact->inexact (/ (opusfile-handle-pcm-pos handle)
+                                                    opus-sample-rate)))
+      ((opusfile-handle-cb-audio handle) h buffer size)))
+
+  (define s24-pos-scale #x7FFFFF)
+  (define s24-neg-scale #x800000)
+
+  (define (clip-sample x)
+    (cond [(< x -1.0) -1.0]
+          [(> x 1.0) 1.0]
+          [else x]))
+
+  (define (float->s24 x)
+    (let ((y (clip-sample x)))
+      (if (negative? y)
+          (inexact->exact (round (* y s24-neg-scale)))
+          (inexact->exact (round (* y s24-pos-scale))))))
+
+  (define (write-s24-native! bs offset sample)
+    (let ((v (if (negative? sample) (+ sample #x1000000) sample)))
+      (if (system-big-endian?)
+          (begin
+            (bytes-set! bs offset (bitwise-and (arithmetic-shift v -16) #xFF))
+            (bytes-set! bs (+ offset 1) (bitwise-and (arithmetic-shift v -8) #xFF))
+            (bytes-set! bs (+ offset 2) (bitwise-and v #xFF)))
+          (begin
+            (bytes-set! bs offset (bitwise-and v #xFF))
+            (bytes-set! bs (+ offset 1) (bitwise-and (arithmetic-shift v -8) #xFF))
+            (bytes-set! bs (+ offset 2) (bitwise-and (arithmetic-shift v -16) #xFF))))))
+
+  (define (opusfile-valid? audio-file)
+    (and (opusfile-available?)
+         (file-exists? audio-file)
+         #t))
+
+  (define (opusfile-open audio-file* cb-stream-info cb-audio)
+    (check-libopusfile 'opusfile-open)
+    (let ((audio-file (if (path? audio-file*)
+                          (path->string audio-file*)
+                          audio-file*)))
+      (if (file-exists? audio-file)
+          (let-values (((of err) (op_open_file audio-file)))
+            (if of
+                (let* ((channels (op_channel_count of -1))
+                       (total-samples (op_pcm_total of -1))
+                       (fmt (make-format channels total-samples))
+                       (h (make-opusfile-handle of cb-stream-info cb-audio #f #f #f fmt 0)))
+                  (report-format h)
+                  h)
+                (raise-opus 'opusfile-open
+                            "could not open Opus file ~a; opusfile error code: ~a"
+                            audio-file err)))
+          #f)))
+
+  (define (handle-pending-seek! handle)
+    (unless (eq? (opusfile-handle-seek handle) #f)
+      (let ((sample (opusfile-handle-seek handle)))
+        (dbg-sound "Seeking opusfile to sample ~a" sample)
+        (let ((r (op_pcm_seek (opusfile-handle-of handle) sample)))
+          (when (negative? r)
+            (err-sound "opusfile seek error: ~a" r))
+          (when (not (negative? r))
+            (set-opusfile-handle-pcm-pos! handle sample)))
+        (set-opusfile-handle-seek! handle #f))))
+
+  (define (read-s16 handle channels)
+    (let* ((max-samples (* default-frames-per-read channels))
+           (buffer (make-bytes (* max-samples 2))))
+      (let-values (((read-frames link-index)
+                    (op_read (opusfile-handle-of handle) buffer max-samples)))
+        (cond [(negative? read-frames)
+               (values read-frames #f 0)]
+              [(zero? read-frames)
+               (values 0 #f 0)]
+              [else
+               (let* ((read-samples (* read-frames channels))
+                      (read-bytes (* read-samples 2))
+                      (out (if (= read-bytes (bytes-length buffer)) buffer (subbytes buffer 0 read-bytes))))
+                 (values read-frames out read-bytes))]))))
+
+  (define (read-s24 handle channels)
+    (let* ((max-samples (* default-frames-per-read channels))
+           (float-buffer (malloc _float max-samples 'atomic-interior)))
+      (let-values (((read-frames link-index)
+                    (op_read_float (opusfile-handle-of handle) float-buffer max-samples)))
+        (cond [(negative? read-frames)
+               (values read-frames #f 0)]
+              [(zero? read-frames)
+               (values 0 #f 0)]
+              [else
+               (let* ((read-samples (* read-frames channels))
+                      (out (make-bytes (* read-samples 3))))
+                 (for ([i (in-range read-samples)])
+                   (write-s24-native! out (* i 3) (float->s24 (ptr-ref float-buffer _float i))))
+                 (values read-frames out (bytes-length out)))]))))
+
+  (define (read-audio-buffer handle channels)
+    (case (current-opusfile-output-format)
+      [(s16) (read-s16 handle channels)]
+      [(s24) (read-s24 handle channels)]))
+
+  (define (opusfile-read handle)
+    (set-opusfile-handle-stop! handle #f)
+    (set-opusfile-handle-reading! handle #t)
+    (let loop ()
+      (cond
+        [(opusfile-handle-stop handle)
+         (dbg-sound "Stopping opusfile decoding")
+         (set-opusfile-handle-reading! handle #f)
+         'stopped-reading]
+        [else
+         (handle-pending-seek! handle)
+         (let ((channels (hash-ref (opusfile-handle-format handle) 'channels 2)))
+           (let-values (((read-frames out read-bytes) (read-audio-buffer handle channels)))
+             (cond [(negative? read-frames)
+                    (err-sound "opusfile decode error: ~a" read-frames)
+                    (set-opusfile-handle-stop! handle #t)
+                    (loop)]
+                   [(zero? read-frames)
+                    (set-opusfile-handle-stop! handle #t)
+                    (loop)]
+                   [else
+                    (give-audio handle out read-bytes)
+                    (set-opusfile-handle-pcm-pos! handle (+ (opusfile-handle-pcm-pos handle) read-frames))
+                    (loop)])))]))
+    (op_free (opusfile-handle-of handle))
+    (set-opusfile-handle-reading! handle #f))
+
+  (define (opusfile-seek handle percentage)
+    (let* ((fmt (opusfile-handle-format handle))
+           (total-samples (hash-ref fmt 'total-samples 0)))
+      (unless (or (eq? total-samples #f) (= total-samples -1) (= total-samples 0))
+        (let* ((percentage (max 0 (min 100 percentage)))
+               (sample (inexact->exact
+                        (round (* (exact->inexact (/ percentage 100.0))
+                                  total-samples)))))
+          (set-opusfile-handle-seek! handle sample)))))
+
+  (define (opusfile-stop handle)
+    (set-opusfile-handle-stop! handle #t)
+    (while (opusfile-handle-reading handle)
+           (sleep 0.01)))
+
+  ) ; end of module

play-test.rkt

@@ -1,174 +1,84 @@
 #lang racket/base
-(require "libao.rkt"
+(require "audio-player.rkt"
-         "audio-decoder.rkt"
          simple-log
          "private/utils.rkt"
          racket-sprintf
          racket/runtime-path
-         ;data/queue
+         racket/path
-         ;racket-sound
+         early-return
+         "tests.rkt"
          )
 
-(define-runtime-path tests "../racket-audio-test")
+(define place-mode #t)
 
-(define test-file3 #f)
+(define run-queue #f)
-(define test-file4 #f)
+(define (set-test a)
-(define test-file3-id 3)
+  (set! run-queue a))
-(define test-file4-id 4)
 
-(set! test-file3 (build-path tests "mahler-1.mp3"))
+(define play-queue (list test-file2 test-file3 test-file4))
-(set! test-file4 (build-path tests "mahler-2.mp3"))
 
-;(define fmt (ao-mk-format 24 48000 2 'big-endian))
+(define current-sec -1)
-;(define ao-h (ao-open-live #f fmt))
 
-(define current-seconds 0)
+(define (to-time-str s*)
-(define ao-h #f)
+  (let* ((s (round s*))
-(define current-file-id -1)
+         (minutes (quotient s 60))
-(define current-audio-h #f)
+         (seconds (remainder s 60))
-
-(define current-bits -1)
-(define current-rate -1)
-(define current-channels -1)
-
-(sl-log-to-display)
-(define wav-output-file #f)
-(define seeked #f)
-
-(define (audio-play type ao-type handle buf-info buffer buf-len)
-  ;(dbg-sound "~a ~a ~a ~a ~a" type ao-type handle buf-info buf-len)
-  (let* ((sample (hash-ref buf-info 'sample))
-         (rate (hash-ref buf-info 'sample-rate))
-         (second (/ (* sample 1.0) (* rate 1.0)))
-         (bits-per-sample (hash-ref buf-info 'bits-per-sample))
-         (bytes-per-sample (/ bits-per-sample 8))
-         (channels (hash-ref buf-info 'channels))
-         (bytes-per-sample-all-channels (* channels bytes-per-sample))
-         (duration (hash-ref buf-info 'duration))
-         (cond-seek (λ ()
-                      (when (>= (round current-seconds) 10)
-                        (when (and (= current-file-id 3) (not seeked))
-                          (set! seeked #t)
-                          (let ((perc (exact->inexact (* (/ (- duration 15) duration) 100.0))))
-                            (info-sound "Seeking to ~a%" perc)
-                            (audio-seek current-audio-h perc))))))
-         (cond-volume (λ ()
-                        (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))))
          )
+    (sprintf "%02d:%02d" minutes seconds)))
 
-    (when (not (eq? ao-h #f))
+(define (audio-player-state h s st)
-      (when (not (and
+  (early-return
-                  (= current-bits bits-per-sample)
+   ((? (not (audio-play? h)) => 'done))
-                  (= current-rate rate)
+   (let* ((f (audio-file h))
-                  (= current-channels channels)))
+          (name (if (eq? f #f) "none" (file-name-from-path f)))
-        (ao-close ao-h)
+          (sec* (audio-at-second h))
-        (set! ao-h #f)))
+          (sec  (if (eq? sec* #f) 0 (round sec*)))
-    
+          (msg (hash-ref st 'msg "none"))
-    ;(displayln buf-info)
+          (bs (hash-ref st 'buf-size 0))
-    (when (eq? ao-h #f)
+          (dur* (audio-duration h))
-      
+          (dur (if (eq? dur* #f) 0 (round dur*)))
-      (info-sound "Opening ao handle")
+          )
-      (info-sound "bits-per-sample: ~a" bits-per-sample)
+     (unless (= current-sec sec)
-      (info-sound "rate           : ~a" rate)
+       (displayln (format "~a (~a): ~a - ~a - ~a - ~a - ~a - ~a"
-      (info-sound "channels       : ~a" channels)
+                          name
-      (info-sound "endian         : ~a" 'native-endian)
+                          (audio-music-id h)
-      (info-sound "(optional) file: ~a" wav-output-file)
+                          (to-time-str sec)
-      (sync-log-sound)
+                          (to-time-str dur)
-      
+                          (audio-state h)
-      (set! ao-h (ao-open-file bits-per-sample rate channels 'native-endian wav-output-file))
+                          (audio-volume h)
-
+                          bs
-      (set! current-bits bits-per-sample)
+                          msg))
-      (set! current-rate rate)
+       (set! current-sec sec)
-      (set! current-channels channels)
+       )
-      (info-sound "ao bits per sample: ~a" (ao-device-bits ao-h))
+     )
-      (sync-log-sound)
+   )
-      )
-    
-    ;(displayln 'ao-play)
-    ;(dbg-sound "Playing audio at ~a" second)
-    ;(sync-log-sound)
-               
-    (ao-play ao-h current-file-id second duration buffer buf-len ao-type)
-    (set! duration (inexact->exact (round duration)))
-    ;(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)
-                                (let ((minutes (quotient s 60))
-                                      (seconds (remainder s 60))
-                                      (tminutes (quotient duration 60))
-                                      (tseconds (remainder duration 60))
-                                      (volume (ao-volume ao-h))
-                                      )
-                                (info-sound
-                                 (sprintf "At time: %02d:%02d (%02d:%02d) - %d - volume: %d"
-                                                   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 buf-seconds)
-        (cond-seek)
-        (cond-volume)
-        (when (> buf-seconds 10)
-          (info-sound "Reuse buf/Sample queue: ~a/~a"
-                      (ao-reuse-buf-len-async ao-h)
-                      (ao-sample-queue-len-async ao-h))
-          (letrec ((waiter (λ ()
-                             (let ((buf-seconds-left (exact->inexact
-                                                      (/ (ao-bufsize-async ao-h)
-                                                         bytes-per-sample-all-channels
-                                                         rate))))
-                               (if (< buf-seconds-left 3.0)
-                                   (info-sound "Seconds in buffer left: ~a" buf-seconds-left)
-                                   (begin
-                                     (sleep 0.5)
-                                     (second-printer buf-seconds)
-                                     (cond-volume)
-                                     (cond-seek)
-                                     (waiter)))))
-                             ))
-            (waiter)
-            (info-sound "Reuse buf/Sample queue: ~a/~a"
-                        (ao-reuse-buf-len-async ao-h)
-                        (ao-sample-queue-len-async ao-h))
-            )))
-      )
-    )
   )
 
-(define (audio-meta type ao-type handle meta)
+(define (audio-player-eof h)
-  (dbg-sound "type:    ~a" type)
+  (dbg-sound "audio-player-eof called")
-  (dbg-sound "ao-type: ~a" ao-type)
+  (when (eq? run-queue 'queue)
-  (dbg-sound "meta:    ~a" meta))
+    (if (null? play-queue)
+        (audio-quit! h)
+        (begin
+          (dbg-sound "audio-play! -> ~a" (audio-play! h (car play-queue)))
+          (set! play-queue (cdr play-queue))
+          )
+        ))
+  (when (eq? run-queue 'once)
+    (set! run-queue #f)
+    (dbg-sound "audio-play! -> ~a" (audio-play! h (car play-queue))))
+  )
+
+(displayln "Making audio player")
+
+(define h (make-audio-player audio-player-state
+                             audio-player-eof
+                             #:use-place place-mode))
+
+(displayln "done")
+
+(sl-log-to-display)
+(audio-player-eof h)
 
-(define (play)
-  (set! ao-h #f)
-  (let ((audio-h (audio-open test-file3 audio-meta audio-play)))
-    (set! current-file-id test-file3-id)
-    (set! current-audio-h audio-h)
-    (audio-read audio-h)
-    )
-  (info-sound "Opening next file: ~a" test-file4)
-  (let ((audio-h (audio-open test-file4 audio-meta audio-play)))
-    (set! current-file-id test-file4-id)
-    (set! current-audio-h audio-h)
-    (audio-read audio-h)
-    )
-  (ao-close ao-h)
-  (set! ao-h #f))
 
-(play)
 

private/config.rkt

@@ -0,0 +1,100 @@
+#lang racket/base
+
+(provide audio-cfg-get
+         audio-cfg-set!
+         audio-remote-cfg-get
+         audio-remote-cfg-set!
+         )
+
+(require simple-ini/class)
+
+        
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; Supporting functions
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(define (build-env-path env . parts)
+  (let ((base (getenv env)))
+    (if (eq? base #f)
+        #f
+        (apply build-path (cons base parts)))))
+    
+(define (try-programs . prgs)
+  (letrec ((f (λ (l)
+                (if (null? l)
+                    #f
+                    (if (and (car l) (file-exists? (car l)))
+                        (car l)
+                        (f (cdr l)))))))
+    (f prgs)))
+   
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; Initialization
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(define cfg (new ini% [file 'racket-audio]))
+
+(when (eq? (send cfg get 'init 'initialized #f) #f)
+  (let ((s! (λ (e v)
+              (send cfg set! 'racket-audio e v))))
+    (s! 'remote-racket "racket")
+    (s! 'remote-module "racket-audio/audio-placed-player")
+    (s! 'ssh-program (cond
+                       ((eq? (system-type 'os) 'windows)
+                        (let ((p (try-programs
+                                  (build-env-path "ProgramFiles" "PuTTY" "plink.exe")
+                                  (build-env-path "ProgramFiles" "OpenSSH" "ssh.exe")
+                                  (build-env-path "SystemRoot" "System32" "OpenSSH" "ssh.exe")
+                                  (find-executable-path "ssh.exe")
+                                  (find-executable-path "plink.exe"))))
+                          (if (eq? p #f)
+                              "plink.exe"
+                              p)))
+                       (else (let ((p (find-executable-path "ssh")))
+                               (if (eq? p #f)
+                                   "ssh"
+                                   p))))
+        )
+    (send cfg set! 'init 'initialized #t)
+    )
+  )
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; Provided API
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(define (missing-cfg-value? v)
+  (eq? v '@racket-audio-no-value@))
+
+(define (audio-getter section entry default-provider)
+  (let ((v (send cfg get section entry '@racket-audio-no-value@)))
+    (if (missing-cfg-value? v)
+        (cond ((null? default-provider)
+               (error (format
+                       "audio-cfg-get: No such entry ~a in section ~a"
+                       section entry)))
+              ((procedure? (car default-provider))
+               ((car default-provider) entry))
+              (else
+               (car default-provider)))
+        v)))
+  
+        
+(define (audio-cfg-get entry . default-provider)
+  (audio-getter 'racket-audio entry default-provider))
+
+(define (audio-cfg-set! entry val)
+  (send cfg set! 'racket-audio entry val))
+
+(define (audio-remote-cfg-get host entry . default-provider)
+  (audio-getter (string->symbol (format "~a" host))
+                entry
+                (list (lambda (entry)
+                        (apply audio-cfg-get (cons entry default-provider))))))
+
+(define (audio-remote-cfg-set! host entry val)
+  (send cfg set! (string->symbol (format "~a" host)) entry val))
+                                    
+    
+

private/downloader.rkt

@@ -9,6 +9,7 @@
          racket/system
          racket/string
          file/unzip
+         early-return
          )
 
 (provide download-soundlibs
@@ -25,8 +26,8 @@
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 
 (define version-major 1)
-(define version-minor 0)
+(define version-minor 1)
-(define version-patch 0)
+(define version-patch 2)
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;; Internal functions
@@ -39,8 +40,8 @@
                                  version-patch
                                  ))
 
-(define download-site "git.dijkewijk.nl")
+(define download-site "codeberg.org")
-(define base-path "hans/racket-sound-lib/releases/download")
+(define base-path "hnmdijkema/racket-sound-lib/releases/download")
 (define os (system-type 'os*))
 (define arch (system-type 'arch))
 
@@ -91,7 +92,9 @@
 ;; Provided functions
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 
-(define (soundlibs-available?)
+(define/return (soundlibs-available?) return
+  (unless (eq? (system-type 'os) 'windows)   ; We only need to download libraries for windows. 
+    (return #t))
   (if (file-exists? version-file)
       (with-handlers ([exn:fail? (λ (e) #f)])
         (let ((v (file->value version-file)))
@@ -142,7 +145,7 @@
     (let* ((file (build-path install-path "archive.zip"))
            (out (open-output-file file #:exists 'replace))
            )
-      (displayln (format "Downloading racket-webview-qt (~a)..." download-url))
+      (displayln (format "Downloading racket-sound-lib (~a)..." download-url))
       (do-download in out)
       (displayln (format "downloaded '~a'" file))
       (when (directory-exists? ffi-path)

private/pcm-converter.rkt

@@ -0,0 +1,150 @@
+(module pcm-converter racket/base
+
+  (require ffi/unsafe
+           "utils.rkt"
+           "../resampler.rkt")
+
+  (provide pcm-conversion-needed?
+           make-pcm-converter
+           pcm-converter?
+           pcm-converter-input-format
+           pcm-converter-output-format
+           pcm-converter-convert
+           pcm-converter-drain
+           pcm-converter-close!)
+
+  (define S32-BYTES 4)
+
+  (define-struct pcm-converter (resampler input-format output-format channels in-rate out-rate closed?)
+    #:mutable
+    #:constructor-name make-raw-pcm-converter)
+
+  (define (hash-ref/default h k default)
+    (if (and (hash? h) (hash-has-key? h k)) (hash-ref h k) default))
+
+  (define (copy-hash h)
+    (let ((out (make-hash)))
+      (when (hash? h)
+        (for-each (lambda (k) (hash-set! out k (hash-ref h k))) (hash-keys h)))
+      out))
+
+  (define (native-signed-ref bs start bytes)
+    (int-bytes->integer bs #t (system-big-endian?) start (+ start bytes)))
+
+  (define (native-signed-set! bs start bytes value)
+    (integer->int-bytes value bytes #t (system-big-endian?) bs start))
+
+  (define (clamp-s32 v)
+    (cond [(< v -2147483648) -2147483648]
+          [(> v 2147483647) 2147483647]
+          [else v]))
+
+  (define (expand-sample-to-s32 sample in-bits)
+    (clamp-s32 (if (< in-bits 32) (arithmetic-shift sample (- 32 in-bits)) sample)))
+
+  (define (pcm-bytes->s32-bytes buffer size in-bits)
+    (cond [(= in-bits 32) (if (= size (bytes-length buffer)) buffer (subbytes buffer 0 size))]
+          [else
+           (let* ((in-bytes (quotient in-bits 8))
+                  (sample-count (quotient size in-bytes))
+                  (out (make-bytes (* sample-count S32-BYTES))))
+             (for ([i (in-range sample-count)])
+               (let* ((in-off (* i in-bytes))
+                      (out-off (* i S32-BYTES))
+                      (sample (native-signed-ref buffer in-off in-bytes)))
+                 (native-signed-set! out out-off S32-BYTES (expand-sample-to-s32 sample in-bits))))
+             out)]))
+
+  (define (source-value v source)
+    (if (eq? v 'source) source v))
+
+  (define (target-sample-rate settings input-format)
+    (source-value
+     (hash-ref/default settings 'target-sample-rate
+                       (hash-ref/default settings 'sample-rate
+                                         (hash-ref input-format 'sample-rate)))
+     (hash-ref input-format 'sample-rate)))
+
+  (define (target-channels settings input-format)
+    (source-value
+     (hash-ref/default settings 'target-channels
+                       (hash-ref/default settings 'channels
+                                         (hash-ref input-format 'channels)))
+     (hash-ref input-format 'channels)))
+
+  (define (target-bits settings input-format)
+    (let ((source-bits (let ((bits (hash-ref/default input-format 'bits-per-sample 24)))
+                         (if (and (integer? bits) (<= bits 24)) bits 24))))
+      (source-value
+       (hash-ref/default settings 'target-bits-per-sample
+                         (hash-ref/default settings 'bits-per-sample source-bits))
+       source-bits)))
+
+  (define (make-output-format input-format settings)
+    (let* ((out (copy-hash input-format))
+           (in-rate (hash-ref input-format 'sample-rate))
+           (out-rate (target-sample-rate settings input-format))
+           (total (hash-ref/default input-format 'total-samples #f)))
+      (hash-set! out 'sample-rate out-rate)
+      (hash-set! out 'channels (target-channels settings input-format))
+      (hash-set! out 'bits-per-sample (target-bits settings input-format))
+      (hash-set! out 'pcm-bits-per-sample 32)
+      (hash-set! out 'type 'interleaved)
+      (hash-set! out 'endianness 'native-endian)
+      (when (and (integer? total) (>= total 0) (integer? in-rate) (> in-rate 0))
+        (hash-set! out 'total-samples (inexact->exact (round (* total (/ out-rate in-rate))))))
+      out))
+
+  (define (pcm-conversion-needed? input-format settings)
+    (let ((in-rate (hash-ref input-format 'sample-rate))
+          (in-channels (hash-ref input-format 'channels))
+          (out-rate (target-sample-rate settings input-format))
+          (out-channels (target-channels settings input-format)))
+      (or (not (= in-rate out-rate))
+          (not (= in-channels out-channels)))))
+
+  (define (make-pcm-converter input-format settings)
+    (let* ((channels-in (hash-ref input-format 'channels))
+           (channels-out (target-channels settings input-format))
+           (rate-in (hash-ref input-format 'sample-rate))
+           (rate-out (target-sample-rate settings input-format))
+           (quality (hash-ref/default settings 'resampler-quality 'hq))
+           (phase (hash-ref/default settings 'resampler-phase 'linear))
+           (steep? (hash-ref/default settings 'resampler-steep-filter? #f))
+           (out-format (make-output-format input-format settings)))
+      (unless (= channels-in channels-out)
+        (error 'make-pcm-converter
+               "SoXR PCM converter only supports unchanged channel count; got input ~a and output ~a"
+               channels-in channels-out))
+      (let ((r (make-resampler rate-in rate-out channels-in
+                               #:input-format 's32
+                               #:output-format 's32
+                               #:quality quality
+                               #:phase phase
+                               #:steep-filter? steep?)))
+        (make-raw-pcm-converter r input-format out-format channels-out rate-in rate-out #f))))
+
+  (define (ensure-open! c who)
+    (when (or (not (pcm-converter? c)) (pcm-converter-closed? c))
+      (error who "PCM converter is closed")))
+
+  (define (pcm-converter-convert c buffer size buf-info)
+    (ensure-open! c 'pcm-converter-convert)
+    (let* ((in-bits (hash-ref/default buf-info 'bits-per-sample (hash-ref (pcm-converter-input-format c) 'bits-per-sample)))
+           (in-bytes (quotient in-bits 8))
+           (in-channels (hash-ref (pcm-converter-input-format c) 'channels))
+           (in-samples (quotient (quotient size in-bytes) in-channels))
+           (s32 (pcm-bytes->s32-bytes buffer size in-bits)))
+      (resampler-convert (pcm-converter-resampler c) s32 (* in-samples in-channels S32-BYTES))))
+
+  (define (pcm-converter-drain c)
+    (ensure-open! c 'pcm-converter-drain)
+    (resampler-drain (pcm-converter-resampler c)))
+
+  (define (pcm-converter-close! c)
+    (when (and (pcm-converter? c) (not (pcm-converter-closed? c)))
+      (resampler-close! (pcm-converter-resampler c))
+      (set-pcm-converter-closed?! c #t))
+    #t)
+
+  ) ; end of module

private/remote-utils.rkt

@@ -0,0 +1,109 @@
+#lang racket/base
+
+(require racket/path
+         racket/string
+         port-channel
+         uni-channel
+         "config.rkt"
+         "utils.rkt"
+         )
+
+(provide replace-base-paths?
+         replace-base-path
+         start-remote-placed-player)
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; Remote path replacement
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(define (path-string->string p)
+  (if (path? p) (path->string p) p))
+
+(define (replace-base-paths? v)
+  (and (list? v)
+       (andmap (lambda (entry)
+                 (and (pair? entry)
+                      (path-string? (car entry))
+                      (path-string? (cdr entry))))
+               v)))
+
+(define (get-path-separator s)
+  (let ((m (regexp-match #rx"[\\\\/]" s)))
+    (if (eq? m #f)
+        (begin
+          (warn-sound "No delimiter found in ~a, assuming unix: '/'" s)
+          "/")
+        (car m))))
+
+(define (replace-base-path path replace-base-paths)
+  (let ((s (path-string->string path)))
+    (let loop ((entries replace-base-paths))
+      (cond [(null? entries) s]
+            [else
+             (let* ((entry (car entries))
+                    (base-path-local (path-string->string (car entry)))
+                    (base-path-remote (path-string->string (cdr entry))))
+               (if (string-prefix? s base-path-local)
+                   (let* ((new-path* (string-append base-path-remote
+                                                   (substring s (string-length base-path-local))))
+                          (delim (get-path-separator new-path*))
+                          (new-path (string-replace (string-replace new-path* "/" delim) "\\" delim))
+                          )
+                     new-path
+                     )
+                   (loop (cdr entries))))]))))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; Remote placed player
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(define (executable-name p)
+  (let ((p* (if (path? p) p (string->path p))))
+    (path->string (file-name-from-path p*))))
+
+(define (plink-program? p)
+  (regexp-match? #rx"(?i:^plink(\\.exe)?$)" (executable-name p)))
+
+(define (ssh-options ssh-program)
+  (if (plink-program? ssh-program)
+      '("-batch" "-T" "-load")
+      '("-T" "-q")))
+
+(define (shell-quote s)
+  (string-append "'"
+                 (regexp-replace* #rx"'" s "'\"'\"'")
+                 "'"))
+
+(define (remote-command remote-host #:cmd [cmd #f])
+  (if (eq? cmd #f)
+      (list (audio-remote-cfg-get remote-host 'remote-racket)
+            "-l"
+            (audio-remote-cfg-get remote-host 'remote-module)
+            "--"
+            "--stdio")
+      (list (audio-remote-cfg-get remote-host 'remote-racket)
+            "-e"
+            (shell-quote cmd)
+            "--"
+            "--stdio")
+      )
+  )
+
+(define (start-ssh-subprocess remote-host #:cmd [cmd #f])
+  (let* ((ssh-program (audio-cfg-get 'ssh-program))
+         (args (append (ssh-options ssh-program)
+                       (list remote-host)
+                       (remote-command remote-host #:cmd cmd))))
+    (apply subprocess #f #f #f ssh-program args)))
+
+(define (make-port-uc port direction source)
+  (make-uni-channel (make-port-channel port #:direction direction #:source source #:close? #t)))
+
+(define (start-remote-placed-player remote-host)
+  (define-values (proc stdout stdin stderr)
+    (start-ssh-subprocess remote-host))
+  (define cmd-ch (make-port-uc stdin 'output 'remote-stdin))
+  (define ret-ch (make-port-uc stdout 'input 'remote-stdout))
+  (define evt-ch (make-port-uc stderr 'input 'remote-stderr))
+  (define dead-guard (lambda () (subprocess-wait proc)))
+  (values cmd-ch ret-ch evt-ch proc dead-guard))

private/utils.rkt

@@ -1,7 +1,9 @@
 (module utils racket/base
 
   (require racket/path
+           racket/file
            racket/runtime-path
+           racket/system
            ffi/unsafe
            setup/dirs
            "downloader.rkt"
@@ -12,6 +14,9 @@
            until
            build-lib-path
            get-lib
+           get-lib/quiet
+           linux-lib-versions
+           ffmpeg-lib-versions
            do-for
            dbg-sound
            info-sound
@@ -19,9 +24,16 @@
            warn-sound
            fatal-sound
            sync-log-sound
+           racket-sound-cache-directory
+           racket-sound-log-file
+           open-racket-sound-log-file
            integer->int-bytes
            int-bytes->integer
            valid-ffmpeg-versions
+           make-mutex
+           mutex-lock
+           mutex-unlock
+           with-mutex
            )
 
   ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
@@ -30,6 +42,81 @@
   
   (sl-def-log racket-sound sound)
 
+
+
+  ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+  ;; Standard cache/log paths
+  ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+  (define (racket-sound-cache-directory)
+    (build-path (find-system-path 'cache-dir) "racket-audio"))
+
+  (define (racket-sound-log-file name)
+    (define filename
+      (cond [(symbol? name) (format "~a.log" name)]
+            [(string? name) name]
+            [else (raise-argument-error 'racket-sound-log-file "(or/c symbol? string?)" name)]))
+    (build-path (racket-sound-cache-directory) filename))
+
+  (define (open-racket-sound-log-file path #:exists [exists 'append])
+    (define parent (path-only (path->complete-path path)))
+    (when parent (make-directory* parent))
+    (open-output-file path #:exists exists))
+
+
+
+
+  ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+  ;; Mutex definitions
+  ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+  (define-struct mutex
+    (thread count mut own) #:mutable)
+
+  (define make-mutex-struct make-mutex)
+  
+  (set! make-mutex (λ ()
+                     (make-mutex-struct #f 0 (make-semaphore 1) (make-semaphore 1))))
+
+  (define (mutex-lock m)
+    (semaphore-wait (mutex-own m))
+    (if (eq? (mutex-thread m) (current-thread))
+        (begin
+          (set-mutex-count! m (+ (mutex-count m) 1))
+          (semaphore-post (mutex-own m))
+          )
+        (begin
+          (semaphore-post (mutex-own m))
+          (semaphore-wait (mutex-mut m))
+          (set-mutex-count! m 1)
+          (set-mutex-thread! m (current-thread)))
+        )
+    )
+
+  (define (mutex-unlock m)
+    (semaphore-wait (mutex-own m))
+    (let ((count (mutex-count m)))
+      (set! count (- count 1))
+      (set-mutex-count! m count)
+      (if (= count 0)
+          (begin
+            (set-mutex-thread! m #f)
+            (semaphore-post (mutex-own m))
+            (semaphore-post (mutex-mut m)))
+          (semaphore-post (mutex-own m)))
+      )
+    )
+
+  (define-syntax with-mutex
+    (syntax-rules ()
+      ((_ m b1 ...)
+       (begin
+         (dynamic-wind
+          (λ () (mutex-lock m))
+          (λ () b1 ...)
+          (λ () (mutex-unlock m)))))))
+
+
   ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
   ;; Provide some loop constructions
   ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
@@ -80,75 +167,99 @@
   ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 
   (define valid-ffmpeg-versions
-    (make-hash (list (list 'avutil 58 60 "libavcodec")
+    (make-hash (list (list 'avutil 58 60 "libavutil")
-                      (list 'avcodec 60 62 "libavutil")
+                     (list 'avcodec 60 62 "libavcodec")
-                      (list 'avformat 60 62 "libswresample")
+                     (list 'avformat 60 62 "libavformat")
-                      (list 'swresample 4 6 "libavformat")
+                     (list 'swresample 4 6 "libswresample"))))
-                      ))
-    )
 
-  (define (version-str kind)
+  (define (versions-high-to-low from until)
+    (let loop ((n from) (acc '(#f)))
+      (if (> n until)
+          acc
+          (loop (+ n 1) (cons (number->string n) acc)))))
+
+  (define (ffmpeg-lib-versions kind)
+    (case (system-type 'os*)
+      [(linux)
+       (let ((v (hash-ref valid-ffmpeg-versions kind)))
+         (versions-high-to-low (car v) (cadr v)))]
+      [else '(#f)]))
+
+  (define (linux-lib-versions versions [default '(#f)])
+    (case (system-type 'os*)
+      [(linux) versions]
+      [else default]))
+
+  (define (ffmpeg-version-line kind)
     (let ((v (hash-ref valid-ffmpeg-versions kind)))
-      (format "  - ~a~a - ~a~a\n" (caddr v) (car v) (caddr v) (cadr v))
+      (format "  ~a: ~a .. ~a" (caddr v) (car v) (cadr v))))
-      )
+
-    )
+  (define (display-section title lines)
+    (displayln title)
+    (for ([line (in-list lines)]) (displayln line))
+    (newline))
+
+  (define (display-command title chunks)
+    (displayln title)
+    (displayln "  sudo apt install \\")
+    (let loop ((xs chunks))
+      (cond [(null? xs) (newline)]
+            [(null? (cdr xs))
+             (displayln (format "    ~a" (car xs)))
+             (newline)]
+            [else
+             (displayln (format "    ~a \\" (car xs)))
+             (loop (cdr xs))])))
+
+  (define linux-runtime-package-lines
+    '("libflac12 libmpg123-0 libao4"
+      "libavcodec60 libavutil58 libswresample4 libavformat60"
+      "libogg0 libopus0 libopusenc0 libopusfile0"
+      "libsoxr0 libtag1v5"))
+
+  (define linux-dev-package-lines
+    '("libflac-dev libmpg123-dev libao-dev"
+      "libavcodec-dev libavutil-dev libswresample-dev libavformat-dev"
+      "libogg-dev libopus-dev libopusenc-dev libopusfile-dev"
+      "libsoxr-dev libtag1-dev"))
+
+  (define brew-package-lines
+    '("ffmpeg libao mpg123 flac opus"
+      "libopusenc libsoxr taglib"))
 
   (define (lib-not-found-message orig-libs libs-path)
-    (displayln (format "Warning: Cannot find library, tried ~a in ~a" orig-libs libs-path))
+    (newline)
+    (displayln "Warning: native library not found")
+    (newline)
+    (display-section "Tried library names:"
+                     (for/list ([lib (in-list orig-libs)]) (format "  - ~a" lib)))
+    (display-section "Search paths:"
+                     (for/list ([path (in-list libs-path)]) (format "  - ~a" path)))
     (let ((st (system-type 'os*)))
-      (cond ((eq? st 'windows)
+      (cond [(eq? st 'windows)
-             (displayln
+             (display-section "Windows native library directory:"
-              (format
+                              (list (format "  - ~a" (soundlibs-directory))))]
-               "\nLibraries for Windows should have been downloaded to\n\n  - ~a\n"
+            [(eq? st 'linux)
-               (soundlibs-directory))))
+             (display-command "Debian/Ubuntu runtime packages:" linux-runtime-package-lines)
-            ((eq? st 'linux)
+             (display-command "Debian/Ubuntu development packages, for local FFI rebuilding:" linux-dev-package-lines)]
-             (displayln
+            [(eq? st 'macosx)
-               (string-append
+             (display-command "Homebrew packages:" brew-package-lines)
-                "Make sure you have installed the following libraries,\n"
+             (displayln "If your local setup uses ffmpeg-full instead of ffmpeg, install that variant instead.")
-                "e.g. on a debian based system with apt:\n"
+             (newline)]
-                "\n"
+            [else
-                "  FLAC   : sudo apt install libflac12\n"
+             (display-section "Required native libraries:"
-                "  mpg123 : libmpg123-0\n"
+                              '("  - xiph libao"
-                "  libao  : libao4\n"
+                                "  - xiph libFLAC"
-                "  ffmpeg : libavcodec60 libavutil58 libswresample4 libavformat60\n"
+                                "  - ffmpeg"
-                "\n"
+                                "  - libmpg123"
-                )))
+                                "  - libopus/libopusenc/libopusfile"
-            ((eq? st 'macosx)
+                                "  - libsoxr"
-             (displayln
+                                "  - taglib"))])
-              (string-append
+      (display-section "Supported FFmpeg ABI versions:"
-               "Make sure you have the right libraries installed, using 'homebrew', see https://brew.sh/\n"
+                       (list (ffmpeg-version-line 'avcodec)
-               "\n"
+                             (ffmpeg-version-line 'avutil)
-               "  brew install ffmpeg-full\n"
+                             (ffmpeg-version-line 'swresample)
-               "  brew install libao\n"
+                             (ffmpeg-version-line 'avformat)))))
-               "  brew install mpg123\n"
-               "  brew install flac\n"
-               "\n"
-               )))
-            (else
-             (displayln
-              (string-append
-               "Make sure you have the right libraries installed on your system and reachable by racket\n"
-               "\n"
-               "You need following libraries:\n"
-               "\n"
-               "- xiph libao (https://xiph.org).\n"
-               "- xiph libFLAC (https://xiph.org).\n"
-               "- ffmpeg of the right version (https://ffmpeg.org).\n"
-               "- libmpg123 (https://mpg123.org).\n"
-               "\n")
-              ))
-            )
-      (displayln
-       (string-append "NB. currently supported major versions for the ffmpeg libraries are:\n"
-                      "\n"
-                      (version-str 'avcodec)
-                      (version-str 'avutil)
-                      (version-str 'swresample)
-                      (version-str 'avformat)
-                      "\n"
-                      ))
-      )
-    )
 
   (define (build-lib-path p)
     (if (eq? (system-type 'os) 'macosx)
@@ -156,7 +267,7 @@
           (cons (soundlibs-directory) (cons brew-lib p)))
        (cons (soundlibs-directory) p)))
 
-  (define (get-lib* libs-to-try orig-libs versions)
+  (define (get-lib* libs-to-try orig-libs versions warn?)
 
     (unless (soundlibs-available?)
       (download-soundlibs))
@@ -164,21 +275,24 @@
     (let ((libs-path (build-lib-path (get-lib-search-dirs))))
       (if (null? libs-to-try)
           (begin
-            (lib-not-found-message orig-libs libs-path)
+            (when warn? (lib-not-found-message orig-libs libs-path))
             #f)
           (ffi-lib (car libs-to-try) versions
                    #:get-lib-dirs (λ () libs-path)
                    #:fail (λ ()
                             (ffi-lib (car libs-to-try) versions
                                      #:fail (λ () 
-                                              (get-lib* (cdr libs-to-try) orig-libs versions))))
+                                              (get-lib* (cdr libs-to-try) orig-libs versions warn?))))
                    )
           )
       )
     )
 
   (define (get-lib libs-to-try versions)
-    (get-lib* libs-to-try libs-to-try versions))
+    (get-lib* libs-to-try libs-to-try versions #t))
+
+  (define (get-lib/quiet libs-to-try versions)
+    (get-lib* libs-to-try libs-to-try versions #f))
 
 
   ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

resampler.rkt

@@ -0,0 +1,285 @@
+(module resampler racket/base
+
+  (require ffi/unsafe
+           "soxr-ffi.rkt"
+           "private/utils.rkt")
+
+  (provide resampler-available?
+           resampler-version
+           make-resampler
+           resampler?
+           resampler-input-rate
+           resampler-output-rate
+           resampler-channels
+           resampler-input-format
+           resampler-output-format
+           resampler-convert
+           resampler-drain
+           resampler-clear!
+           resampler-close!
+           resample-bytes
+           pcm-format?
+           pcm-format-sample-bytes
+           pcm-format->soxr-datatype
+           quality->soxr-recipe)
+
+  (define-struct resampler
+    (ctx input-rate output-rate channels input-format output-format
+         soxr-input-format soxr-output-format input-sample-bytes output-sample-bytes closed?)
+    #:mutable
+    #:constructor-name make-raw-resampler)
+
+  (define (resampler-available?) (soxr-available?))
+  (define (resampler-version) (soxr-version))
+
+  (define (normalize-format fmt who)
+    (cond [(or (eq? fmt 's16) (eq? fmt 'int16) (eq? fmt 'int16-interleaved)) 's16]
+          [(or (eq? fmt 's24) (eq? fmt 'int24) (eq? fmt 'int24-interleaved)) 's24]
+          [(or (eq? fmt 's32) (eq? fmt 'int32) (eq? fmt 'int32-interleaved)) 's32]
+          [(or (eq? fmt 'float32) (eq? fmt 'f32) (eq? fmt 'float)) 'float32]
+          [(or (eq? fmt 'float64) (eq? fmt 'f64) (eq? fmt 'double)) 'float64]
+          [else (raise-argument-error who "(or/c 's16 's24 's32 'float32 'float64)" fmt)]))
+
+  (define (pcm-format? fmt)
+    (with-handlers ([exn:fail? (lambda (e) #f)])
+      (normalize-format fmt 'pcm-format?)
+      #t))
+
+  (define (pcm-format-sample-bytes fmt)
+    (case (normalize-format fmt 'pcm-format-sample-bytes)
+      [(s16) 2]
+      [(s24) 3]
+      [(s32 float32) 4]
+      [(float64) 8]))
+
+  (define (pcm-format-actual-sample-bytes fmt)
+    ;; SoXR has no packed 24-bit datatype.  The wrapper expands s24 to s32
+    ;; before processing and packs s32 back to s24 afterwards when requested.
+    (case (normalize-format fmt 'pcm-format-actual-sample-bytes)
+      [(s24) 4]
+      [else (pcm-format-sample-bytes fmt)]))
+
+  (define (pcm-format->soxr-datatype fmt)
+    (case (normalize-format fmt 'pcm-format->soxr-datatype)
+      [(s16) SOXR_INT16_I]
+      [(s24 s32) SOXR_INT32_I]
+      [(float32) SOXR_FLOAT32_I]
+      [(float64) SOXR_FLOAT64_I]))
+
+  (define (quality->soxr-recipe q)
+    ;; The '*-bitq' recipes are resampling precision recipes; they do not mean
+    ;; that the PCM output is 16/24/32-bit.  Output format is controlled by
+    ;; #:output-format.
+    (cond [(integer? q) q]
+          [(or (eq? q 'qq) (eq? q 'quick)) SOXR_QQ]
+          [(or (eq? q 'lq) (eq? q 'low)) SOXR_LQ]
+          [(or (eq? q 'mq) (eq? q 'medium)) SOXR_MQ]
+          [(or (eq? q 'hq) (eq? q 'high)) SOXR_HQ]
+          [(or (eq? q 'vhq) (eq? q 'very-high)) SOXR_VHQ]
+          [(eq? q '16-bit) SOXR_16_BITQ]
+          [(eq? q '20-bit) SOXR_20_BITQ]
+          [(eq? q '24-bit) SOXR_24_BITQ]
+          [(eq? q '28-bit) SOXR_28_BITQ]
+          [(eq? q '32-bit) SOXR_32_BITQ]
+          [else (raise-argument-error 'quality->soxr-recipe
+                                      "(or/c 'qq 'lq 'mq 'hq 'vhq '16-bit '20-bit '24-bit '28-bit '32-bit exact-integer?)" q)]))
+
+  (define (phase->flags phase)
+    (cond [(or (eq? phase 'linear) (eq? phase #f)) SOXR_LINEAR_PHASE]
+          [(or (eq? phase 'intermediate) (eq? phase 'medium)) SOXR_INTERMEDIATE_PHASE]
+          [(or (eq? phase 'minimum) (eq? phase 'min)) SOXR_MINIMUM_PHASE]
+          [else (raise-argument-error 'make-resampler "(or/c 'linear 'intermediate 'minimum)" phase)]))
+
+  (define (check-error who err)
+    (when err (error who "~a" err)))
+
+  (define (bytes->native bs size)
+    (let ((p (malloc size 'atomic-interior)))
+      (memcpy p 0 bs 0 size)
+      p))
+
+  (define (native->bytes p size)
+    (let ((bs (make-bytes size)))
+      (memcpy bs 0 p 0 size)
+      bs))
+
+  (define (native-signed-ref bs start bytes)
+    (int-bytes->integer bs #t (system-big-endian?) start (+ start bytes)))
+
+  (define (native-signed-set! bs start bytes value)
+    (integer->int-bytes value bytes #t (system-big-endian?) bs start))
+
+  (define (clamp-s32 v)
+    (cond [(< v -2147483648) -2147483648]
+          [(> v 2147483647) 2147483647]
+          [else v]))
+
+  (define (clamp-s24 v)
+    (cond [(< v -8388608) -8388608]
+          [(> v 8388607) 8388607]
+          [else v]))
+
+  (define (s24-bytes->s32-bytes buffer size)
+    (let* ((sample-count (quotient size 3))
+           (out (make-bytes (* sample-count 4))))
+      (for ([i (in-range sample-count)])
+        (let* ((in-off (* i 3))
+               (out-off (* i 4))
+               (sample (native-signed-ref buffer in-off 3)))
+          (native-signed-set! out out-off 4 (clamp-s32 (arithmetic-shift sample 8)))))
+      out))
+
+  (define (s32-bytes->s24-bytes buffer size)
+    (let* ((sample-count (quotient size 4))
+           (out (make-bytes (* sample-count 3))))
+      (for ([i (in-range sample-count)])
+        (let* ((in-off (* i 4))
+               (out-off (* i 3))
+               (sample (native-signed-ref buffer in-off 4)))
+          (native-signed-set! out out-off 3 (clamp-s24 (arithmetic-shift sample -8)))))
+      out))
+
+  (define (subbytes/size bs size)
+    (if (= size (bytes-length bs)) bs (subbytes bs 0 size)))
+
+  (define (prepare-input-bytes r buffer size)
+    (case (resampler-input-format r)
+      [(s24) (s24-bytes->s32-bytes buffer size)]
+      [else (subbytes/size buffer size)]))
+
+  (define (finish-output-bytes r buffer size)
+    (case (resampler-output-format r)
+      [(s24) (s32-bytes->s24-bytes buffer size)]
+      [else (subbytes/size buffer size)]))
+
+  (define (output-frame-capacity r in-frames)
+    (let* ((ratio (/ (resampler-output-rate r) (resampler-input-rate r)))
+           (delay (if (resampler-ctx r) (max 0.0 (soxr-delay (resampler-ctx r))) 0.0))
+           (n (ceiling (+ 256 delay (* in-frames ratio)))))
+      (max 256 (inexact->exact n))))
+
+  (define (make-resampler input-rate output-rate channels
+                          #:input-format [input-format 's32]
+                          #:output-format [output-format 's32]
+                          #:quality [quality 'hq]
+                          #:phase [phase 'linear]
+                          #:steep-filter? [steep-filter? #f]
+                          #:scale [scale 1.0]
+                          #:no-dither? [no-dither? #f]
+                          #:num-threads [num-threads 1])
+    (unless (resampler-available?)
+      (error 'make-resampler "libsoxr is not available"))
+    (unless (and (integer? channels) (> channels 0))
+      (raise-argument-error 'make-resampler "exact-positive-integer?" channels))
+    (let* ((in-fmt (normalize-format input-format 'make-resampler))
+           (out-fmt (normalize-format output-format 'make-resampler))
+           (itype (pcm-format->soxr-datatype in-fmt))
+           (otype (pcm-format->soxr-datatype out-fmt))
+           (io-flags (if no-dither? SOXR_NO_DITHER 0))
+           (quality-flags (bitwise-ior (phase->flags phase) (if steep-filter? SOXR_STEEP_FILTER 0)))
+           (io-spec (soxr-io-spec itype otype #:scale scale #:flags io-flags))
+           (quality-spec (soxr-quality-spec (quality->soxr-recipe quality) #:flags quality-flags))
+           (runtime-spec (soxr-runtime-spec #:num-threads num-threads)))
+      (let-values (((ctx err) (soxr-create input-rate output-rate channels
+                                           #:io-spec io-spec
+                                           #:quality-spec quality-spec
+                                           #:runtime-spec runtime-spec)))
+        (check-error 'make-resampler err)
+        (unless ctx (error 'make-resampler "libsoxr returned no resampler context"))
+        (make-raw-resampler ctx input-rate output-rate channels in-fmt out-fmt itype otype
+                            (pcm-format-actual-sample-bytes in-fmt)
+                            (pcm-format-actual-sample-bytes out-fmt)
+                            #f))))
+
+  (define (ensure-open! r who)
+    (when (or (not (resampler? r)) (resampler-closed? r))
+      (error who "resampler is closed")))
+
+  (define (check-frame-size who size frame-bytes)
+    (unless (= (remainder size frame-bytes) 0)
+      (error who "buffer size ~a is not a whole number of interleaved frames of ~a bytes" size frame-bytes)))
+
+  (define (resampler-convert r buffer [size (bytes-length buffer)])
+    (ensure-open! r 'resampler-convert)
+    (let* ((nominal-in-frame-bytes (* (resampler-channels r) (pcm-format-sample-bytes (resampler-input-format r))))
+           (actual-in-frame-bytes (* (resampler-channels r) (resampler-input-sample-bytes r))))
+      (check-frame-size 'resampler-convert size nominal-in-frame-bytes)
+      (cond [(zero? size) (values #"" 0)]
+            [else
+             (let* ((in-frames (quotient size nominal-in-frame-bytes))
+                    (prepared (prepare-input-bytes r buffer size))
+                    (in-ptr0 (bytes->native prepared (bytes-length prepared))))
+               (let loop ((offset-frames 0) (remaining in-frames) (pieces '()) (total-frames 0))
+                 (cond [(zero? remaining) (values (apply bytes-append (reverse pieces)) total-frames)]
+                       [else
+                        (let* ((out-cap (output-frame-capacity r remaining))
+                               (out-size (* out-cap (resampler-channels r) (resampler-output-sample-bytes r)))
+                               (out-ptr (malloc out-size 'atomic-interior))
+                               (in-ptr (ptr-add in-ptr0 (* offset-frames actual-in-frame-bytes))))
+                          (let-values (((err idone odone) (soxr-process (resampler-ctx r) in-ptr remaining out-ptr out-cap)))
+                            (check-error 'resampler-convert err)
+                            (when (and (> remaining 0) (zero? idone) (zero? odone))
+                              (error 'resampler-convert "libsoxr made no progress"))
+                            (let* ((raw-size (* odone (resampler-channels r) (resampler-output-sample-bytes r)))
+                                   (raw (native->bytes out-ptr raw-size))
+                                   (piece (finish-output-bytes r raw raw-size)))
+                              (loop (+ offset-frames idone) (- remaining idone)
+                                    (if (zero? odone) pieces (cons piece pieces))
+                                    (+ total-frames odone)))))])))])))
+
+  (define (resampler-drain r)
+    (ensure-open! r 'resampler-drain)
+    (let loop ((pieces '()) (total-frames 0))
+      (let* ((delay (max 0.0 (soxr-delay (resampler-ctx r))))
+             (out-cap (max 4096 (inexact->exact (ceiling (+ delay 256)))))
+             (out-size (* out-cap (resampler-channels r) (resampler-output-sample-bytes r)))
+             (out-ptr (malloc out-size 'atomic-interior)))
+        (let-values (((err idone odone) (soxr-process (resampler-ctx r) #f 0 out-ptr out-cap)))
+          (check-error 'resampler-drain err)
+          (cond [(zero? odone) (values (apply bytes-append (reverse pieces)) total-frames)]
+                [else
+                 (let* ((raw-size (* odone (resampler-channels r) (resampler-output-sample-bytes r)))
+                        (raw (native->bytes out-ptr raw-size))
+                        (piece (finish-output-bytes r raw raw-size)))
+                   (loop (cons piece pieces) (+ total-frames odone)))])))))
+
+  (define (resampler-clear! r)
+    (ensure-open! r 'resampler-clear!)
+    (check-error 'resampler-clear! (soxr-clear (resampler-ctx r)))
+    #t)
+
+  (define (resampler-close! r)
+    (when (and (resampler? r) (not (resampler-closed? r)))
+      (soxr-delete (resampler-ctx r))
+      (set-resampler-ctx! r #f)
+      (set-resampler-closed?! r #t))
+    #t)
+
+  (define (resample-bytes buffer input-rate output-rate channels
+                          #:size [size (bytes-length buffer)]
+                          #:input-format [input-format 's32]
+                          #:output-format [output-format 's32]
+                          #:quality [quality 'hq]
+                          #:phase [phase 'linear]
+                          #:steep-filter? [steep-filter? #f]
+                          #:scale [scale 1.0]
+                          #:no-dither? [no-dither? #f]
+                          #:num-threads [num-threads 1])
+    (let ((r (make-resampler input-rate output-rate channels
+                             #:input-format input-format
+                             #:output-format output-format
+                             #:quality quality
+                             #:phase phase
+                             #:steep-filter? steep-filter?
+                             #:scale scale
+                             #:no-dither? no-dither?
+                             #:num-threads num-threads)))
+      (dynamic-wind
+       void
+       (lambda ()
+         (let-values (((a af) (resampler-convert r buffer size)))
+           (let-values (((b bf) (resampler-drain r)))
+             (values (bytes-append a b) (+ af bf)))))
+       (lambda () (resampler-close! r)))))
+
+  ) ; end of module

scrbl/audio-decoder.scrbl

@@ -2,8 +2,10 @@
 
 @(require racket/base
           (for-label racket/base
+                     racket/contract
                      racket/path
-                     "../audio-decoder.rkt"))
+                     "../audio-decoder.rkt"
+                     "../audio-sniffer.rkt"))
 
 @title{audio-decoder}
 @author[@author+email["Hans Dijkema" "hans@dijkewijk.nl"]]
@@ -15,9 +17,9 @@ decoders. A backend is selected from the filename extension and is then
 used through a uniform interface for opening, reading, seeking, and
 stopping.
 
-The module includes built-in readers for FLAC and MP3, and it allows
+The module includes built-in readers for FLAC, MP3, Opus via
-additional backends to be registered with
+@tt{libopusfile}, and FFmpeg-backed formats. Additional backends can be
-@racket[audio-register-reader!].
+registered with @racket[audio-register-reader!].
 
 @section{Reader registration}
 
@@ -67,7 +69,7 @@ available to @racket[audio-open].
 This procedure is the extension point for custom audio decoders.
 }
 
-@section{Audio handles}
+@section[#:tag "audio-decoder-audio-handles"]{Audio handles}
 
 @defproc[(audio-handle? [v any/c]) boolean?]{
 
@@ -79,8 +81,8 @@ otherwise.
 
 Returns the reader type stored in @racket[handle].
 
-For the built-in readers this is either @racket['flac] or
+For the built-in readers this is usually @racket['flac], @racket['mp3],
-@racket['mp3].
+@racket['opusfile], or @racket['ffmpeg].
 }
 
 @section{Known extensions and validation}
@@ -89,9 +91,74 @@ For the built-in readers this is either @racket['flac] or
 
 Returns the list of known filename extensions.
 
-The initial list contains @racket["flac"] and @racket["mp3"].
+The initial list contains the extensions handled by the built-in readers:
-Additional extensions are added when readers are registered with
+@racket["flac"], @racket["mp3"], Opus/Ogg extensions such as
-@racket[audio-register-reader!].
+@racket["opus"], @racket["ogg"], and @racket["oga"], and the extensions
+handled by the FFmpeg reader. Additional extensions are added when
+readers are registered with @racket[audio-register-reader!].
+}
+
+
+@defproc[(audio-supported-extensions) (listof string?)]{
+
+Returns the current list of supported filename extensions. This is the
+same list returned by @racket[audio-known-exts?].
+}
+
+@defproc[(audio-supported-formats)
+         (listof (cons/c string? string?))]{
+
+Returns the supported filename extensions together with the MIME type
+reported by @racketmodname[racket-mimetypes]. Unknown MIME types use
+@racket["application/octet-stream"].
+}
+
+@defproc[(audio-decoder-for-extension
+          [extension (or/c string? symbol?)])
+         (or/c #f symbol?)]{
+
+Returns the decoder selected for audio with @racket[extension], such as
+@racket['flac], @racket['opusfile], or @racket['ffmpeg]. The result is
+@racket[#f] when the extension is not recognized. Actual playback still
+sniffs the file contents before selecting its decoder.
+}
+
+@section{Built-in decoder selection}
+
+The built-in decoder table contains:
+
+@itemlist[#:style 'compact
+ @item{@racket['flac] for FLAC files;}
+ @item{@racket['mp3] for MP3 files;}
+ @item{@racket['opusfile] for Ogg Opus streams through Xiph
+       @tt{libopusfile};}
+ @item{@racket['ffmpeg] for formats handled by the FFmpeg backend.}]
+
+When a file is opened, the module first asks
+@racket[audio-sniff-format/extension] for the detected format. Opus
+streams are mapped to @racket['opusfile] when @tt{libopusfile} is
+available and to @racket['ffmpeg] otherwise.
+
+The Opusfile decoder has one global setting for its PCM output format:
+@racket[current-opusfile-output-format]. This setting is re-exported by
+this module for callers that use only the generic decoder API.
+
+@defthing[current-opusfile-output-format procedure?]{
+
+A global setting procedure for the Opusfile backend. Called without
+arguments, it returns the current Opusfile output format. Called with one
+argument, it sets the output format. Accepted values are @racket['s16]
+and @racket['s24].
+
+The default is @racket['s16]. Set it to @racket['s24] before opening or
+reading an Opus file when the playback pipeline should receive packed
+signed 24-bit PCM instead of signed 16-bit PCM.
+}
+
+@defproc[(opusfile-output-format? [v any/c]) boolean?]{
+
+Returns @racket[#t] when @racket[v] is one of the supported Opusfile
+output format symbols: @racket['s16] or @racket['s24].
 }
 
 @defproc[(audio-valid-ext? [ext any/c]) boolean?]{
@@ -146,7 +213,8 @@ where:
 
 @itemlist[#:style 'compact
  @item{@racket[audio-type] is the registered reader type, such as
-       @racket['flac] or @racket['mp3];}
+       @racket['flac], @racket['mp3], @racket['opusfile], or
+       @racket['ffmpeg];}
  @item{@racket[ao-type] is the audio-output type stored in the reader,
        such as @racket['flac] or @racket['ao];}
  @item{@racket[handle] is the generic @racket[audio-handle];}
@@ -255,5 +323,5 @@ A backend integrated through this interface should provide:
        backend produces.}]
 
 Once registered, files with matching extensions can be opened through
-@racket[audio-open] in the same way as the built-in FLAC and MP3
+@racket[audio-open] in the same way as the built-in FLAC, MP3,
-backends.
+Opusfile, and FFmpeg backends.

scrbl/audio-encoder.scrbl

@@ -0,0 +1,231 @@
+#lang scribble/manual
+
+@(require (for-label racket/base
+                     racket/contract
+                     racket/path
+                     "../audio-encoder.rkt"))
+
+@title{Audio Encoding}
+@author[@author+email["Hans Dijkema" "hans@dijkewijk.nl"]]
+
+@defmodule[racket-audio/audio-encoder]
+
+The @racketmodname[racket-audio/audio-encoder] module provides the high level
+file-to-file encoding pipeline.  It reuses the existing decoder environment to
+read the input file and sends the decoded PCM stream to a selected encoder
+backend.  The built-in backends are Opus, implemented with @tt{libopusenc}, and
+FLAC, implemented with @tt{libFLAC}.
+
+This module is intended as the public encoding API.  The concrete backend
+modules are small FFI backends; applications normally call @racket[audio-encode]
+instead of using those modules directly.
+
+@section{Pipeline}
+
+Encoding is organised as a streaming pipeline:
+
+@racketblock[
+input file
+  ;; decoded by audio-decoder.rkt
+  -> PCM buffers
+  ;; optional conversion for FLAC
+  -> encoder backend
+  -> output file]
+
+The encoder is selected from @racket[#:encoder] or, when that argument is not
+provided, from the output filename extension.  The initial built-in encoders are
+@racket['opus] for @filepath{.opus} and @filepath{.oga} files, and
+@racket['flac] for @filepath{.flac} files.
+
+The PCM stream is not collected in memory.  Each decoded buffer is forwarded to
+the selected backend.  FLAC encoding may insert a PCM conversion step when the
+settings request a different sample rate, channel count, or bit depth.  Opus
+encoding feeds floating-point PCM to @tt{libopusenc}; sample-rate conversion for
+Opus is left to @tt{libopusenc}.
+
+@section{Encoding a file}
+
+@defproc[(audio-encode [input-file path-string?]
+                       [output-file path-string?]
+                       [settings hash?]
+                       [#:encoder encoder (or/c symbol? #f) #f]
+                       [#:copy-tags? copy-tags? boolean? #t]
+                       [#:progress-callback progress-callback
+                         (or/c procedure? #f) #f])
+         hash?]{
+Encodes @racket[input-file] to @racket[output-file] and returns a result hash.
+The @racket[settings] hash is interpreted by the selected backend.
+
+When @racket[encoder] is @racket[#f], the backend is inferred from the output
+file extension.  Pass @racket['opus] or @racket['flac] to force a backend.
+
+When @racket[copy-tags?] is true, common textual tags and an embedded picture
+are copied from the source file to the destination file.  Opus comments and
+cover art are written before encoding starts through @tt{libopusenc}.  FLAC
+metadata is copied after the encoded file has been written, using the
+read-write API from @racketmodname[racket-audio/taglib].
+
+When @racket[progress-callback] is a procedure, it is called with a progress
+hash during encoding.  Progress is based on the number of input frames read from
+the decoder, not on the number of frames written by the encoder.  This matters
+for resampling, because output frame counts can differ from input frame counts.}
+
+@racketblock[
+(audio-encode "input.flac"
+              "output.opus"
+              (hash 'bitrate 224000
+                    'vbr? #t
+                    'complexity 10)
+              #:encoder 'opus)
+
+(audio-encode "input-96k.flac"
+              "output-48k.flac"
+              (hash 'sample-rate 48000
+                    'bits-per-sample 24
+                    'compression-level 8)
+              #:encoder 'flac)]
+
+@section{Result hash}
+
+The result hash contains the following keys:
+
+@itemlist[#:style 'compact
+ @item{@racket['encoder], the selected backend symbol;}
+ @item{@racket['input] and @racket['output], the source and destination paths;}
+ @item{@racket['input-format], the final decoded input format hash seen by the
+       pipeline;}
+ @item{@racket['output-format], the resolved backend output format hash;}
+ @item{@racket['frames-read], the number of input frames consumed;}
+ @item{@racket['frames-written], the number of frames accepted by the backend;}
+ @item{@racket['tag-copy], a hash describing how metadata was handled.}]
+
+The @racket['tag-copy] hash contains a @racket['method] key.  For Opus the
+method is @racket['libopusenc-comments], because metadata must be supplied to
+@tt{libopusenc} before the encoder writes the OpusTags packet.  For FLAC the
+method is @racket['taglib-post-copy], because the encoded file is tagged after
+encoding.
+
+@section{Progress callback}
+
+The progress callback receives a hash with at least these keys:
+
+@itemlist[#:style 'compact
+ @item{@racket['phase], such as @racket['format], @racket['audio],
+       @racket['finished-encoding], or @racket['finished];}
+ @item{@racket['frames-read] and @racket['frames-written];}
+ @item{@racket['total-frames], when the decoder reported a known input length;}
+ @item{@racket['progress], a number between @racket[0.0] and @racket[1.0] when
+       @racket['total-frames] is known, otherwise @racket[#f];}
+ @item{@racket['input-format] and, after the backend has opened,
+       @racket['output-format].}]
+
+A simple command-line style progress callback can print a percentage on one
+line:
+
+@racketblock[
+(define (show-progress h)
+  (let ((p (hash-ref h 'progress #f)))
+    (when (number? p)
+      (printf "\rprogress: ~a%" (round (* 100 p)))
+      (flush-output))))]
+
+@section{Opus settings}
+
+The Opus backend uses @tt{libopusenc}.  The input PCM is converted to interleaved
+floating-point samples in the range @racket[-1.0] to @racket[1.0] and written
+with @tt{ope_encoder_write_float}.  The source sample rate is passed to
+@tt{libopusenc}; @tt{libopusenc} performs the required internal resampling for
+Opus output.
+
+The following settings are recognised:
+
+@itemlist[#:style 'compact
+ @item{@racket['bitrate], bitrate in bits per second.  The default is
+       @racket[160000].}
+ @item{@racket['vbr?], whether variable bitrate is enabled.  The default is
+       @racket[#t].}
+ @item{@racket['constrained-vbr?], whether constrained VBR is enabled.  The
+       default is @racket[#f].}
+ @item{@racket['complexity], encoder complexity.  The default is @racket[10].}
+ @item{@racket['comment-padding], Opus comment padding in bytes.  The default
+       is @racket[512].}
+ @item{@racket['signal], optionally @racket['auto], @racket['voice], or
+       @racket['music].}
+ @item{@racket['lsb-depth], optionally passed to the encoder as the source
+       least significant bit depth.}
+ @item{@racket['comments], an optional hash of Opus comment strings.  When
+       @racket[#:copy-tags?] is true, @racket[audio-encode] fills this from the
+       source tags.}
+ @item{@racket['picture], an optional picture value from @racketmodname[racket-audio/taglib].
+       When @racket[#:copy-tags?] is true, @racket[audio-encode] fills this
+       from the source tags.}]
+
+The first backend version supports mono and stereo input.
+
+@section{FLAC settings}
+
+The FLAC backend uses the @tt{libFLAC} stream encoder.  It writes interleaved
+integer PCM samples through the FLAC encoder API.  When the requested output
+sample rate differs from the decoded input format, @tt{racket-audio/private/pcm-converter}
+uses @racketmodname[racket-audio/resampler], backed by @tt{libsoxr}, to perform
+PCM sample-rate conversion.  Channel-count conversion is not handled by this
+SoXR path; keep the source channel count for encoder-side conversion.
+
+The following settings are recognised:
+
+@itemlist[#:style 'compact
+ @item{@racket['compression-level], FLAC compression level.  The default is
+       @racket[5].}
+ @item{@racket['verify?], whether the FLAC encoder verifies encoded output.  The
+       default is @racket[#f].}
+ @item{@racket['blocksize], explicit FLAC block size.  The default is
+       @racket[0], meaning the library default.}
+ @item{@racket['sample-rate] or @racket['target-sample-rate], target sample rate
+       in Hz.  Use @racket['source] or omit the key to keep the source rate.}
+ @item{@racket['channels] or @racket['target-channels], target channel count.
+       Use @racket['source] or omit the key to keep the source channel count.}
+ @item{@racket['bits-per-sample] or @racket['target-bits-per-sample], target
+       bit depth.  Use @racket['source] or omit the key to keep the source bit
+       depth.}]
+
+For example, a 24-bit 96 kHz FLAC file can be transcoded to 24-bit 48 kHz FLAC
+with:
+
+@racketblock[
+(audio-encode "input-96k.flac"
+              "output-48k.flac"
+              (hash 'sample-rate 48000
+                    'bits-per-sample 24
+                    'compression-level 8)
+              #:encoder 'flac)]
+
+@section{Encoder registration}
+
+@defproc[(audio-supported-encoder-extensions) (listof string?)]{
+Returns the extensions supported by the currently registered encoders.  The
+initial list includes @racket["flac"], @racket["opus"], and @racket["oga"].}
+
+@defproc[(make-audio-encoder [exts (listof string?)]
+                             [open procedure?]
+                             [write procedure?]
+                             [finish procedure?]
+                             [settings procedure?])
+         audio-encoder?]{
+Creates an encoder descriptor.  The descriptor is used by
+@racket[audio-register-encoder!] to register a backend.
+
+The @racket[open] procedure receives the output file, settings hash, and input
+format hash.  The @racket[write] procedure receives the backend handle, buffer
+format hash, byte buffer, and byte length, and returns the number of frames
+accepted by the backend.  The @racket[finish] procedure finalises and releases
+the backend handle.  The @racket[settings] procedure resolves backend defaults
+against the input format and returns the output format hash.}
+
+@defproc[(audio-encoder? [v any/c]) boolean?]{
+Returns @racket[#t] when @racket[v] is an encoder descriptor.}
+
+@defproc[(audio-register-encoder! [type symbol?]
+                                 [encoder audio-encoder?])
+         void?]{
+Registers @racket[encoder] under @racket[type].  The encoder's extensions are
+used for extension-based selection in @racket[audio-encode].}

scrbl/audio-placed-player.scrbl

@@ -0,0 +1,336 @@
+#lang scribble/manual
+
+@(require racket/runtime-path
+          (for-label racket/base
+                     racket/contract
+                     racket/place
+                     racket/async-channel
+                     uni-channel
+                     port-channel
+                     "../audio-placed-player.rkt"
+                     "../audio-player.rkt"))
+
+@(define-runtime-path placed-player-state-model-svg
+   "placed-player-state-model.svg")
+@(define-runtime-path placed-player-worker-detail-model-svg
+   "placed-player-worker-detail-model.svg")
+
+@title{Placed Audio Player}
+@author[@author+email["Hans Dijkema" "hans@dijkewijk.nl"]]
+
+
+@defmodule[racket-audio/audio-placed-player]
+
+The @racketmodname[racket-audio/audio-placed-player] module contains the worker side
+of the audio player.  It is normally started by
+@racket[make-audio-player] from @racketmodname[racket-audio/audio-player], and user
+code should normally use that module's higher level procedures, such as
+@racket[audio-play!], @racket[audio-pause!], @racket[audio-stop!],
+@racket[audio-quit!], @racket[audio-seek!], and @racket[audio-volume!].
+
+The placed player is implemented as a command loop around a decoder, an
+asynchronous libao output handle, and a small amount of state that is reported
+back to the controlling side.  In normal use it runs in a Racket place, so that
+the audio side has a separate Racket VM.  The same function can also run in a
+normal Racket thread with async channels.  Both modes are mediated through
+@racketmodname[uni-channel]: each of the existing logical channels is wrapped as
+a uni-channel endpoint, so the worker no longer depends directly on
+@racket[place-channel-put], @racket[place-channel-get],
+@racket[async-channel-put], or @racket[async-channel-get].
+
+It is normally run in a separate place so that audio decoding and feeding are
+isolated from scheduling delays in the main Racket VM, such as GUI activity,
+debugging, or interaction with DrRacket.
+
+@section{Interface}
+
+@defproc[(placed-player
+          [ch-in (or/c uni-channel? place-channel? async-channel? port-channel?)]
+          [ch-out (or/c #f uni-channel? place-channel? async-channel? port-channel?) #f]
+          [ch-evt (or/c #f uni-channel? place-channel? async-channel? port-channel?) #f])
+         void?]{
+Runs the placed-player command loop on @racket[ch-in].  Each channel may already
+be a @racket[uni-channel?] or may be a supported raw channel that can be wrapped
+with @racket[make-uni-channel].  The command loop receives list commands,
+initializes its reply and event channels, and then processes playback commands
+until it receives @racket['quit].
+
+When @racket[ch-out] and @racket[ch-evt] are @racket[#f], the command loop
+expects an initial @racket['init] command containing the raw reply and event
+channels.  This remains the normal path for @racket[dynamic-place], because a
+@racket[uni-channel] value contains procedures and must not be sent through a
+place channel.  In that case the controlling side sends the raw place channels
+and the worker wraps them locally.
+
+When all three channels are supplied, the worker starts initialized.  This is
+used by the standard-port worker entry point and can also be used by custom
+launchers.}
+
+@defproc[(placed-player/stdio [#:log-file log-file (or/c #f path-string?) (racket-sound-log-file 'placed-audio-player-stdio)])
+         void?]{
+Runs @racket[placed-player] using the process standard streams as three logical
+channels: @racket[current-input-port] is the command channel,
+@racket[current-output-port] is the reply channel, and
+@racket[current-error-port] is the asynchronous event channel.  The streams are
+wrapped through @racket[make-port-channel] and then through
+@racket[make-uni-channel].
+
+Because stdout and stderr are protocol streams in this mode, ordinary display
+and log output is redirected while the worker is running.  By default, output is
+appended to a log file under Racket's standard cache directory, for example
+@filepath{~/.cache/racket/racket-audio/placed-audio-player-stdio.log} on many
+Unix-like systems.  Pass @racket[#f] explicitly to discard ordinary output, or
+pass a path to choose a different log file.
+
+The module also has a command-line entry point.  A remote or local subprocess
+worker can be started with:
+
+@verbatim{
+racket -l racket-audio/audio-placed-player -- --stdio
+}
+
+This is the command used by @racket[make-audio-player] when SSH remote playback
+is enabled, unless the caller supplies a custom remote command.}
+
+The public wrapper in @racketmodname[racket-audio/audio-player] creates the channels,
+sends the initial @racket['init] command when needed, starts an event thread, and exposes a
+contracted API.  The placed player exports @racket[placed-player] and the
+standard-port worker entry point @racket[placed-player/stdio].
+
+@section{Overall state model}
+
+The logical player state is deliberately small.  The stored value of
+@racket[player-state] is one of @racket['stopped], @racket['playing], or
+@racket['paused].  The state diagram below also shows protocol states around
+initialization and termination.
+
+@(image placed-player-state-model-svg)
+
+The important command-level behaviour is:
+
+@itemlist[#:style 'compact
+ @item{@racket['init] installs the reply and event channels and moves the
+       player into the initialized command loop.}
+ @item{@racket['open] starts a decoder and a read worker.  If another worker is
+       still feeding audio, it is first interrupted and joined. Returns
+       a @tt{music id} for the given file.}
+ @item{@racket['pause] only changes @racket[player-state].  The worker observes
+       that state and applies @racket[ao-pause] to the output side.}
+ @item{@racket['seek] clears the async output queue and seeks the decoder, but
+       does not change the logical player state.}
+ @item{@racket['stop] performs cleanup and returns to @racket['stopped].}
+ @item{@racket['quit] performs cleanup, emits a final forced state event, sends
+       the @racket['quit] reply, and exits the command loop.}]
+
+A @racket['quit] command is part of the valid protocol after initialization.  A
+@racket['quit] before @racket['init] is not a normal use case: cleanup emits
+state information through the event channel, and that channel has not yet been
+installed.
+
+@section{Command protocol}
+
+The controlling side sends commands as lists on @racket[ch-in].  The result of
+an RPC-style command is sent on the reply channel installed by
+@racket['init] or supplied directly to @racket[placed-player].  Asynchronous
+events are sent on the event channel.  These are logical channels; the concrete
+transport may be place channels, async channels, or port channels wrapped as
+uni-channels.
+
+@itemlist[#:style 'compact
+ @item{@racket[(list 'init ch-out ch-evt)] installs @racket[ch-out] and
+       @racket[ch-evt], and replies with @racket['(initialized)].}
+ @item{@racket[(list 'open file)] opens @racket[file], starts the decoder
+       worker, and replies with @racket[(list ok music-id)], where
+       @tt{music-id} is the given music id to the file to play.}
+ @item{@racket[(list 'pause paused?)] sets @racket[player-state] to
+       @racket['paused] or @racket['playing] when the player is already active,
+       and replies with @racket['(ok)].}
+ @item{@racket[(list 'paused)] replies with a one-element list containing a
+       boolean.}
+ @item{@racket[(list 'seek percentage)] clears the output queue, seeks the
+       decoder if present, and replies with @racket['(ok)].}
+ @item{@racket[(list 'volume percentage)] stores a requested volume percentage,
+       and replies with @racket['(ok)].  The worker applies the change when it
+       next feeds audio.}
+ @item{@racket[(list 'get-volume)] replies with the current volume in a
+       one-element list.}
+ @item{@racket[(list 'buf-seconds min max)] configures the output buffering
+       range.  The values are clamped by the placed player.}
+ @item{@racket[(list 'stop)] calls the cleanup path, returns to
+       @racket['stopped], and replies with @racket['(ok)].}
+ @item{@racket[(list 'state)] builds a forced state snapshot and replies with
+       the state event payload.}
+ @item{@racket[(list 'quit)] calls the cleanup path, emits a final state event,
+       replies with @racket['(quit)], and terminates the loop.}]
+
+Unknown commands are caught inside the initialized loop and receive an
+@racket['error] reply.  Exceptions during an RPC command are reported both as an
+@racket['exception] event and, when possible, as an @racket['error] reply for
+the current RPC.
+
+@section{Worker and decoder lifecycle}
+
+Opening a file creates a decoder with @racket[audio-open].  The decoder is
+called with two callbacks: one for metadata and one for audio buffers.  Metadata
+is stored for later state reporting.  Audio buffers are passed to the libao
+asynchronous player by @racket[ao-play].
+
+The decoder is read by a Racket thread created by @racket[audio-read-worker].
+That thread is separate from the command loop, even when the whole placed player
+is already running inside a Racket place.  This lets the command loop continue
+to receive commands while decoding and output buffering are active.
+
+@(image placed-player-worker-detail-model-svg)
+
+The most important internal flags are:
+
+@itemlist[#:style 'compact
+ @item{@racket[feeding-audio] records that a worker is still active.  The
+       command loop uses it when replacing the current file.}
+ @item{@racket[feed-interrupted] tells the worker that its current read was
+       intentionally aborted by @racket['open], @racket['stop], or cleanup.}
+ @item{@racket[current-file-id] identifies the latest file.  A worker that is
+       draining old audio may clean itself up, but only the current worker may
+       move the global state to @racket['stopped].}
+ @item{@racket[play-thread] is the Racket thread that runs the decoder read.}
+ @item{@racket[ao-h] is the asynchronous output handle.  Access is protected by
+       @racket[ao-mutex] and by the local @racket[with-ao-h] form.}]
+
+When @racket[audio-read] returns normally, the worker emits an
+@racket['audio-done] event and then waits for the asynchronous output queue to
+finish playing.  This is necessary because the decoder may be done while libao
+still has queued PCM samples.  If the queue becomes empty and the worker still
+belongs to the current file id, the worker changes @racket[player-state] to
+@racket['stopped] and emits a state update.
+
+If a new file is opened while a worker is still feeding audio, the command loop
+sets @racket[feed-interrupted], clears the output queue, stops the decoder, and
+waits for the worker to finish before starting the next decoder.  This prevents
+old decoder data and new decoder data from being mixed in the output queue.
+
+@section{Audio output and buffering}
+
+The @racket[audio-play] callback is called by the decoder for each decoded audio
+buffer.  It updates the current decoder buffer information, opens or reopens the
+libao output handle when the sample format changes, applies pending volume
+changes, queues the buffer, and publishes state updates when the playback second
+changes.
+
+The player keeps a minimum and maximum buffer target.  When the asynchronous
+output queue grows above the configured maximum, the callback waits until the
+queue drops below the configured minimum.  During that wait it still observes
+pause changes and continues to publish coarse-grained position updates.
+
+A format change requires special care.  If the sample width, rate, or channel
+count changes, the existing output queue must drain before the output handle is
+closed and reopened with the new format.  The code waits for the buffer to
+become empty before closing the old handle.
+
+@section{Pause, seek, and volume}
+
+Pause is represented only as logical player state.  The command loop changes
+@racket[player-state], and the worker checks that state while feeding or
+waiting.  When the state is @racket['paused], the worker calls
+@racket[ao-pause] with @racket[#t] and waits until the state changes.  When the
+state changes away from @racket['paused], it calls @racket[ao-pause] with
+@racket[#f].
+
+Seek does not change @racket[player-state].  It clears the output queue and
+asks the decoder to seek to the given percentage.  If the player was playing, it
+continues as playing.  If it was paused, it remains paused.
+
+Volume changes are staged in @racket[req-volume].  The audio callback compares
+@racket[req-volume] with @racket[current-volume] and applies the change to the
+output handle when audio is being processed.
+
+@section{State snapshots and events}
+
+The placed player has two outgoing channels after initialization:
+@racket[ch-out] for synchronous RPC replies, and @racket[ch-evt] for
+asynchronous events.  The high-level wrapper in @racketmodname["audio-player.rkt"]
+uses a separate event thread to consume @racket[ch-evt], cache the latest state
+hash in the audio-player handle, and call the user-supplied callbacks.
+
+State snapshots are built by the internal @racket[state] procedure.  The hash
+contains operational information such as:
+
+@itemlist[#:style 'compact
+ @item{@racket['state], @racket['msg], @racket['file], and
+       @racket['valid-ao-handle];}
+ @item{@racket['duration], @racket['at-second], and @racket['at-music-id];}
+ @item{@racket['volume], @racket['buf-size], @racket['sample-queue-len], and
+       @racket['reuse-buf-len];}
+ @item{@racket['bits], @racket['rate], @racket['channels],
+       @racket['decoder], @racket['decoder-meta], and
+       @racket['decoder-buf-info].}]
+
+Most state events are suppressed until there is a valid music id.  Forced state
+snapshots bypass that suppression.  Forced snapshots are used for the explicit
+@racket['state] command and for cleanup paths such as @racket['stop] and
+@racket['quit].
+
+The asynchronous event stream currently uses these event shapes:
+
+@itemlist[#:style 'compact
+ @item{@racket[(list 'state hash)] for state updates;}
+ @item{@racket['(audio-done)] when the decoder has finished reading the current
+       stream;}
+ @item{@racket[(list 'exception message)] when the worker or command loop
+       reports an exception.}]
+
+@section{Stop, cleanup, and quit}
+
+@racket[stop-and-cleanup] is shared by @racket['stop] and @racket['quit].  It
+marks the feed as interrupted, clears the output queue, moves the logical state
+to @racket['stopped], stops the decoder when present, waits for the play thread,
+closes the output handle, resets the internal bookkeeping fields, and emits a
+forced state event.
+
+The difference between @racket['stop] and @racket['quit] is what happens after
+cleanup.  @racket['stop] replies with @racket['(ok)] and continues the command
+loop.  @racket['quit] emits an additional forced state event with the message
+@racket["quit"], replies with @racket['(quit)], and returns from the loop.  The
+place or thread then terminates.
+
+@section{Running in a place or in a thread}
+
+The normal path in @racket[make-audio-player] uses @racket[dynamic-place] when
+places are enabled.  The command, reply, and event channels are wrapped with
+@racket[make-uni-channel] on each side.  This gives the audio side its own Racket VM and isolates
+it from the main controller, while the command and event protocol stays the
+same.
+
+For debugging, @racket[make-audio-player] can be called with
+@racket[#:use-place #f].  In that mode, the placed player is started in a
+normal Racket thread and communicates through async channels:
+
+@racketblock[
+(define player
+  (make-audio-player
+   (lambda (handle state-hash)
+     (void))
+   (lambda (handle)
+     (void))
+   #:use-place #f))
+
+(audio-play! player "track.flac")
+(audio-pause! player #t)
+(audio-pause! player #f)
+(audio-stop! player)
+(audio-quit! player)]
+
+The thread mode uses the same command protocol and the same worker code.  It is
+therefore useful for reproducing and debugging player behaviour before moving
+back to the place-based configuration.
+
+The place-based mode is the preferred mode for playback.  A place runs in a
+separate Racket virtual machine, with its own scheduler state, and communicates
+with the main program only through explicit messages.  This matters for audio:
+the audio backend must be fed regularly, and small scheduling delays can already
+show up as clicks, gaps, or stuttering playback.  When the player runs in the
+same VM as DrRacket, a GUI application, logging, debugging, or other active
+threads, those activities can delay the audio feeder at the wrong moment.  By
+running the player in a place, the playback pipeline gets a quieter execution
+environment.  Running the same command loop in an ordinary thread is useful for
+debugging, because normal asynchronous channels are easier to inspect, but it is
+not the preferred mode for robust playback.

scrbl/audio-player.scrbl

@@ -0,0 +1,388 @@
+#lang scribble/manual
+
+@(require (for-label racket/base
+                     racket/contract
+                     racket/path
+                     racket/place
+                     "../audio-player.rkt"))
+
+@title{Audio Player}
+@author[@author+email["Hans Dijkema" "hans@dijkewijk.nl"]]
+
+
+@defmodule[racket-audio/audio-player]
+
+The @racketmodname[racket-audio/audio-player] module is the high level interface for
+audio playback.  It hides the command protocol of
+@racketmodname[racket-audio/audio-placed-player], creates the playback place or
+thread, receives asynchronous events, and exposes a small handle-based API for
+starting, pausing, seeking, stopping, and observing playback.
+
+The player is asynchronous.  Playback commands are sent to a worker side and
+normally return after the command has been accepted, not after all audio has
+finished playing.  State changes and end-of-stream notifications are delivered
+through callbacks supplied when the player is created.
+
+@section{Creating a player}
+
+@defproc[(make-audio-player
+          [cb-state procedure?]
+          [cb-eof-stream procedure?]
+          [#:use-place use-place boolean?]
+          [#:remote-host remote-host (or/c #f string?) #f]
+          [#:replace-base-paths replace-base-paths any/c '()])
+         audio-play?]{
+Creates an audio player and returns a player handle.  The handle is passed to
+all other procedures in this module.
+
+The @racket[cb-state] callback is called as:
+
+@racketblock[
+(cb-state player current-player-state state-hash)]
+
+where @racket[player] is the player handle,
+@racket[current-player-state] is the logical player state reported by the
+worker, and @racket[state-hash] is the most recent state snapshot received from
+the worker side.  The callback is called from the event thread created by
+@racket[make-audio-player].
+
+The worker-side player state is one of the following symbols:
+
+@itemlist[
+ #:style 'compact
+
+ @item{@racket['stopped] -- no stream is currently playing.  This is the
+ initial state of the placed player.  The player also enters this state after
+ @racket[audio-stop!] or after the decoder has reached the end of the stream
+ and the libao output queue has drained.}
+
+ @item{@racket['playing] -- a stream is active.  The decoder may still be
+ reading from the input file, or the decoder may already have finished while
+ libao is still playing queued PCM samples.}
+
+ @item{@racket['paused] -- playback is paused.  The current stream is retained
+ and the libao output side is paused.  Resuming playback moves the player back
+ to @racket['playing].}
+
+ @item{@racket['quit] -- the placed player has been asked to terminate.  This
+ is the terminal state of the worker.}
+]
+
+The wrapper around the placed player may also report these states through
+@racket[audio-state]:
+
+@itemlist[
+ #:style 'compact
+
+ @item{@racket['initialized] -- the audio handle has been created, but no
+ worker-side state snapshot has been received yet.}
+
+ @item{@racket['invalid] -- the audio handle is no longer valid.  This happens
+ after @racket[audio-quit!] or when the underlying place or thread has stopped.}
+]
+
+The @racket[state-hash] contains the detailed playback state reported by the
+worker.  It includes values such as the current playback position, stream
+duration, buffer status, music id, and libao handle validity.  Code that only
+needs the logical playback state should use @racket[current-player-state]
+instead of extracting it from the hash.
+
+The @racket[cb-eof-stream] callback is called as:
+
+@racketblock[
+(cb-eof-stream player)]
+
+when the decoder reports that the current stream has been read.  This means
+that the decoder has finished queueing the stream.  The audio device may still
+have buffered samples to play, and the logical player state may move to
+@racket['stopped] slightly later when the output queue has drained.
+
+End-of-stream is not represented as a separate player state.
+
+When @racket[use-place] is true, @racket[make-audio-player] starts
+@racket[placed-player] with @racket[dynamic-place] and communicates with it
+through place channels.  When @racket[use-place] is false, the same command loop
+is started in an ordinary Racket thread and communicates through async channels.
+The default value is @racket[(place-enabled?)].
+
+The place-based mode is the normal playback mode.  A place gives the audio side
+a separate Racket VM, so decoding and buffer feeding are less exposed to
+scheduling delays caused by DrRacket, GUI event handling, debugging, logging, or
+other active threads in the main VM.  Those delays can otherwise be heard as
+clicks, gaps, or stuttering playback.  Thread mode is useful for debugging the
+protocol and callbacks, but it is not the preferred mode for robust playback.
+
+When @racket[remote-host] is a string, @racket[make-audio-player] starts the
+worker over SSH instead of starting a local place or thread.  All SSH and remote
+Racket details are handled by the remote utility layer and its
+@tt{racket-audio.ini} configuration.  The public player API only needs the host
+name.
+
+The remote player must be able to open the requested audio files.  When the
+local and remote file trees differ, use @racket[replace-base-paths].  It is a
+list of cons pairs.  The @racket[car] is the local base path, and the
+@racket[cdr] is the remote base path.  The first matching local prefix is
+replaced before the @racket['open] command is sent.  For example:
+
+@racketblock[
+(make-audio-player cb-state cb-eof
+                   #:remote-host "nas"
+                   #:replace-base-paths
+                   (list (cons "/muziek" "/volume1/music")))]
+
+With that mapping, @filepath{/muziek/klassiek/x.flac} is sent to the remote
+worker as @filepath{/volume1/music/klassiek/x.flac}.}
+
+
+@defproc[(replace-base-path [path path-string?]
+                            [replace-base-paths any/c])
+         string?]{
+Applies the same base-path replacement used by remote playback.  This is a small
+helper for testing the mapping before starting playback.}
+
+
+
+@defproc[(audio-play? [v any/c]) boolean?]{
+Returns @racket[#t] when @racket[v] is a currently valid audio player handle.
+
+The predicate is intentionally stricter than merely recognizing the underlying
+structure.  After @racket[audio-quit!] or after the worker has died, the handle
+is invalidated and @racket[audio-play?] returns @racket[#f].}
+
+@section{Basic playback}
+
+@defproc[(audio-play! [player audio-play?]
+                      [audio-file path-string?])
+         number?]{
+Starts playback of @racket[audio-file].  The file is opened by the worker side,
+a decoder is selected, and audio feeding begins asynchronously.  In normal use
+the return value is @racket[music-id], where @tt{music-id} is the
+given @tt{id}, a @tt{number? >= 1} to the file to play, which will be used when reporting in
+callbacks about e.g. state.
+
+Calling @racket[audio-play!] while another file is still active replaces the
+current stream.  The worker side interrupts the old decoder, clears the output
+queue, waits for the old worker thread, and then starts the new stream.}
+
+@defproc[(audio-pause! [player audio-play?]
+                       [paused? boolean?])
+         symbol?]{
+Pauses or resumes playback.  Passing @racket[#t] moves the logical player state
+to @racket['paused].  Passing @racket[#f] moves it back to @racket['playing].
+In normal use the return value is @racket['ok].
+
+Pause is implemented as player state observed by the worker.  The worker
+translates the state to calls to the asynchronous audio backend.}
+
+@defproc[(audio-paused? [player audio-play?]) boolean?]{
+Returns whether the worker currently reports the logical player state as
+@racket['paused].  This is an RPC-style query to the worker side.}
+
+@defproc[(audio-stop! [player audio-play?]) symbol?]{
+Stops the current stream, clears the audio output queue, closes the active
+decoder and output handle when present, and returns the logical state to
+@racket['stopped].  In normal use the return value is @racket['ok].
+
+The player remains valid after @racket[audio-stop!], so another
+@racket[audio-play!] call can be used to start a new file.}
+
+@defproc[(audio-quit! [player audio-play?])
+         (or/c number? boolean? symbol?)]{
+Stops playback, performs the same cleanup as @racket[audio-stop!], sends a
+@racket['quit] command to the worker side, and invalidates the handle.  In
+normal use the return value is @racket['quit].
+
+After this procedure returns, the command loop in the place or thread is
+expected to terminate.  Most other operations require @racket[audio-play?] and
+therefore should not be used on the handle after quitting.  The implementation
+also registers a finalizer that sends @racket['quit] when a still-valid handle
+is collected, but explicit shutdown with @racket[audio-quit!] is preferred.}
+
+@section{Position, volume, and buffering}
+
+@defproc[(audio-seek! [player audio-play?]
+                      [percentage (and/c number? (>=/c 0) (<=/c 100))])
+         symbol?]{
+Seeks the current stream to @racket[percentage], where @racket[0] is the start
+and @racket[100] is the end.  The output queue is cleared before the decoder is
+asked to seek.  In normal use the return value is @racket['ok].
+
+Seeking does not change the logical playback state.  A playing stream remains
+playing, and a paused stream remains paused.}
+
+@defproc[(audio-volume! [player audio-play?]
+                        [percentage (and/c number? (>=/c 0))])
+         symbol?]{
+Requests a new playback volume.  The value is stored by the worker and applied
+to the audio output side when audio is processed.  In normal use the return
+value is @racket['ok].}
+
+@defproc[(audio-volume [player audio-play?]) number?]{
+Returns the current volume value known by the worker.}
+
+@defproc[(audio-buf-seconds! [player audio-play?]
+                             [min number?]
+                             [max number?])
+         (or/c symbol? boolean?)]{
+Configures the output buffering range, in seconds.  The worker tries to keep
+the queued audio between the requested lower and upper bounds while decoding.
+
+The wrapper normalizes the values before sending the command.  A @racket[min]
+below @racket[1] is raised to @racket[1], and a @racket[min] above @racket[10]
+is lowered to @racket[10].  A @racket[max] below @racket[min] is changed to
+@racket[(+ min 1)], and a @racket[max] above @racket[30] is lowered to
+@racket[30].  The worker side applies its own safe ordering and clamping before
+using the values.  In normal use the return value is @racket['ok].}
+
+@deftogether[
+(@defproc[(audio-ao-buf-ms! [handle audio-play?]
+                            [ms integer?])
+          (or/c integer? boolean?)]
+ @defproc[(audio-ao-buf-ms [handle audio-play?])
+          (or/c integer? boolean?)])
+]{
+
+Sets or queries the libao output buffer size, expressed in milliseconds.
+
+The @racket[audio-ao-buf-ms!] procedure forwards @racket[ms] to the audio
+player backend by sending the @racket['ao-buf-ms] RPC command.  This hooks
+into the libao-side buffer configuration and can be used to tune the amount of
+audio data that the output layer keeps ahead of playback.
+
+The @racket[audio-ao-buf-ms] procedure queries the currently configured value
+by sending the same RPC command without a new value.
+
+The returned value is the value reported by the backend.  Normally this is an
+integer number of milliseconds.  A boolean result indicates that the value could
+not be set or queried, or that the backend reported a non-numeric status.
+
+Larger buffer values can make playback more robust against short scheduling
+delays, but also increase latency.  Smaller values reduce latency, but may make
+drop-outs more likely when the decoder or GUI thread is temporarily delayed.
+
+The value is clamped between 50 and 1000ms. 
+
+@racketblock[
+(audio-ao-buf-ms! player 500)
+(audio-ao-buf-ms player)
+]
+}
+
+@section{State snapshots}
+
+The player keeps a local cache of the most recent state snapshot received from
+the worker.  The cache is updated by an event thread created by
+@racket[make-audio-player].  The state accessor procedures below read this
+local cache; they do not synchronously ask the worker for a fresh state.
+
+Before the first state event has arrived, most accessors return @racket[#f].
+The logical state accessor returns @racket['initialized] for a valid handle
+whose state hash does not yet contain a @racket['state] entry.  If the worker
+dies or the handle is explicitly invalidated, @racket[audio-state] returns
+@racket['invalid].
+
+@defproc[(audio-full-state [player audio-play?]) hash?]{
+Returns the complete cached state hash.  The hash is the payload of the most
+recent @racket['state] event.  It may contain keys such as @racket['state],
+@racket['file], @racket['duration], @racket['at-second],
+@racket['at-music-id], @racket['volume], @racket['bits], @racket['rate],
+@racket['channels], @racket['decoder], @racket['decoder-meta], and
+@racket['decoder-buf-info].}
+
+@defproc[(audio-state [player audio-play?]) symbol?]{
+Returns the cached logical player state.  Typical values are
+@racket['initialized], @racket['stopped], @racket['playing],
+@racket['paused], and @racket['invalid].}
+
+@defproc[(audio-at-second [player audio-play?]) (or/c number? boolean?)]{
+Returns the cached playback position in seconds, or @racket[#f] when no
+position is known yet.}
+
+@defproc[(audio-duration [player audio-play?]) (or/c number? boolean?)]{
+Returns the cached stream duration in seconds, or @racket[#f] when the duration
+is not known.}
+
+@defproc[(audio-file [player audio-play?]) (or/c path-string? boolean?)]{
+Returns the cached path of the file currently associated with the active music
+id, or @racket[#f] when no such file is known.}
+
+@defproc[(audio-music-id [player audio-play?]) (or/c number? boolean?)]{
+Returns the cached music id used by the asynchronous output side, or
+@racket[#f] when no output handle is active.}
+
+@defproc[(audio-bits [player audio-play?]) (or/c number? boolean?)]{
+Returns the cached sample width in bits, or @racket[#f] when the format is not
+known.}
+
+@defproc[(audio-rate [player audio-play?]) (or/c number? boolean?)]{
+Returns the cached sample rate, or @racket[#f] when the format is not known.}
+
+@defproc[(audio-channels [player audio-play?]) (or/c number? boolean?)]{
+Returns the cached channel count, or @racket[#f] when the format is not known.}
+
+@defproc[(audio-decoder [player audio-play?]) (or/c symbol? boolean?)]{
+Returns the cached decoder kind, or @racket[#f] when no decoder kind is known.}
+
+@section{Events and callbacks}
+
+The wrapper receives asynchronous events from the worker side.  A state event
+updates the cached state hash and calls @racket[cb-state].  An
+@racket['audio-done] event calls @racket[cb-eof-stream].  Unknown events are
+reported through the module's warning mechanism.
+
+Callbacks run in the event thread owned by the player handle.  They should
+therefore be quick, should not block for long periods, and should avoid
+performing complicated UI work directly.  A GUI program can use the callbacks
+to enqueue work onto the GUI eventspace instead.
+
+The RPC command path is protected by a mutex in the wrapper.  This allows
+different application threads to call playback procedures on the same handle
+without interleaving the command and reply parts of a single RPC.
+
+@section[#:tag "audio-player-example"]{Example}
+
+The following example creates a player, prints state changes, plays a file, and
+then shuts the player down explicitly.
+
+For a larger integration example, see @filepath{play-test.rkt}.  The queue
+variant in that file, selected with @code{(set-test 'queue)}, is  documented separately in @filepath{play-test.scrbl}.
+
+
+@codeblock{
+#lang racket/base
+
+(require "audio-player.rkt")
+
+(define player
+  (make-audio-player
+   (lambda (p st)
+     (printf "state: ~a at ~a seconds\n"
+             (hash-ref st 'state #f)
+             (hash-ref st 'at-second #f)))
+   (lambda (p)
+     (printf "decoder reached end of stream\n"))))
+
+(audio-play! player "track.flac")
+
+;; Later, for example in response to user input:
+(audio-pause! player #t)
+(audio-pause! player #f)
+(audio-seek! player 50)
+(audio-volume! player 80)
+(audio-stop! player)
+
+;; When the player is no longer needed:
+(audio-quit! player)}
+
+For debugging the worker in the same Racket VM, create the player with
+@racket[#:use-place #f]:
+
+@racketblock[
+(define debug-player
+  (make-audio-player
+   (lambda (p st) (void))
+   (lambda (p) (void))
+   #:use-place #f))]
+
+This uses the same command loop and event handling, but starts the worker side
+in a normal Racket thread instead of a place.

scrbl/audio-sniffer.scrbl

@@ -15,7 +15,7 @@ file contents (signature sniffing) and, optionally, file extensions.
 The sniffer prefers binary inspection over extensions and only falls back
 to extensions when detection is inconclusive.
 
-@section{Overview}
+@section[#:tag "audio-sniffer-overview"]{Overview}
 
 The detection strategy is as follows:
 

scrbl/encoder-test.scrbl

@@ -0,0 +1,91 @@
+#lang scribble/manual
+
+@(require (for-label racket/base
+                     racket/path
+                     "../encoder-test.rkt"))
+
+@title{Encoder Test Program}
+@author[@author+email["Hans Dijkema" "hans@dijkewijk.nl"]]
+
+@defmodule[racket-audio/encoder-test]
+
+The @racketmodname[racket-audio/encoder-test] module is a small integration test
+and command-line wrapper around @racketmodname[racket-audio/audio-encoder].  It
+is useful for checking that the native encoder libraries are available and that
+a concrete source file can be transcoded to Opus or FLAC.
+
+The module depends on @filepath{tests.rkt} for its default input file.  For
+portable tests, pass an explicit input file.
+
+@section{Program use}
+
+Run the test module directly to encode the default test file to a temporary
+Opus file:
+
+@verbatim{
+racket encoder-test.rkt
+}
+
+Useful command-line examples:
+
+@verbatim{
+racket encoder-test.rkt --encoder opus --input input.flac --output output.opus --bitrate-kbps 224
+
+racket encoder-test.rkt --encoder flac --input input-96k.flac --output output-48k.flac --sample-rate 48000 --bits-per-sample 24 --compression-level 8
+}
+
+The program prints the selected encoder, settings, percentage progress, and a
+summary of the result hash returned by @racket[audio-encode].  Progress is based
+on input frames read from the decoder.
+
+@section{Program options}
+
+The command-line wrapper accepts these options:
+
+@itemlist[#:style 'compact
+ @item{@tt{-e}, @tt{--encoder}: @tt{opus} or @tt{flac}.}
+ @item{@tt{-i}, @tt{--input}: input audio file.}
+ @item{@tt{-o}, @tt{--output}: output audio file.}
+ @item{@tt{--sample-rate}: target sample rate or @tt{source}.}
+ @item{@tt{--bits-per-sample}: target FLAC bit depth or @tt{source}.}
+ @item{@tt{--bitrate-kbps}: Opus bitrate in kbit/s.}
+ @item{@tt{--compression-level}: FLAC compression level.}
+ @item{@tt{--no-tags}: disable copying tags and embedded pictures.}]
+
+@section{Racket functions}
+
+@defproc[(encoder-test [input-file path-string?]
+                       [output-file (or/c path-string? #f)]
+                       [encoder (or/c symbol? string?)]
+                       [settings hash?]
+                       [#:copy-tags? copy-tags? boolean? #t])
+         hash?]{
+Runs one encode test and prints a human-readable summary.  The return value is
+the result hash produced by @racket[audio-encode].  When @racket[output-file] is
+@racket[#f], a temporary output path is chosen from the encoder kind.}
+
+@defproc[(encoder-test-opus [input-file path-string?]
+                            [output-file (or/c path-string? #f) #f]
+                            [#:bitrate-kbps bitrate-kbps exact-positive-integer? 160]
+                            [#:sample-rate sample-rate (or/c exact-positive-integer? 'source) 'source]
+                            [#:copy-tags? copy-tags? boolean? #t])
+         hash?]{
+Encodes @racket[input-file] to an Opus file using @racket[encoder-test].  The
+bitrate argument is expressed in kbit/s and is converted to the @racket['bitrate]
+setting used by the Opus backend.
+
+The @racket[sample-rate] argument is normally @racket['source].  Opus encoding
+passes the input rate to @tt{libopusenc}; @tt{libopusenc} performs the internal
+resampling required for Opus output.}
+
+@defproc[(encoder-test-flac [input-file path-string?]
+                            [output-file (or/c path-string? #f) #f]
+                            [#:compression-level compression-level exact-nonnegative-integer? 8]
+                            [#:sample-rate sample-rate (or/c exact-positive-integer? 'source) 'source]
+                            [#:bits-per-sample bits-per-sample (or/c exact-positive-integer? 'source) 'source]
+                            [#:copy-tags? copy-tags? boolean? #t])
+         hash?]{
+Encodes @racket[input-file] to a FLAC file using @racket[encoder-test].  When
+@racket[sample-rate] or @racket[bits-per-sample] is not @racket['source], the
+FLAC pipeline requests the corresponding output format from
+@racketmodname[racket-audio/audio-encoder].}

scrbl/ffmpeg-decoder.scrbl

@@ -12,7 +12,7 @@
 @defmodule[racket-audio/ffmpeg-decoder]
 
 This module provides an audio decoder based on the FFmpeg audio shim. It
-uses the lower-level @racketmodname[racket-sound/ffmpeg-ffi] module and presents a
+uses the lower-level @racketmodname[racket-audio/ffmpeg-ffi] module and presents a
 callback-based decoder interface comparable to the other audio decoders.
 
 The native FFmpeg layer decodes audio to signed 32-bit interleaved PCM.
@@ -121,7 +121,7 @@ Seeking is asynchronous with respect to @racket[ffmpeg-seek]: the
 function only records the requested target sample. The read loop applies
 the pending seek request before decoding the next block.
 
-@section{Notes}
+@section[#:tag "ffmpeg-decoder-notes"]{Notes}
 
 The FFmpeg shim output is expected to be signed 32-bit interleaved PCM.
 This keeps the decoder interface suitable for a playback pipeline that

scrbl/ffmpeg-definitions.scrbl

@@ -0,0 +1,441 @@
+#lang scribble/manual
+
+@(require (for-label racket/base
+                     ;racket/contract
+                     racket/path
+                     ffi/unsafe
+                     let-assert
+                     early-return
+                     "../ffmpeg-definitions.rkt"
+                     "../private/cstruct-helper.rkt"))
+
+@title[#:tag "ffmpeg-definitions"]{FFmpeg Decoder Definitions}
+@author[@author+email["Hans Dijkema" "hans@dijkewijk.nl"]]
+
+@defmodule[racket-audio/ffmpeg-definitions]
+
+This module provides the direct FFmpeg-backed decoder layer used by the audio
+pipeline.  It is deliberately small and stateful.  A caller creates one decoder
+instance, opens one file on it, queries the selected audio stream, repeatedly
+asks for the next PCM block, and closes the instance again.
+
+The module does not expose FFmpeg metadata.  It only exposes the information
+needed for playback: stream count, sample rate, channel count, duration,
+bitrate, decoded PCM data, and sample positions.  The output format is fixed:
+interleaved signed 32-bit PCM, four bytes per sample, using FFmpeg's
+@tt{AV_SAMPLE_FMT_S32} sample format.
+
+The FFmpeg libraries are loaded when the module is required.  The module checks
+that the runtime FFmpeg major versions are in the supported range configured by
+the implementation.  This binding targets the FFmpeg library major versions
+used by FFmpeg 6, 7, and 8: @tt{libavutil} 58 to 60, @tt{libavcodec} 60 to 62,
+@tt{libavformat} 60 to 62, and @tt{libswresample} 4 to 6.  Unsupported runtime
+versions fail early, before a decoder instance is used.
+
+On Windows, the private library loader may download the bundled sound-library
+set into Racket's add-on directory before the FFI libraries are opened.  On
+Unix-like systems, the FFmpeg libraries are expected to be installed by the
+operating system or platform package manager and to be reachable by Racket's
+FFI library search path.
+
+@section{Layering}
+
+This module is the low-level Racket FFI layer.  It is normally wrapped by
+@filepath{ffmpeg-ffi.rkt} and then by @filepath{ffmpeg-decoder.rkt}.  The first
+wrapper adapts this module to the command protocol used by the audio decoder
+frontend.  The second wrapper exposes the callback-oriented decoder interface
+used by the rest of the playback pipeline.
+
+The distinction matters for buffer lifetime.  At this level,
+@racket[fmpg-buffer] returns the current buffer owned by the decoder instance.
+The adapter in @filepath{ffmpeg-ffi.rkt} copies that buffer before passing it to
+@filepath{ffmpeg-decoder.rkt}.  Code that uses this module directly must copy
+the buffer itself when the bytes must survive the next decoder operation.
+
+@section{FFmpeg version information}
+
+@defproc[(ffmpeg-version [lib (or/c 'avutil 'avcodec 'avformat
+                                    'swr 'swresample)])
+         (list/c exact-nonnegative-integer?
+                 exact-nonnegative-integer?
+                 exact-nonnegative-integer?)]{
+Returns the runtime version of one FFmpeg library as a three-element list
+containing the major, minor, and micro version numbers.  The symbols
+@racket['swr] and @racket['swresample] both refer to @tt{libswresample}.
+
+The version is read from FFmpeg's packed integer value.  For example, a runtime
+value corresponding to @tt{62.28.100} is returned as @racket['(62 28 100)].
+The function raises an exception for an unknown library symbol.
+}
+
+The runtime versions determine which partial FFmpeg struct layouts are safe to
+use.  If a future FFmpeg major release changes a layout before one of the
+fields read by this module, the supported range should be extended only after
+the affected partial definitions have been checked.
+
+@section[#:tag "ffmpeg-definitions-implementation-strategy"]{Implementation strategy}
+
+This module talks directly to the FFmpeg shared libraries through Racket's FFI.
+There is no C shim that hides FFmpeg's structs or normalizes their layout.  The
+price of that choice is that the Racket side must know enough of the relevant C
+struct layouts to read the fields used by the decoder.  The benefit is that the
+binding remains a Racket module with direct access to the platform FFmpeg
+libraries.
+
+@subsection{C structs and offsets}
+
+Small and stable structures, such as @tt{AVRational} and
+@tt{AVChannelLayout}, are described with @racket[define-cstruct].  A
+@racket[define-cstruct] form describes the C fields to Racket's FFI.  Racket
+then calculates the correct field offsets for the current platform ABI and
+creates the corresponding pointer type, constructor, accessors and mutators.
+
+The larger FFmpeg structures are handled by @tt{def-cstruct} from
+@filepath{private/cstruct-helper.rkt}.  Structures such as
+@tt{AVCodecParameters}, @tt{AVStream}, @tt{AVFormatContext}, @tt{AVFrame} and
+@tt{AVPacket} are large and may differ between FFmpeg major versions.  The
+decoder only needs a few fields from each one, but those fields must still be
+read from their exact native offsets.
+
+The helper solves this by describing the complete field sequence up to the last
+field the backend needs.  Unnamed entries are used only to advance the offset.
+Named entries become generated accessors.  Repeated entries such as
+@racket[(6 _int)] keep the definition compact while still allowing Racket's FFI
+to compute alignment, padding and pointer size correctly.  Tail fields after
+the last required member are not described.
+
+The right layout is selected when the module is required, after the runtime
+FFmpeg major versions have been read from the libraries.  For the supported
+range, @tt{_AVCodecParameters} uses one layout for @tt{libavcodec} major
+version 60 and another for major versions 61 and 62.  Likewise,
+@tt{_AVFrame} uses one layout for @tt{libavutil} major version 58 and
+another for major versions 59 and 60.  The other partial structs used by this
+module are defined with a single layout across the supported versions.
+
+@subsection{Defensive control flow}
+
+Most FFmpeg calls report ordinary failure through C-style return values or null
+pointers.  The implementation treats those results as normal control flow.  The
+@racket[let/assert] form is used for setup paths where each native result must
+be checked before the next native call is made.  It behaves like a sequential
+binding form: each binding can be checked immediately, and a failed check
+returns the specified failure value for the whole form.
+
+That style is used for opening a file, selecting stream information, allocating
+the codec context, and initializing the resampler.  Predicates such as
+@tt{a-!nullptr?}, @tt{a-nullptr?}, @tt{a-true?}, and @tt{a->=?} express the
+usual FFmpeg checks directly next to the binding that produced the value.
+
+The decode and seek paths also use @racket[early-return] where processing must
+stop immediately from a nested position.  This keeps the normal FFmpeg outcomes
+away from exception-based control flow while still making cleanup actions local
+to the point where a failure can occur.
+
+@section{Decoder instances}
+
+A decoder instance is an opaque value returned by @racket[fmpg-init].  Its
+structure type and predicate are not exported.  Pass the value back to the
+functions in this module and do not inspect it directly.  The contracts below
+therefore use @racket[any/c] for the instance argument.  Operationally, that
+argument must be a value returned by @racket[fmpg-init].
+
+The instance owns native FFmpeg resources: a format context, a codec context,
+an audio frame, a resampler, and the Racket byte string used for the current
+PCM block.  Finalizers are installed as a last line of defence, but callers
+should still call @racket[fmpg-close!] explicitly when playback stops or when
+the file is no longer needed.  Explicit close keeps the lifetime of native
+resources predictable.
+
+@defproc[(fmpg-init) any/c]{
+Creates a new decoder instance.  The result is an opaque instance value, or
+@racket[#f] if the instance could not be created.
+
+Creating the instance does not open a file.  Use @racket[fmpg-open-file!]
+before querying stream information or decoding audio.
+}
+
+@defproc[(fmpg-open-file! [instance any/c]
+                         [filename (or/c path? string?)])
+         (integer-in 0 1)]{
+Opens @racket[filename] on @racket[instance], reads the stream information,
+selects the best audio stream, initializes the codec context, and initializes
+the resampler.
+
+The function returns @racket[1] on success and @racket[0] on failure.  On
+failure, partially initialized native state is closed again.  A non-string,
+non-path filename is treated as an open failure and returns @racket[0].
+
+An instance can only have one file open.  Close it with @racket[fmpg-close!]
+before opening another file on the same instance.
+}
+
+@defproc[(fmpg-close! [instance any/c]) void?]{
+Closes @racket[instance] if it is open and releases the native FFmpeg resources
+owned by the instance.  The codec context, frame and resampler are freed before
+the format context is closed.  This order avoids keeping decoder pointers that
+refer to streams from an already closed container.
+
+The stored audio information is reset.  Calling this function with @racket[#f]
+or with an already closed instance is harmless.
+}
+
+@defproc[(fmpg-is-open [instance any/c]) (integer-in 0 1)]{
+Returns @racket[1] when @racket[instance] is ready for decoding and @racket[0]
+otherwise.  An instance is ready only after a file has been opened, a usable
+audio stream has been selected, and the decoder and resampler have been
+initialized.
+}
+
+@section{Audio stream information}
+
+The decoder selects one audio stream for playback using FFmpeg's best-stream
+selection.  The stream count reports how many audio streams were found in the
+container, but decoding is performed only for the selected stream.
+
+The term @italic{sample} in this module means a sample frame: one time step in
+the audio stream, across all channels.  For stereo 32-bit output, one sample
+frame therefore occupies @racket[(* 2 4)] bytes in the returned PCM buffer.
+
+@defproc[(fmpg-audio-stream-count [instance any/c])
+         exact-nonnegative-integer?]{
+Returns the number of audio streams in the open container.  If the instance is
+not open, the result is @racket[0].  This count is informational; actual stream
+selection is performed during @racket[fmpg-open-file!].
+}
+
+@deftogether[
+(@defproc[(fmpg-audio-sample-rate [instance any/c])
+          exact-nonnegative-integer?]
+ @defproc[(fmpg-audio-channels [instance any/c])
+          exact-nonnegative-integer?])]{
+Return the sample rate and channel count of the selected audio stream.  If the
+instance is not ready, both functions return @racket[0].
+}
+
+@deftogether[
+(@defproc[(fmpg-audio-bits-per-sample [instance any/c])
+          exact-positive-integer?]
+ @defproc[(fmpg-audio-bytes-per-sample [instance any/c])
+          exact-positive-integer?])]{
+Return the fixed output sample width in bits and bytes.  The current output
+format is 32-bit signed PCM, so @racket[fmpg-audio-bits-per-sample] returns
+@racket[32] and @racket[fmpg-audio-bytes-per-sample] returns @racket[4].  The
+values are independent of the input file's original sample format and do not
+depend on the instance state.
+}
+
+@deftogether[
+(@defproc[(fmpg-duration-ms [instance any/c]) exact-integer?]
+ @defproc[(fmpg-duration-samples [instance any/c]) exact-integer?])]{
+Return the duration of the selected audio stream in milliseconds and in sample
+frames.  If the stream duration is not available, the container duration is
+used as a fallback.  If no duration can be determined, or when the instance is
+not ready, the result is @racket[-1].
+}
+
+@defproc[(fmpg-file-bitrate [instance any/c]) exact-integer?]{
+Returns the container bitrate in bits per second.  If the bitrate is unavailable
+or if the instance is not open, the result is @racket[-1].  Only positive
+FFmpeg bitrates are passed through as reliable.
+}
+
+@section{Output format}
+
+The decoder output format is intentionally fixed:
+
+@itemlist[
+ #:style 'compact
+ @item{sample format: signed 32-bit PCM, @tt{AV_SAMPLE_FMT_S32}}
+ @item{layout: interleaved}
+ @item{sample rate: the selected stream's sample rate}
+ @item{channels: the selected stream's channel count}
+]
+
+This keeps the playback layer simple.  The FFmpeg input format may be planar,
+floating point, compressed, or otherwise different; @tt{libswresample} converts
+the decoded frames to the fixed output format before the bytes are exposed to
+Racket.
+
+@section{Decoding}
+
+Decoding is block oriented.  Each call to @racket[fmpg-decode-next!] clears the
+previous PCM block and attempts to produce the next decoded block for the
+selected audio stream.  When the call returns @racket[1], the block can be read
+with @racket[fmpg-buffer] and described with the buffer query functions.
+
+@defproc[(fmpg-decode-next! [instance any/c]) exact-integer?]{
+Decodes until a block of PCM output is available, end of stream is reached, or
+an error occurs.  The return values are:
+
+@itemlist[
+ #:style 'compact
+ @item{@racket[1]: a new PCM buffer is available through @racket[fmpg-buffer].}
+ @item{@racket[0]: decoding is complete and no more PCM is available.}
+ @item{A negative value: decoding failed or the instance was not ready.}
+]
+
+Internally, the decoder first tries to receive frames that FFmpeg may already
+have buffered.  If no frame is ready, it reads packets until it finds a packet
+for the selected audio stream.  Packets from other streams are skipped and
+immediately unreferenced.  Sent packets are unreferenced after
+@tt{avcodec_send_packet}, because the codec has then taken what it needs.
+
+At end of input, the function drains both the codec and the resampler.  This is
+necessary because FFmpeg and @tt{libswresample} may still hold delayed samples
+even after the demuxer has no more packets.
+}
+
+@section{Decoded buffers}
+
+The PCM buffer belongs to the decoder instance.  It is replaced by the next
+call to @racket[fmpg-decode-next!], @racket[fmpg-seek-ms!], or
+@racket[fmpg-close!].  Treat the returned byte string as read-only.  Copy it if
+it must outlive the next decoder operation or if another component may mutate
+it.
+
+@defproc[(fmpg-buffer [instance any/c]) (or/c bytes? #f)]{
+Returns the current decoded PCM block as a byte string, or @racket[#f] when no
+PCM block is available.
+
+The byte string contains interleaved signed 32-bit samples.  Its logical frame
+count is available as the difference between @racket[fmpg-buffer-end-sample]
+and @racket[fmpg-buffer-start-sample].  Its byte size is also available through
+@racket[fmpg-buffer-size].
+}
+
+@defproc[(fmpg-buffer-size [instance any/c]) exact-nonnegative-integer?]{
+Returns the number of valid bytes in the current PCM buffer.  If no decoder
+state is available, or if the size would not fit in the internal integer range,
+the function returns @racket[0].
+}
+
+@deftogether[
+(@defproc[(fmpg-buffer-start-sample [instance any/c])
+          exact-nonnegative-integer?]
+ @defproc[(fmpg-buffer-end-sample [instance any/c])
+          exact-nonnegative-integer?]
+ @defproc[(fmpg-sample-position [instance any/c])
+          exact-nonnegative-integer?])]{
+Return sample-frame positions for the current decoder state.
+
+@racket[fmpg-buffer-start-sample] returns the first sample frame represented by
+the current PCM buffer.  @racket[fmpg-buffer-end-sample] returns the half-open
+end position: the first sample frame after the current buffer.
+@racket[fmpg-sample-position] returns the next sample position the decoder
+expects to produce.
+
+These values count sample frames, not individual channel samples.  For stereo
+audio, one sample frame contains one sample for the left channel and one sample
+for the right channel.
+}
+
+@section[#:tag "ffmpeg-definitions-seeking"]{Seeking}
+
+@defproc[(fmpg-seek-ms! [instance any/c]
+                       [target-pos-ms exact-nonnegative-integer?])
+         (integer-in 0 1)]{
+Seeks the selected audio stream to @racket[target-pos-ms] milliseconds and
+resets the decoder and resampler state.  The function returns @racket[1] on
+success and @racket[0] on failure.  Seeking is allowed only when the instance
+is already ready for decoding and the target position is non-negative.
+
+Seeking uses FFmpeg's backward seek flag.  FFmpeg may therefore seek to a packet
+position before the requested target.  The decoder stores a discard target in
+sample frames.  During the following decode calls, frames before the target are
+dropped, and frames that overlap the target are trimmed so the exposed PCM
+buffer starts at, or as close as FFmpeg can provide to, the requested position.
+
+After a successful seek, the codec buffers are flushed, the resampler is closed
+and reinitialized, EOF state is cleared, and sample bookkeeping is reset to the
+target position.
+}
+
+@section{Resource ownership}
+
+The decoder instance owns the native FFmpeg objects it allocates.  The codec
+pointer returned by FFmpeg is not owned by the instance, but the codec context,
+frame, resampler and format context are.  They are released by
+@racket[fmpg-close!].  Finalizers are registered as a safety net, but callers
+should close decoder instances explicitly.
+
+Temporary native buffers used during resampling are allocated only for the
+duration of a conversion step and are always freed before control returns to the
+caller.  The public PCM buffer is a Racket byte string, so it can safely be
+passed to the Racket-side playback backend.
+
+@section{Use through the decoder frontend}
+
+The direct API above is normally wrapped by @filepath{ffmpeg-ffi.rkt} and by
+@filepath{ffmpeg-decoder.rkt}.  The frontend function @tt{ffmpeg-open} returns
+a handle or @racket[#f] when the file does not exist.  Its stream-info callback
+receives a mutable hash with at least these playback keys:
+
+@racketblock[
+(list 'sample-rate
+      'channels
+      'bits-per-sample
+      'bytes-per-sample
+      'total-samples
+      'duration)]
+
+The audio callback receives the same hash extended for the current buffer with
+these keys:
+
+@racketblock[
+(list 'sample
+      'current-time)]
+
+The hash is followed by a copied byte string and its valid byte count.  The
+copy is made by @filepath{ffmpeg-ffi.rkt}, not by the low-level buffer function
+itself.
+
+The frontend's seek function accepts a percentage of the stream and translates
+that percentage to a sample position.  The adapter then translates the sample
+position to milliseconds and calls @racket[fmpg-seek-ms!].  This is why the
+low-level module exposes millisecond seeking while the frontend exposes
+percentage seeking.
+
+@section{Examples}
+
+The following example opens a file, decodes all PCM blocks, and reports their
+byte ranges and sample ranges.  A real playback loop would pass each buffer to
+the audio output layer before requesting the next block.
+
+@racketblock[
+(define dec (fmpg-init))
+
+(when (and dec (= (fmpg-open-file! dec "track.ogg") 1))
+  (printf "~a Hz, ~a channels, ~a ms\n"
+          (fmpg-audio-sample-rate dec)
+          (fmpg-audio-channels dec)
+          (fmpg-duration-ms dec))
+
+  (let loop ()
+    (case (fmpg-decode-next! dec)
+      [(1)
+       (define pcm (fmpg-buffer dec))
+       (define size (fmpg-buffer-size dec))
+       (define start (fmpg-buffer-start-sample dec))
+       (define end (fmpg-buffer-end-sample dec))
+       (printf "decoded ~a bytes, samples [~a, ~a)\n"
+               size start end)
+       ;; Pass pcm to the audio output layer here, or copy it if needed.
+       (loop)]
+      [(0)
+       (printf "done\n")]
+      [else
+       (error "decode error")]))
+
+  (fmpg-close! dec))
+]
+
+A simple seek flow looks the same after the seek succeeds.  The following code
+moves to 30 seconds and then requests the next decoded buffer.
+
+@racketblock[
+(when (= (fmpg-seek-ms! dec 30000) 1)
+  (when (= (fmpg-decode-next! dec) 1)
+    (define pcm (fmpg-buffer dec))
+    (define start (fmpg-buffer-start-sample dec))
+    (printf "first buffer after seek starts at sample ~a\n" start)))
+]

scrbl/ffmpeg-definitions2.scrbl

@@ -0,0 +1,441 @@
+#lang scribble/manual
+
+@(require (for-label racket/base
+                     (except-in racket/contract ->)
+                     racket/path
+                     ffi/unsafe
+                     let-assert
+                     early-return
+                     "../ffmpeg-definitions.rkt"
+                     "../private/cstruct-helper.rkt"))
+
+@title[#:tag "ffmpeg-definitions"]{FFmpeg Decoder Definitions}
+@author[@author+email["Hans Dijkema" "hans@dijkewijk.nl"]]
+
+@defmodule[racket-audio/ffmpeg-definitions]
+
+This module provides the direct FFmpeg-backed decoder layer used by the audio
+pipeline.  It is deliberately small and stateful.  A caller creates one decoder
+instance, opens one file on it, queries the selected audio stream, repeatedly
+asks for the next PCM block, and closes the instance again.
+
+The module does not expose FFmpeg metadata.  It only exposes the information
+needed for playback: stream count, sample rate, channel count, duration,
+bitrate, decoded PCM data, and sample positions.  The output format is fixed:
+interleaved signed 32-bit PCM, four bytes per sample, using FFmpeg's
+@tt{AV_SAMPLE_FMT_S32} sample format.
+
+The FFmpeg libraries are loaded when the module is required.  The module checks
+that the runtime FFmpeg major versions are in the supported range configured by
+the implementation.  This binding targets the FFmpeg library major versions
+used by FFmpeg 6, 7, and 8: @tt{libavutil} 58 to 60, @tt{libavcodec} 60 to 62,
+@tt{libavformat} 60 to 62, and @tt{libswresample} 4 to 6.  Unsupported runtime
+versions fail early, before a decoder instance is used.
+
+On Windows, the private library loader may download the bundled sound-library
+set into Racket's add-on directory before the FFI libraries are opened.  On
+Unix-like systems, the FFmpeg libraries are expected to be installed by the
+operating system or platform package manager and to be reachable by Racket's
+FFI library search path.
+
+@section{Layering}
+
+This module is the low-level Racket FFI layer.  It is normally wrapped by
+@filepath{ffmpeg-ffi.rkt} and then by @filepath{ffmpeg-decoder.rkt}.  The first
+wrapper adapts this module to the command protocol used by the audio decoder
+frontend.  The second wrapper exposes the callback-oriented decoder interface
+used by the rest of the playback pipeline.
+
+The distinction matters for buffer lifetime.  At this level,
+@racket[fmpg-buffer] returns the current buffer owned by the decoder instance.
+The adapter in @filepath{ffmpeg-ffi.rkt} copies that buffer before passing it to
+@filepath{ffmpeg-decoder.rkt}.  Code that uses this module directly must copy
+the buffer itself when the bytes must survive the next decoder operation.
+
+@section{FFmpeg version information}
+
+@defproc[(ffmpeg-version [lib (or/c 'avutil 'avcodec 'avformat
+                                    'swr 'swresample)])
+         (list/c exact-nonnegative-integer?
+                 exact-nonnegative-integer?
+                 exact-nonnegative-integer?)]{
+Returns the runtime version of one FFmpeg library as a three-element list
+containing the major, minor, and micro version numbers.  The symbols
+@racket['swr] and @racket['swresample] both refer to @tt{libswresample}.
+
+The version is read from FFmpeg's packed integer value.  For example, a runtime
+value corresponding to @tt{62.28.100} is returned as @racket['(62 28 100)].
+The function raises an exception for an unknown library symbol.
+}
+
+The runtime versions determine which partial FFmpeg struct layouts are safe to
+use.  If a future FFmpeg major release changes a layout before one of the
+fields read by this module, the supported range should be extended only after
+the affected partial definitions have been checked.
+
+@section{Implementation strategy}
+
+This module talks directly to the FFmpeg shared libraries through Racket's FFI.
+There is no C shim that hides FFmpeg's structs or normalizes their layout.  The
+price of that choice is that the Racket side must know enough of the relevant C
+struct layouts to read the fields used by the decoder.  The benefit is that the
+binding remains a Racket module with direct access to the platform FFmpeg
+libraries.
+
+@subsection{C structs and offsets}
+
+Small and stable structures, such as @tt{AVRational} and
+@tt{AVChannelLayout}, are described with @racket[define-cstruct].  A
+@racket[define-cstruct] form describes the C fields to Racket's FFI.  Racket
+then calculates the correct field offsets for the current platform ABI and
+creates the corresponding pointer type, constructor, accessors and mutators.
+
+The larger FFmpeg structures are handled by @racket[def-cstruct] from
+@filepath{private/cstruct-helper.rkt}.  Structures such as
+@tt{AVCodecParameters}, @tt{AVStream}, @tt{AVFormatContext}, @tt{AVFrame} and
+@tt{AVPacket} are large and may differ between FFmpeg major versions.  The
+decoder only needs a few fields from each one, but those fields must still be
+read from their exact native offsets.
+
+The helper solves this by describing the complete field sequence up to the last
+field the backend needs.  Unnamed entries are used only to advance the offset.
+Named entries become generated accessors.  Repeated entries such as
+@racket[(6 _int)] keep the definition compact while still allowing Racket's FFI
+to compute alignment, padding and pointer size correctly.  Tail fields after
+the last required member are not described.
+
+The right layout is selected when the module is required, after the runtime
+FFmpeg major versions have been read from the libraries.  For the supported
+range, @tt{_AVCodecParameters} uses one layout for @tt{libavcodec} major
+version 60 and another for major versions 61 and 62.  Likewise,
+@tt{_AVFrame} uses one layout for @tt{libavutil} major version 58 and
+another for major versions 59 and 60.  The other partial structs used by this
+module are defined with a single layout across the supported versions.
+
+@subsection{Defensive control flow}
+
+Most FFmpeg calls report ordinary failure through C-style return values or null
+pointers.  The implementation treats those results as normal control flow.  The
+@racket[let/assert] form is used for setup paths where each native result must
+be checked before the next native call is made.  It behaves like a sequential
+binding form: each binding can be checked immediately, and a failed check
+returns the specified failure value for the whole form.
+
+That style is used for opening a file, selecting stream information, allocating
+the codec context, and initializing the resampler.  Predicates such as
+@tt{a-!nullptr?}, @tt{a-nullptr?}, @tt{a-true?}, and @tt{a->=?} express the
+usual FFmpeg checks directly next to the binding that produced the value.
+
+The decode and seek paths also use @racket[early-return] where processing must
+stop immediately from a nested position.  This keeps the normal FFmpeg outcomes
+away from exception-based control flow while still making cleanup actions local
+to the point where a failure can occur.
+
+@section{Decoder instances}
+
+A decoder instance is an opaque value returned by @racket[fmpg-init].  Its
+structure type and predicate are not exported.  Pass the value back to the
+functions in this module and do not inspect it directly.  The contracts below
+therefore use @racket[any/c] for the instance argument.  Operationally, that
+argument must be a value returned by @racket[fmpg-init].
+
+The instance owns native FFmpeg resources: a format context, a codec context,
+an audio frame, a resampler, and the Racket byte string used for the current
+PCM block.  Finalizers are installed as a last line of defence, but callers
+should still call @racket[fmpg-close!] explicitly when playback stops or when
+the file is no longer needed.  Explicit close keeps the lifetime of native
+resources predictable.
+
+@defproc[(fmpg-init) any/c]{
+Creates a new decoder instance.  The result is an opaque instance value, or
+@racket[#f] if the instance could not be created.
+
+Creating the instance does not open a file.  Use @racket[fmpg-open-file!]
+before querying stream information or decoding audio.
+}
+
+@defproc[(fmpg-open-file! [instance any/c]
+                         [filename (or/c path? string?)])
+         (integer-in 0 1)]{
+Opens @racket[filename] on @racket[instance], reads the stream information,
+selects the best audio stream, initializes the codec context, and initializes
+the resampler.
+
+The function returns @racket[1] on success and @racket[0] on failure.  On
+failure, partially initialized native state is closed again.  A non-string,
+non-path filename is treated as an open failure and returns @racket[0].
+
+An instance can only have one file open.  Close it with @racket[fmpg-close!]
+before opening another file on the same instance.
+}
+
+@defproc[(fmpg-close! [instance any/c]) void?]{
+Closes @racket[instance] if it is open and releases the native FFmpeg resources
+owned by the instance.  The codec context, frame and resampler are freed before
+the format context is closed.  This order avoids keeping decoder pointers that
+refer to streams from an already closed container.
+
+The stored audio information is reset.  Calling this function with @racket[#f]
+or with an already closed instance is harmless.
+}
+
+@defproc[(fmpg-is-open [instance any/c]) (integer-in 0 1)]{
+Returns @racket[1] when @racket[instance] is ready for decoding and @racket[0]
+otherwise.  An instance is ready only after a file has been opened, a usable
+audio stream has been selected, and the decoder and resampler have been
+initialized.
+}
+
+@section{Audio stream information}
+
+The decoder selects one audio stream for playback using FFmpeg's best-stream
+selection.  The stream count reports how many audio streams were found in the
+container, but decoding is performed only for the selected stream.
+
+The term @italic{sample} in this module means a sample frame: one time step in
+the audio stream, across all channels.  For stereo 32-bit output, one sample
+frame therefore occupies @racket[(* 2 4)] bytes in the returned PCM buffer.
+
+@defproc[(fmpg-audio-stream-count [instance any/c])
+         exact-nonnegative-integer?]{
+Returns the number of audio streams in the open container.  If the instance is
+not open, the result is @racket[0].  This count is informational; actual stream
+selection is performed during @racket[fmpg-open-file!].
+}
+
+@deftogether[
+(@defproc[(fmpg-audio-sample-rate [instance any/c])
+          exact-nonnegative-integer?]
+ @defproc[(fmpg-audio-channels [instance any/c])
+          exact-nonnegative-integer?])]{
+Return the sample rate and channel count of the selected audio stream.  If the
+instance is not ready, both functions return @racket[0].
+}
+
+@deftogether[
+(@defproc[(fmpg-audio-bits-per-sample [instance any/c])
+          exact-positive-integer?]
+ @defproc[(fmpg-audio-bytes-per-sample [instance any/c])
+          exact-positive-integer?])]{
+Return the fixed output sample width in bits and bytes.  The current output
+format is 32-bit signed PCM, so @racket[fmpg-audio-bits-per-sample] returns
+@racket[32] and @racket[fmpg-audio-bytes-per-sample] returns @racket[4].  The
+values are independent of the input file's original sample format and do not
+depend on the instance state.
+}
+
+@deftogether[
+(@defproc[(fmpg-duration-ms [instance any/c]) exact-integer?]
+ @defproc[(fmpg-duration-samples [instance any/c]) exact-integer?])]{
+Return the duration of the selected audio stream in milliseconds and in sample
+frames.  If the stream duration is not available, the container duration is
+used as a fallback.  If no duration can be determined, or when the instance is
+not ready, the result is @racket[-1].
+}
+
+@defproc[(fmpg-file-bitrate [instance any/c]) exact-integer?]{
+Returns the container bitrate in bits per second.  If the bitrate is unavailable
+or if the instance is not open, the result is @racket[-1].  Only positive
+FFmpeg bitrates are passed through as reliable.
+}
+
+@section{Output format}
+
+The decoder output format is intentionally fixed:
+
+@itemlist[
+ #:style 'compact
+ @item{sample format: signed 32-bit PCM, @tt{AV_SAMPLE_FMT_S32}}
+ @item{layout: interleaved}
+ @item{sample rate: the selected stream's sample rate}
+ @item{channels: the selected stream's channel count}
+]
+
+This keeps the playback layer simple.  The FFmpeg input format may be planar,
+floating point, compressed, or otherwise different; @tt{libswresample} converts
+the decoded frames to the fixed output format before the bytes are exposed to
+Racket.
+
+@section{Decoding}
+
+Decoding is block oriented.  Each call to @racket[fmpg-decode-next!] clears the
+previous PCM block and attempts to produce the next decoded block for the
+selected audio stream.  When the call returns @racket[1], the block can be read
+with @racket[fmpg-buffer] and described with the buffer query functions.
+
+@defproc[(fmpg-decode-next! [instance any/c]) exact-integer?]{
+Decodes until a block of PCM output is available, end of stream is reached, or
+an error occurs.  The return values are:
+
+@itemlist[
+ #:style 'compact
+ @item{@racket[1]: a new PCM buffer is available through @racket[fmpg-buffer].}
+ @item{@racket[0]: decoding is complete and no more PCM is available.}
+ @item{A negative value: decoding failed or the instance was not ready.}
+]
+
+Internally, the decoder first tries to receive frames that FFmpeg may already
+have buffered.  If no frame is ready, it reads packets until it finds a packet
+for the selected audio stream.  Packets from other streams are skipped and
+immediately unreferenced.  Sent packets are unreferenced after
+@tt{avcodec_send_packet}, because the codec has then taken what it needs.
+
+At end of input, the function drains both the codec and the resampler.  This is
+necessary because FFmpeg and @tt{libswresample} may still hold delayed samples
+even after the demuxer has no more packets.
+}
+
+@section{Decoded buffers}
+
+The PCM buffer belongs to the decoder instance.  It is replaced by the next
+call to @racket[fmpg-decode-next!], @racket[fmpg-seek-ms!], or
+@racket[fmpg-close!].  Treat the returned byte string as read-only.  Copy it if
+it must outlive the next decoder operation or if another component may mutate
+it.
+
+@defproc[(fmpg-buffer [instance any/c]) (or/c bytes? #f)]{
+Returns the current decoded PCM block as a byte string, or @racket[#f] when no
+PCM block is available.
+
+The byte string contains interleaved signed 32-bit samples.  Its logical frame
+count is available as the difference between @racket[fmpg-buffer-end-sample]
+and @racket[fmpg-buffer-start-sample].  Its byte size is also available through
+@racket[fmpg-buffer-size].
+}
+
+@defproc[(fmpg-buffer-size [instance any/c]) exact-nonnegative-integer?]{
+Returns the number of valid bytes in the current PCM buffer.  If no decoder
+state is available, or if the size would not fit in the internal integer range,
+the function returns @racket[0].
+}
+
+@deftogether[
+(@defproc[(fmpg-buffer-start-sample [instance any/c])
+          exact-nonnegative-integer?]
+ @defproc[(fmpg-buffer-end-sample [instance any/c])
+          exact-nonnegative-integer?]
+ @defproc[(fmpg-sample-position [instance any/c])
+          exact-nonnegative-integer?])]{
+Return sample-frame positions for the current decoder state.
+
+@racket[fmpg-buffer-start-sample] returns the first sample frame represented by
+the current PCM buffer.  @racket[fmpg-buffer-end-sample] returns the half-open
+end position: the first sample frame after the current buffer.
+@racket[fmpg-sample-position] returns the next sample position the decoder
+expects to produce.
+
+These values count sample frames, not individual channel samples.  For stereo
+audio, one sample frame contains one sample for the left channel and one sample
+for the right channel.
+}
+
+@section{Seeking}
+
+@defproc[(fmpg-seek-ms! [instance any/c]
+                       [target-pos-ms exact-nonnegative-integer?])
+         (integer-in 0 1)]{
+Seeks the selected audio stream to @racket[target-pos-ms] milliseconds and
+resets the decoder and resampler state.  The function returns @racket[1] on
+success and @racket[0] on failure.  Seeking is allowed only when the instance
+is already ready for decoding and the target position is non-negative.
+
+Seeking uses FFmpeg's backward seek flag.  FFmpeg may therefore seek to a packet
+position before the requested target.  The decoder stores a discard target in
+sample frames.  During the following decode calls, frames before the target are
+dropped, and frames that overlap the target are trimmed so the exposed PCM
+buffer starts at, or as close as FFmpeg can provide to, the requested position.
+
+After a successful seek, the codec buffers are flushed, the resampler is closed
+and reinitialized, EOF state is cleared, and sample bookkeeping is reset to the
+target position.
+}
+
+@section{Resource ownership}
+
+The decoder instance owns the native FFmpeg objects it allocates.  The codec
+pointer returned by FFmpeg is not owned by the instance, but the codec context,
+frame, resampler and format context are.  They are released by
+@racket[fmpg-close!].  Finalizers are registered as a safety net, but callers
+should close decoder instances explicitly.
+
+Temporary native buffers used during resampling are allocated only for the
+duration of a conversion step and are always freed before control returns to the
+caller.  The public PCM buffer is a Racket byte string, so it can safely be
+passed to the Racket-side playback backend.
+
+@section{Use through the decoder frontend}
+
+The direct API above is normally wrapped by @filepath{ffmpeg-ffi.rkt} and by
+@filepath{ffmpeg-decoder.rkt}.  The frontend function @tt{ffmpeg-open} returns
+a handle or @racket[#f] when the file does not exist.  Its stream-info callback
+receives a mutable hash with at least these playback keys:
+
+@racketblock[
+(list 'sample-rate
+      'channels
+      'bits-per-sample
+      'bytes-per-sample
+      'total-samples
+      'duration)]
+
+The audio callback receives the same hash extended for the current buffer with
+these keys:
+
+@racketblock[
+(list 'sample
+      'current-time)]
+
+The hash is followed by a copied byte string and its valid byte count.  The
+copy is made by @filepath{ffmpeg-ffi.rkt}, not by the low-level buffer function
+itself.
+
+The frontend's seek function accepts a percentage of the stream and translates
+that percentage to a sample position.  The adapter then translates the sample
+position to milliseconds and calls @racket[fmpg-seek-ms!].  This is why the
+low-level module exposes millisecond seeking while the frontend exposes
+percentage seeking.
+
+@section{Examples}
+
+The following example opens a file, decodes all PCM blocks, and reports their
+byte ranges and sample ranges.  A real playback loop would pass each buffer to
+the audio output layer before requesting the next block.
+
+@racketblock[
+(define dec (fmpg-init))
+
+(when (and dec (= (fmpg-open-file! dec "track.ogg") 1))
+  (printf "~a Hz, ~a channels, ~a ms\n"
+          (fmpg-audio-sample-rate dec)
+          (fmpg-audio-channels dec)
+          (fmpg-duration-ms dec))
+
+  (let loop ()
+    (case (fmpg-decode-next! dec)
+      [(1)
+       (define pcm (fmpg-buffer dec))
+       (define size (fmpg-buffer-size dec))
+       (define start (fmpg-buffer-start-sample dec))
+       (define end (fmpg-buffer-end-sample dec))
+       (printf "decoded ~a bytes, samples [~a, ~a)\n"
+               size start end)
+       ;; Pass pcm to the audio output layer here, or copy it if needed.
+       (loop)]
+      [(0)
+       (printf "done\n")]
+      [else
+       (error "decode error")]))
+
+  (fmpg-close! dec))
+]
+
+A simple seek flow looks the same after the seek succeeds.  The following code
+moves to 30 seconds and then requests the next decoded buffer.
+
+@racketblock[
+(when (= (fmpg-seek-ms! dec 30000) 1)
+  (when (= (fmpg-decode-next! dec) 1)
+    (define pcm (fmpg-buffer dec))
+    (define start (fmpg-buffer-start-sample dec))
+    (printf "first buffer after seek starts at sample ~a\n" start)))
+]

scrbl/ffmpeg-ffi.scrbl

@@ -105,7 +105,7 @@ When the stream ends, the callback is called as:
 
 The command returns @racket[#t].
 
-@section{Seeking}
+@section[#:tag "ffmpeg-ffi-seeking"]{Seeking}
 
 The @racket['seek] command takes an absolute PCM sample position:
 

scrbl/flac-decoder.scrbl

@@ -9,7 +9,7 @@
 @title{flac-decoder}
 @author[@author+email["Hans Dijkema" "hans@dijkewijk.nl"]]
 
-@defmodule[racket-audio/flac-decoder]
+@defmodule[racket-audio/flac-decoder #:use-sources (racket-audio/flac-definitions)]
 
 This module provides a small decoder interface on top of the FLAC
 FFI layer. It opens a decoder for a file, reads stream metadata,
@@ -33,12 +33,12 @@ 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
+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.
+@racket[flac-stream-info?] value.
 
 When decoded audio data is processed and @racket[cb-audio] is a
 procedure, it is called as
@@ -80,7 +80,7 @@ with @racket['stopped-reading] and @racket[reading] is reset to
 
 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
+@racket['streaminfo], a @racket[flac-stream-info?] value is
 constructed, stored in the handle, and passed to the
 stream-info callback.
 
@@ -110,7 +110,7 @@ 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.
+@racket[flac-stream-info?] value by this module.
 }
 
 @defproc[(flac-stop [handle flac-handle?]) void?]{
@@ -125,6 +125,13 @@ The procedure prints timing information before and after the
 wait.
 }
 
+@defproc[(flac-duration [handle flac-handle?])
+         (or/c #f exact-nonnegative-integer?)]{
+
+Returns the rounded duration in seconds, or @racket[#f] while no stream
+information is available.
+}
+
 @section{Diagnostic bindings}
 
 @defthing[kinds hash?]{
@@ -145,7 +152,7 @@ processing.
 The block size of the most recently processed frame.
 }
 
-@section{Notes}
+@section[#:tag "flac-decoder-notes"]{Notes}
 
 The frame-header hash passed to the audio callback is produced
 by @racket[flac-ffi-frame-header]. In this module it is extended

scrbl/intro.scrbl

@@ -0,0 +1,98 @@
+#lang scribble/manual
+
+@(require racket/runtime-path
+          scribble/core
+          scribble/html-properties
+          (for-label racket/base
+                     racket/path
+                     "../audio-player.rkt"
+                     "../taglib.rkt"
+                     "../audio-sniffer.rkt"
+                     "../audio-decoder.rkt"
+                     "../audio-placed-player.rkt"
+                     "../libao.rkt"
+                     "../mp3-decoder.rkt"
+                     "../flac-decoder.rkt"
+                     "../ffmpeg-decoder.rkt"))
+
+@(define-runtime-path rktplayer-logo "rktplayer.svg")
+
+@(define title-logo-style
+   (style #f
+          (list (attributes
+                 '((style . "float: right; margin-left: 1.5em; margin-bottom: 0.5em;"))))))
+
+@elem[#:style title-logo-style]{@image[#:scale 0.25 rktplayer-logo]}
+
+@title{@elem{Introduction racket-audio}}
+
+
+@defmodule[racket-audio]
+
+@;;title{racket-audio}
+@author[@author+email["Hans Dijkema" "hans@dijkewijk.nl"]]
+
+@racketmodname[racket-audio] is a small audio playback toolkit for Racket.  It
+combines high-level asynchronous playback, optional metadata reading, file type
+sniffing, decoder backends, and libao based output.  Most applications should
+start with the high-level player API and only use the lower-level modules when
+they need to add a decoder, inspect the playback pipeline, or debug the native
+FFI boundary.
+
+@section{APIs for normal users}
+
+For ordinary playback, use @racketmodname[racket-audio/audio-player].  It
+creates an audio player, starts the worker side, and exposes procedures such as
+@racket[make-audio-player], @racket[audio-play!], @racket[audio-pause!],
+@racket[audio-stop!], @racket[audio-seek!], and @racket[audio-quit!].  The
+player is asynchronous: commands return after they have been accepted, while
+state updates and end-of-stream notifications are delivered through callbacks.
+
+Use @racketmodname[racket-audio/taglib] when an application needs metadata such
+as title, artist, album, duration-related properties, generic TagLib properties,
+or embedded cover art.  The module reads metadata into a Racket-side snapshot
+and does not keep the native TagLib file handle open.
+
+Use @racketmodname[racket-audio/audio-sniffer] when file type detection should
+be based on file contents rather than only on extensions.  The sniffer is useful
+before choosing a decoder, validating input, or presenting a likely media type
+to the user.
+
+The @racketmodname[racket-audio/play-test] module is not a library API, but it
+is a useful integration example.  In particular, its queue mode, selected with
+@racket[(set-test 'queue)], shows how an EOF callback can start the next item
+in a simple playback queue.
+
+@section{Lower-level modules for geeks}
+
+The modules below are normally used by the player implementation rather than by
+application code.  They are documented because they are useful when extending,
+debugging, or replacing parts of the pipeline.
+
+@itemlist[#:style 'compact
+ @item{@racketmodname[racket-audio/audio-placed-player] implements the worker
+       side of the high-level player.  It is normally run in a Racket place, so
+       the timing-sensitive audio feeder runs in a separate VM, but it can also
+       be run in a thread with async channels for easier debugging.}
+ @item{@racketmodname[racket-audio/audio-decoder] provides the decoder registry
+       and a uniform open/read/seek/stop interface over concrete decoder
+       backends.}
+ @item{@racketmodname[racket-audio/mp3-decoder],
+       @racketmodname[racket-audio/flac-decoder], and
+       @racketmodname[racket-audio/ffmpeg-decoder] are concrete decoder
+       frontends.  The FFmpeg path is the general-purpose fallback for formats
+       not handled by the specialised decoders.}
+ @item{@racketmodname[racket-audio/libao] and
+       @racketmodname[racket-audio/libao-async-ffi-racket] form the output side:
+       they open the native audio device, queue PCM buffers, apply volume, and
+       feed libao asynchronously.}
+ @item{@racketmodname[racket-audio/ffmpeg-ffi],
+       @racketmodname[racket-audio/ffmpeg-definitions], and the FFmpeg C backend
+       documentation describe the native FFmpeg boundary, the direct FFI
+       definitions, version-sensitive structures, and the fixed PCM format used
+       by the decoder pipeline.}]
+
+In short: applications should usually combine
+@racketmodname[racket-audio/audio-player] with @racketmodname[racket-audio/taglib].
+The other modules document the machinery underneath: format detection, decoder
+selection, place-based playback, buffering, native output, and FFmpeg access.

scrbl/libao-async-ffi-racket.scrbl

@@ -0,0 +1,320 @@
+#lang scribble/manual
+
+@(require (for-label racket/base
+                     racket/contract
+                     "../libao-async-ffi-racket.rkt"))
+
+@title{Asynchronous libao playback in Racket}
+@author[@author+email["Hans Dijkema" "hans@dijkewijk.nl"]]
+
+@defmodule[racket-audio/libao-async-ffi-racket]
+
+This module implements the asynchronous libao playback backend used by
+@racketmodname[racket-audio].  It is a pure Racket replacement for the older C
+based @filepath{ao_playasync.c} backend.  It exports the same Racket-level API
+as @filepath{libao-async-ffi.rkt} and still sends PCM to Xiph libao, but the
+queue, worker thread, buffering, format conversion and volume scaling are all
+implemented in Racket.
+
+The module is intended as a low-level backend below the higher-level sound
+player.  Client code creates one asynchronous audio handle, queues decoded PCM
+buffers together with playback position information, and lets a Racket worker
+thread feed libao.  Higher-level player code should normally use the public
+player interface instead of calling this module directly.
+
+@section[#:tag "libao-async-overview"]{Overview}
+
+The backend accepts decoded PCM buffers, converts them when needed, groups small
+buffers into larger playback chunks, and sends those chunks to libao from a
+dedicated Racket worker thread.  The foreign @racket[ao_play] call is declared
+with @racket[#:blocking?], so a blocking write to the audio device does not
+unnecessarily hold up other Racket threads.
+
+Incoming buffers may be interleaved or planar.  Planar buffers, such as those
+commonly produced by a FLAC decoder, are converted to interleaved PCM before
+playback.  If the requested sample width cannot be opened on the selected audio
+device, the backend tries lower-width output formats and converts samples before
+they are sent to libao.
+
+The backend also maintains playback position metadata.  Each queued buffer is
+tagged with a music id, a current playback position and a duration.  These
+values are used by the higher-level player to report which track the output
+thread has reached.
+
+@section{Basic example}
+
+The normal live playback path opens the default libao driver.  The output bit
+format may be lower than the requested bit format when libao cannot open the
+device with the requested precision.
+
+@racketblock[
+(define h
+  (ao_create_async 32 44100 2 'native-endian #f))
+
+(define info
+  (make-buffer-info 'interleaved 32 44100 2 'native-endian))
+
+(when h
+  (ao_play_async h 1 0.0 180.0 (bytes-length pcm) pcm info)
+  (ao_set_volume_async h 80.0)
+  (ao_pause_async h #t)
+  (ao_pause_async h #f)
+  (ao_stop_async h))]
+
+To write to a WAV file instead of the default live device, pass a path string
+as the last argument to @racket[ao_create_async] instead of @racket[#f].
+
+@racketblock[
+(define h
+  (ao_create_async 16 48000 2 'little-endian "test-output.wav"))]
+
+@section{Playback handles}
+
+@defproc[(ao_version_async) exact-integer?]{
+Returns the implementation version of this asynchronous backend.  The current
+module returns @racket[3].  The value is useful for diagnostics when multiple
+asynchronous backends exist.
+}
+
+@defproc[(ao_create_async
+          [bits exact-positive-integer?]
+          [rate exact-positive-integer?]
+          [channels exact-positive-integer?]
+          [byte-format (or/c 'little-endian 'big-endian 'native-endian)]
+          [wav-output-file (or/c #f path-string?)])
+         any/c]{
+Creates an asynchronous audio handle.  When @racket[wav-output-file] is
+@racket[#f], the default live libao driver is opened.  Otherwise the libao
+@tt{wav} driver is opened and samples are written to the named file.
+
+The requested format is described by @racket[bits], @racket[rate],
+@racket[channels] and @racket[byte-format].  If the requested number of bits
+cannot be opened and the request is wider than 24 or 16 bits, the module tries
+24-bit and then 16-bit output.  The resulting device precision can be queried
+with @racket[ao_real_output_bits_async].
+
+The result is an asynchronous audio handle, or @racket[#f] when no suitable
+libao device or output file could be opened.  Handles should be closed with
+@racket[ao_stop_async].  A finalizer is also registered as a safety net, but
+explicit stopping is the intended lifecycle.
+}
+
+@defproc[(ao_stop_async [handle any/c]) any/c]{
+Stops playback, clears queued data, wakes the worker thread when it is paused,
+queues a stop command, waits for the worker thread to finish, closes the libao
+device and marks the handle as invalid.  The function returns the handle.
+Calling the other playback functions on an invalid handle is an error.
+}
+
+@defproc[(ao_clear_async [handle any/c]) any/c]{
+Clears queued audio data without closing the device.  The buffer that is being
+assembled for the next queued play item is also discarded.  Already playing
+audio may still finish at the device level, depending on what libao and the
+operating system have accepted.  This operation is used when playback is
+stopped, when the higher layer seeks, or when the current stream is replaced.
+}
+
+@defproc[(ao_pause_async [handle any/c]
+                         [paused (or/c boolean? integer?)])
+         any/c]{
+Pauses or resumes the worker thread.  A boolean value is used directly.  An
+integer value is accepted for compatibility with the old FFI layer, where
+@racket[0] means resume and any other integer means pause.
+
+Pausing does not prevent producers from queueing additional buffers.  It only
+prevents the worker thread from taking more data from the queue.
+}
+
+@section{Buffer descriptions}
+
+@defproc[(make-buffer-info
+          [type symbol?]
+          [sample-bits exact-positive-integer?]
+          [sample-rate exact-positive-integer?]
+          [channels exact-positive-integer?]
+          [endianness (or/c 'little-endian 'big-endian 'native-endian)])
+         any/c]{
+Constructs the format description passed to @racket[ao_play_async].  Only the
+constructor is exported.  The struct predicate and accessors remain private to
+this module, because the value is primarily a compatibility object for the
+audio backend.
+
+The @racket[type] field controls whether the incoming buffer is already
+interleaved.  Use @racket['interleaved] or the older name @racket['ao] for
+ordinary PCM in frame order.  Use @racket['planar] or the older name
+@racket['flac] when each channel is stored as a separate plane.  Planar input
+is copied to an interleaved buffer before it is queued.
+
+The @racket[sample-bits], @racket[sample-rate] and @racket[channels] fields
+describe the format of the supplied buffer, not necessarily the format that will
+eventually be accepted by the device.  Samples are treated as signed integer
+PCM.  @racket[sample-bits] must describe whole bytes, such as 16, 24 or 32
+bits.  The conversion code uses the supplied endianness when reading input
+samples and when writing converted output samples.
+}
+
+@defproc[(make-BufferInfo_t
+          [type symbol?]
+          [sample-bits exact-positive-integer?]
+          [sample-rate exact-positive-integer?]
+          [channels exact-positive-integer?]
+          [endianness (or/c 'little-endian 'big-endian 'native-endian)])
+         any/c]{
+Compatibility alias for @racket[make-buffer-info].  The name is kept so code
+that used the older FFI module can keep constructing buffer descriptions
+without changing call sites.
+}
+
+@section{Queuing audio}
+
+@defproc[(ao_play_async
+          [handle any/c]
+          [music-id any/c]
+          [at-second real?]
+          [music-duration real?]
+          [buf-size exact-nonnegative-integer?]
+          [audio-buffer (or/c bytes? any/c)]
+          [buffer-info any/c])
+         any/c]{
+Queues a PCM buffer for asynchronous playback.  @racket[audio-buffer] may be a
+byte string, or an internal reusable memory object produced by this backend.
+External callers normally pass a byte string.  @racket[buf-size] is the number
+of valid bytes in the buffer.
+
+The position values @racket[music-id], @racket[at-second] and
+@racket[music-duration] are copied into the queue element.  When the worker
+thread starts playing that element, these values become visible through
+@racket[ao_is_at_music_id_async], @racket[ao_is_at_second_async] and
+@racket[ao_music_duration_async].  They do not affect sample conversion.
+
+If the input buffer is planar, it is first converted to interleaved PCM.  If the
+input sample width or endianness differs from the opened output device, the
+sample data is converted before queueing.  Small input chunks are collected into
+larger queue elements.  The target chunk size is controlled by
+@racket[ao-playback-buf-ms] and defaults to 150 milliseconds.  Buffers with
+different @racket[music-id] values are not merged into the same output chunk.
+}
+
+@section[#:tag "libao-async-playback-state"]{Playback state}
+
+@defproc[(ao_is_at_second_async [handle any/c]) real?]{
+Returns the playback position, in seconds, associated with the queue element
+most recently taken by the worker thread.  This value is not measured by libao;
+it is the @racket[at-second] value supplied by the producer of the PCM buffer.
+}
+
+@defproc[(ao_is_at_music_id_async [handle any/c]) any/c]{
+Returns the music id associated with the queue element most recently taken by
+the worker thread.  The value is whatever was passed as @racket[music-id] to
+@racket[ao_play_async].
+}
+
+@defproc[(ao_music_duration_async [handle any/c]) real?]{
+Returns the duration value associated with the queue element most recently
+taken by the worker thread.  The value is copied from the
+@racket[music-duration] argument passed to @racket[ao_play_async].
+}
+
+@defproc[(ao_bufsize_async [handle any/c]) exact-nonnegative-integer?]{
+Returns the number of audio bytes currently counted as buffered by the async
+queue administration.  The value is updated when buffers are queued, combined,
+taken by the worker thread or cleared.  It is a backend queue size, not the size
+of the operating-system or hardware audio buffer.
+}
+
+@defproc[(ao_sample_queue_len [handle any/c]) exact-nonnegative-integer?]{
+Returns the number of queue elements currently counted by the async queue
+administration.  Since the module combines small input buffers into larger
+playback chunks, this is not the same as the number of calls made to
+@racket[ao_play_async].
+}
+
+@defproc[(ao_reuse_buf_len [handle any/c]) exact-nonnegative-integer?]{
+Returns the number of reusable byte buffers currently kept by the backend.  This
+is an implementation diagnostic.  It is useful for checking whether the reuse
+pool is being exercised, but it is not an audio latency measurement.
+}
+
+@section{Volume and output format}
+
+@defproc[(ao_set_volume_async [handle any/c]
+                              [percentage real?])
+         any/c]{
+Sets the software volume.  @racket[100.0] is normal volume, @racket[50.0] is
+half volume and values above @racket[100.0] amplify the samples.  The
+implementation stores the setting as an integer scaled by 100, so normal volume
+is represented internally as @racket[10000].  Values very close to
+@racket[100.0] are normalized to exactly @racket[10000] to avoid unnecessary
+sample processing.
+
+Volume is applied by the worker thread immediately before copying the playback
+chunk to the foreign buffer passed to libao.  Scaled samples are clipped to the
+signed range of the opened output sample width.
+}
+
+@defproc[(ao_volume_async [handle any/c]) real?]{
+Returns the current software volume percentage.  A result of @racket[100.0]
+means normal volume.
+}
+
+@defproc[(ao_real_output_bits_async [handle any/c])
+         exact-nonnegative-integer?]{
+Returns the actual number of bits per sample used by the opened libao device.
+This may be lower than the requested width if device opening fell back from
+32-bit to 24-bit or 16-bit output.  In that case, @racket[ao_play_async]
+converts the incoming samples before playback.
+}
+
+@section{Playback buffer tuning}
+
+@defproc[(ao-playback-buf-ms) exact-nonnegative-integer?]{
+Returns the target size, in milliseconds, of the playback chunks that the
+backend sends to libao.  The default is @racket[150].
+}
+
+@defproc[(ao-set-playback-buf-ms! [ms exact-nonnegative-integer?])
+         void?]{
+Sets the target playback chunk size in milliseconds.
+
+Larger values reduce the number of calls to libao and may help prevent audible
+glitches when decoders produce many small buffers.  Smaller values reduce
+latency but increase scheduling pressure on the Racket worker thread and on the
+audio backend.
+}
+
+@section[#:tag "libao-async-implementation-strategy"]{Implementation strategy}
+
+The module keeps libao as the only native audio backend, but moves the async
+queue and playback thread from C to Racket.  It initializes libao lazily when
+the first handle or temporary driver query is opened.  A small reference count
+is used so @racket[ao_shutdown] is called when the last opened handle is closed.
+A custodian and exit finalizer call shutdown as a last resort.
+
+The worker thread waits for queue elements, observes the pause lock, applies
+volume when necessary, copies the chunk into foreign memory allocated as
+@racket['atomic-interior], and calls libao.  The foreign @racket[ao_play]
+binding is marked as blocking.  The combination matters: libao may retain the
+pointer for the duration of the call, and a blocking foreign call should not
+receive movable Racket byte storage directly.
+
+Small decoder buffers are combined before reaching libao.  The target chunk
+size is controlled by @racket[ao-playback-buf-ms].  The buffer reuse pool keeps
+allocated byte strings around for future chunks, reducing allocation churn in
+long playback sessions.
+
+The conversion path is intentionally narrow.  Planar input is converted to
+interleaved PCM.  Sample width conversion is done with arithmetic shifts, and
+endianness conversion is handled through Racket byte operations.  This backend
+therefore expects integer PCM with byte-aligned sample widths.
+
+@section{Compatibility notes}
+
+The exported names are kept compatible with the old
+@filepath{libao-async-ffi.rkt} layer.  In particular,
+@racket[make-BufferInfo_t] remains available even though the actual value is a
+Racket struct, not a C struct.  The higher layers can therefore select this
+module as an implementation backend without changing the playback API.
+
+The queue state functions report the backend's own administration.  They do not
+query libao for device latency, and they do not know how many samples are
+already buffered by the operating system or the audio driver.

scrbl/libao-async-ffi-racket2.scrbl

@@ -0,0 +1,306 @@
+#lang scribble/manual
+
+@(require (for-label racket/base
+                     racket/contract
+                     "../libao-async-ffi-racket.rkt"))
+
+@title{Pure Racket Asynchronous libao Backend}
+
+@defmodule[racket-audio/libao-async-ffi-racket]
+
+This module implements the asynchronous libao playback backend used by
+@racketmodname[racket-audio].  It provides the same public Racket API as the
+older C-backed asynchronous player, but keeps the queueing, buffering,
+conversion and worker-thread logic in Racket.  The only foreign calls made by
+this module are the direct calls into Xiph's libao library.
+
+The module is intended as a low-level backend.  Higher-level player code should
+normally use the public audio-player interface instead of calling this module
+directly.  It is documented here because it defines the exact contract between
+decoded PCM data and the libao output path.
+
+@section{Overview}
+
+The backend accepts decoded PCM buffers, converts them when needed, groups small
+buffers into larger playback chunks, and sends those chunks to libao from a
+dedicated Racket worker thread.  The worker thread calls @racket[ao_play] as a
+blocking foreign call, so other Racket threads and places do not have to wait
+for the audio device to accept more data.
+
+Incoming buffers may be interleaved or planar.  Planar buffers, such as those
+commonly produced by a FLAC decoder, are converted to interleaved PCM before
+playback.  If the requested sample width cannot be opened on the selected audio
+device, the backend tries lower-width output formats and converts samples before
+they are sent to libao.
+
+The backend also maintains playback position metadata.  Each queued buffer is
+tagged with a music id, a current playback position and a duration.  These
+values are used by the higher-level player to report where the audio device is
+in the current track.
+
+@section{Buffer information}
+
+@defproc[(make-buffer-info [type symbol?]
+                           [sample-bits exact-positive-integer?]
+                           [sample-rate exact-positive-integer?]
+                           [channels exact-positive-integer?]
+                           [endianness symbol?])
+         any/c]{
+
+Creates a buffer description object for PCM data passed to
+@racket[ao_play_async].
+
+The @racket[type] field describes the memory layout.  The supported values are
+@racket['interleaved] for normal interleaved PCM and @racket['planar] for planar
+PCM.  For compatibility with older code, @racket['ao] is treated as interleaved
+by convention and @racket['flac] is accepted as planar input.
+
+The @racket[sample-bits], @racket[sample-rate] and @racket[channels] fields
+describe the format of the supplied buffer, not necessarily the format that will
+eventually be accepted by the device.  The backend may convert the sample width
+to the actual device width.
+
+The @racket[endianness] field must be one of @racket['little-endian],
+@racket['big-endian] or @racket['native-endian].  It is used when samples are
+converted between different sample widths or byte orders.}
+
+@defproc[(make-BufferInfo_t [type symbol?]
+                            [sample-bits exact-positive-integer?]
+                            [sample-rate exact-positive-integer?]
+                            [channels exact-positive-integer?]
+                            [endianness symbol?])
+         any/c]{
+
+Compatibility alias for @racket[make-buffer-info].  The name matches the older
+FFI module and the former C structure naming convention.}
+
+@section{Creating and closing a backend}
+
+@defproc[(ao_version_async) exact-integer?]{
+
+Returns the version number of this asynchronous backend implementation.  The
+current implementation returns @racket[3].  The value is useful for diagnostics
+when multiple asynchronous backend implementations exist.}
+
+@defproc[(ao_create_async [bits exact-positive-integer?]
+                          [rate exact-positive-integer?]
+                          [channels exact-positive-integer?]
+                          [byte-format symbol?]
+                          [wav-output-file (or/c #f path-string?)])
+         any/c]{
+
+Opens a libao output device and creates an asynchronous playback handle.
+
+The @racket[bits], @racket[rate], @racket[channels] and @racket[byte-format]
+arguments describe the preferred output format.  The byte format must be one of
+@racket['little-endian], @racket['big-endian] or @racket['native-endian].
+
+When @racket[wav-output-file] is @racket[#f], the default live libao driver is
+used.  When it is a path string, the backend opens libao's @tt{wav} driver and
+writes the audio stream to that file instead.
+
+The backend first tries to open the requested sample width.  If that fails and
+the requested width is greater than 24 bits, it tries 24-bit output.  If that
+also fails and the requested width is greater than 16 bits, it tries 16-bit
+output.  The actual device width can be queried with
+@racket[ao_real_output_bits_async].
+
+The function returns a playback handle on success and @racket[#f] when no
+suitable libao device could be opened.}
+
+@defproc[(ao_stop_async [handle any/c]) any/c]{
+
+Stops the worker thread, clears pending audio, closes the libao device and
+invalidates @racket[handle].
+
+The stop operation first clears all queued buffers, then queues an internal stop
+command, waits for the playback thread to terminate, and finally closes the
+underlying libao handle.  Calling this function on an already invalid handle is
+an error.}
+
+@section{Submitting audio}
+
+@defproc[(ao_play_async [handle any/c]
+                        [music-id any/c]
+                        [at-second real?]
+                        [music-duration real?]
+                        [buf-size exact-nonnegative-integer?]
+                        [au-buf (or/c bytes? any/c)]
+                        [info any/c])
+         void?]{
+
+Queues a PCM buffer for asynchronous playback.
+
+The @racket[music-id], @racket[at-second] and @racket[music-duration] values are
+stored together with the queued buffer.  They do not affect sample conversion,
+but they allow the player to report the current track id, playback position and
+track duration while the worker thread is playing the queued data.
+
+The @racket[buf-size] argument gives the number of valid bytes in
+@racket[au-buf].  The input buffer is copied into backend-owned memory before
+the function returns, so the caller may reuse or discard the original byte
+string after the call.
+
+The @racket[info] argument should be created with @racket[make-buffer-info].  If
+the buffer is planar, it is converted to interleaved PCM.  If the buffer's
+sample width or byte order differs from the actual libao device format, the
+backend converts it before queueing.
+
+The backend groups smaller buffers into larger playback chunks.  This reduces
+the number of calls to libao and helps prevent underruns.  Buffers with
+different @racket[music-id] values are not merged into the same output chunk.}
+
+@defproc[(ao_clear_async [handle any/c]) any/c]{
+
+Clears all queued audio buffers that have not yet been played.
+
+The current aggregation buffer is also cleared.  Already playing audio may still
+finish at the device level, depending on what libao and the operating system
+have accepted.  This operation is used by higher-level code when stopping,
+seeking or replacing the current stream.}
+
+@section{Playback state}
+
+@defproc[(ao_is_at_second_async [handle any/c]) real?]{
+
+Returns the playback position associated with the most recently dequeued buffer.
+This value is the @racket[at-second] value supplied to @racket[ao_play_async],
+not a sample-accurate query into the audio device.}
+
+@defproc[(ao_is_at_music_id_async [handle any/c]) any/c]{
+
+Returns the music id associated with the most recently dequeued buffer.  The
+higher-level player uses this value to determine which track the output thread
+has reached.}
+
+@defproc[(ao_music_duration_async [handle any/c]) real?]{
+
+Returns the duration associated with the most recently dequeued buffer.  This is
+the @racket[music-duration] value supplied to @racket[ao_play_async].}
+
+@defproc[(ao_bufsize_async [handle any/c]) exact-nonnegative-integer?]{
+
+Returns the number of queued PCM bytes that have been accepted by the backend
+but not yet removed from the asynchronous queue.  This is a backend queue size,
+not the size of the operating-system or hardware audio buffer.}
+
+@defproc[(ao_sample_queue_len [handle any/c]) exact-nonnegative-integer?]{
+
+Returns the number of queued playback elements waiting in the backend queue.
+This is mainly useful for diagnostics and tuning.}
+
+@defproc[(ao_reuse_buf_len [handle any/c]) exact-nonnegative-integer?]{
+
+Returns the number of reusable internal buffers currently kept by the backend.
+This is a diagnostic value that can help detect excessive allocation or
+unexpected buffer retention.}
+
+@section{Pause and volume}
+
+@defproc[(ao_pause_async [handle any/c]
+                         [paused (or/c boolean? integer?)])
+         void?]{
+
+Pauses or resumes the playback worker.
+
+When @racket[paused] is @racket[#t], or an integer other than @racket[0], the
+worker thread is blocked before it dequeues the next element.  When
+@racket[paused] is @racket[#f] or @racket[0], playback is resumed.
+
+Pausing does not prevent producers from queueing additional buffers.  It only
+prevents the worker thread from taking more data from the queue.}
+
+@defproc[(ao_set_volume_async [handle any/c]
+                              [percentage real?])
+         void?]{
+
+Sets the output volume as a percentage.
+
+A value of @racket[100.0] means unchanged volume.  Values below
+@racket[100.0] attenuate the signal.  Values above @racket[100.0] amplify the
+signal and are clipped to the signed range of the actual device sample width.
+
+Internally the value is stored as an integer in hundredths of a percent: for
+example, @racket[100.0] becomes @racket[10000].  Values very close to
+@racket[100.0] are normalized to exactly @racket[10000] to avoid unnecessary
+sample processing.}
+
+@defproc[(ao_volume_async [handle any/c]) real?]{
+
+Returns the currently configured output volume percentage.}
+
+@section{Output format}
+
+@defproc[(ao_real_output_bits_async [handle any/c])
+         exact-nonnegative-integer?]{
+
+Returns the actual sample width opened on the libao device.
+
+This may be lower than the requested width passed to @racket[ao_create_async].
+For example, a request for 32-bit output may result in a 24-bit or 16-bit device
+when the default libao driver cannot open the preferred format.  In that case,
+@racket[ao_play_async] converts the incoming samples before playback.}
+
+@section{Playback buffer tuning}
+
+@defproc[(ao-playback-buf-ms) exact-nonnegative-integer?]{
+
+Returns the target size, in milliseconds, of the playback chunks that the
+backend sends to libao.  The default is @racket[150].}
+
+@defproc[(ao-set-playback-buf-ms! [ms exact-nonnegative-integer?])
+         void?]{
+
+Sets the target playback chunk size in milliseconds.
+
+Larger values reduce the number of calls to libao and may help prevent audible
+glitches when decoders produce many small buffers.  Smaller values reduce
+latency but increase scheduling pressure on the Racket worker thread and on the
+audio backend.}
+
+@section{Implementation notes}
+
+The worker thread is created with its own thread pool and uses libao's
+@racket[ao_play] through a blocking FFI call.  Before calling libao, the worker
+copies the queued bytes into memory allocated with @racket['atomic-interior].
+This is important because a blocking foreign call must not be handed a pointer
+to movable Racket memory that could be relocated by the garbage collector while
+the foreign function is still using it.
+
+The backend keeps a small pool of previously allocated buffers.  Buffers created
+internally for conversion or aggregation can be reused after playback.  This
+reduces allocation pressure during continuous playback.
+
+The module initializes libao when the first handle is opened and shuts libao
+down when the last handle is closed.  This keeps libao lifetime management local
+to the backend and avoids repeated global initialization during normal playback.
+
+@section{Example}
+
+@racketblock[
+(define h
+  (ao_create_async 32 44100 2 'native-endian #f))
+
+(define info
+  (make-buffer-info 'interleaved 32 44100 2 'native-endian))
+
+(when h
+  (ao_play_async h
+                 1
+                 0.0
+                 180.0
+                 (bytes-length pcm-bytes)
+                 pcm-bytes
+                 info)
+
+  (ao_set_volume_async h 80.0)
+
+  (ao_pause_async h #t)
+  (ao_pause_async h #f)
+
+  (ao_stop_async h))
+]
+
+The example opens the default live libao device, queues one interleaved
+32-bit PCM buffer, lowers the volume to 80 percent, briefly pauses and resumes
+the worker, and finally closes the backend.

scrbl/libao.scrbl

@@ -23,7 +23,7 @@ stores the requested playback configuration together with a native
 asynchronous player handle. It also records the real bit depth accepted
 by the selected libao output device.
 
-@section{Audio handles}
+@section[#:tag "libao-audio-handles"]{Audio handles}
 
 @defproc[(ao-handle? [v any/c]) boolean?]{
 
@@ -216,7 +216,7 @@ A true value pauses playback. @racket[#f] resumes playback.
 Clears buffered asynchronous playback data for @racket[handle].
 }
 
-@section{Playback state}
+@section[#:tag "libao-playback-state"]{Playback state}
 
 @defproc[(ao-at-second [handle ao-handle?]) number?]{
 
@@ -259,7 +259,7 @@ Returns the current playback volume as reported by the native
 asynchronous player.
 }
 
-@section{Notes}
+@section[#:tag "libao-notes"]{Notes}
 
 This module is a higher-level wrapper around the asynchronous FFI layer.
 It stores the playback configuration in the handle, and reuses that

scrbl/mp3-decoder.scrbl

@@ -16,10 +16,10 @@ reports stream information through a callback, streams decoded PCM
 buffers, and supports stopping and seeking.
 
 The module is intended to be used through
-@racketmodname[racket-sound/audio-decoder], but its procedures can also
+@racketmodname[racket-audio/audio-decoder], but its procedures can also
 be used directly.
 
-@section{Validation}
+@section[#:tag "mp3-decoder-validation"]{Validation}
 
 @defproc[(mp3-valid? [mp3-file any/c]) boolean?]{
 
@@ -27,14 +27,14 @@ Returns #t.
 
 The current implementation does not inspect mp3-file. This procedure
 exists to satisfy the reader interface used by
-@racketmodname[racket-sound/audio-decoder].
+@racketmodname[racket-audio/audio-decoder].
 
 Basic validation such as file existence and extension matching is
 performed in the higher-level module. This procedure therefore acts as
 an additional hook and currently accepts all inputs.
 }
 
-@section{Opening}
+@section[#:tag "mp3-decoder-opening"]{Opening}
 
 @defproc[(mp3-open [mp3-file* (or/c path? string?)]
                    [cb-stream-info procedure?]
@@ -68,7 +68,7 @@ where info is a mutable hash containing at least:
  @item{'total-samples}]
 }
 
-@section{Reading}
+@section[#:tag "mp3-decoder-reading"]{Reading}
 
 @defproc[(mp3-read [handle struct?]) any/c]{
 
@@ -104,7 +104,7 @@ After termination, the underlying decoder is closed and released.
 The return value is otherwise unspecified.
 }
 
-@section{Seeking}
+@section[#:tag "mp3-decoder-seeking"]{Seeking}
 
 @defproc[(mp3-seek [handle struct?]
                    [percentage number?])
@@ -127,7 +127,7 @@ If the total number of samples is unavailable or equal to -1, this
 procedure has no effect.
 }
 
-@section{Stopping}
+@section[#:tag "mp3-decoder-stopping"]{Stopping}
 
 @defproc[(mp3-stop [handle struct?]) void?]{
 
@@ -137,7 +137,7 @@ The procedure sets an internal stop flag and waits until the read loop
 has terminated, sleeping briefly between checks.
 }
 
-@section{Notes}
+@section[#:tag "mp3-decoder-notes"]{Notes}
 
 The stream-info hash is shared between initialization and decoding and
 is updated in place during playback.

scrbl/opusfile-decoder.scrbl

@@ -0,0 +1,196 @@
+#lang scribble/manual
+
+@(require racket/base
+          (for-label racket/base
+                     racket/contract
+                     racket/path
+                     "../opusfile-decoder.rkt"))
+
+@title{opusfile-decoder}
+@author[@author+email["Hans Dijkema" "hans@dijkewijk.nl"]]
+
+@defmodule[racket-audio/opusfile-decoder]
+
+This module provides an Opus decoder backend based on Xiph
+@tt{libopusfile}. It opens Ogg Opus files, reports stream information
+through a callback, streams decoded interleaved PCM buffers, and supports
+stopping and seeking.
+
+The module is intended to be used through
+@racketmodname[racket-audio/audio-decoder], but its procedures can also
+be used directly.
+
+Opus decoding produces 48 kHz PCM. The original input rate stored in an
+Opus file, if present, is not the decoder output sample rate.
+
+@section{Availability}
+
+@defproc[(opusfile-available?) boolean?]{
+
+Returns @racket[#t] if @tt{libopusfile} and the native procedures used
+by this backend could be loaded, and @racket[#f] otherwise.
+
+The generic @racketmodname[racket-audio/audio-decoder] module prefers
+this decoder for Opus streams when it is available. If it is not
+available, Opus files may still be handled by the FFmpeg backend if that
+backend is available.
+}
+
+@section{Output format setting}
+
+@defproc[(opusfile-output-format? [v any/c]) boolean?]{
+
+Returns @racket[#t] when @racket[v] is one of the supported Opus decoder
+output formats: @racket['s16] or @racket['s24].
+}
+
+@defthing[current-opusfile-output-format procedure?]{
+
+A global output-format setting for this decoder.
+
+Called without arguments, it returns the current output format. Called
+with one argument, it sets the current output format and returns the new
+value. The accepted values are:
+
+@itemlist[#:style 'compact
+ @item{@racket['s16] --- signed 16-bit interleaved PCM. This is the
+       default. The backend uses @tt{op_read}.}
+ @item{@racket['s24] --- packed signed 24-bit interleaved PCM in native
+       byte order. The backend uses @tt{op_read_float} and converts the
+       float samples to 24-bit PCM.}]
+
+The setting is global. It is read when stream format hashes are produced
+and when audio buffers are decoded. For normal use, set it before
+opening or reading an Opus file.
+
+Example:
+
+@racketblock[
+(current-opusfile-output-format 's24)
+]
+
+This binding is also re-exported by
+@racketmodname[racket-audio/audio-decoder] and by
+@racketmodname[racket-audio].
+}
+
+@section[#:tag "opusfile-decoder-validation"]{Validation}
+
+@defproc[(opusfile-valid? [audio-file any/c]) boolean?]{
+
+Returns @racket[#t] when @tt{libopusfile} is available and
+@racket[audio-file] exists.
+
+This predicate is deliberately small. Detailed validation is performed
+when the file is opened by @racket[opusfile-open]. The generic decoder
+layer also performs extension and existence checks before opening a file.
+}
+
+@section[#:tag "opusfile-decoder-opening"]{Opening}
+
+@defproc[(opusfile-open [audio-file (or/c path? string?)]
+                        [cb-stream-info procedure?]
+                        [cb-audio procedure?])
+         (or/c struct? #f)]{
+
+Opens @racket[audio-file] with @tt{libopusfile} and returns an opaque
+Opus decoder handle. If @racket[audio-file] is a path, it is converted
+with @racket[path->string]. If the file does not exist, the result is
+@racket[#f].
+
+If @tt{libopusfile} cannot be loaded, an exception is raised. If the
+file exists but cannot be opened by @tt{libopusfile}, an exception is
+raised with the native Opusfile error code.
+
+The stream-info callback is called once after the file has been opened:
+
+@racketblock[
+(cb-stream-info info)
+]
+
+where @racket[info] is a mutable hash containing at least:
+
+@itemlist[#:style 'compact
+ @item{@racket['duration] --- duration in seconds, based on the total
+       number of decoded PCM samples when available;}
+ @item{@racket['sample-rate] --- always @racket[48000];}
+ @item{@racket['channels] --- number of decoded channels;}
+ @item{@racket['bits-per-sample] --- @racket[16] for @racket['s16] and
+       @racket[24] for @racket['s24];}
+ @item{@racket['bytes-per-sample] --- @racket[2] for @racket['s16] and
+       @racket[3] for @racket['s24];}
+ @item{@racket['sample-format] --- the value of
+       @racket[current-opusfile-output-format];}
+ @item{@racket['total-samples] --- total number of decoded PCM samples,
+       or the value reported by @tt{libopusfile}.}]
+}
+
+@section[#:tag "opusfile-decoder-reading"]{Reading}
+
+@defproc[(opusfile-read [handle struct?]) any/c]{
+
+Starts the decode loop for @racket[handle].
+
+The loop repeatedly decodes audio blocks and invokes the audio callback:
+
+@racketblock[
+(cb-audio info buffer size)
+]
+
+where @racket[info] is the mutable stream-info hash, @racket[buffer] is
+an interleaved PCM buffer, and @racket[size] is the buffer size in bytes.
+Before each callback, the info hash is updated in place with:
+
+@itemlist[#:style 'compact
+ @item{@racket['sample] --- the current decoded sample position;}
+ @item{@racket['current-time] --- the current decoded time in seconds.}]
+
+The buffer format is determined by
+@racket[current-opusfile-output-format]. In @racket['s16] mode the
+buffer contains signed 16-bit PCM. In @racket['s24] mode the buffer
+contains packed signed 24-bit PCM.
+
+The loop also checks for a pending seek request. If a seek has been
+requested with @racket[opusfile-seek], it is applied before the next
+read from @tt{libopusfile}.
+
+The loop terminates at end-of-stream or when a stop has been requested
+with @racket[opusfile-stop]. After termination, the underlying
+@tt{libopusfile} handle is freed.
+}
+
+@section[#:tag "opusfile-decoder-seeking"]{Seeking}
+
+@defproc[(opusfile-seek [handle struct?]
+                         [percentage number?])
+         void?]{
+
+Requests a seek within the stream.
+
+The @racket[percentage] argument represents a position relative to the
+full stream, where @racket[0] is the start and @racket[100] is the end.
+The value may be fractional and is clamped to that range.
+
+If the total sample count is known and non-zero, the procedure computes
+a target decoded sample and stores it as a pending seek request. The
+actual native seek is performed later by @racket[opusfile-read].
+}
+
+@section[#:tag "opusfile-decoder-stopping"]{Stopping}
+
+@defproc[(opusfile-stop [handle struct?]) void?]{
+
+Requests termination of an active @racket[opusfile-read] loop.
+
+The procedure sets an internal stop flag and waits until the read loop
+has terminated, sleeping briefly between checks.
+}
+
+@section[#:tag "opusfile-decoder-notes"]{Notes}
+
+The Opusfile backend is registered in
+@racketmodname[racket-audio/audio-decoder] as reader type
+@racket['opusfile] for files and streams recognized as Opus.
+
+The generic decoder callbacks therefore receive @racket['opusfile] as
+@racket[audio-type] and @racket['ao] as @racket[ao-type].

scrbl/placed-player-state-model-2.plantuml

@@ -0,0 +1,91 @@
+@startuml
+!theme plain
+hide empty description
+top to bottom direction
+
+title Placed audio player - public state model
+
+skinparam backgroundColor transparent
+skinparam shadowing false
+skinparam roundcorner 14
+skinparam ArrowThickness 1.2
+skinparam DefaultFontName "DejaVu Sans"
+skinparam DefaultFontSize 13
+
+skinparam state {
+  BackgroundColor #F8F8F8
+  BorderColor #555555
+  FontColor #222222
+  StartColor #555555
+  EndColor #555555
+
+  BackgroundColor<<blue>> #DCEEFF
+  BorderColor<<blue>> #3A7FC4
+  FontColor<<blue>> #123A63
+
+  BackgroundColor<<green>> #E3F6E3
+  BorderColor<<green>> #3C9D40
+  FontColor<<green>> #1E5C22
+
+  BackgroundColor<<purple>> #F0E6FF
+  BorderColor<<purple>> #8A5CC2
+  FontColor<<purple>> #4B2A73
+
+  BackgroundColor<<orange>> #FFE8CC
+  BorderColor<<orange>> #D8842A
+  FontColor<<orange>> #7A4A12
+
+  BackgroundColor<<red>> #FFE5E5
+  BorderColor<<red>> #CC3333
+  FontColor<<red>> #7A1F1F
+}
+
+state NotInitialized <<purple>>
+state FatalError <<red>>
+state Terminated <<purple>>
+
+[*] -[#8A5CC2]-> NotInitialized
+
+NotInitialized -[#3A7FC4]-> Initialized : init
+NotInitialized -[#CC3333]-> FatalError : command before init
+
+state Initialized {
+
+  [*] -[#3A7FC4]-> Stopped
+
+  state Stopped <<blue>> {
+    Stopped : volume(p) / set volume
+    Stopped : stop / ignore
+  }
+
+  state Playing <<orange>> {
+    Playing : seek(p) / seek decoder
+    Playing : volume(p) / set volume
+  }
+
+  state Paused <<green>> {
+    Paused : seek(p) / seek decoder
+    Paused : volume(p) / set volume
+  }
+
+  Stopped -[#D8842A]-> Playing : open(file)
+
+  Playing -[#3C9D40]-> Paused : pause #t
+  Paused -[#D8842A]-> Playing : pause #f
+
+  Playing -[#3A7FC4]-> Stopped : audio done
+  Playing -[#3A7FC4]-> Stopped : stop
+  Paused -[#3A7FC4]-> Stopped : stop
+
+  Playing -[#D8842A]-> Playing : open(new-file)
+
+  Playing -[#3A7FC4]-> Stopped : worker exception
+  Paused -[#3A7FC4]-> Stopped : worker exception
+}
+
+Initialized -[#8A5CC2]-> Terminated : quit / cleanup
+
+FatalError -[#555555]-> [*]
+Terminated -[#555555]-> [*]
+
+@enduml

scrbl/play-test.scrbl

@@ -0,0 +1,206 @@
+#lang scribble/manual
+
+@(require (for-label racket/base
+                     racket/path
+                     early-return
+                     simple-log
+                     "../audio-player.rkt"))
+
+@title{Playback Test Program}
+@author[@author+email["Hans Dijkema" "hans@dijkewijk.nl"]]
+
+
+@defmodule[racket-audio/play-test]
+
+The @racketmodname[racket-audio/play-test] module is a small integration test and
+usage example for @racketmodname[racket-audio/audio-player].  It is not the public
+playback API itself; normal applications should use @racketmodname[racket-audio/audio-player]
+directly.  This module shows how a program can create an audio player, observe
+state updates, react to end-of-stream events, and use the EOF callback to drive
+a simple playback queue.
+
+The test is intentionally close to the way an application would use the high
+level player API.  It creates one player handle with @racket[make-audio-player],
+prints compact progress information from the state callback, and starts the
+next file from the EOF callback when queue mode is enabled.
+
+@section{Purpose}
+
+The test exercises three parts of the player wrapper:
+
+@itemlist[#:style 'compact
+ @item{state callback handling, including cached position, duration, buffer
+       size, volume, and logical player state;}
+ @item{EOF callback handling, including starting another file after the
+       current stream has reached decoder end-of-stream;}
+ @item{place based playback through @racket[make-audio-player]'s
+       @racket[#:use-place] argument.}]
+
+The file depends on @filepath{tests.rkt} for the concrete test files, such as
+@racket[test-file2], @racket[test-file3], and @racket[test-file4].  The test
+therefore documents the integration pattern rather than a portable standalone
+program.
+
+@section{Selecting the test mode}
+
+The module contains a small mode variable:
+
+@racketblock[
+(define run-queue #f)
+
+(define (set-test a)
+  (set! run-queue a))]
+
+When @racket[run-queue] is @racket['queue], the EOF callback consumes files
+from @racket[play-queue].  When it is @racket['once], the first EOF callback
+starts @racket[test-file3] once and then disables that mode.  With the default
+@racket[#f] value, the final kickoff call does not start playback.
+
+For queue playback, select queue mode before the kickoff call:
+
+@racketblock[
+(set-test 'queue)]
+
+In the current test file the kickoff is performed by calling the EOF callback
+manually at the end of the module.  That is a convenient test idiom: the same
+callback that advances the queue after a stream has finished is also reused to
+start the first stream.
+
+@section{Queue setup}
+
+The queue itself is a simple list of path values supplied by
+@filepath{tests.rkt}:
+
+@racketblock[
+(define play-queue (list test-file2 test-file3 test-file4))]
+
+The queue is destructive in the ordinary Racket sense: each successful EOF
+advance starts @racket[(car play-queue)] and then updates @racket[play-queue]
+to @racket[(cdr play-queue)].  When the queue is empty, the callback shuts the
+player down with @racket[audio-quit!].
+
+@section{Formatting state output}
+
+The helper @racket[to-time-str] turns a second count into a compact
+@tt{mm:ss} string:
+
+@racketblock[
+(define (to-time-str s*)
+  (let* ((s (round s*))
+         (minutes (quotient s 60))
+         (seconds (remainder s 60)))
+    (sprintf "%02d:%02d" minutes seconds)))]
+
+The state callback uses this helper to print progress lines that are easier to
+read than raw seconds.
+
+@section{State callback}
+
+The state callback has the shape expected by @racket[make-audio-player]:
+
+@racketblock[
+(define (audio-player-state h st)
+  ...)]
+
+The first argument is the player handle and the second argument is the state
+hash received from the worker side.  The callback begins with an
+@racket[early-return] guard:
+
+@racketblock[
+(early-return
+ ((? (not (audio-play? h)) => 'done))
+ ...)]
+
+This avoids using a handle after it has been invalidated, for example after
+@racket[audio-quit!].  The rest of the callback reads the current file name,
+position, duration, logical player state, volume, buffer size, and diagnostic
+message.  It prints at most one line per rounded second by comparing the
+current second with @racket[current-sec].
+
+The output line is deliberately compact.  It contains the current file name,
+music id, playback time, duration, logical state, volume, buffer size, and the
+message stored in the state hash.
+
+@section{EOF callback and queue advancement}
+
+The EOF callback is where the queue behaviour is implemented:
+
+@racketblock[
+(define (audio-player-eof h)
+  (dbg-sound "audio-player-eof called")
+  (when (eq? run-queue 'queue)
+    (if (null? play-queue)
+        (audio-quit! h)
+        (begin
+          (audio-play! h (car play-queue))
+          (set! play-queue (cdr play-queue))))))]
+
+In queue mode, an empty queue means that playback is finished and the player is
+closed with @racket[audio-quit!].  Otherwise the next file is started with
+@racket[audio-play!] and removed from the queue.
+
+The same callback also contains a small @racket['once] mode:
+
+@racketblock[
+(when (eq? run-queue 'once)
+  (set! run-queue #f)
+  (audio-play! h test-file3))]
+
+That mode is useful when testing a single explicit transition from an EOF event
+to a new file.
+
+@section{Creating the player}
+
+The test creates the player with the two callbacks and an explicit place-mode
+flag:
+
+@racketblock[
+(define place-mode #t)
+
+(define h
+  (make-audio-player audio-player-state
+                     audio-player-eof
+                     #:use-place place-mode))]
+
+With @racket[place-mode] set to @racket[#t], the player runs the playback side
+in a separate place.  This is the normal robustness mode for audio playback,
+because the decoder and audio feeder run in a separate Racket VM.  Setting
+@racket[place-mode] to @racket[#f] runs the same command loop in a Racket
+thread with ordinary asynchronous channels, which can be easier to debug from
+DrRacket.
+
+@section{Starting the test}
+
+At the end of the module, logging is sent to the display and the EOF callback
+is called once by hand:
+
+@racketblock[
+(sl-log-to-display)
+(audio-player-eof h)]
+
+Calling @racket[audio-player-eof] manually may look unusual, but it keeps the
+queue logic in one place.  The first call starts the first queued file; later
+calls are made by the player wrapper when the decoder reports end-of-stream.
+
+A typical queue test therefore looks like this in the source:
+
+@racketblock[
+(set-test 'queue)
+
+(sl-log-to-display)
+(audio-player-eof h)]
+
+@section{Integration pattern}
+
+The important pattern for an application is not the global variables in the
+test file, but the division of responsibility:
+
+@itemlist[#:style 'compact
+ @item{create one player with @racket[make-audio-player];}
+ @item{keep display or application state in the state callback;}
+ @item{keep queue advancement in the EOF callback;}
+ @item{use @racket[audio-play!] to start the next file;}
+ @item{use @racket[audio-quit!] when the queue is exhausted.}]
+
+An application will usually wrap the queue in its own data structure instead of
+using a top-level mutable list, but the control flow is the same.

scrbl/play-workerthread-states.plantuml

@@ -0,0 +1,123 @@
+@startuml
+!theme plain
+hide empty description
+
+title Placed audio player - command loop and worker detail
+
+skinparam backgroundColor transparent
+skinparam shadowing false
+skinparam roundcorner 14
+skinparam ArrowThickness 1.2
+skinparam DefaultFontName "DejaVu Sans"
+skinparam DefaultFontSize 13
+
+skinparam state {
+  BackgroundColor #F8F8F8
+  BorderColor #555555
+  FontColor #222222
+  StartColor #555555
+  EndColor #555555
+
+  BackgroundColor<<blue>> #DCEEFF
+  BorderColor<<blue>> #3A7FC4
+  FontColor<<blue>> #123A63
+
+  BackgroundColor<<green>> #E3F6E3
+  BorderColor<<green>> #3C9D40
+  FontColor<<green>> #1E5C22
+
+  BackgroundColor<<orange>> #FFE8CC
+  BorderColor<<orange>> #D8842A
+  FontColor<<orange>> #7A4A12
+
+  BackgroundColor<<red>> #FFE5E5
+  BorderColor<<red>> #CC3333
+  FontColor<<red>> #7A1F1F
+
+  BackgroundColor<<gray>> #F2F2F2
+  BorderColor<<gray>> #888888
+  FontColor<<gray>> #444444
+}
+
+state "Command loop:\nreplace active worker" as A <<gray>> {
+  [*] -down-> CurrentWorkerActive
+
+  state "Current worker active" as CurrentWorkerActive <<orange>>
+  state "Interrupt requested" as InterruptRequested <<green>>
+  state "Waiting for worker" as WaitingForWorker <<green>>
+  state "Starting new worker" as StartingNewWorker <<orange>>
+  state "New worker active" as NewWorkerActive <<orange>>
+
+  InterruptRequested : entry / feed-interrupted := #t
+  InterruptRequested : entry / ao-clear-async
+  InterruptRequested : entry / player-state := stopped
+  InterruptRequested : entry / audio-stop
+
+  WaitingForWorker : do / wait until feeding-audio = #f
+  
+  StartingNewWorker : entry / thread-wait
+  StartingNewWorker : entry / audio-open
+  StartingNewWorker : entry / player-state := playing
+  StartingNewWorker : entry / spawn worker
+
+  CurrentWorkerActive -down-> InterruptRequested : open(new)
+  InterruptRequested -down-> WaitingForWorker
+  WaitingForWorker -down-> StartingNewWorker : ready
+  StartingNewWorker -down-> NewWorkerActive
+
+  NewWorkerActive -down-> [*]
+}
+
+state "Worker thread lifecycle" as B <<gray>> {
+  [*] -down-> WorkerIdle
+
+  state "WorkerIdle" as WorkerIdle <<blue>>
+  state "WorkerExited" as WorkerExited <<blue>>
+  state "WorkerFailed" as WorkerFailed <<red>>
+
+  WorkerIdle -down-> C : open(file)\n/ audio-open\nspawn worker
+
+  state "Worker active" as C <<orange>> {
+    C : entry / feeding-audio := #t
+    C : exit / feeding-audio := #f
+
+    [*] -right-> Reading
+
+    state "Reading" as Reading <<orange>>
+    state "DrainingAO" as DrainingAO <<green>>
+    state "MarkStopped" as MarkStopped <<blue>>
+    state "WorkerDone" as WorkerDone <<blue>>
+
+    Reading : do / audio-read
+    Reading : pause #t / ao-pause #t and wait
+    Reading : pause #f / ao-pause #f
+
+    DrainingAO : do / wait until AO queue drains
+    DrainingAO : pause #t / ao-pause #t
+    DrainingAO : pause #f / ao-pause #f
+
+    Reading -right-> DrainingAO : audio-read returns\n[not feed-interrupted]\n/ emit audio-done
+    DrainingAO -right-> MarkStopped : [AO queue empty\nand file-id is current]
+    MarkStopped -right-> WorkerDone : / player-state := stopped
+    WorkerDone -right-> [*]
+
+    Reading -down-> WorkerDone : [feed-interrupted]\n/ feed-interrupted := #f
+    DrainingAO -down-> WorkerDone : [AO closed,\nqueue grows,\nor old file-id]
+
+    note bottom of DrainingAO
+      The file-id check prevents an old worker
+      from stopping a newly opened file.
+    end note
+  }
+
+  C -down-> WorkerExited : worker exits
+  C -down-> WorkerFailed : exception\n/ emit exception\nplayer-state := stopped
+
+  WorkerExited -down-> [*]
+  WorkerFailed -down-> [*]
+}
+
+A -[hidden]right-> B
+
+
+@enduml

scrbl/racket-audio.scrbl

@@ -0,0 +1,39 @@
+#lang scribble/manual
+
+@(require racket/runtime-path
+          scribble/core
+          scribble/html-properties)
+
+@(define-runtime-path rktplayer-logo "rktplayer.svg")
+
+@(define title-logo-style
+   (style #f
+          (list (attributes
+                 '((style . "float: right; margin-left: 1.5em; margin-bottom: 0.5em;"))))))
+
+@elem[#:style title-logo-style]{@image[#:scale 0.25 rktplayer-logo]}
+
+@title{@elem{racket-audio}}
+
+@table-of-contents[]
+
+@include-section["intro.scrbl"]
+@include-section["audio-player.scrbl"]
+@include-section["audio-sniffer.scrbl"]
+@include-section["taglib.scrbl"]
+@include-section["audio-encoder.scrbl"]
+@include-section["resampler.scrbl"]
+@include-section["encoder-test.scrbl"]
+@include-section["play-test.scrbl"]
+@include-section["audio-placed-player.scrbl"]
+@include-section["audio-decoder.scrbl"]
+@include-section["libao-async-ffi-racket.scrbl"]
+@include-section["flac-decoder.scrbl"]
+@include-section["opusfile-decoder.scrbl"]
+@include-section["mp3-decoder.scrbl"]
+@include-section["ffmpeg-decoder.scrbl"]
+@include-section["libao.scrbl"]
+@include-section["ffmpeg-definitions.scrbl"]
+@include-section["ffmpeg-ffi.scrbl"]
+
+@index-section[]

scrbl/resampler.scrbl

@@ -0,0 +1,101 @@
+#lang scribble/manual
+
+@title{PCM resampling with SoXR}
+
+@defmodule[racket-audio/resampler]
+
+This module provides a small Racket wrapper around @tt{libsoxr}.  It is meant
+for interleaved PCM buffers such as stereo @tt{L R L R ...} data.  It supports
+sample-rate conversion and the PCM datatypes that SoXR can process directly:
+@racket['s16], @racket['s32], @racket['float32] and @racket['float64].  Packed
+24-bit PCM is supported by the wrapper by expanding @racket['s24] input to
+@racket['s32] before calling SoXR and packing @racket['s32] output back to
+@racket['s24] afterwards.
+
+SoXR does not perform general channel-layout conversion in this wrapper.  Use it
+for unchanged channel counts, for example mono-to-mono or stereo-to-stereo.
+
+@defproc[(resampler-available?) boolean?]{
+Returns @racket[#t] when @tt{libsoxr} was loaded.
+}
+
+@defproc[(resampler-version) string?]{
+Returns the version string reported by @tt{libsoxr}.
+}
+
+@defproc[(make-resampler
+          [input-rate exact-positive-integer?]
+          [output-rate exact-positive-integer?]
+          [channels exact-positive-integer?]
+          [#:input-format input-format symbol? 's32]
+          [#:output-format output-format symbol? 's32]
+          [#:quality quality symbol? 'hq]
+          [#:phase phase symbol? 'linear]
+          [#:steep-filter? steep-filter? boolean? #f]
+          [#:scale scale real? 1.0]
+          [#:no-dither? no-dither? boolean? #f]
+          [#:num-threads num-threads exact-positive-integer? 1])
+         resampler?]{
+Creates a streaming resampler.  The supported PCM formats are @racket['s16],
+@racket['s24], @racket['s32], @racket['float32] and @racket['float64].
+
+The quality value selects a SoXR resampling recipe.  Useful values are
+@racket['qq], @racket['lq], @racket['mq], @racket['hq], @racket['vhq],
+@racket['16-bit], @racket['20-bit], @racket['24-bit], @racket['28-bit] and
+@racket['32-bit].  The @racket['24-bit] quality recipe is a filter precision
+setting; it is not the same thing as 24-bit PCM output.  Use
+@racket[#:output-format 's24] for packed 24-bit output.
+}
+
+@defproc[(resampler-convert
+          [r resampler?]
+          [buffer bytes?]
+          [size exact-nonnegative-integer? (bytes-length buffer)])
+         (values bytes? exact-nonnegative-integer?)]{
+Feeds interleaved PCM bytes to the resampler and returns converted PCM bytes and
+the number of output frames.  A frame contains one sample for each channel.
+}
+
+@defproc[(resampler-drain [r resampler?])
+         (values bytes? exact-nonnegative-integer?)]{
+Flushes delayed output after the last input block and returns converted bytes and
+frames.
+}
+
+@defproc[(resampler-clear! [r resampler?]) boolean?]{
+Clears the resampler state so the same instance can be reused for a fresh signal
+with the same configuration.
+}
+
+@defproc[(resampler-close! [r resampler?]) boolean?]{
+Releases the native SoXR resampler.  Calling this more than once is harmless.
+}
+
+@defproc[(resample-bytes
+          [buffer bytes?]
+          [input-rate exact-positive-integer?]
+          [output-rate exact-positive-integer?]
+          [channels exact-positive-integer?]
+          [#:size size exact-nonnegative-integer? (bytes-length buffer)]
+          [#:input-format input-format symbol? 's32]
+          [#:output-format output-format symbol? 's32]
+          [#:quality quality symbol? 'hq]
+          [#:phase phase symbol? 'linear]
+          [#:steep-filter? steep-filter? boolean? #f]
+          [#:scale scale real? 1.0]
+          [#:no-dither? no-dither? boolean? #f]
+          [#:num-threads num-threads exact-positive-integer? 1])
+         (values bytes? exact-nonnegative-integer?)]{
+Convenience function for one buffer.  It creates a resampler, processes the
+input, drains delayed samples and closes the native state.
+}
+
+@defproc[(pcm-format? [v any/c]) boolean?]{
+Returns whether @racket[v] is one of the supported PCM format symbols.
+}
+
+@defproc[(pcm-format-sample-bytes [fmt symbol?]) exact-positive-integer?]{
+Returns the packed sample size in bytes for @racket[fmt].  For @racket['s24]
+this is @racket[3], even though the wrapper internally expands to 32-bit samples
+for SoXR.
+}

scrbl/rktplayer.svg

@@ -0,0 +1,73 @@
+<?xml version="1.0" encoding="UTF-8" standalone="no"?>
+<!-- Generator: Adobe Illustrator 15.1.0, SVG Export Plug-In . SVG Version: 6.00 Build 0)  -->
+
+<svg
+   version="1.1"
+   id="circle_pieces"
+   x="0px"
+   y="0px"
+   width="700"
+   height="700"
+   viewBox="0 0 700 699.99999"
+   enable-background="new 0 0 511.875 511.824"
+   xml:space="preserve"
+   sodipodi:docname="rktplayer.svg"
+   inkscape:version="1.4.3 (0d15f75042, 2025-12-25)"
+   inkscape:export-filename="rktplayer.png"
+   inkscape:export-xdpi="96"
+   inkscape:export-ydpi="96"
+   xmlns:inkscape="http://www.inkscape.org/namespaces/inkscape"
+   xmlns:sodipodi="http://sodipodi.sourceforge.net/DTD/sodipodi-0.dtd"
+   xmlns="http://www.w3.org/2000/svg"
+   xmlns:svg="http://www.w3.org/2000/svg"><defs
+   id="defs1" /><sodipodi:namedview
+   id="namedview1"
+   pagecolor="#ffffff"
+   bordercolor="#000000"
+   borderopacity="0.25"
+   inkscape:showpageshadow="2"
+   inkscape:pageopacity="0.0"
+   inkscape:pagecheckerboard="0"
+   inkscape:deskcolor="#d1d1d1"
+   inkscape:zoom="2.6152606"
+   inkscape:cx="442.21215"
+   inkscape:cy="327.30964"
+   inkscape:window-width="3840"
+   inkscape:window-height="2088"
+   inkscape:window-x="0"
+   inkscape:window-y="0"
+   inkscape:window-maximized="1"
+   inkscape:current-layer="g2" />
+
+
+
+
+<g
+   id="g2"><ellipse
+     style="fill:#ffffff;stroke:none;stroke-width:12.2336"
+     id="path5"
+     cx="340.64243"
+     cy="411.03333"
+     rx="224.86732"
+     ry="244.94084" /><path
+     id="blue-piece"
+     fill="#3e5ba9"
+     d="m 517.53252,561.05183 c 29.98772,-41.38652 47.87279,-93.56675 47.87279,-150.27611 0,-134.46841 -100.55629,-243.4773 -224.59995,-243.4773 -26.98291,0 -52.853,5.16309 -76.82046,14.61962 91.18247,51.85123 211.79537,221.0202 253.54762,379.13379 z"
+     style="stroke-width:0.923962" /><path
+     id="left-red-piece"
+     fill="#9f1d20"
+     d="m 308.63814,322.60871 c -35.03626,-40.91705 -74.27268,-73.41269 -115.82881,-94.96454 -46.95076,44.62655 -76.60304,110.12097 -76.60304,183.13155 0,61.38953 20.9662,117.46493 55.54987,160.29253 30.48734,-99.2955 87.80229,-195.00079 136.88198,-248.45954 z"
+     style="stroke-width:0.923962" /><path
+     id="bottom-red-piece"
+     fill="#9f1d20"
+     d="M 350.023,377.81831 C 301.39945,434.6258 252.94628,534.06945 235.41085,625.818 c 31.43155,18.14057 67.30198,28.43598 105.3954,28.43598 39.16364,0 75.97918,-10.87646 108.03459,-29.97904 C 430.36385,531.72504 395.48556,446.9645 350.023,377.81831 Z"
+     style="stroke-width:0.923962" /><path
+     d="m 130.9,323.08501 c 19.13656,-1.81007 36.94048,13.59009 40.79155,36.14648 l 27.27181,159.74052 c 4.10781,24.06017 -9.2145,47.15353 -29.75784,51.57967 -20.54206,4.42609 -46.83685,-11.17988 -50.94473,-35.24153 L 90.989079,375.57159 c -4.107817,-24.06018 15.527281,-47.46572 36.069341,-51.8918 1.28388,-0.27664 2.5658,-0.47409 3.84158,-0.59478 z"
+     style="stroke-width:3;stroke-linejoin:round;fill:#999999;stroke:#000000;stroke-opacity:1;stroke-dasharray:none"
+     id="path12" /><path
+     d="m 564.07865,327.18539 c -19.13791,-1.79576 -36.9303,13.61771 -40.76451,36.17698 l -27.15231,159.76087 c -4.08982,24.06324 9.24977,47.14663 29.7964,51.5574 20.54537,4.41072 46.82848,-11.2149 50.91837,-35.27963 L 604.02882,379.6421 c 4.08982,-24.06324 -15.56278,-47.45409 -36.10814,-51.86481 -1.28409,-0.27567 -2.56616,-0.47217 -3.84203,-0.5919 z"
+     style="stroke-width:3;stroke-linejoin:round;fill:#999999;stroke:#000000;stroke-opacity:1;stroke-dasharray:none"
+     id="path12-5" /><path
+     d="m 343.63672,38.474609 c 0,0 -324.531251,-6.13e-4 -324.531251,295.406251 0,132.9331 34.615466,177.24529 51.923828,192.01562 0,0 51.925783,29.54031 34.619143,-11.07812 0,-34.17562 -17.310549,-107.08399 -17.310549,-107.08399 0,0 -17.308594,-0.002 -17.308594,-73.85351 0,-88.62206 69.234883,-243.708985 259.626953,-243.708985 h 34.61523 c 190.39209,0 259.62696,155.086925 259.62696,243.708985 0,73.85171 -17.3086,73.85351 -17.3086,73.85351 0,0 -17.31054,72.90837 -17.31054,107.08399 -17.30663,40.61843 34.61914,11.07812 34.61914,11.07812 17.30837,-14.77033 51.92383,-59.08252 51.92383,-192.01562 0,-295.406864 -324.53125,-295.406251 -324.53125,-295.406251 z"
+     style="stroke-width:3;stroke-linejoin:round;fill:#cccccc;stroke:#000000;stroke-opacity:1;stroke-dasharray:none"
+     id="path11" /></g></svg>

scrbl/taglib.scrbl

@@ -0,0 +1,339 @@
+#lang scribble/manual
+
+@(require (for-label racket/base
+                     racket/contract
+                     racket/path
+                     racket/draw
+                     "../taglib.rkt"))
+
+@title{TagLib Metadata}
+@author[@author+email["Hans Dijkema" "hans@dijkewijk.nl"]]
+
+@defmodule[racket-audio/taglib]
+
+The @racketmodname[racket-audio/taglib] module provides the high level metadata
+API used by the audio package.  It wraps the lower level TagLib C FFI module and
+presents a Racket API for common tags, generic properties, audio properties, and
+embedded cover art.
+
+The module can be used in two modes.  The default mode is read-only and returns
+a snapshot of the metadata.  A handle opened with @racket[#:mode 'read-write]
+keeps the native TagLib file open and can be modified with the setter
+procedures documented below.  Changes are written to the media file by calling
+@racket[tags-save!].
+
+The name @racket[id3-tags] is historical.  The implementation uses TagLib, so
+the usable file types are the file types supported by the TagLib library
+available at run time.
+
+@section{Opening and closing tag handles}
+
+@defproc[(id3-tags [file path-string?]
+                   [#:mode mode (or/c 'read 'read-only 'read-write 'write) 'read])
+         any/c]{
+Opens @racket[file] through TagLib and returns an opaque tag handle.  In the
+default read-only mode, the module copies the values needed on the Racket side,
+frees the native TagLib objects, and returns a snapshot handle.
+
+In read-write mode, the native TagLib file remains open.  Setter procedures may
+then be used to modify fields, properties, and pictures.  Call
+@racket[tags-save!] to write changes and @racket[tags-close!] to close the
+native handle.
+
+On Windows, the implementation retries with the wide-character TagLib open
+function when the normal open function does not produce a valid TagLib file.}
+
+@defproc[(call-with-id3-tags [file path-string?]
+                             [proc procedure?]
+                             [#:mode mode (or/c 'read 'read-only 'read-write 'write) 'read])
+         any/c]{
+Opens @racket[file], calls @racket[proc] with the tag handle, and closes the
+handle afterwards with @racket[tags-close!].  This is most useful for
+read-write code because it avoids leaking the native TagLib file handle.}
+
+@deftogether[
+(@defproc[(tags-valid? [tags any/c]) boolean?]
+ @defproc[(tags-read-write? [tags any/c]) boolean?]
+ @defproc[(tags-closed? [tags any/c]) boolean?])]{
+Return handle state.  @racket[tags-valid?] reports whether TagLib opened the
+file successfully.  @racket[tags-read-write?] reports whether the handle was
+opened in read-write mode.  @racket[tags-closed?] reports whether the native
+TagLib file handle has been closed.}
+
+@deftogether[
+(@defproc[(tags-save! [tags any/c]) boolean?]
+ @defproc[(tags-close! [tags any/c]) void?])]{
+@racket[tags-save!] writes pending changes for a read-write handle to the media
+file.  @racket[tags-close!] closes the native TagLib file handle.  Closing a
+read-only snapshot is harmless.
+}
+
+@racketblock[
+(call-with-id3-tags "track.flac"
+  (lambda (tags)
+    (when (tags-valid? tags)
+      (tags-title! tags "New title")
+      (tags-save! tags)))
+  #:mode 'read-write)]
+
+@section{Common tag fields}
+
+@deftogether[
+(@defproc[(tags-title [tags any/c]) string?]
+ @defproc[(tags-album [tags any/c]) string?]
+ @defproc[(tags-artist [tags any/c]) string?]
+ @defproc[(tags-comment [tags any/c]) string?]
+ @defproc[(tags-genre [tags any/c]) string?])]{
+Return the common textual fields from the TagLib tag interface.  Missing fields
+are returned as the empty string.}
+
+@deftogether[
+(@defproc[(tags-year [tags any/c]) integer?]
+ @defproc[(tags-track [tags any/c]) integer?])]{
+Return the year and track number from the common TagLib tag interface.  Missing
+numeric values are returned as @racket[-1].}
+
+@deftogether[
+(@defproc[(tags-title! [tags any/c] [value (or/c string? 'clear)]) void?]
+ @defproc[(tags-album! [tags any/c] [value (or/c string? 'clear)]) void?]
+ @defproc[(tags-artist! [tags any/c] [value (or/c string? 'clear)]) void?]
+ @defproc[(tags-comment! [tags any/c] [value (or/c string? 'clear)]) void?]
+ @defproc[(tags-genre! [tags any/c] [value (or/c string? 'clear)]) void?])]{
+Set common textual fields on a read-write handle.  Passing @racket['clear]
+clears the field.  Call @racket[tags-save!] to persist the change.}
+
+@deftogether[
+(@defproc[(tags-year! [tags any/c] [value (or/c exact-nonnegative-integer? 'clear)]) void?]
+ @defproc[(tags-track! [tags any/c] [value (or/c exact-nonnegative-integer? 'clear)]) void?])]{
+Set numeric common fields on a read-write handle.  Passing @racket['clear]
+writes zero through the TagLib C API and updates the Racket-side cache to
+@racket[-1].}
+
+@section{Selected generic fields}
+
+@deftogether[
+(@defproc[(tags-composer [tags any/c]) (or/c string? (listof string?))]
+ @defproc[(tags-album-artist [tags any/c]) (or/c string? (listof string?))]
+ @defproc[(tags-disc-number [tags any/c]) (or/c number? #f)])]{
+Return selected values from the generic TagLib property store.  The composer is
+read from the @racket['composer] key, the album artist from
+@racket['albumartist], and the disc number from @racket['discnumber].  Use
+@racket[tags-keys] and @racket[tags-ref] for direct access to the complete
+generic property store.}
+
+@deftogether[
+(@defproc[(tags-composer! [tags any/c] [value (or/c string? 'clear)]) void?]
+ @defproc[(tags-album-artist! [tags any/c] [value (or/c string? 'clear)]) void?]
+ @defproc[(tags-disc-number! [tags any/c]
+                            [value (or/c exact-nonnegative-integer? string? 'clear)])
+          void?])]{
+Set selected generic properties on a read-write handle.  The disc number may be
+provided as a number or as the exact string that should be written.}
+
+@section{Audio properties}
+
+@deftogether[
+(@defproc[(tags-length [tags any/c]) integer?]
+ @defproc[(tags-sample-rate [tags any/c]) integer?]
+ @defproc[(tags-bit-rate [tags any/c]) integer?]
+ @defproc[(tags-channels [tags any/c]) integer?])]{
+Return audio properties reported by TagLib: length in seconds, sample rate in
+Hz, bit rate in kbit/s, and number of channels.  These values are read-only
+properties of the media stream, not editable tags.  Missing values are returned
+as @racket[-1].}
+
+@section{Generic properties}
+
+@defproc[(tags-keys [tags any/c]) (listof symbol?)]{
+Returns the generic TagLib property keys found in the file.  Keys are
+lower-cased and converted to symbols.}
+
+@defproc[(tags-ref [tags any/c] [key symbol?])
+         (or/c (listof string?) #f)]{
+Returns the list of values associated with @racket[key], or @racket[#f] when the
+property was not found.  Use lower-case symbol keys, matching the values
+returned by @racket[tags-keys].}
+
+@defproc[(tags-set! [tags any/c]
+                    [key (or/c symbol? string?)]
+                    [value (or/c string? 'clear)])
+         void?]{
+Sets a generic property on a read-write handle.  Symbol keys are converted to
+upper-case TagLib property names; string keys are passed as supplied.  Passing
+@racket['clear] clears the property.}
+
+@defproc[(tags-set-values! [tags any/c]
+                           [key (or/c symbol? string?)]
+                           [values (or/c (listof string?) 'clear)])
+         void?]{
+Replaces a generic property with zero or more values.  Passing @racket['clear]
+removes the property.}
+
+@defproc[(tags-append! [tags any/c]
+                       [key (or/c symbol? string?)]
+                       [value string?])
+         void?]{
+Appends a value to a generic property on a read-write handle.}
+
+@defproc[(tags-clear! [tags any/c]
+                      [key (or/c symbol? string?)])
+         void?]{
+Clears a generic property on a read-write handle.}
+
+@racketblock[
+(call-with-id3-tags "track.flac"
+  (lambda (tags)
+    (tags-set-values! tags 'composer '("Johann Sebastian Bach"))
+    (tags-set! tags 'discnumber "1")
+    (tags-save! tags))
+  #:mode 'read-write)]
+
+Generic properties may contain multiple values for a single key.  The API keeps
+those values as lists instead of joining them into one string.
+
+@section{Embedded pictures}
+
+The module represents embedded artwork as an opaque @deftech{picture value}.
+The picture value is returned by @racket[tags-picture] and can be inspected with
+the picture procedures documented below.  It can also be written to another
+file with @racket[tags-picture!] or @racket[tags-append-picture!].
+
+@defproc[(tags-picture [tags any/c]) (or/c any/c #f)]{
+Returns the embedded picture value, or @racket[#f] when the file has no picture
+that the underlying FFI layer could read.}
+
+@deftogether[
+(@defproc[(tags-picture->kind [tags any/c]) (or/c integer? #f)]
+ @defproc[(tags-picture->mimetype [tags any/c]) (or/c string? #f)]
+ @defproc[(tags-picture->description [tags any/c]) (or/c string? #f)]
+ @defproc[(tags-picture->size [tags any/c]) (or/c integer? #f)]
+ @defproc[(tags-picture->ext [tags any/c]) (or/c symbol? #f)])]{
+Return selected information about the embedded picture.  The kind is the
+numeric picture type reported by the FFI layer.  The MIME type is the stored
+MIME type, such as @racket["image/jpeg"] or @racket["image/png"].  The size is
+the number of bytes in the embedded image.  The extension helper returns
+@racket['jpg], @racket['png], or @racket[#f] when the MIME type is not
+recognized.}
+
+@defproc[(tags-picture->bitmap [tags any/c])
+         (or/c (is-a?/c bitmap%) #f)]{
+Reads the embedded picture bytes with @racket[read-bitmap] and returns a
+@racket[bitmap%] object.  If there is no embedded picture, the result is
+@racket[#f].}
+
+@defproc[(tags-picture->file [tags any/c]
+                            [path path-string?])
+         boolean?]{
+Writes the embedded picture bytes to @racket[path] in binary mode, replacing an
+existing file.  The procedure returns @racket[#t] when a picture was written and
+@racket[#f] when the tag handle has no picture.}
+
+@defproc[(make-tags-picture [mimetype string?]
+                            [kind integer?]
+                            [data (or/c bytes? (is-a?/c bitmap%))]
+                            [#:description description string? ""])
+         id3-picture?]{
+Creates a picture value from encoded image bytes or from a @racket[bitmap%].
+The MIME type should normally be @racket["image/jpeg"] or @racket["image/png"].}
+
+@defproc[(make-tags-picture-from-bitmap [bitmap (is-a?/c bitmap%)]
+                                        [kind integer?]
+                                        [#:mimetype mimetype string? "image/png"]
+                                        [#:description description string? ""])
+         id3-picture?]{
+Creates a picture value by encoding @racket[bitmap] as PNG or JPEG.}
+
+@deftogether[
+(@defproc[(tags-picture! [tags any/c]
+                          [picture (or/c id3-picture? 'clear)])
+          void?]
+ @defproc[(tags-append-picture! [tags any/c]
+                                 [picture id3-picture?])
+          void?]
+ @defproc[(tags-clear-picture! [tags any/c]) void?])]{
+Set, append, or clear embedded artwork on a read-write handle.  The procedures
+use TagLib complex properties underneath.  Call @racket[tags-save!] to persist
+the change.}
+
+@racketblock[
+(define cover
+  (make-tags-picture "image/jpeg" 3 (file->bytes "cover.jpg")
+                     #:description "Cover"))
+
+(call-with-id3-tags "track.flac"
+  (lambda (tags)
+    (tags-picture! tags cover)
+    (tags-save! tags))
+  #:mode 'read-write)]
+
+@section{Picture values}
+
+@deftogether[
+(@defproc[(id3-picture? [v any/c]) boolean?]
+ @defproc[(id3-picture-mimetype [picture id3-picture?]) string?]
+ @defproc[(id3-picture-kind [picture id3-picture?]) integer?]
+ @defproc[(id3-picture-size [picture id3-picture?]) integer?]
+ @defproc[(id3-picture-bytes [picture id3-picture?]) bytes?]
+ @defproc[(id3-picture-description [picture id3-picture?]) string?])]{
+Access the fields of a picture value.  These procedures are useful when the
+caller wants to process the image bytes directly or pass a picture to another
+component.}
+
+@section{Converting to a hash}
+
+@defproc[(tags->hash [tags any/c]) hash?]{
+Returns a mutable hash containing the core values copied from the tag handle.
+The hash contains the keys @racket['valid?], @racket['read-write?],
+@racket['closed?], @racket['title], @racket['album], @racket['artist],
+@racket['comment], @racket['composer], @racket['genre], @racket['year],
+@racket['track], @racket['length], @racket['sample-rate], @racket['bit-rate],
+@racket['channels], @racket['picture], and @racket['keys].
+
+The hash is intended as a convenient snapshot for application code.  Generic
+property values are not expanded into the hash; use @racket[tags-ref] for those
+values.}
+
+@section{Copying tags and pictures}
+
+The encoder pipeline uses this module for metadata transfer.  For FLAC output,
+@racket[audio-encode] first writes the audio stream and then opens the resulting
+file with @racket[id3-tags] in read-write mode to copy tags and pictures through
+TagLib.  For Opus output, comments and pictures are supplied to
+@tt{libopusenc} before encoding starts, because OpusTags are written at the
+start of the Ogg Opus stream.
+
+Applications that need explicit metadata editing should use the read-write API
+directly, as in the examples above.
+
+@section[#:tag "taglib-example"]{Example}
+
+@racketblock[
+(define tags (id3-tags "track.flac"))
+
+(cond
+  [(not (tags-valid? tags))
+   (printf "No readable tags\n")]
+  [else
+   (printf "Title:  ~a\n" (tags-title tags))
+   (printf "Artist: ~a\n" (tags-artist tags))
+   (printf "Album:  ~a\n" (tags-album tags))
+   (printf "Length: ~a seconds\n" (tags-length tags))
+
+   (when (tags-picture tags)
+     (define ext (or (tags-picture->ext tags) 'bin))
+     (tags-picture->file tags (format "cover.~a" ext)))])]
+
+@section{Implementation notes}
+
+This chapter documents the public @racketmodname["taglib.rkt"] layer.  The
+native TagLib calls are delegated to @racketmodname["taglib-ffi.rkt"], but
+callers normally should not use that lower level module directly.
+
+A read-only tag handle is a Racket-side snapshot.  A read-write tag handle keeps
+the native TagLib file open until @racket[tags-close!] is called.  Setter
+procedures update both the native file and the Racket-side cache; the changes
+are persisted only after @racket[tags-save!] succeeds.
+
+The implementation normalizes generic property names by lower-casing TagLib
+property keys and converting them to symbols.  Values remain lists of strings
+because TagLib properties may contain multiple values for one key.

soxr-ffi.rkt

@@ -0,0 +1,255 @@
+(module soxr-ffi racket/base
+
+  (require ffi/unsafe
+           ffi/unsafe/define
+           "private/utils.rkt")
+
+  (provide soxr-available?
+           soxr-version
+           soxr-create
+           soxr-process
+           soxr-delay
+           soxr-clear
+           soxr-delete
+           soxr-error
+           soxr-engine
+           soxr-io-spec
+           soxr-quality-spec
+           soxr-runtime-spec
+           soxr-error-ptr->string
+           soxr-datatype-size
+
+           _soxr_t
+           _soxr_io_spec
+           _soxr_io_spec-pointer
+           soxr_io_spec?
+           soxr_io_spec-itype
+           soxr_io_spec-otype
+           soxr_io_spec-scale
+           soxr_io_spec-flags
+           set-soxr_io_spec-scale!
+           set-soxr_io_spec-flags!
+
+           _soxr_quality_spec
+           _soxr_quality_spec-pointer
+           soxr_quality_spec?
+           soxr_quality_spec-precision
+           soxr_quality_spec-phase_response
+           soxr_quality_spec-passband_end
+           soxr_quality_spec-stopband_begin
+           soxr_quality_spec-flags
+           set-soxr_quality_spec-precision!
+           set-soxr_quality_spec-phase_response!
+           set-soxr_quality_spec-passband_end!
+           set-soxr_quality_spec-stopband_begin!
+           set-soxr_quality_spec-flags!
+
+           _soxr_runtime_spec
+           _soxr_runtime_spec-pointer
+           soxr_runtime_spec?
+           soxr_runtime_spec-log2_min_dft_size
+           soxr_runtime_spec-log2_large_dft_size
+           soxr_runtime_spec-coef_size_kbytes
+           soxr_runtime_spec-num_threads
+           soxr_runtime_spec-flags
+           set-soxr_runtime_spec-num_threads!
+           set-soxr_runtime_spec-flags!
+
+           SOXR_FLOAT32
+           SOXR_FLOAT64
+           SOXR_INT32
+           SOXR_INT16
+           SOXR_SPLIT
+           SOXR_FLOAT32_I
+           SOXR_FLOAT64_I
+           SOXR_INT32_I
+           SOXR_INT16_I
+           SOXR_FLOAT32_S
+           SOXR_FLOAT64_S
+           SOXR_INT32_S
+           SOXR_INT16_S
+
+           SOXR_TPDF
+           SOXR_NO_DITHER
+           SOXR_QQ
+           SOXR_LQ
+           SOXR_MQ
+           SOXR_HQ
+           SOXR_VHQ
+           SOXR_16_BITQ
+           SOXR_20_BITQ
+           SOXR_24_BITQ
+           SOXR_28_BITQ
+           SOXR_32_BITQ
+           SOXR_LINEAR_PHASE
+           SOXR_INTERMEDIATE_PHASE
+           SOXR_MINIMUM_PHASE
+           SOXR_STEEP_FILTER
+           SOXR_ROLLOFF_SMALL
+           SOXR_ROLLOFF_MEDIUM
+           SOXR_ROLLOFF_NONE
+           SOXR_HI_PREC_CLOCK
+           SOXR_DOUBLE_PRECISION
+           SOXR_VR
+           SOXR_COEF_INTERP_AUTO
+           SOXR_COEF_INTERP_LOW
+           SOXR_COEF_INTERP_HIGH)
+
+  ;; libsoxr is normally libsoxr.so.0 on Linux and libsoxr.dylib on macOS.
+  ;; The Windows build supplied with racket-audio may be either soxr.dll or
+  ;; libsoxr.dll, so both stems are tried through the existing get-lib helper.
+  (define libsoxr
+    (get-lib (case (system-type 'os)
+               [(windows) '("soxr" "libsoxr")]
+               [else '("soxr" "libsoxr")])
+             (case (system-type 'os*)
+               [(linux) '("0" #f)]
+               [else '(#f)])))
+
+  (define-ffi-definer def-soxr libsoxr #:default-make-fail make-not-available)
+
+  (define _soxr_t (_cpointer/null 'soxr))
+
+  ;; soxr.h structs.  These are passed by pointer to soxr_create, while the
+  ;; constructor functions in the C API return initialized structs by value.
+  (define-cstruct _soxr_io_spec
+    ([itype _int]
+     [otype _int]
+     [scale _double]
+     [e _pointer]
+     [flags _ulong]))
+
+  (define-cstruct _soxr_quality_spec
+    ([precision _double]
+     [phase_response _double]
+     [passband_end _double]
+     [stopband_begin _double]
+     [e _pointer]
+     [flags _ulong]))
+
+  (define-cstruct _soxr_runtime_spec
+    ([log2_min_dft_size _uint]
+     [log2_large_dft_size _uint]
+     [coef_size_kbytes _uint]
+     [num_threads _uint]
+     [e _pointer]
+     [flags _ulong]))
+
+  ;; Datatypes supported by libsoxr.  The *_I values are channel-interleaved;
+  ;; those are what resampler.rkt uses for normal PCM byte strings.
+  (define SOXR_FLOAT32 0)
+  (define SOXR_FLOAT64 1)
+  (define SOXR_INT32 2)
+  (define SOXR_INT16 3)
+  (define SOXR_SPLIT 4)
+  (define SOXR_FLOAT32_I SOXR_FLOAT32)
+  (define SOXR_FLOAT64_I SOXR_FLOAT64)
+  (define SOXR_INT32_I SOXR_INT32)
+  (define SOXR_INT16_I SOXR_INT16)
+  (define SOXR_FLOAT32_S SOXR_SPLIT)
+  (define SOXR_FLOAT64_S 5)
+  (define SOXR_INT32_S 6)
+  (define SOXR_INT16_S 7)
+
+  (define SOXR_TPDF 0)
+  (define SOXR_NO_DITHER 8)
+
+  (define SOXR_QQ 0)
+  (define SOXR_LQ 1)
+  (define SOXR_MQ 2)
+  (define SOXR_16_BITQ 3)
+  (define SOXR_20_BITQ 4)
+  (define SOXR_24_BITQ 5)
+  (define SOXR_28_BITQ 6)
+  (define SOXR_32_BITQ 7)
+  (define SOXR_HQ SOXR_20_BITQ)
+  (define SOXR_VHQ SOXR_28_BITQ)
+
+  (define SOXR_LINEAR_PHASE #x00)
+  (define SOXR_INTERMEDIATE_PHASE #x10)
+  (define SOXR_MINIMUM_PHASE #x30)
+  (define SOXR_STEEP_FILTER #x40)
+
+  (define SOXR_ROLLOFF_SMALL 0)
+  (define SOXR_ROLLOFF_MEDIUM 1)
+  (define SOXR_ROLLOFF_NONE 2)
+  (define SOXR_HI_PREC_CLOCK 8)
+  (define SOXR_DOUBLE_PRECISION 16)
+  (define SOXR_VR 32)
+
+  (define SOXR_COEF_INTERP_AUTO 0)
+  (define SOXR_COEF_INTERP_LOW 2)
+  (define SOXR_COEF_INTERP_HIGH 3)
+
+  (define (soxr-datatype-size t)
+    (case (bitwise-and t 3)
+      [(0) 4]
+      [(1) 8]
+      [(2) 4]
+      [(3) 2]
+      [else (error 'soxr-datatype-size "invalid datatype ~a" t)]))
+
+  (define (soxr-error-ptr->string p)
+    (and p (cast p _pointer _string/utf-8)))
+
+  (def-soxr soxr_version/raw (_fun -> _string/utf-8) #:c-id soxr_version)
+  (def-soxr soxr_io_spec/raw (_fun _int _int -> _soxr_io_spec) #:c-id soxr_io_spec)
+  (def-soxr soxr_quality_spec/raw (_fun _ulong _ulong -> _soxr_quality_spec) #:c-id soxr_quality_spec)
+  (def-soxr soxr_runtime_spec/raw (_fun _uint -> _soxr_runtime_spec) #:c-id soxr_runtime_spec)
+
+  (def-soxr soxr_create/raw
+    (_fun _double _double _uint
+          (errp : (_ptr o _pointer))
+          _soxr_io_spec-pointer/null
+          _soxr_quality_spec-pointer/null
+          _soxr_runtime_spec-pointer/null
+          -> (ctx : _soxr_t)
+          -> (values ctx errp))
+    #:c-id soxr_create)
+
+  (def-soxr soxr_process/raw
+    (_fun _soxr_t
+          _pointer _size (idone : (_ptr o _size))
+          _pointer _size (odone : (_ptr o _size))
+          -> (err : _pointer)
+          -> (values err idone odone))
+    #:c-id soxr_process)
+
+  (def-soxr soxr-delay (_fun _soxr_t -> _double) #:c-id soxr_delay)
+  (def-soxr soxr-clear (_fun _soxr_t -> (err : _pointer) -> (soxr-error-ptr->string err)) #:c-id soxr_clear)
+  (def-soxr soxr-error (_fun _soxr_t -> (err : _pointer) -> (soxr-error-ptr->string err)) #:c-id soxr_error)
+  (def-soxr soxr-engine (_fun _soxr_t -> _string/utf-8) #:c-id soxr_engine)
+  (def-soxr soxr-delete (_fun _soxr_t -> _void) #:c-id soxr_delete)
+
+  (define (soxr-available?) (and libsoxr #t))
+
+  (define (soxr-version)
+    (soxr_version/raw))
+
+  (define (soxr-io-spec itype otype #:scale [scale 1.0] #:flags [flags 0])
+    (let ((s (soxr_io_spec/raw itype otype)))
+      (set-soxr_io_spec-scale! s scale)
+      (set-soxr_io_spec-flags! s flags)
+      s))
+
+  (define (soxr-quality-spec recipe #:flags [flags 0])
+    (soxr_quality_spec/raw recipe flags))
+
+  (define (soxr-runtime-spec #:num-threads [num-threads 1])
+    (soxr_runtime_spec/raw num-threads))
+
+  (define (soxr-create input-rate output-rate channels #:io-spec [io-spec #f]
+                       #:quality-spec [quality-spec #f] #:runtime-spec [runtime-spec #f])
+    (let-values (((ctx err) (soxr_create/raw (exact->inexact input-rate)
+                                             (exact->inexact output-rate)
+                                             channels
+                                             io-spec
+                                             quality-spec
+                                             runtime-spec)))
+      (values ctx (soxr-error-ptr->string err))))
+
+  (define (soxr-process ctx in ilen out olen)
+    (let-values (((err idone odone) (soxr_process/raw ctx in ilen out olen)))
+      (values (soxr-error-ptr->string err) idone odone)))
+
+  ) ; end of module

taglib-ffi.rkt

@@ -3,8 +3,7 @@
 (require ffi/unsafe
          ffi/unsafe/define
          "private/utils.rkt"
-         "private/downloader.rkt"
+         "private/downloader.rkt")
-         )
 
 (provide TagLib_File_Type
          _TagLib_File-pointer
@@ -16,11 +15,12 @@
          taglib_file_new_type
          taglib_file_is_valid
          taglib_file_free
+         taglib_file_save
 
          taglib_file_tag
          taglib_file_audioproperties
          taglib_tag_free_strings
-         
+
          taglib_tag_title
          taglib_tag_artist
          taglib_tag_album
@@ -29,6 +29,14 @@
          taglib_tag_year
          taglib_tag_track
 
+         taglib_tag_set_title
+         taglib_tag_set_artist
+         taglib_tag_set_album
+         taglib_tag_set_comment
+         taglib_tag_set_genre
+         taglib_tag_set_year
+         taglib_tag_set_track
+
          taglib_audioproperties_length
          taglib_audioproperties_bitrate
          taglib_audioproperties_samplerate
@@ -36,40 +44,23 @@
 
          taglib_property_keys
          taglib_property_key
-         
          taglib_property_get
          taglib_property_val
-         
+         taglib_property_set
+         taglib_property_set_append
          taglib_property_free
 
+         taglib_complex_property_set
+         taglib_complex_property_set_append
+
          taglib-get-picture
-         )
+         taglib-set-picture
+         taglib-append-picture
+         taglib-clear-picture)
 
-
+(define zlib (get-lib '("zlib" "libz") (linux-lib-versions '("1" #f))))
-;(define-runtime-path lib-path "..");
+(define libtag (get-lib '("tag" "libtag") (linux-lib-versions '("2" #f) '("2" #f))))
-;
+(define libtag_c (get-lib '("tag_c" "libtag_c") (linux-lib-versions '("2" #f) '("2" #f))))
-;(define libs (let ((os-type (system-type 'os*)))
-;              (if (eq? os-type 'windows)
-;                  (list
-;                   (build-path lib-path "lib" "dll" "tag")
-;                   (build-path lib-path "lib" "dll" "tag_c"))
-;                  (let* ((arch (symbol->string (system-type 'arch)))
-;                         (subdir (string-append (symbol->string os-type) "-" arch)))
-;                    (list
-;                     (build-path lib-path "lib" subdir "libtag")
-;                     (build-path lib-path "lib" subdir "libtag_c"))))))
-
-;(define (get-lib l)
-;  (ffi-lib l '("2" #f)
-;           #:get-lib-dirs (λ ()
-;                            (cons (build-path ".") (get-lib-search-dirs)))
-;           #: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
   #:default-make-fail make-not-available)
@@ -97,45 +88,39 @@
            dsf
            dsdiff
            shorten
-           )))
+           matroska)))
 
 (define _TagLib_File-pointer (_cpointer/null 'taglib-file))
 (define _TagLib_Tag-pointer (_cpointer/null 'taglib-tag))
 (define _TagLib_AudioProperties-pointer (_cpointer/null 'taglib-audioproperties))
 
-; TagLib_File *taglib_file_new(const char *filename);
 (define-tag-c-lib taglib_file_new
-  (_fun _string/utf-8 -> _TagLib_File-pointer ))
+  (_fun _string/utf-8 -> _TagLib_File-pointer))
 
-; TAGLIB_C_EXPORT TagLib_File *taglib_file_new_wchar(const wchar_t *filename);
 (define-tag-c-lib taglib_file_new_wchar
-  (_fun _string/utf-16 -> _TagLib_File-pointer ))
+  (_fun _string/utf-16 -> _TagLib_File-pointer))
 
-; TagLib_File *taglib_file_new_type(const char *filename, TagLib_File_Type type);
 (define-tag-c-lib taglib_file_new_type
   (_fun _string/utf-8 TagLib_File_Type -> _TagLib_File-pointer))
 
-; TagLib_File *taglib_file_new_type_wchar(const char *filename, TagLib_File_Type type);
 (define-tag-c-lib taglib_file_new_type_wchar
   (_fun _string/utf-16 TagLib_File_Type -> _TagLib_File-pointer))
 
-; void taglib_file_free(TagLib_File *file);
 (define-tag-c-lib taglib_file_free
   (_fun _TagLib_File-pointer -> _void))
 
-; BOOL taglib_file_is_valid(const TagLib_File *file);
 (define-tag-c-lib taglib_file_is_valid
   (_fun _TagLib_File-pointer -> _bool))
 
-; TagLib_Tag *taglib_file_tag(const TagLib_File *file);
+(define-tag-c-lib taglib_file_save
+  (_fun _TagLib_File-pointer -> _bool))
+
 (define-tag-c-lib taglib_file_tag
   (_fun _TagLib_File-pointer -> _TagLib_Tag-pointer))
 
-; const TagLib_AudioProperties *taglib_file_audioproperties(const TagLib_File *file);
 (define-tag-c-lib taglib_file_audioproperties
   (_fun _TagLib_File-pointer -> _TagLib_AudioProperties-pointer))
 
-; void taglib_tag_free_strings(void);
 (define-tag-c-lib taglib_tag_free_strings
   (_fun -> _void))
 
@@ -150,12 +135,8 @@
        (_fun _TagLib_Tag-pointer -> _string/utf-8)))
     ((_ name ret-type)
      (define-tag-c-lib name
-       (_fun _TagLib_Tag-pointer -> ret-type)))
+       (_fun _TagLib_Tag-pointer -> ret-type)))))
-    ))
 
-
-; char *taglib_tag_title(const TagLib_Tag *tag);
-; etc..
 (tg taglib_tag_title)
 (tg taglib_tag_artist)
 (tg taglib_tag_album)
@@ -164,6 +145,23 @@
 (tg taglib_tag_year _uint)
 (tg taglib_tag_track _uint)
 
+(define-syntax tgs
+  (syntax-rules ()
+    ((_ name)
+     (define-tag-c-lib name
+       (_fun _TagLib_Tag-pointer _string/utf-8 -> _void)))
+    ((_ name arg-type)
+     (define-tag-c-lib name
+       (_fun _TagLib_Tag-pointer arg-type -> _void)))))
+
+(tgs taglib_tag_set_title)
+(tgs taglib_tag_set_artist)
+(tgs taglib_tag_set_album)
+(tgs taglib_tag_set_comment)
+(tgs taglib_tag_set_genre)
+(tgs taglib_tag_set_year _uint)
+(tgs taglib_tag_set_track _uint)
+
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;; audio properties
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
@@ -172,11 +170,7 @@
   (syntax-rules ()
     ((_ name)
      (define-tag-c-lib name
-       (_fun _TagLib_AudioProperties-pointer -> _int)))
+       (_fun _TagLib_AudioProperties-pointer -> _int)))))
-    ))
-
-; int taglib_audioproperties_length(const TagLib_AudioProperties *audioProperties);
-; etc...
 
 (ap taglib_audioproperties_length)
 (ap taglib_audioproperties_bitrate)
@@ -184,24 +178,29 @@
 (ap taglib_audioproperties_channels)
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;; keys in the propertymap
+;; property map
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 
-; char** taglib_property_keys(const TagLib_File *file);
 (define-tag-c-lib taglib_property_keys
   (_fun _TagLib_File-pointer -> (_ptr i _string/utf-8)))
 
 (define (taglib_property_key keys i)
   (ptr-ref keys _string/utf-8 i))
 
-;char** taglib_property_get(const TagLib_File *file, const char *prop);
 (define-tag-c-lib taglib_property_get
   (_fun _TagLib_File-pointer _string/utf-8 -> (_ptr i _string/utf-8)))
 
 (define (taglib_property_val prop i)
   (ptr-ref prop _string/utf-8 i))
 
-; void taglib_property_free(char **props);
+;; value may be NULL to clear the property.
+(define-tag-c-lib taglib_property_set
+  (_fun _TagLib_File-pointer _string/utf-8 _pointer -> _void))
+
+;; value may be NULL to clear all values for the property.
+(define-tag-c-lib taglib_property_set_append
+  (_fun _TagLib_File-pointer _string/utf-8 _pointer -> _void))
+
 (define-tag-c-lib taglib_property_free
   (_fun _pointer -> _void))
 
@@ -209,40 +208,12 @@
 ;; Picture data
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 
-
-;typedef struct {
-;  char *mimeType;
-;  char *description;
-;  char *pictureType;
-;  char *data;
-;  unsigned int size;
-;} TagLib_Complex_Property_Picture_Data;
-
 (define-cstruct _TagLib_Complex_Property_Picture_Data
-  (
+  ([mimeType _string/utf-8]
-   [mimeType _string/utf-8]
    [description _string/utf-8]
    [pictureType _string/utf-8]
    [data _pointer]
-   [size _uint]
+   [size _uint]))
-   ))
-
-
-
-; TagLib_Complex_Property_Attribute*** properties = *   taglib_complex_property_get(file, "PICTURE");
-; * TagLib_File *file = taglib_file_new("myfile.mp3");
-; * TagLib_Complex_Property_Attribute*** properties =
-; *   taglib_complex_property_get(file, "PICTURE");
-; * TagLib_Complex_Property_Picture_Data picture;
-; * taglib_picture_from_complex_property(properties, &picture);
-; * // Do something with picture.mimeType, picture.description,
-; * // picture.pictureType, picture.data, picture.size, e.g. extract it.
-; * FILE *fh = fopen("mypicture.jpg", "wb");
-; * if(fh) {
-; *   fwrite(picture.data, picture.size, 1, fh);
-; *   fclose(fh);
-; * }
-; * taglib_complex_property_free(properties);
 
 (define _Complex_Property_Attribute-pointer (_cpointer/null 'taglib-complex-property-attribute))
 
@@ -257,38 +228,107 @@
 (define-tag-c-lib taglib_complex_property_free
   (_fun _Complex_Property_Attribute-pointer -> _void))
 
-;TAGLIB_C_EXPORT char** taglib_complex_property_keys(const TagLib_File *file);
 (define-tag-c-lib taglib_complex_property_keys
   (_fun _TagLib_File-pointer -> (_ptr i _string/utf-8)))
 
-;  void taglib_complex_property_free_keys(char **keys);
 (define-tag-c-lib taglib_complex_property_free_keys
   (_fun _pointer -> _void))
 
+;; TagLib_Variant is { enum type; unsigned int size; union value; }.
+;; For writing pictures we only use pointer-valued union members: stringValue
+;; and byteVectorValue. A pointer-sized field has the same size/alignment as
+;; the union on the supported ABIs.
+(define TagLib_Variant_ByteVector 9)
+(define TagLib_Variant_String 7)
+
+(define-cstruct _TagLib_Variant
+  ([type _int]
+   [size _uint]
+   [value _pointer]))
+
+(define-cstruct _TagLib_Complex_Property_Attribute
+  ([key _pointer]
+   [value _TagLib_Variant]))
+
+(define-tag-c-lib taglib_complex_property_set
+  (_fun _TagLib_File-pointer _string/utf-8 _pointer -> _bool))
+
+(define-tag-c-lib taglib_complex_property_set_append
+  (_fun _TagLib_File-pointer _string/utf-8 _pointer -> _bool))
+
+(define (bytes->malloc-ptr bs [nul? #f])
+  (define len (bytes-length bs))
+  (define ptr (malloc _byte (+ len (if nul? 1 0)) 'atomic-interior))
+  (for ([i (in-range len)]) (ptr-set! ptr _byte i (bytes-ref bs i)))
+  (when nul? (ptr-set! ptr _byte len 0))
+  ptr)
+
+(define (string/bytes->malloc-cstring who v)
+  (define bs
+    (cond
+      [(bytes? v) v]
+      [(string? v) (string->bytes/utf-8 v)]
+      [(symbol? v) (string->bytes/utf-8 (symbol->string v))]
+      [(number? v) (string->bytes/utf-8 (number->string v))]
+      [else (raise-argument-error who "(or/c string? bytes? symbol? number?)" v)]))
+  (bytes->malloc-ptr bs #t))
+
+(define (string->malloc-cstring s)
+  (string/bytes->malloc-cstring 'string->malloc-cstring s))
+
+(define (picture->complex-property data size description mimetype picture-type)
+  (define data-ptr (bytes->malloc-ptr data #f))
+  (define data-key (string->malloc-cstring "data"))
+  (define mime-key (string->malloc-cstring "mimeType"))
+  (define desc-key (string->malloc-cstring "description"))
+  (define type-key (string->malloc-cstring "pictureType"))
+  (define mime-ptr (string->malloc-cstring mimetype))
+  (define desc-ptr (string->malloc-cstring description))
+  (define type-ptr (string->malloc-cstring picture-type))
+  (define data-attr (make-TagLib_Complex_Property_Attribute data-key (make-TagLib_Variant TagLib_Variant_ByteVector size data-ptr)))
+  (define mime-attr (make-TagLib_Complex_Property_Attribute mime-key (make-TagLib_Variant TagLib_Variant_String 0 mime-ptr)))
+  (define desc-attr (make-TagLib_Complex_Property_Attribute desc-key (make-TagLib_Variant TagLib_Variant_String 0 desc-ptr)))
+  (define type-attr (make-TagLib_Complex_Property_Attribute type-key (make-TagLib_Variant TagLib_Variant_String 0 type-ptr)))
+  (define propv (malloc _pointer 5 'atomic-interior))
+  (ptr-set! propv _pointer 0 data-attr)
+  (ptr-set! propv _pointer 1 mime-attr)
+  (ptr-set! propv _pointer 2 desc-attr)
+  (ptr-set! propv _pointer 3 type-attr)
+  (ptr-set! propv _pointer 4 #f)
+  ;; Return keepalive values as well as the pointer array. TagLib copies during
+  ;; taglib_complex_property_set(), but all buffers must remain live for the call.
+  (values propv (list data-ptr data-key mime-key desc-key type-key mime-ptr desc-ptr type-ptr
+                      data-attr mime-attr desc-attr type-attr propv)))
+
+(define (taglib-set-picture tag-file mimetype picture-type description data)
+  (define-values (props keepalive)
+    (picture->complex-property data (bytes-length data) description mimetype picture-type))
+  (define ok? (taglib_complex_property_set tag-file "PICTURE" props))
+  keepalive
+  ok?)
+
+(define (taglib-append-picture tag-file mimetype picture-type description data)
+  (define-values (props keepalive)
+    (picture->complex-property data (bytes-length data) description mimetype picture-type))
+  (define ok? (taglib_complex_property_set_append tag-file "PICTURE" props))
+  keepalive
+  ok?)
+
+(define (taglib-clear-picture tag-file)
+  (taglib_complex_property_set tag-file "PICTURE" #f))
+
 (define (taglib-get-picture tag-file)
-  (define (cp s) (string-append s ""))
+  (define (cp s) (if (eq? s #f) "" (string-append s "")))
-  (define (to-bytestring data size)
-    
-    (let* ((v (make-vector size 0))
-           (i 0))
-      (while (< i size)
-             (vector-set! v (ptr-ref data _byte i) i)
-             (set! i (+ i 1)))
-      v))
   (let ((props (taglib_complex_property_get tag-file "PICTURE")))
     (if (eq? props #f)
         #f
         (let ((pd (make-TagLib_Complex_Property_Picture_Data #f #f #f #f 0)))
           (taglib_picture_from_complex_property props pd)
           (let* ((mimetype (cp (TagLib_Complex_Property_Picture_Data-mimeType pd)))
-                 (description  (cp (TagLib_Complex_Property_Picture_Data-description pd)))
+                 (description (cp (TagLib_Complex_Property_Picture_Data-description pd)))
                  (type (cp (TagLib_Complex_Property_Picture_Data-pictureType pd)))
                  (size (TagLib_Complex_Property_Picture_Data-size pd))
-                 (data  (cast (TagLib_Complex_Property_Picture_Data-data pd)
+                 (data (cast (TagLib_Complex_Property_Picture_Data-data pd) _pointer (_bytes o size))))
-                               _pointer
-                               (_bytes o size)))
-                 )
             (let ((r (list mimetype description type size data)))
               (taglib_complex_property_free props)
-              r))))
+              r))))))
-    ))

taglib-tests.rkt

@@ -0,0 +1,278 @@
+#lang racket/base
+
+(require rackunit
+         racket/class
+         racket/draw
+         racket/file
+         racket/list
+         racket/path
+         racket/runtime-path
+         "taglib.rkt")
+
+(provide run-taglib-tests
+         run-taglib-tests/verbose
+         current-taglib-test-verbosity
+         test-audio-dir
+         taglib-read-files
+         taglib-write-files)
+
+;; These tests expect the repository hans/racket-audio-test next to this
+;; package checkout, matching the layout already used by tests.rkt:
+;;
+;;   parent/
+;;     racket-audio/
+;;     racket-audio-test/
+;;
+;; The tests are defensive: missing test files are skipped, but existing files
+;; are tested. Write tests always work on a temporary copy and never modify the
+;; original test audio files.
+
+
+(define current-taglib-test-verbosity (make-parameter 'normal))
+
+(define (taglib-test-verbose?)
+  (memq (current-taglib-test-verbosity) '(verbose very-verbose)))
+
+(define (taglib-test-note fmt . args)
+  (when (taglib-test-verbose?)
+    (apply printf fmt args)
+    (newline)
+    (flush-output)))
+
+(define-syntax-rule (taglib-test-case name body ...)
+  (test-case name
+    (taglib-test-note "[taglib] running: ~a" name)
+    body ...
+    (taglib-test-note "[taglib] ok: ~a" name)))
+
+(define-runtime-path test-audio-dir "../racket-audio-test")
+
+(define taglib-read-files
+  '("idyll.flac"
+    "idyll.m4a"
+    "idyll.mp3"
+    "idyll.ogg"
+    "idyll.opus"
+    "mahler-1.mp3"
+    "mahler-1.ogg"
+    "mahler-1.opus"
+    "mahler-2.mp3"
+    "mahler-2.ogg"
+    "mahler-2.opus"
+    "ff-16b-2c-44100hz.flac"
+    "ff-16b-2c-44100hz.m4a"
+    "ff-16b-2c-44100hz.mp3"
+    "ff-16b-2c-44100hz.ogg"
+    "ff-16b-2c-44100hz.opus"))
+
+;; Keep the write matrix deliberately small. These formats should cover the
+;; main TagLib backends used by the package without making the test suite slow.
+(define taglib-write-files
+  '("idyll.flac"
+    "idyll.mp3"
+    "idyll.m4a"
+    "idyll.ogg"
+    "idyll.opus"))
+
+(define (existing-test-files names)
+  (for/list ([name (in-list names)]
+             #:when (file-exists? (build-path test-audio-dir name)))
+    (build-path test-audio-dir name)))
+
+(define (taglib-usable?)
+  (with-handlers ([exn:fail? (lambda (_) #f)])
+    (define files (existing-test-files taglib-read-files))
+    (and (pair? files)
+         (let ([tags (id3-tags (car files))])
+           (and (tags-valid? tags) #t)))))
+
+(define (copy-test-file-to-temp src)
+  (define dst (make-temporary-file (format "racket-audio-taglib-~a-~~a~a"
+                                           (path->string (file-name-from-path src))
+                                           (or (path-get-extension src) #""))))
+  (copy-file src dst #t)
+  dst)
+
+(define (check-nonnegative/name name v)
+  (check-true (and (exact-integer? v) (>= v -1)) name))
+
+(define (check-readable-snapshot path)
+  (taglib-test-case (format "read-only snapshot: ~a" (file-name-from-path path))
+    (define tags (id3-tags path))
+    (check-true (tags-valid? tags))
+    (check-false (tags-read-write? tags))
+    (check-true (tags-closed? tags))
+    (check-pred string? (tags-title tags))
+    (check-pred string? (tags-album tags))
+    (check-pred string? (tags-artist tags))
+    (check-pred string? (tags-comment tags))
+    (check-pred string? (tags-genre tags))
+    (check-nonnegative/name "year" (tags-year tags))
+    (check-nonnegative/name "track" (tags-track tags))
+    (check-nonnegative/name "length" (tags-length tags))
+    (check-nonnegative/name "sample-rate" (tags-sample-rate tags))
+    (check-nonnegative/name "bit-rate" (tags-bit-rate tags))
+    (check-nonnegative/name "channels" (tags-channels tags))
+    (check-true (list? (tags-keys tags)))
+    ;; A read-only snapshot must still be usable after the native TagLib file
+    ;; has been closed. This protects the audio playback path from stale file
+    ;; handles/locks after metadata reading.
+    (check-pred hash? (tags->hash tags))
+    (check-exn exn:fail? (lambda () (tags-title! tags "must fail")))))
+
+(define (check-call-with-closes path)
+  (taglib-test-case (format "call-with-id3-tags closes read-write handle: ~a" (file-name-from-path path))
+    (define captured #f)
+    (with-handlers ([exn:fail? void])
+      (call-with-id3-tags path #:mode 'read-write
+        (lambda (tags)
+          (set! captured tags)
+          (check-true (tags-read-write? tags))
+          (check-false (tags-closed? tags))
+          (error 'expected-test-exception "force close path"))))
+    (check-true (tags-closed? captured))))
+
+(define (check-simple-write-roundtrip path)
+  (taglib-test-case (format "tag write/read/clear roundtrip: ~a" (file-name-from-path path))
+    (define tmp (copy-test-file-to-temp path))
+    (displayln (format "tmp = ~a" tmp))
+    (dynamic-wind
+      void
+      (lambda ()
+        (define title (format "Racket Audio TagLib Test ~a" (current-inexact-milliseconds)))
+        (call-with-id3-tags tmp #:mode 'read-write
+          (lambda (tags)
+            (check-true (tags-valid? tags))
+            (check-true (tags-read-write? tags))
+            (check-false (tags-closed? tags))
+            (tags-title! tags title)
+            (tags-album! tags "Racket Audio Test Album")
+            (tags-artist! tags "Racket Audio Test Artist")
+            (tags-comment! tags "Written by racket-audio taglib-tests.rkt")
+            (tags-genre! tags "Test")
+            (tags-year! tags 2026)
+            (tags-track! tags 7)
+            (tags-composer! tags "Racket Composer")
+            (tags-album-artist! tags "Racket Album Artist")
+            (tags-disc-number! tags 2)
+            (tags-set-values! tags 'performer '("Performer One" "Performer Two"))
+            (check-true (tags-save! tags))))
+
+        (define reread (id3-tags tmp))
+        (check-true (tags-valid? reread))
+        (check-true (tags-closed? reread))
+        (check-equal? (tags-title reread) title)
+        (check-equal? (tags-album reread) "Racket Audio Test Album")
+        (check-equal? (tags-artist reread) "Racket Audio Test Artist")
+        (check-equal? (tags-comment reread) "Written by racket-audio taglib-tests.rkt")
+        (check-equal? (tags-genre reread) "Test")
+        (check-equal? (tags-year reread) 2026)
+        (check-equal? (tags-track reread) 7)
+        (check-equal? (tags-composer reread) "Racket Composer")
+        (check-equal? (tags-album-artist reread) "Racket Album Artist")
+        (check-equal? (tags-disc-number reread) 2)
+        (check-equal? (tags-ref reread 'performer) '("Performer One" "Performer Two"))
+
+        (call-with-id3-tags tmp #:mode 'read-write
+          (lambda (tags)
+            (tags-title! tags 'clear)
+            (tags-year! tags 'clear)
+            (tags-track! tags 'clear)
+            (tags-clear! tags 'composer)
+            (tags-clear! tags 'performer)
+            (check-true (tags-save! tags))))
+
+        (define cleared (id3-tags tmp))
+        (check-equal? (tags-title cleared) "")
+        (check-equal? (tags-year cleared) -1)
+        (check-equal? (tags-track cleared) -1)
+        (check-equal? (tags-composer cleared) "")
+        (check-false (tags-ref cleared 'performer)))
+      (lambda ()
+        (when (file-exists? tmp) (delete-file tmp))))))
+
+(define (make-test-bitmap)
+  (define bm (make-object bitmap% 4 4))
+  (define dc (new bitmap-dc% [bitmap bm]))
+  (send dc set-pen "black" 1 'solid)
+  (send dc set-brush "white" 'solid)
+  (send dc draw-rectangle 0 0 4 4)
+  (send dc set-pen "black" 1 'solid)
+  (send dc draw-line 0 0 3 3)
+  (send dc set-bitmap #f)
+  bm)
+
+(define (check-picture-roundtrip path)
+  (taglib-test-case (format "picture write/read/clear roundtrip: ~a" (file-name-from-path path))
+    (define tmp (copy-test-file-to-temp path))
+    (dynamic-wind
+      void
+      (lambda ()
+        (define picture (make-tags-picture-from-bitmap (make-test-bitmap)
+                                                       "Front Cover"
+                                                       #:mimetype "image/png"
+                                                       #:description "Racket test cover"))
+        (call-with-id3-tags tmp #:mode 'read-write
+          (lambda (tags)
+            (tags-picture! tags picture)
+            (check-true (tags-save! tags))))
+
+        (define reread (id3-tags tmp))
+        (define p (tags-picture reread))
+        (check-true (id3-picture? p))
+        (check-equal? (id3-picture-mimetype p) "image/png")
+        (check-equal? (id3-picture-kind p) "Front Cover")
+        (check-equal? (id3-picture-description p) "Racket test cover")
+        (check-true (> (id3-picture-size p) 0))
+        (check-true (is-a? (tags-picture->bitmap reread) bitmap%))
+
+        (call-with-id3-tags tmp #:mode 'read-write
+          (lambda (tags)
+            (tags-clear-picture! tags)
+            (check-true (tags-save! tags))))
+        (check-false (tags-picture (id3-tags tmp)))
+        )
+      (lambda ()
+        (when (file-exists? tmp) (delete-file tmp))))))
+
+(define (run-taglib-tests [verbosity 'normal])
+  (unless (memq verbosity '(quiet normal verbose very-verbose))
+    (raise-argument-error 'run-taglib-tests "(or/c 'quiet 'normal 'verbose 'very-verbose)" verbosity))
+  (parameterize ([current-taglib-test-verbosity verbosity])
+    (cond
+      [(not (directory-exists? test-audio-dir))
+       (unless (eq? verbosity 'quiet)
+         (printf "Skipping TagLib tests: test audio directory not found: ~a\n" test-audio-dir))
+       (void)]
+      [(not (taglib-usable?))
+       (unless (eq? verbosity 'quiet)
+         (printf "Skipping TagLib tests: TagLib runtime is not available or no readable test file was found.\n"))
+       (void)]
+      [else
+       (define read-files (existing-test-files taglib-read-files))
+       (define write-files (existing-test-files taglib-write-files))
+       (taglib-test-note "[taglib] test audio directory: ~a" test-audio-dir)
+       (taglib-test-note "[taglib] read files: ~a" (length read-files))
+       (taglib-test-note "[taglib] write files: ~a" (length write-files))
+       (for ([path (in-list read-files)]) (check-readable-snapshot path))
+       (when (pair? write-files)
+         ;; call-with close behavior only needs one writable copy.
+         (define tmp (copy-test-file-to-temp (car write-files)))
+         (dynamic-wind void
+                       (lambda () (check-call-with-closes tmp))
+                       (lambda () (when (file-exists? tmp) (delete-file tmp)))))
+       (for ([path (in-list write-files)]) (check-simple-write-roundtrip path))
+       ;; Exercise picture writing on FLAC first, because it is the least
+       ;; ambiguous container for embedded cover-art roundtrips with TagLib.
+       (define flac (build-path test-audio-dir "idyll.flac"))
+       (when (file-exists? flac) (check-picture-roundtrip flac))
+       (taglib-test-note "[taglib] done")])))
+
+(define (run-taglib-tests/verbose)
+  (run-taglib-tests 'verbose))
+
+(module+ test
+  (run-taglib-tests))
+
+(module+ main
+  (run-taglib-tests))

taglib.rkt

@@ -2,12 +2,19 @@
 
   (require "taglib-ffi.rkt"
            "private/utils.rkt"
-           racket/string
+           ffi/unsafe
-           racket/draw)
+           racket/class
+           racket/draw
+           racket/string)
 
   (provide id3-tags
+           call-with-id3-tags
 
            tags-valid?
+           tags-read-write?
+           tags-closed?
+           tags-close!
+           tags-save!
 
            tags-title
            tags-album
@@ -19,7 +26,18 @@
            tags-composer
            tags-disc-number
            tags-album-artist
-           
+
+           tags-title!
+           tags-album!
+           tags-artist!
+           tags-comment!
+           tags-year!
+           tags-genre!
+           tags-track!
+           tags-composer!
+           tags-disc-number!
+           tags-album-artist!
+
            tags-length
            tags-sample-rate
            tags-bit-rate
@@ -27,202 +45,514 @@
 
            tags-keys
            tags-ref
+           tags-set!
+           tags-set-values!
+           tags-append!
+           tags-clear!
 
            tags-picture
+           tags-picture!
+           tags-append-picture!
+           tags-clear-picture!
            tags-picture->bitmap
            tags-picture->file
            tags-picture->kind
            tags-picture->mimetype
+           tags-picture->description
            tags-picture->size
            tags-picture->ext
 
            tags->hash
 
+           make-tags-picture
+           make-tags-picture-from-bitmap
+           id3-picture?
            id3-picture-mimetype
            id3-picture-kind
            id3-picture-size
            id3-picture-bytes
+           id3-picture-description
+
+           PIC-KIND-OTHER
+           PIC-KIND-PNG-ICON32x32
+           PIC-KIND-OTHER-ICON
+           PIC-KIND-COVER
+           PIC-KIND-COVER-FRONT
+           PIC-KIND-COVER-BACK
+           PIC-KIND-LEAFLET
+           PIC-KIND-MEDIA
+           PIC-KIND-LEAD-SOLOIST
+           PIC-KIND-ARTIST
+           PIC-KIND-CONDUCTOR
+           PIC-KIND-BAND
+           PIC-KIND-ORCHESTRA
+           PIC-KIND-COMPOSER
+           PIC-KIND-LYRICIST
+           PIC-KIND-SONG-WRITER
+           PIC-KIND-TEXT-WRITER
+           PIC-KIND-RECORDING-LOCATION
+           PIC-KIND-DURING-RECORDING
+           PIC-KIND-DURING-PERFORMANCE
+           PIC-KIND-SCREEN-CAPTURE
+           PIC-KIND-BRIGHT-COLORED-FISH
+           PIC-KIND-ILLUSTRATION
+           PIC-KIND-BAND-LOGO
+           PIC-KIND-PUBLISHER-LOGO
            )
 
-  (define-struct id3-tag-struct
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-    (handle))
+;; Picture kinds
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;$00: Other
+;$01: 32x32 pixels 'file icon' (PNG only)
+;$02: Other file icon
+;$03: Cover (front) (The most common standard for album art)
+;$04: Cover (back)
+;$05: Leaflet page
+;$06: Media (e.g., label side of CD)
+;$07: Lead artist/soloist
+;$08: Artist/performer
+;$09: Conductor
+;$0A: Band/Orchestra
+;$0B: Composer
+;$0C: Lyricist/text writer
+;$0D: Recording location
+;$0E: During recording
+;$0F: During performance
+;$10: Movie/video screen capture
+;$11: A bright colored fish
+;$12: Illustration
+;$13: Band/artist logotype
+;$14: Publisher/Studio logotype
 
-  (define-struct id3-picture
+  (define PIC-KIND-OTHER 0)
-    (mimetype kind size bytes))
+  (define PIC-KIND-PNG-ICON32x32 1)
+  (define PIC-KIND-OTHER-ICON 2)
+  (define PIC-KIND-COVER 3)
+  (define PIC-KIND-COVER-FRONT 3)
+  (define PIC-KIND-COVER-BACK 4)
+  (define PIC-KIND-LEAFLET 5)
+  (define PIC-KIND-MEDIA 6)
+  (define PIC-KIND-LEAD-SOLOIST 7)
+  (define PIC-KIND-ARTIST 8)
+  (define PIC-KIND-CONDUCTOR 9)
+  (define PIC-KIND-BAND 10)
+  (define PIC-KIND-ORCHESTRA 10)
+  (define PIC-KIND-COMPOSER 11)
+  (define PIC-KIND-LYRICIST 12)
+  (define PIC-KIND-SONG-WRITER 12)
+  (define PIC-KIND-TEXT-WRITER 12)
+  (define PIC-KIND-RECORDING-LOCATION 13)
+  (define PIC-KIND-DURING-RECORDING 14)
+  (define PIC-KIND-DURING-PERFORMANCE 15)
+  (define PIC-KIND-SCREEN-CAPTURE 16)
+  (define PIC-KIND-BRIGHT-COLORED-FISH 17)
+  (define PIC-KIND-ILLUSTRATION 18)
+  (define PIC-KIND-BAND-LOGO 19)
+  (define PIC-KIND-PUBLISHER-LOGO 20)
+  
+  
+  (define-struct id3-tag-struct (handle))
+  (define-struct id3-picture (mimetype kind size bytes description))
 
-  (define (id3-tags file*)
+  (define clear-tag-value 'clear)
-    (let ((file (if (path? file*) (path->string file*) file*))
+
-          (valid? #f)
+  (define (normal-mode mode)
-          (title "")
+    (cond
-          (album "")
+      [(or (eq? mode 'read) (eq? mode 'read-only)) 'read]
-          (artist "")
+      [(or (eq? mode 'write) (eq? mode 'read-write)) 'read-write]
-          (comment "")
+      [else (raise-argument-error 'id3-tags "(or/c 'read 'read-only 'read-write 'write)" mode)]))
-          (year -1)
+
-          (genre "")
+  (define (file->string file*)
-          (track -1)
+    (if (path? file*) (path->string file*) file*))
-          (length -1)
+
-          (sample-rate -1)
+  (define (copy-string s)
-          (bit-rate -1)
+    (if (eq? s #f) "" (string-append s "")))
-          (channels -1)
+
-          (key-store (make-hash))
+  (define (property-name k)
-          (composer "")
+    (cond
-          (album-artist "")
+      [(symbol? k) (string-upcase (symbol->string k))]
-          (disc-number -1)
+      [(string? k) k]
-          (picture #f))
+      [else (raise-argument-error 'tag-property "(or/c symbol? string?)" k)]))
-      (let ((tag-file (taglib_file_new file)))
+
-        (if (eq? tag-file #f)
+  (define (property-symbol k)
+    (string->symbol (string-downcase (property-name k))))
+
+  (define (first-property h key [default ""])
+    (let ((v (hash-ref h key #f)))
+      (cond
+        [(and (pair? v) (string? (car v))) (car v)]
+        [(string? v) v]
+        [else default])))
+
+  (define (first-property-number h key [default -1])
+    (let ((n (string->number (first-property h key (number->string default)))))
+      (if n n default)))
+
+  (define (string-list? v)
+    (and (list? v) (andmap string? v)))
+
+  (define (bitmap->encoded-bytes bm mimetype)
+    (define kind
+      (cond
+        [(or (string-ci=? mimetype "image/jpeg") (string-ci=? mimetype "image/jpg")) 'jpeg]
+        [(string-ci=? mimetype "image/png") 'png]
+        [else (error 'make-tags-picture-from-bitmap
+                     "unsupported bitmap mimetype: ~a; use image/png or image/jpeg" mimetype)]))
+    (define out (open-output-bytes))
+    (unless (send bm save-file out kind)
+      (error 'make-tags-picture-from-bitmap "could not encode bitmap as ~a" mimetype))
+    (get-output-bytes out))
+
+
+  (define picture-type-names
+    (hash 0 "Other"
+          1 "File Icon"
+          2 "Other File Icon"
+          3 "Front Cover"
+          4 "Back Cover"
+          5 "Leaflet Page"
+          6 "Media"
+          7 "Lead Artist"
+          8 "Artist"
+          9 "Conductor"
+          10 "Band"
+          11 "Composer"
+          12 "Lyricist"
+          13 "Recording Location"
+          14 "During Recording"
+          15 "During Performance"
+          16 "Movie Screen Capture"
+          17 "Coloured Fish"
+          18 "Illustration"
+          19 "Band Logo"
+          20 "Publisher Logo"))
+
+  (define (picture-kind->string kind)
+    (cond
+      [(string? kind) kind]
+      [(symbol? kind) (string-titlecase (regexp-replace* #rx"-" (symbol->string kind) " "))]
+      [(integer? kind) (hash-ref picture-type-names kind (number->string kind))]
+      [else (raise-argument-error 'make-tags-picture "(or/c string? symbol? integer?)" kind)]))
+
+  (define (make-tags-picture mimetype kind data #:description [description ""])
+    (define bytes
+      (cond
+        [(bytes? data) data]
+        [(is-a? data bitmap%) (bitmap->encoded-bytes data mimetype)]
+        [else (raise-argument-error 'make-tags-picture "(or/c bytes? (is-a?/c bitmap%))" data)]))
+    (make-id3-picture mimetype (picture-kind->string kind) (bytes-length bytes) bytes description))
+
+  (define (make-tags-picture-from-bitmap bm kind #:mimetype [mimetype "image/png"] #:description [description ""])
+    (make-tags-picture mimetype kind bm #:description description))
+
+  (define (open-tag-file file)
+    (let ((tag-file (if (eq? (system-type 'os) 'windows)
+                        (taglib_file_new_wchar file)
+                        (taglib_file_new file))))
+      (cond
+        ((eq? tag-file #f) #f)
+        ((taglib_file_is_valid tag-file) tag-file)
+        (else
+         (taglib_file_free tag-file)
+         #f))
+      )
+    )
+
+  (define (read-property-map tag-file)
+    (define key-store (make-hash))
+    (let* ((keys (taglib_property_keys tag-file))
+           (i 0)
+           (key (and keys (taglib_property_key keys i)))
+           (key-list '()))
+      (while (not (eq? key #f))
+             (set! key-list (append key-list (list (copy-string key))))
+             (set! i (+ i 1))
+             (set! key (taglib_property_key keys i)))
+      (for-each
+       (lambda (key)
+         (let ((props (taglib_property_get tag-file key)))
+           (let* ((vals '())
+                  (i 0)
+                  (val (and props (taglib_property_val props i))))
+             (while (not (eq? val #f))
+                    (set! vals (append vals (list (copy-string val))))
+                    (set! i (+ i 1))
+                    (set! val (taglib_property_val props i)))
+             (when props (taglib_property_free props))
+             (hash-set! key-store (string->symbol (string-downcase key)) vals))))
+       key-list))
+    key-store)
+
+  (define (read-picture tag-file)
+    (let ((p (taglib-get-picture tag-file)))
+      (if (eq? p #f)
+          #f
+          (let ((mimetype (car p))
+                (description (cadr p))
+                (kind (caddr p))
+                (size (cadddr p))
+                (bytes (car (cddddr p))))
+            (make-id3-picture mimetype kind size bytes description)))))
+
+  (define (id3-tags file* #:mode [mode 'read])
+    (define file (file->string file*))
+    (define actual-mode (normal-mode mode))
+    (define read-write? (eq? actual-mode 'read-write))
+    (define valid? #f)
+    (define closed? #t)
+    (define tag-file #f)
+    (define tag #f)
+    (define title "")
+    (define album "")
+    (define artist "")
+    (define comment "")
+    (define year -1)
+    (define genre "")
+    (define track -1)
+    (define length -1)
+    (define sample-rate -1)
+    (define bit-rate -1)
+    (define channels -1)
+    (define key-store (make-hash))
+    (define composer "")
+    (define album-artist "")
+    (define disc-number -1)
+    (define picture #f)
+
+    (define (refresh-derived!)
+      (set! composer (first-property key-store 'composer ""))
+      (set! album-artist (first-property key-store 'albumartist ""))
+      (set! disc-number (first-property-number key-store 'discnumber -1)))
+
+    (define (open-and-read!)
+      (set! tag-file (open-tag-file file))
+      (if (eq? tag-file #f)
+          (begin
             (set! valid? #f)
-            (set! valid? (taglib_file_is_valid tag-file)))
+            (warn-sound "Could not open file ~a" file))
-        
+          (begin
-        (unless valid?
+            (set! valid? #t)
-          (when (eq? (system-type 'os) 'windows)
+            (set! closed? #f)
-            (dbg-sound "Could not open file ~a, trying wchar version on windows" file)
+            (set! tag (taglib_file_tag tag-file))
-            (unless (eq? tag-file #f)
+            (let ((ap (taglib_file_audioproperties tag-file)))
-              (taglib_file_free tag-file))
+              (set! title (copy-string (taglib_tag_title tag)))
-            (set! tag-file (taglib_file_new_wchar file))
+              (set! album (copy-string (taglib_tag_album tag)))
-            (if (eq? tag-file #f)
+              (set! artist (copy-string (taglib_tag_artist tag)))
-                (set! valid? #f)
+              (set! comment (copy-string (taglib_tag_comment tag)))
-                (set! valid? (taglib_file_is_valid tag-file)))))
+              (set! genre (copy-string (taglib_tag_genre tag)))
+              (set! year (let ((v (taglib_tag_year tag))) (if (zero? v) -1 v)))
+              (set! track (let ((v (taglib_tag_track tag))) (if (zero? v) -1 v)))
+              (set! length (taglib_audioproperties_length ap))
+              (set! sample-rate (taglib_audioproperties_samplerate ap))
+              (set! bit-rate (taglib_audioproperties_bitrate ap))
+              (set! channels (taglib_audioproperties_channels ap))
+              (set! key-store (read-property-map tag-file))
+              (refresh-derived!)
+              (set! picture (read-picture tag-file))
+              (taglib_tag_free_strings)
+              (unless read-write? (close!))))))
 
-        (unless valid?
+    (define (close!)
-          (warn-sound "Could not open file ~a" file)
+      (unless closed?
-          (unless (eq? tag-file #f)
+        (taglib_file_free tag-file)
-            (taglib_file_free tag-file)
+        (set! tag-file #f)
-            (set! tag-file #f)))
+        (set! tag #f)
-        
+        (set! closed? #t))
-        (when valid?
+      (void))
-          (let ((tag (taglib_file_tag tag-file))
-                (ap (taglib_file_audioproperties tag-file))
-                (cp (lambda (s) (string-append s "")))
-                )
-            (set! title (cp (taglib_tag_title tag)))
-            (set! album (cp (taglib_tag_album tag)))
-            (set! artist (cp (taglib_tag_artist tag)))
-            (set! comment (cp (taglib_tag_comment tag)))
-            (set! genre (cp (taglib_tag_genre tag)))
-            (set! year (taglib_tag_year tag))
-            (set! track (taglib_tag_track tag))
-            
-            (set! length (taglib_audioproperties_length ap))
-            (set! sample-rate (taglib_audioproperties_samplerate ap))
-            (set! bit-rate (taglib_audioproperties_bitrate ap))
-            (set! channels (taglib_audioproperties_channels ap))
 
-            (let* ((keys (taglib_property_keys tag-file))
+    (define (ensure-open! who)
-                   (i 0)
+      (unless valid? (error who "tag handle is invalid: ~a" file))
-                   (key (taglib_property_key keys i))
+      (unless read-write?
-                   (key-list '())
+        (error who "tag handle is read-only for ~a; open with #:mode 'read-write" file))
-                   )
+      (when closed? (error who "tag handle is closed: ~a" file)))
-              (while (not (eq? key #f))
-                     (set! key-list (append key-list (list (cp key))))
-                     (set! i (+ i 1))
-                     (set! key (taglib_property_key keys i)))
-              (for-each (lambda (key)
-                          (let ((props (taglib_property_get tag-file key)))
-                            (let* ((vals '())
-                                   (i 0)
-                                   (val (taglib_property_val props i)))
-                              (while (not (eq? val #f))
-                                     (set! vals (append vals (list (cp val))))
-                                     (set! i (+ i 1))
-                                     (set! val (taglib_property_val props i)))
-                              (taglib_property_free props)
-                              (hash-set! key-store
-                                         (string->symbol
-                                          (string-downcase key)) vals)
-                              )))
-                        key-list)
-              (set! composer (hash-ref key-store 'composer ""))
-              (set! album-artist (hash-ref key-store 'albumartist ""))
-              (set! disc-number (string->number
-                                 (car 
-                                  (hash-ref key-store 'discnumber (list "-1")))))
-              )
 
-            ; picture
+    (define (set-property-cache! key vals)
-            (let ((p (taglib-get-picture tag-file)))
+      (define sym (property-symbol key))
-              (if (eq? p #f)
+      (if (null? vals) (hash-remove! key-store sym) (hash-set! key-store sym vals))
-                  (set! picture #f)
+      (refresh-derived!))
-                  (let ((mimetype (car p))
-                        (kind (caddr p))
-                        (size (cadddr p))
-                        (bytes (car (cddddr p))))
-                    (set! picture (make-id3-picture mimetype kind size bytes))
-                    )))
 
-            ; cleaning up
+    (define (string->cptr s)
-            (taglib_tag_free_strings)
+      (define bs (string->bytes/utf-8 s))
-            (taglib_file_free tag-file)
+      (define len (bytes-length bs))
-            )
+      (define ptr (malloc _byte (+ len 1) 'atomic-interior))
-          )
+      (for ([i (in-range len)]) (ptr-set! ptr _byte i (bytes-ref bs i)))
-        (let ((handle 
+      (ptr-set! ptr _byte len 0)
-          (lambda (v . args)
+      ptr)
-            (cond
-              [(eq? v 'valid?) valid?]
-              [(eq? v 'title) title]
-              [(eq? v 'album) album]
-              [(eq? v 'artist) artist]
-              [(eq? v 'comment) comment]
-              [(eq? v 'composer) composer]
-              [(eq? v 'genre) genre]
-              [(eq? v 'year) year]
-              [(eq? v 'track) track]
-              [(eq? v 'length) length]
-              [(eq? v 'sample-rate) sample-rate]
-              [(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
-                   (hash-ref key-store (car args) #f))]
-              [(eq? v 'picture) picture]
-              [(eq? v 'to-hash)
-               (let ((h (make-hash)))
-                 (hash-set! h 'valid? valid?)
-                 (hash-set! h 'title title)
-                 (hash-set! h 'album album)
-                 (hash-set! h 'artist artist)
-                 (hash-set! h 'comment comment)
-                 (hash-set! h 'composer composer)
-                 (hash-set! h 'genre genre)
-                 (hash-set! h 'year year)
-                 (hash-set! h 'track track)
-                 (hash-set! h 'length length)
-                 (hash-set! h 'sample-rate sample-rate)
-                 (hash-set! h 'bit-rate bit-rate)
-                 (hash-set! h 'channels channels)
-                 (hash-set! h 'picture picture)
-                 (hash-set! h 'keys (hash-keys key-store))
-                 h)]
-              [else (error (format "Unknown tag-cmd '~a'" v))]
-              ))))
-          (make-id3-tag-struct handle))
-          )))
 
+    (define (apply-string! who value setter cache!)
+      (ensure-open! who)
+      (cond
+        [(eq? value clear-tag-value) (setter tag "") (cache! "")]
+        [(string? value) (setter tag value) (cache! value)]
+        [else (raise-argument-error who "(or/c string? 'clear)" value)]))
+
+    (define (apply-uint! who value setter cache!)
+      (ensure-open! who)
+      (cond
+        [(eq? value clear-tag-value) (setter tag 0) (cache! -1)]
+        [(and (exact-nonnegative-integer? value) (<= value #xffffffff))
+         (setter tag value) (cache! value)]
+        [else (raise-argument-error who "(or/c exact-nonnegative-integer? 'clear)" value)]))
+
+    (define (set-one-property! who key value #:append? [append? #f])
+      (ensure-open! who)
+      (cond
+        [(eq? value clear-tag-value)
+         (if append?
+             (taglib_property_set_append tag-file (property-name key) #f)
+             (taglib_property_set tag-file (property-name key) #f))
+         (set-property-cache! key '())]
+        [(string? value)
+         (if append?
+             (taglib_property_set_append tag-file (property-name key) (string->cptr value))
+             (taglib_property_set tag-file (property-name key) (string->cptr value)))
+         (if append?
+             (set-property-cache! key (append (hash-ref key-store (property-symbol key) '()) (list value)))
+             (set-property-cache! key (list value)))]
+        [else (raise-argument-error who "(or/c string? 'clear)" value)]))
+
+    (define (set-values-property! key values)
+      (ensure-open! 'tags-set-values!)
+      (cond
+        [(eq? values clear-tag-value)
+         (taglib_property_set tag-file (property-name key) #f)
+         (set-property-cache! key '())]
+        [(string-list? values)
+         (taglib_property_set tag-file (property-name key) #f)
+         (for ([v values]) (taglib_property_set_append tag-file (property-name key) (string->cptr v)))
+         (set-property-cache! key values)]
+        [else (raise-argument-error 'tags-set-values! "(or/c (listof string?) 'clear)" values)]))
+
+    (define (set-picture! value #:append? [append? #f])
+      (ensure-open! (if append? 'tags-append-picture! 'tags-picture!))
+      (cond
+        [(eq? value clear-tag-value)
+         (unless (taglib-clear-picture tag-file)
+           (error 'tags-picture! "could not clear picture for file: ~a" file))
+         (set! picture #f)]
+        [(id3-picture? value)
+         (define ok?
+           (if append?
+               (taglib-append-picture tag-file
+                                      (id3-picture-mimetype value)
+                                      (id3-picture-kind value)
+                                      (id3-picture-description value)
+                                      (id3-picture-bytes value))
+               (taglib-set-picture tag-file
+                                   (id3-picture-mimetype value)
+                                   (id3-picture-kind value)
+                                   (id3-picture-description value)
+                                   (id3-picture-bytes value))))
+         (unless ok? (error (if append? 'tags-append-picture! 'tags-picture!)
+                            "could not set picture for file: ~a" file))
+         (unless append? (set! picture value))]
+        [else (raise-argument-error (if append? 'tags-append-picture! 'tags-picture!)
+                                    "(or/c id3-picture? 'clear)" value)]))
+
+    (define (save!)
+      (ensure-open! 'tags-save!)
+      (taglib_file_save tag-file))
+
+    (define (to-hash)
+      (let ((h (make-hash)))
+        (hash-set! h 'valid? valid?)
+        (hash-set! h 'read-write? read-write?)
+        (hash-set! h 'closed? closed?)
+        (hash-set! h 'title title)
+        (hash-set! h 'album album)
+        (hash-set! h 'artist artist)
+        (hash-set! h 'comment comment)
+        (hash-set! h 'composer composer)
+        (hash-set! h 'genre genre)
+        (hash-set! h 'year year)
+        (hash-set! h 'track track)
+        (hash-set! h 'length length)
+        (hash-set! h 'sample-rate sample-rate)
+        (hash-set! h 'bit-rate bit-rate)
+        (hash-set! h 'channels channels)
+        (hash-set! h 'picture picture)
+        (hash-set! h 'keys (hash-keys key-store))
+        h))
+
+    (define (handle v . args)
+      (cond
+        [(eq? v 'valid?) valid?]
+        [(eq? v 'read-write?) read-write?]
+        [(eq? v 'closed?) closed?]
+        [(eq? v 'close!) (close!)]
+        [(eq? v 'save!) (save!)]
+        [(eq? v 'title) title]
+        [(eq? v 'album) album]
+        [(eq? v 'artist) artist]
+        [(eq? v 'comment) comment]
+        [(eq? v 'composer) composer]
+        [(eq? v 'genre) genre]
+        [(eq? v 'year) year]
+        [(eq? v 'track) track]
+        [(eq? v 'length) length]
+        [(eq? v 'sample-rate) sample-rate]
+        [(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 (hash-ref key-store (property-symbol (car args)) #f))]
+        [(eq? v 'picture) picture]
+        [(eq? v 'to-hash) (to-hash)]
+        [(eq? v 'set-title!) (apply-string! 'tags-title! (car args) taglib_tag_set_title (lambda (x) (set! title x)))]
+        [(eq? v 'set-album!) (apply-string! 'tags-album! (car args) taglib_tag_set_album (lambda (x) (set! album x)))]
+        [(eq? v 'set-artist!) (apply-string! 'tags-artist! (car args) taglib_tag_set_artist (lambda (x) (set! artist x)))]
+        [(eq? v 'set-comment!) (apply-string! 'tags-comment! (car args) taglib_tag_set_comment (lambda (x) (set! comment x)))]
+        [(eq? v 'set-genre!) (apply-string! 'tags-genre! (car args) taglib_tag_set_genre (lambda (x) (set! genre x)))]
+        [(eq? v 'set-year!) (apply-uint! 'tags-year! (car args) taglib_tag_set_year (lambda (x) (set! year x)))]
+        [(eq? v 'set-track!) (apply-uint! 'tags-track! (car args) taglib_tag_set_track (lambda (x) (set! track x)))]
+        [(eq? v 'set-composer!) (set-one-property! 'tags-composer! 'composer (car args))]
+        [(eq? v 'set-album-artist!) (set-one-property! 'tags-album-artist! 'albumartist (car args))]
+        [(eq? v 'set-disc-number!)
+         (let ((x (car args)))
+           (cond
+             [(eq? x clear-tag-value) (set-one-property! 'tags-disc-number! 'discnumber clear-tag-value)]
+             [(and (exact-nonnegative-integer? x) (<= x #xffffffff)) (set-one-property! 'tags-disc-number! 'discnumber (number->string x))]
+             [(string? x) (set-one-property! 'tags-disc-number! 'discnumber x)]
+             [else (raise-argument-error 'tags-disc-number! "(or/c exact-nonnegative-integer? string? 'clear)" x)]))]
+        [(eq? v 'set!) (set-one-property! 'tags-set! (car args) (cadr args))]
+        [(eq? v 'set-values!) (set-values-property! (car args) (cadr args))]
+        [(eq? v 'append!) (set-one-property! 'tags-append! (car args) (cadr args) #:append? #t)]
+        [(eq? v 'clear!) (set-one-property! 'tags-clear! (car args) clear-tag-value)]
+        [(eq? v 'set-picture!) (set-picture! (car args))]
+        [(eq? v 'append-picture!) (set-picture! (car args) #:append? #t)]
+        [(eq? v 'clear-picture!) (set-picture! clear-tag-value)]
+        [else (error (format "Unknown tag-cmd '~a'" v))]))
+
+    (open-and-read!)
+    (make-id3-tag-struct handle))
+
+  (define (call-with-id3-tags file proc #:mode [mode 'read])
+    (define tags (id3-tags file #:mode mode))
+    (dynamic-wind
+      void
+      (lambda () (proc tags))
+      (lambda () (tags-close! tags))))
 
   (define-syntax def
     (syntax-rules ()
       ((_ (fun v))
        (define (fun tags . args)
-         (apply (id3-tag-struct-handle tags) (cons v args)))
+         (apply (id3-tag-struct-handle tags) (cons v args))))))
-       )))
 
   (define-syntax defs
     (syntax-rules ()
-      ((_ f1)
+      ((_ f1) (def f1))
-       (def f1))
+      ((_ f1 f2 ...) (begin (def f1) (def f2) ...))))
-      ((_ f1 f2 ...)
-       (begin
-         (def f1)
-         (def f2)
-         ...))
-      ))
 
   (defs
     (tags-valid? 'valid?)
+    (tags-read-write? 'read-write?)
+    (tags-closed? 'closed?)
+    (tags-close! 'close!)
+    (tags-save! 'save!)
+
     (tags-title 'title)
     (tags-album 'album)
     (tags-artist 'artist)
@@ -233,7 +563,18 @@
     (tags-disc-number 'disc-number)
     (tags-year 'year)
     (tags-track 'track)
-    
+
+    (tags-title! 'set-title!)
+    (tags-album! 'set-album!)
+    (tags-artist! 'set-artist!)
+    (tags-comment! 'set-comment!)
+    (tags-genre! 'set-genre!)
+    (tags-composer! 'set-composer!)
+    (tags-album-artist! 'set-album-artist!)
+    (tags-disc-number! 'set-disc-number!)
+    (tags-year! 'set-year!)
+    (tags-track! 'set-track!)
+
     (tags-length 'length)
     (tags-sample-rate 'sample-rate)
     (tags-bit-rate 'bit-rate)
@@ -241,10 +582,16 @@
 
     (tags-keys 'keys)
     (tags-ref 'val)
+    (tags-set! 'set!)
+    (tags-set-values! 'set-values!)
+    (tags-append! 'append!)
+    (tags-clear! 'clear!)
 
     (tags-picture 'picture)
-    (tags->hash 'to-hash)
+    (tags-picture! 'set-picture!)
-    )
+    (tags-append-picture! 'append-picture!)
+    (tags-clear-picture! 'clear-picture!)
+    (tags->hash 'to-hash))
 
   (define (tags-picture->bitmap tags)
     (let ((p (tags-picture tags)))
@@ -257,34 +604,27 @@
 
   (define (tags-picture->kind tags)
     (let ((p (tags-picture tags)))
-      (if (eq? p #f)
+      (if (eq? p #f) #f (id3-picture-kind p))))
-          #f
-          (id3-picture-kind p))))
 
   (define (tags-picture->mimetype tags)
     (let ((p (tags-picture tags)))
-      (if (eq? p #f)
+      (if (eq? p #f) #f (id3-picture-mimetype p))))
-          #f
+
-          (id3-picture-mimetype p))))
+  (define (tags-picture->description tags)
+    (let ((p (tags-picture tags)))
+      (if (eq? p #f) #f (id3-picture-description p))))
 
   (define (tags-picture->ext tags)
     (let ((mt (tags-picture->mimetype tags)))
       (cond
-        ((eq? mt #f)
+        [(eq? mt #f) #f]
-         #f)
+        [(or (string-suffix? mt "/jpeg") (string-suffix? mt "/jpg")) 'jpg]
-        ((or (string-suffix? mt "/jpeg") (string-suffix? mt "/jpg"))
+        [(string-suffix? mt "/png") 'png]
-         'jpg)
+        [else #f])))
-        ((string-suffix? mt "/png")
-         'png)
-        (else #f)
-        )
-      ))
 
   (define (tags-picture->size tags)
     (let ((p (tags-picture tags)))
-      (if (eq? p #f)
+      (if (eq? p #f) #f (id3-picture-size p))))
-          #f
-          (id3-picture-size p))))
 
   (define (tags-picture->file tags path)
     (let ((p (tags-picture tags)))
@@ -299,7 +639,5 @@
             (close-output-port fh)
             (close-input-port in)
             #t))))
-            
-
-  ); end of module
 
+  )

tests.rkt

@@ -0,0 +1,79 @@
+#lang racket/base
+
+(require racket/runtime-path
+         "private/utils.rkt"
+         "libmpg123-ffi.rkt"
+         "audio-decoder.rkt"
+         )
+
+(provide mp3-ffi-read-test
+         decoder-read-test
+         test-file1
+         test-file2
+         test-file3
+         test-file4
+         test-file5)
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; test audio
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(define-runtime-path tests "../racket-audio-test")
+
+(define test-file1 (build-path tests "idyll.mp3"))
+(define test-file2 (build-path tests "idyll.opus"))
+(define test-file3 (build-path tests "mahler-1.mp3"))
+(define test-file4 (build-path tests "mahler-2.mp3"))
+(define test-file5 (build-path tests "mahler-1.opus"))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; test functions
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+;;; mp3 read test ffi
+
+(define (mp3-ffi-read-test)
+  (let* ((file test-file1)
+         (state #f)
+         (audio '())
+         (formats '())
+         (h (mpg123-ffi-decoder-handler))
+         )
+    (h 'new)
+    (h 'init file)
+    (let loop ()
+      (h 'read
+         (λ (kind pos buf done)
+           (set! state kind)
+           (set! audio (cons (list kind pos done) audio)))
+         (λ (pos rate channels sample-bits sample-bytes length)
+           (set! formats (cons (list rate channels sample-bits sample-bytes length) formats))))
+      (unless (eq? state 'done)
+        (loop)))
+    (h 'close)
+    (h 'delete)
+
+    (displayln (format "got ~a audio samples (~a)" (length audio) (car audio)))
+    (displayln (format "got ~a formats (~a)" (length formats) (car formats)))
+    ))
+
+;;; decoder read test
+      
+(define (decoder-read-test file)
+  (let* ((state #f)
+         (audio '())
+         (formats '())
+         (h (audio-open file
+                        (λ (reader-type ao-type handle meta)
+                          (set! formats (cons (list reader-type ao-type meta) formats)))
+                        (λ (reader-type ao-type handle buf-info audio-buffer buf-len)
+                          (set! audio
+                                (cons (list reader-type ao-type buf-info buf-len) audio)))
+                        )))
+    (audio-read h)
+
+    (displayln (format "got ~a audio samples (~a)" (length audio) (car audio)))
+    (displayln (format "got ~a formats (~a)" (length formats) (car formats)))
+    )
+  )
+

tests/capabilities-test.rkt

@@ -0,0 +1,32 @@
+#lang racket/base
+
+(require rackunit
+         racket-audio)
+
+(define formats
+  (audio-supported-formats))
+
+(check-not-false
+ (member "flac"
+         (audio-supported-extensions)))
+(check-equal?
+ (cdr (assoc "flac" formats))
+ "audio/x-flac")
+(check-eq?
+ (audio-decoder-for-extension "flac")
+ 'flac)
+(check-eq?
+ (audio-decoder-for-extension ".mp3")
+ 'ffmpeg)
+(check-not-false
+ (member (audio-decoder-for-extension 'opus)
+         '(opusfile ffmpeg)))
+(check-false
+ (audio-decoder-for-extension "not-audio"))
+
+(for ((extension
+       (in-list
+        (audio-supported-extensions))))
+  (check-true
+   (symbol?
+    (audio-decoder-for-extension extension))))

tests/flac-tests.rkt

@@ -0,0 +1,69 @@
+#lang racket/base
+
+(require "../flac-decoder.rkt")
+
+(define (test-flac-thread flac-path #:pool [pool #f])
+  (define result-ch (make-channel))
+
+  (define (start)
+    (thread
+     (lambda ()
+       (with-handlers ([exn:fail?
+                        (lambda (e)
+                          (channel-put result-ch
+                                       (list 'error (exn-message e))))])
+         (define frames 0)
+         (define buffers 0)
+         (define bytes 0)
+         (define fmt #f)
+
+         (define h
+           (flac-open
+            flac-path
+
+            ;; stream-info callback
+            (lambda (info)
+              (set! fmt info)
+              (printf "format: ~s\n" info)
+              (flush-output))
+
+            ;; audio callback
+            (lambda (info buffer len)
+              (set! buffers (add1 buffers))
+              (set! bytes (+ bytes len))
+              (define blocksize (hash-ref info 'blocksize #f))
+              (when (integer? blocksize)
+                (set! frames (+ frames blocksize)))
+
+              ;; af en toe iets printen, zodat je ziet dat hij loopt
+              (when (zero? (modulo buffers 500))
+                (printf "buffers=~a bytes=~a frames=~a\n"
+                        buffers bytes frames)
+                (flush-output)))))
+
+         (unless h
+           (error 'test-flac-thread "could not open FLAC file: ~a" flac-path))
+
+         (define state (flac-read h))
+
+         (channel-put result-ch
+                      (list 'ok
+                            'state state
+                            'buffers buffers
+                            'bytes bytes
+                            'frames frames
+                            'format fmt))))
+     #:pool pool)
+    )
+   
+  (start)
+  (start)
+  (start)
+
+  (channel-get result-ch)
+  (channel-get result-ch)
+  (channel-get result-ch)
+  )
+
+
+; (test-flac-thread "\\\\panderleou\\music\\Jazz\\LA4\\LA4 - Zaca\\01 Zaca.flac")

tests/opus-tests.rkt

@@ -0,0 +1,46 @@
+#lang racket/base
+
+(require "../main.rkt"
+         "../audio-encoder.rkt")
+
+
+(define (convert-to-opus flac-in opus-out)
+  (let* ((opus-kbps 224)
+         (settings (hash 'bitrate (* opus-kbps 1000)
+                         'vbr #t))
+         )
+    (with-handlers ([exn? (λ (e)
+                            (displayln (format "~a" e))
+                            (when (file-exists? opus-out)
+                              (delete-file opus-out))
+                            #f)])
+      (let ((result (audio-encode flac-in opus-out
+                                  settings
+                                  #:encoder 'opus
+                                  #:copy-tags? #t)))
+        #t)
+      )
+    )
+  )
+
+(define (times-3-convert flac-in opus-out1 opus-out2 opus-out3 #:pool [pool #f])
+  (define (start opus-out)
+    (thread (λ ()
+              (displayln (format "Starting conversion: ~a" opus-out))
+              (convert-to-opus flac-in opus-out)
+              (displayln (format"  converted: ~a" opus-out))
+              #t
+              ) #:pool pool)
+    )
+
+  (let* ((t1 (start opus-out1))
+         (t2 (start opus-out2))
+         (t3 (start opus-out3))
+         )
+    (thread-wait t1)
+    (thread-wait t2)
+    (thread-wait t3)
+    )
+  )
+
+; (convert-to-opus  "\\\\panderleou\\music\\Jazz\\LA4\\LA4 - Zaca\\01 Zaca.flac" "c:\\tmp\\test.opus" )