Documentation oke.

README.md

@@ -1,14 +1,80 @@
 # 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
-% brew install flac
-% brew install mpg123
-% brew install ffmpeg-full
+For playback and decoding, install the native libraries used by the selected
+backends:
 
+- libao
+- libFLAC
+- mpg123
+- FFmpeg libraries, including libavutil, libavcodec, libavformat and
+  libswresample
 
+For encoding, also install:
+
+- libopusenc
+- libopus
+- libogg
+- TagLib with the C binding, usually provided as `taglib` / `taglib_c`
+
+The Opus encoder backend uses libopusenc directly.  The FLAC encoder backend
+uses libFLAC directly.  FLAC sample-rate conversion uses the existing FFmpeg
+swresample layer.  Metadata and cover-art copying use the TagLib wrapper; the
+public `taglib.rkt` API also supports read-write tag editing.
+
+## 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 taglib
+```
+
+Some Homebrew installations provide FFmpeg as `ffmpeg`; older local setups may
+use `ffmpeg-full`.
+
+## 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
+```

audio-decoder.rkt

@@ -2,6 +2,7 @@
 
   (require "flac-decoder.rkt"
            "mp3-decoder.rkt"
+           "opusfile-decoder.rkt"
            "ffmpeg-decoder.rkt"
            "audio-sniffer.rkt"
            "private/utils.rkt"
@@ -22,6 +23,8 @@
            make-audio-reader
            audio-handle?
            audio-supported-extensions
+           current-opusfile-output-format
+           opusfile-output-format?
            )
 
   ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
@@ -56,7 +59,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"
@@ -229,21 +243,23 @@
     (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...
-                 (flac . flac)
-                 (ogg . ffmpeg)
-                 (vorbis . ffmpeg)
-                 (opus . ffmpeg)
-                 (wav . ffmpeg)
-                 (aiff . ffmpeg)
-                 (mp4 . ffmpeg)
-                 (aac . ffmpeg)
-                 (alac . ffmpeg)
-                 (ac3 . ffmpeg)
-                 (ape . ffmpeg)
-                 (wavpack . ffmpeg)
-                 (wma . ffmpeg)
-                 (matroska . ffmpeg))))
+    (make-hash
+     (list (cons 'mp3 'ffmpeg)            ; ffmpeg does a better job on gapless playback...
+           (cons 'flac 'flac)
+           (cons 'ogg 'ffmpeg)
+           (cons 'vorbis 'ffmpeg)
+           (cons 'opus (if (opusfile-available?) 'opusfile 'ffmpeg))
+           (cons 'wav 'ffmpeg)
+           (cons 'aiff 'ffmpeg)
+           (cons 'mp4 'ffmpeg)
+           (cons 'aac 'ffmpeg)
+           (cons 'alac 'ffmpeg)
+           (cons 'ac3 'ffmpeg)
+           (cons 'ape 'ffmpeg)
+           (cons 'wavpack 'ffmpeg)
+           (cons 'wma 'ffmpeg)
+           (cons 'matroska 'ffmpeg))))
+
 
 
   (define (find-reader audio-file)

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-placed-player.rkt

@@ -337,6 +337,32 @@
       (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))
@@ -478,6 +504,15 @@
                    (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))

audio-player.rkt

@@ -33,6 +33,8 @@
          audio-ao-buf-ms!
          audio-ao-buf-ms
          audio-known-exts?
+         audio-param!
+         audio-param
          )
 
 (define-runtime-path placed-player-module "audio-placed-player.rkt")
@@ -52,6 +54,9 @@
 (define (percentage? p)
   (and (number? p) (>= p 0)))
 
+(define (any? x)
+  #t)
+
 (define (max-percentage? n)
   (λ (p) (and (percentage? p)
               (<= p n))))
@@ -281,6 +286,13 @@
   (-> audio-play? (or/c integer? boolean?))
   ((audio-play-rpc handle) 'ao-buf-ms))
 
+(define/contract (audio-param! handle param value)
+  (-> audio-play? symbol? any? any?)
+  ((audio-play-rpc handle) 'param! param value))
+
+(define/contract (audio-param handle param)
+  (-> audio-play? symbol? any?)
+  ((audio-play-rpc handle) 'param param))
   
     
     

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-definitions.rkt

@@ -29,7 +29,20 @@
          fmpg-buffer-start-sample
          fmpg-buffer-end-sample
          fmpg-sample-position
-         ffmpeg-version)
+         ffmpeg-version
+
+         ;; Shared FFmpeg/swresample bindings for encoder-side PCM conversion.
+         ;; Keeping these exports here prevents a second, divergent FFmpeg FFI
+         ;; version layer in private/pcm-converter.rkt.
+         AV_SAMPLE_FMT_S32
+         swr_alloc_set_opts2
+         swr_init
+         swr_free
+         swr_get_out_samples
+         swr_get_delay
+         swr_convert
+         ffmpeg-make-default-channel-layout
+         ffmpeg-channel-layout-uninit!)
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;; C - Types & Functions
@@ -248,6 +261,23 @@
    )
   )
 
+(def-avutil av_channel_layout_default
+  (_fun _AVChannelLayout-pointer _int -> _void))
+
+(def-avutil av_channel_layout_uninit
+  (_fun _AVChannelLayout-pointer -> _void))
+
+(define (ffmpeg-make-default-channel-layout channels)
+  (let ((p (cast (malloc (ctype-sizeof _AVChannelLayout) 'atomic-interior)
+                 _pointer
+                 _AVChannelLayout-pointer)))
+    (av_channel_layout_default p channels)
+    p))
+
+(define (ffmpeg-channel-layout-uninit! p)
+  (when p (av_channel_layout_uninit p))
+  #t)
+
 ; _AVCodecParameters:
 ;   codec_type  : AVMediaType
 ;   codec_id    : int / AVCodecID

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

@@ -15,7 +15,9 @@
   '("racket/gui" "racket/base" "racket"
                  "finalizer" "draw-lib" "net-lib"
                  "simple-log" "racket-sprintf"
-                 "early-return" "let-assert")
+                 "early-return" "let-assert"
+                 "rackunit-lib"
+                 )
   )
 
 (define build-deps

libflac-ffi.rkt

@@ -6,6 +6,7 @@
          )
 
 (provide flac-ffi-decoder-handler
+         flac-ffi-encoder-handler
          _FLAC__StreamMetadata
          FLAC__StreamMetadata-type
          flac-ffi-meta
@@ -371,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))
 
@@ -639,5 +641,164 @@
       ))
   )
 
+
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; 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" r))
+      #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
 

main.rkt

@@ -3,10 +3,13 @@
 (require "taglib.rkt"
          "audio-sniffer.rkt"
          "audio-player.rkt"
+         "opusfile-decoder.rkt"
          )
 
 (provide (all-from-out "taglib.rkt")
          (all-from-out "audio-sniffer.rkt")
          (all-from-out "audio-player.rkt")
+         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")])
+             '(#f)))
+
+  (define libopus
+    (get-lib (case (system-type 'os)
+               [(windows) '("opus")]
+               [else      '("opus" "libopus")])
+             '(#f)))
+
+  (define libopusenc
+    (get-lib (case (system-type 'os)
+               [(windows) '("libopusenc")]
+               [else      '("opusenc" "libopusenc")])
+             '(#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")])
+                               '(#f)))
+
+  (define libopus (get-lib (case (system-type 'os)
+                             [(windows) '("opus")]
+                             [else      '("opus" "libopus")])
+                           '(#f)))
+  
+  (define libopusfile (get-lib (case (system-type 'os)
+                                 [(windows) '("opusfile")]
+                                 [else      '("opusfile" "libopusfile")])
+                               '(#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

@@ -9,7 +9,7 @@
          "tests.rkt"
          )
 
-(define place-mode #f)
+(define place-mode #t)
 
 (define run-queue #f)
 (define (set-test a)
@@ -26,7 +26,7 @@
          )
     (sprintf "%02d:%02d" minutes seconds)))
 
-(define (audio-player-state h st)
+(define (audio-player-state h s st)
   (early-return
    ((? (not (audio-play? h)) => 'done))
    (let* ((f (audio-file h))

private/pcm-converter.rkt

@@ -0,0 +1,187 @@
+(module pcm-converter racket/base
+
+  (require ffi/unsafe
+           "utils.rkt"
+           "../ffmpeg-definitions.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 (swr-ctx in-layout out-layout 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->integer-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 (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 (make-plane ptr)
+    (let ((planes (malloc _pointer 1 'atomic-interior)))
+      (ptr-set! planes _pointer 0 ptr)
+      planes))
+
+  (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))
+           (in-layout (ffmpeg-make-default-channel-layout channels-in))
+           (out-layout (ffmpeg-make-default-channel-layout channels-out)))
+      (let-values (((ret ctx) (swr_alloc_set_opts2 #f
+                                                   out-layout AV_SAMPLE_FMT_S32 rate-out
+                                                   in-layout AV_SAMPLE_FMT_S32 rate-in
+                                                   0 #f)))
+        (when (< ret 0) (error 'make-pcm-converter "swr_alloc_set_opts2 failed: ~a" ret))
+        (let ((ret-init (swr_init ctx)))
+          (when (< ret-init 0) (error 'make-pcm-converter "swr_init failed: ~a" ret-init))
+          (make-raw-pcm-converter ctx in-layout out-layout input-format (make-output-format input-format settings)
+                                  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 (convert* c in-bytes in-samples)
+    (let* ((channels (pcm-converter-channels c))
+           (max-out-samples (swr_get_out_samples (pcm-converter-swr-ctx c) in-samples)))
+      (cond [(<= max-out-samples 0) (values #"" 0)]
+            [else
+             (let* ((out-size (* max-out-samples channels S32-BYTES))
+                    (out-ptr (malloc out-size 'atomic-interior))
+                    (out-planes (make-plane out-ptr))
+                    (in-ptr (and in-bytes (bytes->native in-bytes (bytes-length in-bytes))))
+                    (in-planes (and in-ptr (make-plane in-ptr)))
+                    (out-samples (swr_convert (pcm-converter-swr-ctx c) out-planes max-out-samples in-planes in-samples)))
+               (when (< out-samples 0) (error 'pcm-converter-convert "swr_convert failed: ~a" out-samples))
+               (values (native->bytes out-ptr (* out-samples channels S32-BYTES)) out-samples))])))
+
+  (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)))
+      (convert* c s32 in-samples)))
+
+  (define (pcm-converter-drain c)
+    (ensure-open! c 'pcm-converter-drain)
+    (let* ((ctx (pcm-converter-swr-ctx c))
+           (delay (swr_get_delay ctx (pcm-converter-out-rate c)))
+           (channels (pcm-converter-channels c)))
+      (cond [(<= delay 0) (values #"" 0)]
+            [else
+             (let* ((out-size (* delay channels S32-BYTES))
+                    (out-ptr (malloc out-size 'atomic-interior))
+                    (out-planes (make-plane out-ptr))
+                    (out-samples (swr_convert ctx out-planes delay #f 0)))
+               (when (< out-samples 0) (error 'pcm-converter-drain "swr_convert drain failed: ~a" out-samples))
+               (values (native->bytes out-ptr (* out-samples channels S32-BYTES)) out-samples))])))
+
+  (define (pcm-converter-close! c)
+    (when (and (pcm-converter? c) (not (pcm-converter-closed? c)))
+      (set-pcm-converter-swr-ctx! c (swr_free (pcm-converter-swr-ctx c)))
+      (ffmpeg-channel-layout-uninit! (pcm-converter-in-layout c))
+      (ffmpeg-channel-layout-uninit! (pcm-converter-out-layout c))
+      (set-pcm-converter-closed?! c #t))
+    #t)
+
+  ) ; end of module

scrbl/audio-decoder.scrbl

@@ -67,7 +67,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?]{
 

scrbl/audio-encoder.scrbl

@@ -0,0 +1,230 @@
+#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
+format differs from the decoded input format, @racketmodname[racket-audio/private/pcm-converter]
+uses the existing FFmpeg @tt{swresample} layer from
+@racketmodname[racket-audio/ffmpeg-definitions] to perform PCM normalisation.
+
+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-player.scrbl

@@ -308,7 +308,7 @@ 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{Example}
+@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.

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

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

@@ -73,7 +73,7 @@ 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}
+@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
@@ -329,7 +329,7 @@ audio, one sample frame contains one sample for the left channel and one sample
 for the right channel.
 }
 
-@section{Seeking}
+@section[#:tag "ffmpeg-definitions-seeking"]{Seeking}
 
 @defproc[(fmpg-seek-ms! [instance any/c]
                        [target-pos-ms exact-nonnegative-integer?])

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

@@ -145,7 +145,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/libao-async-ffi-racket.scrbl

@@ -22,7 +22,7 @@ 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{Overview}
+@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
@@ -195,7 +195,7 @@ larger queue elements.  The target chunk size is controlled by
 different @racket[music-id] values are not merged into the same output chunk.
 }
 
-@section{Playback state}
+@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
@@ -282,7 +282,7 @@ latency but increase scheduling pressure on the Racket worker thread and on the
 audio backend.
 }
 
-@section{Implementation strategy}
+@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

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

@@ -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?])
@@ -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/racket-audio.scrbl

@@ -21,6 +21,8 @@
 @include-section["audio-player.scrbl"]
 @include-section["audio-sniffer.scrbl"]
 @include-section["taglib.scrbl"]
+@include-section["audio-encoder.scrbl"]
+@include-section["encoder-test.scrbl"]
 @include-section["play-test.scrbl"]
 @include-section["audio-placed-player.scrbl"]
 @include-section["audio-decoder.scrbl"]

scrbl/taglib.scrbl

@@ -9,48 +9,72 @@
 @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
-reader used by the audio package.  It wraps the lower level TagLib FFI module
-and presents a small, read-only Racket API for common tags, audio properties,
-generic properties, and embedded cover art.
+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.
 
-Calling @racket[id3-tags] opens the file through TagLib, copies the values that
-are needed on the Racket side, reads the optional embedded picture, frees the
-native TagLib objects, and returns an opaque tag handle.  The handle is
-therefore a snapshot of the metadata at the time it was read.  It does not keep
-the media file or the native TagLib handle open.
+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 module uses TagLib to open the
-file, so the usable file types are the file types supported by the TagLib
-library available at run time.  This module is not a tag editor; it only reads
-metadata.
+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{Reading metadata}
+@section{Opening and closing tag handles}
 
-@defproc[(id3-tags [file path-string?]) any/c]{
-Reads metadata from @racket[file] and returns an opaque tag handle.  The
-argument may be a path or a string.  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[(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.
 
-The returned handle is passed to the other procedures in this module.  If the
-file cannot be opened, @racket[id3-tags] still returns a handle, but
-@racket[tags-valid?] returns @racket[#f].  Other accessors then return their
-default values, such as @racket[""], @racket[-1], @racket['()], or
-@racket[#f].}
+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.
 
-@defproc[(tags-valid? [tags any/c]) boolean?]{
-Returns @racket[#t] when @racket[id3-tags] successfully opened the file and
-TagLib reported it as valid.}
+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[
-(define tags (id3-tags "song.mp3"))
-
-(when (tags-valid? tags)
-  (printf "~a - ~a\n" (tags-artist tags) (tags-title tags)))]
+(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}
 
@@ -59,32 +83,52 @@ TagLib reported it as valid.}
  @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?])]
+ @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.
+are returned as the empty string.}
 
 @deftogether[
 (@defproc[(tags-year [tags any/c]) integer?]
- @defproc[(tags-track [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].
+numeric values are returned as @racket[-1].}
 
 @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 lower-case @racket['composer] key, the album artist from
-@racket['albumartist], and the disc number from @racket['discnumber].
+(@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.}
 
-Composer and album artist return a list of strings when the property is present
-and the empty string when it is missing.  The disc number is parsed from the
-first property value and defaults to @racket[-1].  If the stored value cannot be
-parsed as a number, the result may be @racket[#f].  Use @racket[tags-keys] and
-@racket[tags-ref] for direct access to the complete generic property store.
+@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}
 
@@ -92,10 +136,11 @@ parsed as a number, the result may be @racket[#f].  Use @racket[tags-keys] and
 (@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?])] 
+ @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.  Missing values are returned as
-@racket[-1].
+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}
 
@@ -109,9 +154,39 @@ 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[
-(for ([key (in-list (tags-keys tags))])
-  (printf "~a: ~s\n" key (tags-ref tags key)))]
+(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.
@@ -120,8 +195,8 @@ those values as lists instead of joining them into one string.
 
 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.  When no picture is available, the
-picture-related procedures return @racket[#f].
+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
@@ -130,14 +205,15 @@ 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)])] 
+ @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.
+recognized.}
 
 @defproc[(tags-picture->bitmap [tags any/c])
          (or/c (is-a?/c bitmap%) #f)]{
@@ -150,42 +226,86 @@ Reads the embedded picture bytes with @racket[read-bitmap] and returns a
          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.  The file name is not adjusted
-automatically; use @racket[tags-picture->ext] when the caller wants to choose an
-extension from the MIME type.}
+@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 ext (tags-picture->ext tags))
+(define cover
+  (make-tags-picture "image/jpeg" 3 (file->bytes "cover.jpg")
+                     #:description "Cover"))
 
-(when ext
-  (tags-picture->file tags
-                      (format "cover.~a" ext)))]
+(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-mimetype [picture any/c]) string?]
- @defproc[(id3-picture-kind [picture any/c]) integer?]
- @defproc[(id3-picture-size [picture any/c]) integer?]
- @defproc[(id3-picture-bytes [picture any/c]) bytes?])] 
-Access the fields of a picture value returned by @racket[tags-picture].  These
-procedures are useful when the caller wants to process the image bytes directly
-instead of converting them to a bitmap or writing them to a file.
+(@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['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 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{Example}
+@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"))
@@ -209,10 +329,10 @@ 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.
 
-The tag handle is implemented as a small Racket object with a private dispatch
-procedure.  The native TagLib file is not stored in the handle.  This keeps the
-public API simple and prevents native resources from leaking into application
-code.
+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

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,6 +15,7 @@
          taglib_file_new_type
          taglib_file_is_valid
          taglib_file_free
+         taglib_file_save
 
          taglib_file_tag
          taglib_file_audioproperties
@@ -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,36 +44,19 @@
 
          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
-         )
-
-
-;(define-runtime-path lib-path "..");
-;
-;(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)))
-;           ))
+         taglib-set-picture
+         taglib-append-picture
+         taglib-clear-picture)
 
 (define zlib (get-lib '("zlib" "libz") '(#f)))
 (define libtag (get-lib '("tag" "libtag") '("2" #f)))
@@ -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)))
-    ))
-
-; int taglib_audioproperties_length(const TagLib_AudioProperties *audioProperties);
-; etc...
+       (_fun _TagLib_AudioProperties-pointer -> _int)))))
 
 (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]
-   ))
-
-
-
-; 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);
+   [size _uint]))
 
 (define _Complex_Property_Attribute-pointer (_cpointer/null 'taglib-complex-property-attribute))
 
@@ -257,38 +228,97 @@
 (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))
 
-(define (taglib-get-picture tag-file)
-  (define (cp s) (string-append s ""))
-  (define (to-bytestring data size)
+;; 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)
 
-    (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))
+(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->malloc-cstring s)
+  (bytes->malloc-ptr (string->bytes/utf-8 s) #t))
+
+(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) (if (eq? s #f) "" (string-append s "")))
   (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)
-                               _pointer
-                               (_bytes o size)))
-                 )
+                 (data (cast (TagLib_Complex_Property_Picture_Data-data pd) _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
-           racket/draw)
+           ffi/unsafe
+           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
@@ -20,6 +27,17 @@
            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,407 @@
 
            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)
 
-  (define-struct id3-tag-struct
-    (handle))
+  (define-struct id3-tag-struct (handle))
+  (define-struct id3-picture (mimetype kind size bytes description))
 
-  (define-struct id3-picture
-    (mimetype kind size bytes))
+  (define clear-tag-value 'clear)
 
-  (define (id3-tags file*)
-    (let ((file (if (path? file*) (path->string file*) file*))
-          (valid? #f)
-          (title "")
-          (album "")
-          (artist "")
-          (comment "")
-          (year -1)
-          (genre "")
-          (track -1)
-          (length -1)
-          (sample-rate -1)
-          (bit-rate -1)
-          (channels -1)
-          (key-store (make-hash))
-          (composer "")
-          (album-artist "")
-          (disc-number -1)
-          (picture #f))
-      (let ((tag-file (taglib_file_new file)))
-        (if (eq? tag-file #f)
+  (define (normal-mode mode)
+    (cond
+      [(or (eq? mode 'read) (eq? mode 'read-only)) 'read]
+      [(or (eq? mode 'write) (eq? mode 'read-write)) 'read-write]
+      [else (raise-argument-error 'id3-tags "(or/c 'read 'read-only 'read-write 'write)" mode)]))
+
+  (define (file->string file*)
+    (if (path? file*) (path->string file*) file*))
+
+  (define (copy-string s)
+    (if (eq? s #f) "" (string-append s "")))
+
+  (define (property-name k)
+    (cond
+      [(symbol? k) (string-upcase (symbol->string k))]
+      [(string? k) k]
+      [else (raise-argument-error 'tag-property "(or/c symbol? string?)" k)]))
+
+  (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 (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 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 (taglib_file_new file)))
+      (if (and tag-file (taglib_file_is_valid tag-file))
+          tag-file
+          (begin
+            (when (and tag-file (not (eq? tag-file #f))) (taglib_file_free tag-file))
+            (if (eq? (system-type 'os) 'windows)
+                (begin
+                  (dbg-sound "Could not open file ~a, trying wchar version on windows" file)
+                  (let ((wtag-file (taglib_file_new_wchar file)))
+                    (if (and wtag-file (taglib_file_is_valid wtag-file)) wtag-file
+                        (begin
+                          (when (and wtag-file (not (eq? wtag-file #f))) (taglib_file_free wtag-file))
+                          #f))))
+                #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
+            (set! valid? #t)
+            (set! closed? #f)
+            (set! tag (taglib_file_tag tag-file))
+            (let ((ap (taglib_file_audioproperties tag-file)))
+              (set! title (copy-string (taglib_tag_title tag)))
+              (set! album (copy-string (taglib_tag_album tag)))
+              (set! artist (copy-string (taglib_tag_artist tag)))
+              (set! comment (copy-string (taglib_tag_comment tag)))
+              (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?
-          (when (eq? (system-type 'os) 'windows)
-            (dbg-sound "Could not open file ~a, trying wchar version on windows" file)
-            (unless (eq? tag-file #f)
-              (taglib_file_free tag-file))
-            (set! tag-file (taglib_file_new_wchar file))
-            (if (eq? tag-file #f)
-                (set! valid? #f)
-                (set! valid? (taglib_file_is_valid tag-file)))))
+    (define (close!)
+      (unless closed?
+        (taglib_file_free tag-file)
+        (set! tag-file #f)
+        (set! tag #f)
+        (set! closed? #t))
+      (void))
 
-        (unless valid?
-          (warn-sound "Could not open file ~a" file)
-          (unless (eq? tag-file #f)
-            (taglib_file_free tag-file)
-            (set! tag-file #f)))
+    (define (ensure-open! who)
+      (unless valid? (error who "tag handle is invalid: ~a" file))
+      (unless read-write?
+        (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)))
 
-        (when valid?
-          (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))
+    (define (set-property-cache! key vals)
+      (define sym (property-symbol key))
+      (if (null? vals) (hash-remove! key-store sym) (hash-set! key-store sym vals))
+      (refresh-derived!))
 
-            (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))
+    (define (string->cptr s)
+      (define bs (string->bytes/utf-8 s))
+      (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)))
+      (ptr-set! ptr _byte len 0)
+      ptr)
 
-            (let* ((keys (taglib_property_keys tag-file))
-                   (i 0)
-                   (key (taglib_property_key keys i))
-                   (key-list '())
-                   )
-              (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")))))
-              )
+    (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)]))
 
-            ; picture
-            (let ((p (taglib-get-picture tag-file)))
-              (if (eq? p #f)
-                  (set! picture #f)
-                  (let ((mimetype (car p))
-                        (kind (caddr p))
-                        (size (cadddr p))
-                        (bytes (car (cddddr p))))
-                    (set! picture (make-id3-picture mimetype kind size bytes))
-                    )))
+    (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)]))
 
-            ; cleaning up
-            (taglib_tag_free_strings)
-            (taglib_file_free tag-file)
-            )
-          )
-        (let ((handle 
-          (lambda (v . args)
-            (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 (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)
-       (def f1))
-      ((_ f1 f2 ...)
-       (begin
-         (def f1)
-         (def f2)
-         ...))
-      ))
+      ((_ f1) (def f1))
+      ((_ 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)
@@ -234,6 +457,17 @@
     (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 +475,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 +497,27 @@
 
   (define (tags-picture->kind tags)
     (let ((p (tags-picture tags)))
-      (if (eq? p #f)
-          #f
-          (id3-picture-kind p))))
+      (if (eq? p #f) #f (id3-picture-kind p))))
 
   (define (tags-picture->mimetype tags)
     (let ((p (tags-picture tags)))
-      (if (eq? p #f)
-          #f
-          (id3-picture-mimetype p))))
+      (if (eq? p #f) #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)
-         #f)
-        ((or (string-suffix? mt "/jpeg") (string-suffix? mt "/jpg"))
-         'jpg)
-        ((string-suffix? mt "/png")
-         'png)
-        (else #f)
-        )
-      ))
+        [(eq? mt #f) #f]
+        [(or (string-suffix? mt "/jpeg") (string-suffix? mt "/jpg")) 'jpg]
+        [(string-suffix? mt "/png") 'png]
+        [else #f])))
 
   (define (tags-picture->size tags)
     (let ((p (tags-picture tags)))
-      (if (eq? p #f)
-          #f
-          (id3-picture-size p))))
+      (if (eq? p #f) #f (id3-picture-size p))))
 
   (define (tags-picture->file tags path)
     (let ((p (tags-picture tags)))
@@ -300,6 +533,4 @@
             (close-input-port in)
             #t))))
 
-
-  ); end of module
-
+  )

tests.rkt

@@ -21,7 +21,7 @@
 (define-runtime-path tests "../racket-audio-test")
 
 (define test-file1 (build-path tests "idyll.mp3"))
-(define test-file2 (build-path tests "idyll.flac"))
+(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"))