index

README.md

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

audio-decoder.rkt

@@ -6,9 +6,11 @@
            "ffmpeg-decoder.rkt"
            "audio-sniffer.rkt"
            "private/utils.rkt"
+           "audio-errors.rkt"
            racket/contract
            racket/string
            racket/path
+           racket-mimetypes
            )
 
   (provide audio-open
@@ -23,6 +25,8 @@
            make-audio-reader
            audio-handle?
            audio-supported-extensions
+           audio-supported-formats
+           audio-decoder-for-extension
            current-opusfile-output-format
            opusfile-output-format?
            )
@@ -106,6 +110,20 @@
   (define (audio-supported-extensions)
     known-extensions)
 
+  (define/contract (audio-supported-formats)
+    (-> (listof
+         (cons/c string?
+                 string?)))
+    (for/list ((extension
+                (in-list known-extensions)))
+      (cons
+       extension
+       (mimetype-for-ext
+        (string-append "audio."
+                       extension)
+        #:default
+        "application/octet-stream"))))
+
   ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
   ;; Register audio reader
   ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
@@ -193,13 +211,20 @@
     (let ((file (if (path? audio-file)
                     (path->string audio-file)
                     audio-file)))
-      (unless (audio-file-valid? audio-file)
-        (error (format "Not a valid audio file '~a'" audio-file)))
+
       (unless (file-exists? audio-file)
-        (error (format "File '~a' does not exist" audio-file)))
+        (raise-audio-error 'file-not-found
+                           "File not found: '~a'" audio-file))
+
+      (unless (audio-file-valid? audio-file)
+        (raise-audio-error 'invalid-audio-file
+                           "Not a valid audio file: '~a'" audio-file))
+      
       (let ((reader* (find-reader audio-file)))
         (when (eq? reader* #f)
-          (error (format "Cannot find reader for '~a'" audio-file)))
+          (raise-audio-error 'no-audio-reader
+                             "Cannot find reader for '~a'" audio-file))
+
         (let* ((reader-type (car reader*))
                (reader (cadr reader*))
                (ao-type (audio-reader-ao-type reader))
@@ -260,6 +285,14 @@
            (cons 'wma 'ffmpeg)
            (cons 'matroska 'ffmpeg))))
 
+  (define/contract (audio-decoder-for-extension extension)
+    (-> (or/c string? symbol?)
+        (or/c #f symbol?))
+    (hash-ref
+     reader-for-kind
+     (audio-format-for-extension extension)
+     #f))
+
 
 
   (define (find-reader audio-file)

audio-encoder.rkt

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

audio-errors.rkt

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

audio-placed-player.rkt

@@ -1,27 +1,53 @@
 #lang racket/base
 
-(require racket/place
-         racket/async-channel
+(require racket/port
+         port-channel
+         uni-channel
          "libao.rkt"
          "audio-decoder.rkt"
+         "audio-errors.rkt"
          "private/utils.rkt"
          early-return
          )
 
 (provide placed-player
+         placed-player/stdio
          audio-known-exts?
          )
 
 (define get-current-seconds current-seconds)
 
+(define (placed-player/stdio #:log-file [log-file (racket-sound-log-file 'placed-audio-player-stdio)])
+  (define stdin-ch
+    (make-uni-channel
+     (make-port-channel (current-input-port) #:direction 'input #:source 'stdin #:close? #f)))
+  (define stdout-ch
+    (make-uni-channel
+     (make-port-channel (current-output-port) #:direction 'output #:source 'stdout #:close? #f)))
+  (define stderr-ch
+    (make-uni-channel
+     (make-port-channel (current-error-port) #:direction 'output #:source 'stderr #:close? #f)))
+  (define log-port (if log-file (open-racket-sound-log-file log-file) (open-output-nowhere)))
+  (dynamic-wind
+   void
+   (lambda ()
+     ;; stdout and stderr are protocol channels in this mode.  Redirect ordinary
+     ;; output so that display/log output cannot corrupt the serialized channel
+     ;; streams.
+     (parameterize ([current-output-port log-port]
+                    [current-error-port log-port])
+       (placed-player stdin-ch stdout-ch stderr-ch)))
+   (lambda ()
+     (with-handlers ([exn:fail? void]) (close-output-port log-port)))))
+
 (define (eq-seconds? s1 s2)
   (let ((s1* (inexact->exact (round s1)))
         (s2* (inexact->exact (round s2))))
     (= s1* s2*)))
 
-(define (placed-player ch-in)
-  (let ((ch-evt #f)
-        (ch-out #f)
+(define (placed-player ch-in [initial-ch-out #f] [initial-ch-evt #f])
+  (let ((ch-evt initial-ch-evt)
+        (ch-out initial-ch-out)
         (ao-h #f)
         (ao-mutex (make-mutex))
         (ao-dec #f)
@@ -53,20 +79,30 @@
                (begin b1 ...)
                r)))))
 
+    (define (->uni-channel ch)
+      (if (uni-channel? ch) ch (make-uni-channel ch)))
+
+    ;; ch-in is supplied by dynamic-place or by the async/thread launcher.
+    ;; ch-out and ch-evt are supplied by the init command.  Each logical
+    ;; channel is wrapped as a uni-channel on the side where it is used; raw
+    ;; place channels must not be wrapped before they are sent through init.
+    (set! ch-in (->uni-channel ch-in))
+    (when ch-out (set! ch-out (->uni-channel ch-out)))
+    (when ch-evt (set! ch-evt (->uni-channel ch-evt)))
+
     (define (put data)
-      (if (place-channel? ch-out)
-          (place-channel-put ch-out data)
-          (async-channel-put ch-out data)))
+      (uni-channel-put ch-out data))
 
     (define (evt data)
-      (if (place-channel? ch-evt)
-          (place-channel-put ch-evt data)
-          (async-channel-put ch-evt data)))
+      (uni-channel-put ch-evt data))
 
     (define (get)
-      (if (place-channel? ch-in)
-          (place-channel-get ch-in)
-          (async-channel-get ch-in)))
+      (uni-channel-get ch-in))
+
+    (define (close-and-wait ch)
+      (when ch
+        (uni-channel-close ch)
+        (uni-channel-wait ch)))
           
     (define (audio-read-worker ao-dec file-id)
       (set! feeding-audio #t)
@@ -78,7 +114,10 @@
                                          (set! feeding-audio #f)
                                          (set! feed-interrupted #f)
                                          (set! player-state 'stopped)
-                                         (evt (list 'exception (exn-message e))))])
+                                         (let ((code (if (exn:fail:audio? e) (exn:fail:audio-code e) 'no-audio-error)))
+                                           (state (format "audio-read-worker: exception ~a" code) evt)
+                                           (evt (list 'exception (exn-message e) code)))
+                                       )])
                         (dynamic-wind
                          void
                          (λ ()
@@ -337,6 +376,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))
@@ -349,7 +414,8 @@
         (audio-seek ao-dec percentage)))
 
     (define (volume percentage)
-      (set! req-volume percentage))
+      (set! req-volume percentage)
+      (check-volume))
 
     (define (ao-buf-ms)
       (ao-playback-buf-ms))
@@ -371,6 +437,7 @@
                                  (if (null? r) #f (cdar r))))
             (hash-set! h 'state player-state)
             (hash-set! h 'valid-ao-handle (ao-valid? ao-h))
+            (hash-set! h 'ao-device-bits (if (ao-valid? ao-h) (ao-device-bits ao-h) #f))
             (hash-set! h 'duration (if (ao-valid? ao-h) (ao-music-duration ao-h) #f))
             (hash-set! h 'at-second (if (ao-valid? ao-h) (ao-at-second ao-h) #f))
             (hash-set! h 'at-music-id m-id)
@@ -413,25 +480,29 @@
         (with-handlers ([exn:fail? (λ (e)
                                      (if (eq? ch-evt #f)
                                          (raise e)
-                                         (begin
-                                           (evt (list 'exception
-                                                      (exn-message e)))
+                                         (let ((code (if (exn:fail:audio? e) (exn:fail:audio-code e) 'no-audio-error)))
+                                           (evt (list 'exception (exn-message e) code))
                                            (when in-rpc
-                                             (put (list 'error
-                                                        (exn-message e)))
+                                             (put (list 'error (exn-message e) code))
                                              (set! in-rpc #f))
                                            (loop))
                                          ))])
 
            (cond
-             ((eq? cmd 'quit) (do-rpc
-                               (stop-and-cleanup)
-                               (set! player-state 'quit)
-                               (state "quit" evt 'force)
-                               '(quit)))
+             ((eq? cmd 'quit)
+              ;; Quit is the one RPC where the acknowledgement must be written
+              ;; before the worker starts tearing down its audio state and stdio
+              ;; transport.  For port-based uni-channels, put is asynchronous:
+              ;; close-and-wait makes sure the queued '(quit) has actually been
+              ;; written and flushed before the process exits.
+              (put '(quit))
+              (close-and-wait ch-out)
+              (stop-and-cleanup)
+              (set! player-state 'quit)
+              (close-and-wait ch-evt))
              ((eq?  cmd 'init) (do-rpc
-                                (set! ch-out (cadr data))
-                                (set! ch-evt (caddr data))
+                                (set! ch-out (->uni-channel (cadr data)))
+                                (set! ch-evt (->uni-channel (caddr data)))
                                 '(initialized))
                                (loop))
              (else 
@@ -478,6 +549,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))
@@ -491,7 +571,7 @@
                     ))
                   (else
                    (do-rpc
-                    (list 'error (format "Unknown command ~a" cmd))))
+                    (list 'error (format "Unknown command ~a" cmd)  'error-unknown-command)))
                   )
                 (loop)
                 )
@@ -502,3 +582,14 @@
       )
     )
   )
+(module+ main
+  (require racket/cmdline)
+  (define log-file 'default)
+  (command-line
+   #:once-each
+   [("--stdio") "Run the placed audio player over stdin/stdout/stderr." (void)]
+   [("--log-file") file "Write ordinary worker logging to file." (set! log-file file)]
+   [("--no-log-file") "Discard ordinary worker logging." (set! log-file #f)])
+  (placed-player/stdio #:log-file (if (eq? log-file 'default)
+                                      (racket-sound-log-file 'placed-audio-player-stdio)
+                                      log-file)))

audio-player.rkt

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

audio-sniffer.rkt

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

encoder-test.rkt

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

ffmpeg-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
@@ -64,22 +77,26 @@
 ;; FFmpeg DLL names often contain the major version; on Unix-like systems
 ;; the dynamic linker can usually find the generic soname.
 
-(define libavutil (get-lib (case (system-type 'os)
+(define libavutil (get-lib/quiet (case (system-type 'os)
                              [(windows) '("avutil-60")]
-                             [else      '("avutil" "libavutil")]) '(#f)))
+                             [else      '("avutil" "libavutil")])
+                           (ffmpeg-lib-versions 'avutil)))
 
 
-(define libswresample (get-lib (case (system-type 'os)
+(define libswresample (get-lib/quiet (case (system-type 'os)
                                  [(windows) '("swresample-6")]
-                                 [else      '("swresample" "libswresample")]) '(#f)))
+                                 [else      '("swresample" "libswresample")])
+                               (ffmpeg-lib-versions 'swresample)))
 
-(define libavcodec (get-lib (case (system-type 'os)
+(define libavcodec (get-lib/quiet (case (system-type 'os)
                               [(windows) '("avcodec-62")]
-                              [else      '("avcodec" "libavcodec")]) '(#f)))
+                              [else      '("avcodec" "libavcodec")])
+                            (ffmpeg-lib-versions 'avcodec)))
 
-(define libavformat (get-lib (case (system-type 'os)
+(define libavformat (get-lib/quiet (case (system-type 'os)
                                [(windows) '("avformat-62")]
-                               [else      '("avformat" "libavformat")]) '(#f)))
+                               [else      '("avformat" "libavformat")])
+                             (ffmpeg-lib-versions 'avformat)))
 
 
 (define-ffi-definer def-avutil libavutil #:default-make-fail make-not-available)
@@ -92,10 +109,47 @@
 (def-avformat avformat_version (_fun -> _uint))
 (def-swresample swresample_version (_fun -> _uint))
 
-(define avutil-version-major (quotient (avutil_version) 65536))
-(define avcodec-version-major (quotient (avcodec_version) 65536))
-(define avformat-version-major (quotient (avformat_version) 65536))
-(define swresample-version-major (quotient (swresample_version) 65536))
+;; Version functions are regular FFmpeg symbols, but they must not be called
+;; unconditionally at module-load time. When one of the native FFmpeg
+;; libraries is missing, define-ffi-definer creates a make-not-available
+;; procedure. Calling that procedure here would make (require ...) fail even
+;; for callers that do not use FFmpeg. Keep the runtime version as #f when the
+;; library is unavailable and use the highest supported major only to choose a
+;; harmless struct layout for the dormant bindings.
+(define (packed-version->list v)
+  (list (quotient v 65536) (remainder (quotient v 256) 256) (remainder v 256)))
+
+(define (ffmpeg-default-major lib)
+  (cadr (hash-ref valid-ffmpeg-versions lib)))
+
+(define (ffmpeg-version-packed/false lib version-proc)
+  (with-handlers ([exn:fail? (λ (e) #f)])
+    (and lib (version-proc))))
+
+(define avutil-version-packed     (ffmpeg-version-packed/false libavutil avutil_version))
+(define avcodec-version-packed    (ffmpeg-version-packed/false libavcodec avcodec_version))
+(define avformat-version-packed   (ffmpeg-version-packed/false libavformat avformat_version))
+(define swresample-version-packed (ffmpeg-version-packed/false libswresample swresample_version))
+
+(define (ffmpeg-packed-version lib)
+  (cond ((eq? lib 'avutil) avutil-version-packed)
+        ((eq? lib 'avcodec) avcodec-version-packed)
+        ((eq? lib 'avformat) avformat-version-packed)
+        ((or (eq? lib 'swr)
+             (eq? lib 'swresample)) swresample-version-packed)
+        (else (error (format "Unknown library '~a" lib)))))
+
+(define (ffmpeg-runtime-major lib)
+  (let ((v (ffmpeg-packed-version lib)))
+    (and v (car (packed-version->list v)))))
+
+(define (ffmpeg-layout-major lib)
+  (or (ffmpeg-runtime-major lib) (ffmpeg-default-major lib)))
+
+(define avutil-version-major (ffmpeg-layout-major 'avutil))
+(define avcodec-version-major (ffmpeg-layout-major 'avcodec))
+(define avformat-version-major (ffmpeg-layout-major 'avformat))
+(define swresample-version-major (ffmpeg-layout-major 'swresample))
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;; Version check
@@ -106,16 +160,16 @@
 ;; so the rest of the module can choose version-dependent layouts.
 (define (ffmpeg-version lib)
   ;; FFmpeg packs versions as major<<16 | minor<<8 | micro.
-  (let ((v (λ (v) (list (quotient v 65536) (remainder (quotient v 256) 256) (remainder v 256)))))
-    (cond ((eq? lib 'avutil) (v (avutil_version)))
-          ((eq? lib 'avcodec) (v (avcodec_version)))
-          ((eq? lib 'avformat) (v (avformat_version)))
+  ;; If the requested library is missing, call its make-not-available stub so
+  ;; callers get the same error style as every other unavailable FFI binding.
+  (let ((v (ffmpeg-packed-version lib)))
+    (cond (v (packed-version->list v))
+          ((eq? lib 'avutil) (packed-version->list (avutil_version)))
+          ((eq? lib 'avcodec) (packed-version->list (avcodec_version)))
+          ((eq? lib 'avformat) (packed-version->list (avformat_version)))
           ((or (eq? lib 'swr)
-               (eq? lib 'swresample)) (v (swresample_version)))
-          (else (error (format "Unknown library '~a" lib)))
-          )
-    )
-  )
+               (eq? lib 'swresample)) (packed-version->list (swresample_version)))
+          (else (error (format "Unknown library '~a" lib))))))
 
 ;; Formats the runtime version of an FFmpeg library as text.
 ;; This is mainly used in error messages and logging.
@@ -124,31 +178,64 @@
 
 ;; Support ffmpeg 6, 7 and 8
 
-;; Checks at load time whether the detected FFmpeg major versions are supported.
-;; The struct layouts below are deliberately partial and major-version-dependent;
-;; therefore an unknown major version must fail early and loudly.
+;; Logs at load time whether the detected FFmpeg major versions are supported.
+;; The struct layouts below are deliberately partial and major-version-dependent,
+;; so actual FFmpeg entry points call ensure-ffmpeg-library! before using them.
+(define (ffmpeg-raise-unavailable! lib)
+  ;; Deliberately call the library's version binding. When the native library
+  ;; is missing this is the make-not-available stub installed by
+  ;; define-ffi-definer, so the normal FFI unavailable-library message is kept.
+  (cond ((eq? lib 'avutil) (avutil_version))
+        ((eq? lib 'avcodec) (avcodec_version))
+        ((eq? lib 'avformat) (avformat_version))
+        ((or (eq? lib 'swr)
+             (eq? lib 'swresample)) (swresample_version))
+        (else (error (format "Unknown library '~a" lib)))))
+
+(define (ensure-ffmpeg-library! lib)
+  ;; Keep require-time lazy: missing and unsupported libraries are only errors
+  ;; at the boundary where FFmpeg functionality is actually used.
+  (let ((v (ffmpeg-packed-version lib)))
+    (cond
+      ((not v) (ffmpeg-raise-unavailable! lib))
+      (else
+       (let* ((major-version (car (packed-version->list v)))
+              (from (car (hash-ref valid-ffmpeg-versions lib)))
+              (until (cadr (hash-ref valid-ffmpeg-versions lib))))
+         (when (or (< major-version from) (> major-version until))
+           (error
+            (format "Unsupported major version of ffmpeg library ~a: ~a (~a).
+Supported range: ~a - ~a"
+                    lib major-version (ffmpeg-version-string lib) from until)))))))
+  #t)
+
+(define (ensure-ffmpeg-libraries! libs)
+  (for-each ensure-ffmpeg-library! libs)
+  #t)
+
+(define (ensure-ffmpeg-decoder!)
+  ;; The FFmpeg decoder path uses demuxing, decoding, avutil helpers and
+  ;; swresample for conversion to the internal S32 PCM output.
+  (ensure-ffmpeg-libraries! '(avutil avcodec avformat swresample)))
+
 (define-syntax check-support
   (syntax-rules ()
     ((_ lib version-hash)
      (let ((from (car (hash-ref version-hash lib)))
            (until (cadr (hash-ref version-hash lib))))
-       ;; Only the major version determines whether the C struct layouts below are safe.
-       (let ((major-version (car (ffmpeg-version lib))))
+       ;; Probe only for logging. Do not fail at require-time: even unsupported
+       ;; versions should not break users that do not call FFmpeg functionality.
+       (let ((major-version (ffmpeg-runtime-major lib)))
          (cond
+           ((not major-version)
+            (warn-sound "FFmpeg library ~a is not available; FFmpeg bindings stay dormant until the library is installed" lib))
            ((or (< major-version from) (> major-version until))
-            (error
-             (format "Unsupported major version of ffmpeg library ~a: ~a (~a).\nSupported range: ~a - ~a"
-                     'lib major-version (ffmpeg-version-string lib) from until)))
+            (warn-sound "Unsupported ffmpeg library ~a - version ~a; FFmpeg calls will fail until a supported version is installed"
+                        lib (ffmpeg-version-string lib)))
            (else
             (info-sound "Supported ffmpeg library ~a - version ~a between ~a and ~a"
-                        lib (ffmpeg-version-string lib) from until)
-            )
-           )
-         )
-       )
-     )
-    )
-  )
+                        lib (ffmpeg-version-string lib) from until))))))))
+
                       
 (check-support 'avutil valid-ffmpeg-versions)
 (check-support 'avcodec valid-ffmpeg-versions)
@@ -248,6 +335,26 @@
    )
   )
 
+(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)
+  (ensure-ffmpeg-library! 'avutil)
+  (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
+    (ensure-ffmpeg-library! 'avutil)
+    (av_channel_layout_uninit p))
+  #t)
+
 ; _AVCodecParameters:
 ;   codec_type  : AVMediaType
 ;   codec_id    : int / AVCodecID
@@ -583,7 +690,10 @@
 ;; This prevents decoder-storage from keeping an old native pointer after cleanup.
 (define (swr_free ctx)
   (if ctx
-      (begin (swr_free/raw ctx) #f)
+      (begin
+        (ensure-ffmpeg-library! 'swresample)
+        (swr_free/raw ctx)
+        #f)
       #f))
 
 (def-avformat avformat_close_input/raw (_fun (_ptr io _AVFormatContext-pointer/null)
@@ -641,7 +751,7 @@
       (begin (av_frame_free/raw frm) #f)
       #f))
 
-(def-swresample swr_alloc_set_opts2
+(def-swresample swr_alloc_set_opts2/raw
   (_fun (ps : (_ptr io _SwrContext))
         _AVChannelLayout-pointer ; out_ch_layout
         _AVSampleFormat          ; out_sample_fmt
@@ -652,10 +762,18 @@
         _int                     ; log_offset
         _pointer                 ; log_ctx
         -> (r : _int)
-        -> (values r ps)))
+        -> (values r ps)) #:c-id swr_alloc_set_opts2)
 
-(def-swresample swr_init
-  (_fun _SwrContext -> _int))
+(define (swr_alloc_set_opts2 ps out-ch-layout out-sample-fmt out-sample-rate in-ch-layout in-sample-fmt in-sample-rate log-offset log-ctx)
+  (ensure-ffmpeg-library! 'swresample)
+  (swr_alloc_set_opts2/raw ps out-ch-layout out-sample-fmt out-sample-rate in-ch-layout in-sample-fmt in-sample-rate log-offset log-ctx))
+
+(def-swresample swr_init/raw
+  (_fun _SwrContext -> _int) #:c-id swr_init)
+
+(define (swr_init ctx)
+  (ensure-ffmpeg-library! 'swresample)
+  (swr_init/raw ctx))
 
 (def-avcodec avcodec_parameters_alloc
   (_fun -> _AVCodecParameters-pointer/null))
@@ -694,14 +812,26 @@
   (_fun _AVFrame-pointer -> _int64))
 
 
-(def-swresample swr_get_out_samples
-  (_fun _SwrContext _int -> _int))
+(def-swresample swr_get_out_samples/raw
+  (_fun _SwrContext _int -> _int) #:c-id swr_get_out_samples)
 
-(def-swresample swr_convert
-  (_fun _SwrContext _pointer _int _pointer _int -> _int))
+(define (swr_get_out_samples ctx in-samples)
+  (ensure-ffmpeg-library! 'swresample)
+  (swr_get_out_samples/raw ctx in-samples))
 
-(def-swresample swr_get_delay
-  (_fun _SwrContext _int64 -> _int64))
+(def-swresample swr_convert/raw
+  (_fun _SwrContext _pointer _int _pointer _int -> _int) #:c-id swr_convert)
+
+(define (swr_convert ctx out out-count in in-count)
+  (ensure-ffmpeg-library! 'swresample)
+  (swr_convert/raw ctx out out-count in in-count))
+
+(def-swresample swr_get_delay/raw
+  (_fun _SwrContext _int64 -> _int64) #:c-id swr_get_delay)
+
+(define (swr_get_delay ctx base)
+  (ensure-ffmpeg-library! 'swresample)
+  (swr_get_delay/raw ctx base))
 
 (def-avutil av_samples_get_buffer_size
   (_fun _pointer _int _int _AVSampleFormat _int -> _int))
@@ -1226,6 +1356,7 @@
 ;; Opens an audio file and initializes all decode state.
 ;; The function fails safely with 0: at every failed step, the half-open instance is closed.
 (define (fmpg-open-file! instance filename)
+  (ensure-ffmpeg-decoder!)
   ;; First check the API preconditions: valid instance, not already open,
   ;; no old format context, and a filename that FFmpeg can open.
   (let/assert

flac-decoder.rkt

@@ -15,8 +15,6 @@
            flac-stop
            flac-seek
            (all-from-out "flac-definitions.rkt")
-           kinds
-           last-buffer last-buf-len
            )
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
@@ -42,24 +40,13 @@
   (define (flac-stream-state handle)
     ((flac-handle-ffi-decoder-handler handle) 'state))
 
-
-  (define kinds (make-hash))
-  (define last-buffer #f)
-  (define last-buf-len #f)
-
-
-   (define (process-frame handle h mem-out)
+  (define (process-frame handle h mem-out)
      (let* ([cb-audio (flac-handle-cb-audio handle)]
             [type     (hash-ref h 'number-type)]
             [buf-size (bytes-length mem-out)])
 
        (hash-set! h 'duration (flac-duration handle))
 
-       (set! last-buffer mem-out)
-       (set! last-buf-len buf-size)
-
-       (hash-set! kinds type #t)
-
        (when (procedure? cb-audio)
          (cb-audio h mem-out buf-size))
 
@@ -83,6 +70,7 @@
                                  (hash-ref mh 'sample-rate)))))
                (hash-set! mh 'duration duration))
              (set-flac-handle-stream-info! handle si)
+             (hash-set! mh 'audio-bits-per-sample (hash-ref mh 'bits-per-sample))
              (hash-set! mh 'bits-per-sample 32)  ; Flac works internally 32 bits.
              (let ((cb (flac-handle-cb-stream-info handle)))
                (when (procedure? cb)
@@ -91,9 +79,24 @@
       )
     )
 
+  (define (flac-err->str nr)
+    (cond
+      ((= nr 0) "0 = Lost Sync: An error in the stream caused the decoder to lose synchronization.")
+      ((= nr 1) "1 = Bad Header: The decoder encountered a corrupted frame header.")
+      ((= nr 2) "2 = CRC Mismatch: The frame's data did not match the CRC in the footer.")
+      ((= nr 3) "3 = Unparseable Stream: The decoder encountered reserved fields in use in the stream.")
+      ((= nr 4) "4 = Bad Metadata: The decoder encountered a corrupted metadata block.")
+      ((= nr 5) "5 = Out of bounds: The decoder encountered a otherwise valid frame in which the decoded samples exceeded the range offered by the stated bit depth.")
+      ((= nr 6) "6 = Missing Frame: Two adjacent frames had frame numbers increasing by more than 1 or sample numbers increasing by more than the blocksize, indicating that one or more frame/frames was missing between them.")
+      (else (format "~a = Unknown: Unknown status code." nr))
+      )
+    )
+
   (define (flac-read handle)
     (let* ((ffi-handler (flac-handle-ffi-decoder-handler handle))
-           (state (ffi-handler 'state)))
+           (state (ffi-handler 'state))
+           (err-hash (make-hash))
+           )
       (set-flac-handle-stop-reading! handle #f)
       (set-flac-handle-reading! handle #t)
       (letrec ((reader (lambda (frame-nr)
@@ -110,7 +113,12 @@
                                             st frame-nr (ffi-handler 'int-state))
                                  )
                                (when (ffi-handler 'has-errno?)
-                                 (err-sound "Error in stream: ~a" (ffi-handler 'errno))
+                                 (let ((errno (ffi-handler 'errno)))
+                                   (unless (eq? (hash-ref err-hash errno #f) #f)
+                                     (hash-set! err-hash errno #t)
+                                     (warn-sound "Error in stream: ~a (frame-nr = ~a) (int-state = ~a)"
+                                                 (flac-err->str errno)
+                                                 frame-nr (ffi-handler 'int-state))))
                                  )
                                (when (ffi-handler 'has-meta-data?)
                                  (ffi-handler 'process-meta-data
@@ -170,14 +178,21 @@
   (define (flac-stop handle)
     (let ((ct (current-milliseconds)))
       (dbg-sound "requesting stop at: ~a" ct)
-      (set-flac-handle-stop-reading! handle #t)
-      (while (flac-handle-reading handle)
-             (sleep 0.01))
+      (if (flac-handle-reading handle)
+          (begin ; in reading
+            (set-flac-handle-stop-reading! handle #t)
+            (while (flac-handle-reading handle)
+                   (sleep 0.01)))
+          (begin ; never starte reading, or reading finished
+            (dbg-sound "not reading flac, need to finish flac")
+            (let ((ffi-handler (flac-handle-ffi-decoder-handler handle)))
+              (unless (eq? ffi-handler #f)
+                (ffi-handler 'delete))))
+          )
       (let ((ct* (current-milliseconds)))
         (dbg-sound "stop came back at: ~a" ct*)
         (dbg-sound "flac-stop took: ~a ms" (- ct* ct)))
       )
     )
                          
-                         
   ); end of module

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

@@ -14,8 +14,12 @@
 (define deps
   '("racket/gui" "racket/base" "racket"
                  "finalizer" "draw-lib" "net-lib"
-                 "simple-log" "racket-sprintf"
-                 "early-return" "let-assert")
+                 "simple-log" "simple-ini" "racket-sprintf"
+                 "racket-mimetypes"
+                 "early-return" "let-assert"
+                 "uni-channel" "port-channel"
+                 "rackunit-lib"
+                 )
   )
 
 (define build-deps

libao-async-ffi-racket.rkt

@@ -64,10 +64,12 @@
 
 (define libao
   (get-lib (list (case (system-type 'os)
-             [(windows) "libao-1.2.2"]
-             [else      "libao"])) '(#f)))
+                   [(windows) "libao-1.2.2"]
+                   [else      "libao"]))
+           (linux-lib-versions '("4" #f))))
 
-(define-ffi-definer define-ao libao)
+(define-ffi-definer define-ao libao
+  #:default-make-fail make-not-available)
 
 (define _ao-device (_cpointer/null 'ao-device))
 (define _ao-option (_cpointer/null 'ao-option))

libflac-ffi.rkt

@@ -6,6 +6,7 @@
          )
 
 (provide flac-ffi-decoder-handler
+         flac-ffi-encoder-handler
          _FLAC__StreamMetadata
          FLAC__StreamMetadata-type
          flac-ffi-meta
@@ -15,7 +16,7 @@
          )
 
 
-(define lib (get-lib '("libFLAC") '(#f)))
+(define lib (get-lib '("FLAC" "libFLAC") (linux-lib-versions '("14" "12" "8" #f))))
 (define-ffi-definer define-libflac lib
   #:default-make-fail make-not-available)
 
@@ -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))
 
@@ -378,27 +380,46 @@
 ;; FLAC Callback function definitions
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 
+;; libFLAC keeps the C callback pointers that are passed to
+;; FLAC__stream_decoder_init_file and calls them later from
+;; FLAC__stream_decoder_process_single. When process_single runs in a
+;; Racket thread with #:pool 'own, those callbacks can arrive from a
+;; different OS thread than the ordinary Racket coroutine-thread OS
+;; thread. Use #:async-apply so Racket can transfer such callback
+;; invocations safely, and use a per-decoder #:keep box so the generated
+;; callback stubs stay reachable as long as the decoder can call them.
+(define (flac-callback-async-apply thunk)
+  (thunk))
 
 ;typedef FLAC__StreamDecoderWriteStatus(* FLAC__StreamDecoderWriteCallback) (const FLAC__StreamDecoder *decoder, const FLAC__Frame *frame, const FLAC__int32 *const buffer[], void *client_data)
-(define _FLAC__StreamDecoderWriteCallback
-  (_fun _FLAC__StreamDecoder-pointer
-        _FLAC__Frame-pointer
-        FLAC__int32** 
-        _FLAC__Data-pointer
-        -> _int))
+(define (make-FLAC__StreamDecoderWriteCallback keep-box)
+  (_cprocedure
+   (list _FLAC__StreamDecoder-pointer
+         _FLAC__Frame-pointer
+         FLAC__int32**
+         _FLAC__Data-pointer)
+   _int
+   #:async-apply flac-callback-async-apply
+   #:keep keep-box))
 
 ;typedef void(* FLAC__StreamDecoderMetadataCallback) (const FLAC__StreamDecoder *decoder, const FLAC__StreamMetadata *metadata, void *client_data)
-(define _FLAC__StreamDecoderMetadataCallback
-  (_fun _FLAC__StreamDecoder-pointer
-        _FLAC__StreamMetadata-pointer
-        _FLAC__Data-pointer
-        -> _void))
+(define (make-FLAC__StreamDecoderMetadataCallback keep-box)
+  (_cprocedure
+   (list _FLAC__StreamDecoder-pointer
+         _FLAC__StreamMetadata-pointer
+         _FLAC__Data-pointer)
+   _void
+   #:async-apply flac-callback-async-apply
+   #:keep keep-box))
 
-(define _FLAC__StreamDecoderErrorCallback
-  (_fun _FLAC__StreamDecoder-pointer
-        _int
-        _FLAC__Data-pointer
-        -> _void))
+(define (make-FLAC__StreamDecoderErrorCallback keep-box)
+  (_cprocedure
+   (list _FLAC__StreamDecoder-pointer
+         _int
+         _FLAC__Data-pointer)
+   _void
+   #:async-apply flac-callback-async-apply
+   #:keep keep-box))
 
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
@@ -411,6 +432,9 @@
 (define-libflac FLAC__stream_decoder_delete
   (_fun _FLAC__StreamDecoder-pointer -> _void))
 
+(define-libflac FLAC__stream_decoder_finish
+  (_fun _FLAC__StreamDecoder-pointer -> _int))
+
 (define-libflac FLAC__stream_decoder_get_state
   (_fun _FLAC__StreamDecoder-pointer -> _int))
 
@@ -434,9 +458,9 @@
 (define-libflac FLAC__stream_decoder_init_file
   (_fun _FLAC__StreamDecoder-pointer
         _string/utf-8
-        _FLAC__StreamDecoderWriteCallback
-        _FLAC__StreamDecoderMetadataCallback
-        _FLAC__StreamDecoderErrorCallback
+        _pointer
+        _pointer
+        _pointer
         _FLAC__Data-pointer  ; Seen by Jens Axel Søgaard - Is already present in FLAC 1.4.3
         -> _int))
 
@@ -519,26 +543,46 @@
   (define fl #f)
   (define flac-file #f)
   (define client-data #f)
+  (define callback-keepers (box null))
+
+  (define (make-decoder-callback proc type)
+    ;; Convert the Racket procedure to a C function pointer with a type
+    ;; that uses callback-keepers as #:keep. The raw pointer is passed to
+    ;; libFLAC, while the keeper box retains the generated callback stub
+    ;; until delete releases it after FLAC__stream_decoder_finish/delete.
+    (cast proc type _pointer))
 
   ;(define (write-callback fl frame buffer client-data)
   ;  (set! write-data (append write-data (list (cons frame buffer))))
   ;  0)
   (define (write-callback fl frame buffer client-data)
-  (set! write-data (cons (copy-flac-frame frame buffer) write-data))
-    0)
+    (with-handlers ([exn:fail?
+                     (lambda (e)
+                       ;; Never let a Racket exception escape through a C
+                       ;; callback. Return FLAC__STREAM_DECODER_WRITE_STATUS_ABORT.
+                       (set! error-no -2)
+                       1)])
+      (set! write-data (cons (copy-flac-frame frame buffer) write-data))
+      0))
 
   ;(define (meta-callback fl meta client-data)
   ;  (let ((meta-clone (FLAC__metadata_object_clone meta)))
   ;    (unless (eq? meta-clone #f)
   ;      (set! meta-data (append meta-data (list meta-clone))))))
   (define (meta-callback fl meta client-data)
-    (let ((meta-clone (FLAC__metadata_object_clone meta)))
-      (unless (eq? meta-clone #f)
-        (set! meta-data (cons meta-clone meta-data)))))
+    (with-handlers ([exn:fail?
+                     (lambda (e)
+                       ;; Metadata callbacks return void; remember failure and
+                       ;; let the decoder state/error path report it.
+                       (set! error-no -3)
+                       (void))])
+      (let ((meta-clone (FLAC__metadata_object_clone meta)))
+        (unless (eq? meta-clone #f)
+          (set! meta-data (cons meta-clone meta-data))))))
 
   (define (error-callback fl errno client-data)
     (set! error-no errno)
-    )
+    (void))
 
   (define (new)
     (dbg-sound "flac-ffi 'new")
@@ -549,13 +593,25 @@
 
   (define (init file)
     (dbg-sound "flac-ffi 'init")
-    (let ((r (FLAC__stream_decoder_init_file
-              fl
-              file
-              write-callback
-              meta-callback
-              error-callback
-              client-data)))
+    (let* ((write-callback-ptr
+            (make-decoder-callback
+             write-callback
+             (make-FLAC__StreamDecoderWriteCallback callback-keepers)))
+           (meta-callback-ptr
+            (make-decoder-callback
+             meta-callback
+             (make-FLAC__StreamDecoderMetadataCallback callback-keepers)))
+           (error-callback-ptr
+            (make-decoder-callback
+             error-callback
+             (make-FLAC__StreamDecoderErrorCallback callback-keepers)))
+           (r (FLAC__stream_decoder_init_file
+               fl
+               file
+               write-callback-ptr
+               meta-callback-ptr
+               error-callback-ptr
+               client-data)))
       (set! flac-file file)
       r))
 
@@ -564,9 +620,12 @@
     (if (eq? fl #f)
         (error "flac handler has already been deleted")
         (begin
+          (FLAC__stream_decoder_finish fl)
           (FLAC__stream_decoder_delete fl)
-          (set! fl #f)))
-    )
+          (set! fl #f)
+          ;; libFLAC cannot call the callbacks anymore after finish/delete,
+          ;; so the generated callback stubs can now be released.
+          (set-box! callback-keepers null))))
 
   (define (process-single)
     (FLAC__stream_decoder_process_single fl))
@@ -639,5 +698,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, state = ~a" r (FLAC__stream_encoder_get_state enc)))
+      #t))
+
+  (define (write buffer size buf-info)
+    (require-encoder 'flac-encoder-write)
+    (let* ((channels (hash-ref settings 'channels))
+           (in-bits (hash-ref/default buf-info 'pcm-bits-per-sample
+                                      (hash-ref/default buf-info 'bits-per-sample
+                                                        (hash-ref settings 'bits-per-sample))))
+           (out-bits (hash-ref settings 'bits-per-sample)))
+      (let-values (((ptr frames) (pcm-bytes->flac-int32-pointer buffer size channels in-bits out-bits)))
+        (unless (FLAC__stream_encoder_process_interleaved enc ptr frames)
+          (error 'flac-encoder-write "FLAC encoder process_interleaved failed, state ~a" (FLAC__stream_encoder_get_state enc)))
+        frames)))
+
+  (define (finish)
+    (require-encoder 'flac-encoder-finish)
+    (FLAC__stream_encoder_finish enc))
+
+  (define (delete)
+    (unless (eq? enc #f)
+      (FLAC__stream_encoder_delete enc)
+      (set! enc #f))
+    #t)
+
+  (lambda (cmd . args)
+    (cond [(eq? cmd 'new) (new)]
+          [(eq? cmd 'configure) (configure (car args))]
+          [(eq? cmd 'init) (init (car args))]
+          [(eq? cmd 'write) (write (car args) (cadr args) (caddr args))]
+          [(eq? cmd 'finish) (finish)]
+          [(eq? cmd 'delete) (delete)]
+          [(eq? cmd 'state) (and enc (FLAC__stream_encoder_get_state enc))]
+          [(eq? cmd 'file) flac-file]
+          [(eq? cmd 'settings) settings]
+          [else (error (format "unknown FLAC encoder command ~a" cmd))])))
+
+
 ); end of module
 

libmpg123-ffi.rkt

@@ -10,7 +10,7 @@
 
 
   ;(define lib (ffi-lib "/home/hans/tmp/lib/libmpg123.so")) ;(get-lib '("libmpg123") '("0" #f)))
-  (define lib (get-lib '("libmpg123") '("0" #f)))
+  (define lib (get-lib '("mpg123" "libmpg123") (linux-lib-versions '("0" #f) '("0" #f))))
   (define-ffi-definer define-libmpg123 lib
     #:default-make-fail make-not-available)
 

main.rkt

@@ -3,12 +3,19 @@
 (require "taglib.rkt"
          "audio-sniffer.rkt"
          "audio-player.rkt"
+         (only-in "audio-decoder.rkt"
+                  audio-supported-extensions
+                  audio-supported-formats
+                  audio-decoder-for-extension)
          "opusfile-decoder.rkt"
          )
 
 (provide (all-from-out "taglib.rkt")
          (all-from-out "audio-sniffer.rkt")
          (all-from-out "audio-player.rkt")
+         audio-supported-extensions
+         audio-supported-formats
+         audio-decoder-for-extension
          current-opusfile-output-format
          opusfile-output-format?
          )

opus-encoder.rkt

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

opusfile-decoder.rkt

@@ -24,9 +24,21 @@
   ;; Opus decode output is always 48 kHz PCM.  The original input rate, if
   ;; present in metadata, is not the actual decoder output rate.
 
-  (define libopusfile
-    (with-handlers ([exn:fail? (lambda (_) #f)])
-      (ffi-lib "libopusfile" '("0" #f))))
+
+  (define libogg (get-lib (case (system-type 'os)
+                                 [(windows) '("ogg")]
+                                 [else      '("ogg" "libogg")])
+                               (linux-lib-versions '("0" #f))))
+
+  (define libopus (get-lib (case (system-type 'os)
+                             [(windows) '("opus")]
+                             [else      '("opus" "libopus")])
+                           (linux-lib-versions '("0" #f))))
+  
+  (define libopusfile (get-lib (case (system-type 'os)
+                                 [(windows) '("opusfile")]
+                                 [else      '("opusfile" "libopusfile")])
+                               (linux-lib-versions '("0" #f))))
 
   (define _OggOpusFile _pointer)
 
@@ -36,12 +48,16 @@
   (define (opusfile-output-format? v)
     (or (eq? v 's16) (eq? v 's24)))
 
-  (define current-opusfile-output-format
-    (make-parameter 's16
-      (lambda (v)
-        (unless (opusfile-output-format? v)
-          (raise-argument-error 'current-opusfile-output-format "(or/c 's16 's24)" v))
-        v)))
+  (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)

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/config.rkt

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

private/downloader.rkt

@@ -26,8 +26,8 @@
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 
 (define version-major 1)
-(define version-minor 0)
-(define version-patch 0)
+(define version-minor 1)
+(define version-patch 2)
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;; Internal functions
@@ -40,8 +40,8 @@
                                  version-patch
                                  ))
 
-(define download-site "git.dijkewijk.nl")
-(define base-path "hans/racket-sound-lib/releases/download")
+(define download-site "codeberg.org")
+(define base-path "hnmdijkema/racket-sound-lib/releases/download")
 (define os (system-type 'os*))
 (define arch (system-type 'arch))
 
@@ -145,7 +145,7 @@
     (let* ((file (build-path install-path "archive.zip"))
            (out (open-output-file file #:exists 'replace))
            )
-      (displayln (format "Downloading racket-webview-qt (~a)..." download-url))
+      (displayln (format "Downloading racket-sound-lib (~a)..." download-url))
       (do-download in out)
       (displayln (format "downloaded '~a'" file))
       (when (directory-exists? ffi-path)

private/pcm-converter.rkt

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

private/remote-utils.rkt

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

private/utils.rkt

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

resampler.rkt

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

scrbl/audio-decoder.scrbl

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

scrbl/audio-encoder.scrbl

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

scrbl/audio-placed-player.scrbl

@@ -5,6 +5,8 @@
                      racket/contract
                      racket/place
                      racket/async-channel
+                     uni-channel
+                     port-channel
                      "../audio-placed-player.rkt"
                      "../audio-player.rkt"))
 
@@ -30,9 +32,11 @@ The placed player is implemented as a command loop around a decoder, an
 asynchronous libao output handle, and a small amount of state that is reported
 back to the controlling side.  In normal use it runs in a Racket place, so that
 the audio side has a separate Racket VM.  The same function can also run in a
-normal Racket thread with async channels.  That mode is useful for debugging,
-because the player then stays in the same process and can be inspected more
-easily.
+normal Racket thread with async channels.  Both modes are mediated through
+@racketmodname[uni-channel]: each of the existing logical channels is wrapped as
+a uni-channel endpoint, so the worker no longer depends directly on
+@racket[place-channel-put], @racket[place-channel-get],
+@racket[async-channel-put], or @racket[async-channel-get].
 
 It is normally run in a separate place so that audio decoding and feeding are
 isolated from scheduling delays in the main Racket VM, such as GUI activity,
@@ -40,22 +44,58 @@ debugging, or interaction with DrRacket.
 
 @section{Interface}
 
-@defproc[(placed-player [ch-in (or/c place-channel? async-channel?)]) void?]{
-Runs the placed-player command loop on @racket[ch-in].  The channel may be a
-place channel or an async channel.  The command loop receives list commands,
+@defproc[(placed-player
+          [ch-in (or/c uni-channel? place-channel? async-channel? port-channel?)]
+          [ch-out (or/c #f uni-channel? place-channel? async-channel? port-channel?) #f]
+          [ch-evt (or/c #f uni-channel? place-channel? async-channel? port-channel?) #f])
+         void?]{
+Runs the placed-player command loop on @racket[ch-in].  Each channel may already
+be a @racket[uni-channel?] or may be a supported raw channel that can be wrapped
+with @racket[make-uni-channel].  The command loop receives list commands,
 initializes its reply and event channels, and then processes playback commands
 until it receives @racket['quit].
 
-The function is designed to be started either by @racket[dynamic-place] or by
-@racket[thread].  In place mode, all three channels are place channels.  In
-thread mode, all three channels are async channels.  The implementation detects
-the kind of channel and uses @racket[place-channel-put],
-@racket[place-channel-get], @racket[async-channel-put], or
-@racket[async-channel-get] as appropriate.}
+When @racket[ch-out] and @racket[ch-evt] are @racket[#f], the command loop
+expects an initial @racket['init] command containing the raw reply and event
+channels.  This remains the normal path for @racket[dynamic-place], because a
+@racket[uni-channel] value contains procedures and must not be sent through a
+place channel.  In that case the controlling side sends the raw place channels
+and the worker wraps them locally.
+
+When all three channels are supplied, the worker starts initialized.  This is
+used by the standard-port worker entry point and can also be used by custom
+launchers.}
+
+@defproc[(placed-player/stdio [#:log-file log-file (or/c #f path-string?) (racket-sound-log-file 'placed-audio-player-stdio)])
+         void?]{
+Runs @racket[placed-player] using the process standard streams as three logical
+channels: @racket[current-input-port] is the command channel,
+@racket[current-output-port] is the reply channel, and
+@racket[current-error-port] is the asynchronous event channel.  The streams are
+wrapped through @racket[make-port-channel] and then through
+@racket[make-uni-channel].
+
+Because stdout and stderr are protocol streams in this mode, ordinary display
+and log output is redirected while the worker is running.  By default, output is
+appended to a log file under Racket's standard cache directory, for example
+@filepath{~/.cache/racket/racket-audio/placed-audio-player-stdio.log} on many
+Unix-like systems.  Pass @racket[#f] explicitly to discard ordinary output, or
+pass a path to choose a different log file.
+
+The module also has a command-line entry point.  A remote or local subprocess
+worker can be started with:
+
+@verbatim{
+racket -l racket-audio/audio-placed-player -- --stdio
+}
+
+This is the command used by @racket[make-audio-player] when SSH remote playback
+is enabled, unless the caller supplies a custom remote command.}
 
 The public wrapper in @racketmodname[racket-audio/audio-player] creates the channels,
-sends the initial @racket['init] command, starts an event thread, and exposes a
-contracted API.  The placed player itself only exports @racket[placed-player].
+sends the initial @racket['init] command when needed, starts an event thread, and exposes a
+contracted API.  The placed player exports @racket[placed-player] and the
+standard-port worker entry point @racket[placed-player/stdio].
 
 @section{Overall state model}
 
@@ -91,7 +131,10 @@ installed.
 
 The controlling side sends commands as lists on @racket[ch-in].  The result of
 an RPC-style command is sent on the reply channel installed by
-@racket['init].  Asynchronous events are sent on the event channel.
+@racket['init] or supplied directly to @racket[placed-player].  Asynchronous
+events are sent on the event channel.  These are logical channels; the concrete
+transport may be place channels, async channels, or port channels wrapped as
+uni-channels.
 
 @itemlist[#:style 'compact
  @item{@racket[(list 'init ch-out ch-evt)] installs @racket[ch-out] and
@@ -252,7 +295,8 @@ place or thread then terminates.
 @section{Running in a place or in a thread}
 
 The normal path in @racket[make-audio-player] uses @racket[dynamic-place] when
-places are enabled.  This gives the audio side its own Racket VM and isolates
+places are enabled.  The command, reply, and event channels are wrapped with
+@racket[make-uni-channel] on each side.  This gives the audio side its own Racket VM and isolates
 it from the main controller, while the command and event protocol stays the
 same.
 

scrbl/audio-player.scrbl

@@ -28,7 +28,9 @@ through callbacks supplied when the player is created.
 @defproc[(make-audio-player
           [cb-state procedure?]
           [cb-eof-stream procedure?]
-          [#:use-place use-place boolean?])
+          [#:use-place use-place boolean?]
+          [#:remote-host remote-host (or/c #f string?) #f]
+          [#:replace-base-paths replace-base-paths any/c '()])
          audio-play?]{
 Creates an audio player and returns a player handle.  The handle is passed to
 all other procedures in this module.
@@ -108,7 +110,36 @@ a separate Racket VM, so decoding and buffer feeding are less exposed to
 scheduling delays caused by DrRacket, GUI event handling, debugging, logging, or
 other active threads in the main VM.  Those delays can otherwise be heard as
 clicks, gaps, or stuttering playback.  Thread mode is useful for debugging the
-protocol and callbacks, but it is not the preferred mode for robust playback.}
+protocol and callbacks, but it is not the preferred mode for robust playback.
+
+When @racket[remote-host] is a string, @racket[make-audio-player] starts the
+worker over SSH instead of starting a local place or thread.  All SSH and remote
+Racket details are handled by the remote utility layer and its
+@tt{racket-audio.ini} configuration.  The public player API only needs the host
+name.
+
+The remote player must be able to open the requested audio files.  When the
+local and remote file trees differ, use @racket[replace-base-paths].  It is a
+list of cons pairs.  The @racket[car] is the local base path, and the
+@racket[cdr] is the remote base path.  The first matching local prefix is
+replaced before the @racket['open] command is sent.  For example:
+
+@racketblock[
+(make-audio-player cb-state cb-eof
+                   #:remote-host "nas"
+                   #:replace-base-paths
+                   (list (cons "/muziek" "/volume1/music")))]
+
+With that mapping, @filepath{/muziek/klassiek/x.flac} is sent to the remote
+worker as @filepath{/volume1/music/klassiek/x.flac}.}
+
+
+@defproc[(replace-base-path [path path-string?]
+                            [replace-base-paths any/c])
+         string?]{
+Applies the same base-path replacement used by remote playback.  This is a small
+helper for testing the mapping before starting playback.}
+
 
 
 @defproc[(audio-play? [v any/c]) boolean?]{
@@ -308,7 +339,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

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

scrbl/ffmpeg-definitions.scrbl

@@ -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
@@ -90,7 +90,7 @@ Small and stable structures, such as @tt{AVRational} and
 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
+The larger FFmpeg structures are handled by @tt{def-cstruct} from
 @filepath{private/cstruct-helper.rkt}.  Structures such as
 @tt{AVCodecParameters}, @tt{AVStream}, @tt{AVFormatContext}, @tt{AVFrame} and
 @tt{AVPacket} are large and may differ between FFmpeg major versions.  The
@@ -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-ffi.scrbl

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

scrbl/flac-decoder.scrbl

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

scrbl/intro.scrbl

@@ -27,6 +27,8 @@
 @title{@elem{Introduction racket-audio}}
 
 
+@defmodule[racket-audio]
+
 @;;title{racket-audio}
 @author[@author+email["Hans Dijkema" "hans@dijkewijk.nl"]]
 

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.scrbl

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

scrbl/mp3-decoder.scrbl

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

scrbl/opusfile-decoder.scrbl

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

scrbl/play-test.scrbl

@@ -12,7 +12,7 @@
 
 @defmodule[racket-audio/play-test]
 
-The @racketmodname[racket-audio/play-test.rkt] module is a small integration test and
+The @racketmodname[racket-audio/play-test] module is a small integration test and
 usage example for @racketmodname[racket-audio/audio-player].  It is not the public
 playback API itself; normal applications should use @racketmodname[racket-audio/audio-player]
 directly.  This module shows how a program can create an audio player, observe

scrbl/racket-audio.scrbl

@@ -21,11 +21,15 @@
 @include-section["audio-player.scrbl"]
 @include-section["audio-sniffer.scrbl"]
 @include-section["taglib.scrbl"]
+@include-section["audio-encoder.scrbl"]
+@include-section["resampler.scrbl"]
+@include-section["encoder-test.scrbl"]
 @include-section["play-test.scrbl"]
 @include-section["audio-placed-player.scrbl"]
 @include-section["audio-decoder.scrbl"]
 @include-section["libao-async-ffi-racket.scrbl"]
 @include-section["flac-decoder.scrbl"]
+@include-section["opusfile-decoder.scrbl"]
 @include-section["mp3-decoder.scrbl"]
 @include-section["ffmpeg-decoder.scrbl"]
 @include-section["libao.scrbl"]

scrbl/resampler.scrbl

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

scrbl/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

soxr-ffi.rkt

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

taglib-ffi.rkt

@@ -3,8 +3,7 @@
 (require ffi/unsafe
          ffi/unsafe/define
          "private/utils.rkt"
-         "private/downloader.rkt"
-         )
+         "private/downloader.rkt")
 
 (provide TagLib_File_Type
          _TagLib_File-pointer
@@ -16,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,40 +44,23 @@
 
          taglib_property_keys
          taglib_property_key
-         
          taglib_property_get
          taglib_property_val
-         
+         taglib_property_set
+         taglib_property_set_append
          taglib_property_free
 
+         taglib_complex_property_set
+         taglib_complex_property_set_append
+
          taglib-get-picture
-         )
+         taglib-set-picture
+         taglib-append-picture
+         taglib-clear-picture)
 
-
-;(define-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)))
-;           ))
-
-(define zlib (get-lib '("zlib" "libz") '(#f)))
-(define libtag (get-lib '("tag" "libtag") '("2" #f)))
-(define libtag_c (get-lib '("tag_c" "libtag_c") '("#2" #f)))
+(define zlib (get-lib '("zlib" "libz") (linux-lib-versions '("1" #f))))
+(define libtag (get-lib '("tag" "libtag") (linux-lib-versions '("2" #f) '("2" #f))))
+(define libtag_c (get-lib '("tag_c" "libtag_c") (linux-lib-versions '("2" #f) '("2" #f))))
 
 (define-ffi-definer define-tag-c-lib libtag_c
   #:default-make-fail make-not-available)
@@ -97,45 +88,39 @@
            dsf
            dsdiff
            shorten
-           )))
+           matroska)))
 
 (define _TagLib_File-pointer (_cpointer/null 'taglib-file))
 (define _TagLib_Tag-pointer (_cpointer/null 'taglib-tag))
 (define _TagLib_AudioProperties-pointer (_cpointer/null 'taglib-audioproperties))
 
-; TagLib_File *taglib_file_new(const char *filename);
 (define-tag-c-lib taglib_file_new
-  (_fun _string/utf-8 -> _TagLib_File-pointer ))
+  (_fun _string/utf-8 -> _TagLib_File-pointer))
 
-; TAGLIB_C_EXPORT TagLib_File *taglib_file_new_wchar(const wchar_t *filename);
 (define-tag-c-lib taglib_file_new_wchar
-  (_fun _string/utf-16 -> _TagLib_File-pointer ))
+  (_fun _string/utf-16 -> _TagLib_File-pointer))
 
-; TagLib_File *taglib_file_new_type(const char *filename, TagLib_File_Type type);
 (define-tag-c-lib taglib_file_new_type
   (_fun _string/utf-8 TagLib_File_Type -> _TagLib_File-pointer))
 
-; TagLib_File *taglib_file_new_type_wchar(const char *filename, TagLib_File_Type type);
 (define-tag-c-lib taglib_file_new_type_wchar
   (_fun _string/utf-16 TagLib_File_Type -> _TagLib_File-pointer))
 
-; void taglib_file_free(TagLib_File *file);
 (define-tag-c-lib taglib_file_free
   (_fun _TagLib_File-pointer -> _void))
 
-; BOOL taglib_file_is_valid(const TagLib_File *file);
 (define-tag-c-lib taglib_file_is_valid
   (_fun _TagLib_File-pointer -> _bool))
 
-; TagLib_Tag *taglib_file_tag(const TagLib_File *file);
+(define-tag-c-lib taglib_file_save
+  (_fun _TagLib_File-pointer -> _bool))
+
 (define-tag-c-lib taglib_file_tag
   (_fun _TagLib_File-pointer -> _TagLib_Tag-pointer))
 
-; const TagLib_AudioProperties *taglib_file_audioproperties(const TagLib_File *file);
 (define-tag-c-lib taglib_file_audioproperties
   (_fun _TagLib_File-pointer -> _TagLib_AudioProperties-pointer))
 
-; void taglib_tag_free_strings(void);
 (define-tag-c-lib taglib_tag_free_strings
   (_fun -> _void))
 
@@ -150,12 +135,8 @@
        (_fun _TagLib_Tag-pointer -> _string/utf-8)))
     ((_ name ret-type)
      (define-tag-c-lib name
-       (_fun _TagLib_Tag-pointer -> ret-type)))
-    ))
+       (_fun _TagLib_Tag-pointer -> ret-type)))))
 
-
-; char *taglib_tag_title(const TagLib_Tag *tag);
-; etc..
 (tg taglib_tag_title)
 (tg taglib_tag_artist)
 (tg taglib_tag_album)
@@ -164,6 +145,23 @@
 (tg taglib_tag_year _uint)
 (tg taglib_tag_track _uint)
 
+(define-syntax tgs
+  (syntax-rules ()
+    ((_ name)
+     (define-tag-c-lib name
+       (_fun _TagLib_Tag-pointer _string/utf-8 -> _void)))
+    ((_ name arg-type)
+     (define-tag-c-lib name
+       (_fun _TagLib_Tag-pointer arg-type -> _void)))))
+
+(tgs taglib_tag_set_title)
+(tgs taglib_tag_set_artist)
+(tgs taglib_tag_set_album)
+(tgs taglib_tag_set_comment)
+(tgs taglib_tag_set_genre)
+(tgs taglib_tag_set_year _uint)
+(tgs taglib_tag_set_track _uint)
+
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;; audio properties
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
@@ -172,11 +170,7 @@
   (syntax-rules ()
     ((_ name)
      (define-tag-c-lib name
-       (_fun _TagLib_AudioProperties-pointer -> _int)))
-    ))
-
-; 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,107 @@
 (define-tag-c-lib taglib_complex_property_free
   (_fun _Complex_Property_Attribute-pointer -> _void))
 
-;TAGLIB_C_EXPORT char** taglib_complex_property_keys(const TagLib_File *file);
 (define-tag-c-lib taglib_complex_property_keys
   (_fun _TagLib_File-pointer -> (_ptr i _string/utf-8)))
 
-;  void taglib_complex_property_free_keys(char **keys);
 (define-tag-c-lib taglib_complex_property_free_keys
   (_fun _pointer -> _void))
 
-(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/bytes->malloc-cstring who v)
+  (define bs
+    (cond
+      [(bytes? v) v]
+      [(string? v) (string->bytes/utf-8 v)]
+      [(symbol? v) (string->bytes/utf-8 (symbol->string v))]
+      [(number? v) (string->bytes/utf-8 (number->string v))]
+      [else (raise-argument-error who "(or/c string? bytes? symbol? number?)" v)]))
+  (bytes->malloc-ptr bs #t))
+
+(define (string->malloc-cstring s)
+  (string/bytes->malloc-cstring 'string->malloc-cstring s))
+
+(define (picture->complex-property data size description mimetype picture-type)
+  (define data-ptr (bytes->malloc-ptr data #f))
+  (define data-key (string->malloc-cstring "data"))
+  (define mime-key (string->malloc-cstring "mimeType"))
+  (define desc-key (string->malloc-cstring "description"))
+  (define type-key (string->malloc-cstring "pictureType"))
+  (define mime-ptr (string->malloc-cstring mimetype))
+  (define desc-ptr (string->malloc-cstring description))
+  (define type-ptr (string->malloc-cstring picture-type))
+  (define data-attr (make-TagLib_Complex_Property_Attribute data-key (make-TagLib_Variant TagLib_Variant_ByteVector size data-ptr)))
+  (define mime-attr (make-TagLib_Complex_Property_Attribute mime-key (make-TagLib_Variant TagLib_Variant_String 0 mime-ptr)))
+  (define desc-attr (make-TagLib_Complex_Property_Attribute desc-key (make-TagLib_Variant TagLib_Variant_String 0 desc-ptr)))
+  (define type-attr (make-TagLib_Complex_Property_Attribute type-key (make-TagLib_Variant TagLib_Variant_String 0 type-ptr)))
+  (define propv (malloc _pointer 5 'atomic-interior))
+  (ptr-set! propv _pointer 0 data-attr)
+  (ptr-set! propv _pointer 1 mime-attr)
+  (ptr-set! propv _pointer 2 desc-attr)
+  (ptr-set! propv _pointer 3 type-attr)
+  (ptr-set! propv _pointer 4 #f)
+  ;; Return keepalive values as well as the pointer array. TagLib copies during
+  ;; taglib_complex_property_set(), but all buffers must remain live for the call.
+  (values propv (list data-ptr data-key mime-key desc-key type-key mime-ptr desc-ptr type-ptr
+                      data-attr mime-attr desc-attr type-attr propv)))
+
+(define (taglib-set-picture tag-file mimetype picture-type description data)
+  (define-values (props keepalive)
+    (picture->complex-property data (bytes-length data) description mimetype picture-type))
+  (define ok? (taglib_complex_property_set tag-file "PICTURE" props))
+  keepalive
+  ok?)
+
+(define (taglib-append-picture tag-file mimetype picture-type description data)
+  (define-values (props keepalive)
+    (picture->complex-property data (bytes-length data) description mimetype picture-type))
+  (define ok? (taglib_complex_property_set_append tag-file "PICTURE" props))
+  keepalive
+  ok?)
+
+(define (taglib-clear-picture tag-file)
+  (taglib_complex_property_set tag-file "PICTURE" #f))
+
+(define (taglib-get-picture tag-file)
+  (define (cp s) (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,514 @@
 
            tags-keys
            tags-ref
+           tags-set!
+           tags-set-values!
+           tags-append!
+           tags-clear!
 
            tags-picture
+           tags-picture!
+           tags-append-picture!
+           tags-clear-picture!
            tags-picture->bitmap
            tags-picture->file
            tags-picture->kind
            tags-picture->mimetype
+           tags-picture->description
            tags-picture->size
            tags-picture->ext
 
            tags->hash
 
+           make-tags-picture
+           make-tags-picture-from-bitmap
+           id3-picture?
            id3-picture-mimetype
            id3-picture-kind
            id3-picture-size
            id3-picture-bytes
+           id3-picture-description
+
+           PIC-KIND-OTHER
+           PIC-KIND-PNG-ICON32x32
+           PIC-KIND-OTHER-ICON
+           PIC-KIND-COVER
+           PIC-KIND-COVER-FRONT
+           PIC-KIND-COVER-BACK
+           PIC-KIND-LEAFLET
+           PIC-KIND-MEDIA
+           PIC-KIND-LEAD-SOLOIST
+           PIC-KIND-ARTIST
+           PIC-KIND-CONDUCTOR
+           PIC-KIND-BAND
+           PIC-KIND-ORCHESTRA
+           PIC-KIND-COMPOSER
+           PIC-KIND-LYRICIST
+           PIC-KIND-SONG-WRITER
+           PIC-KIND-TEXT-WRITER
+           PIC-KIND-RECORDING-LOCATION
+           PIC-KIND-DURING-RECORDING
+           PIC-KIND-DURING-PERFORMANCE
+           PIC-KIND-SCREEN-CAPTURE
+           PIC-KIND-BRIGHT-COLORED-FISH
+           PIC-KIND-ILLUSTRATION
+           PIC-KIND-BAND-LOGO
+           PIC-KIND-PUBLISHER-LOGO
            )
 
-  (define-struct id3-tag-struct
-    (handle))
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; Picture kinds
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;$00: Other
+;$01: 32x32 pixels 'file icon' (PNG only)
+;$02: Other file icon
+;$03: Cover (front) (The most common standard for album art)
+;$04: Cover (back)
+;$05: Leaflet page
+;$06: Media (e.g., label side of CD)
+;$07: Lead artist/soloist
+;$08: Artist/performer
+;$09: Conductor
+;$0A: Band/Orchestra
+;$0B: Composer
+;$0C: Lyricist/text writer
+;$0D: Recording location
+;$0E: During recording
+;$0F: During performance
+;$10: Movie/video screen capture
+;$11: A bright colored fish
+;$12: Illustration
+;$13: Band/artist logotype
+;$14: Publisher/Studio logotype
 
-  (define-struct id3-picture
-    (mimetype kind size bytes))
+  (define PIC-KIND-OTHER 0)
+  (define PIC-KIND-PNG-ICON32x32 1)
+  (define PIC-KIND-OTHER-ICON 2)
+  (define PIC-KIND-COVER 3)
+  (define PIC-KIND-COVER-FRONT 3)
+  (define PIC-KIND-COVER-BACK 4)
+  (define PIC-KIND-LEAFLET 5)
+  (define PIC-KIND-MEDIA 6)
+  (define PIC-KIND-LEAD-SOLOIST 7)
+  (define PIC-KIND-ARTIST 8)
+  (define PIC-KIND-CONDUCTOR 9)
+  (define PIC-KIND-BAND 10)
+  (define PIC-KIND-ORCHESTRA 10)
+  (define PIC-KIND-COMPOSER 11)
+  (define PIC-KIND-LYRICIST 12)
+  (define PIC-KIND-SONG-WRITER 12)
+  (define PIC-KIND-TEXT-WRITER 12)
+  (define PIC-KIND-RECORDING-LOCATION 13)
+  (define PIC-KIND-DURING-RECORDING 14)
+  (define PIC-KIND-DURING-PERFORMANCE 15)
+  (define PIC-KIND-SCREEN-CAPTURE 16)
+  (define PIC-KIND-BRIGHT-COLORED-FISH 17)
+  (define PIC-KIND-ILLUSTRATION 18)
+  (define PIC-KIND-BAND-LOGO 19)
+  (define PIC-KIND-PUBLISHER-LOGO 20)
   
-  (define (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-struct id3-tag-struct (handle))
+  (define-struct id3-picture (mimetype kind size bytes description))
+
+  (define clear-tag-value 'clear)
+
+  (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 picture-type-names
+    (hash 0 "Other"
+          1 "File Icon"
+          2 "Other File Icon"
+          3 "Front Cover"
+          4 "Back Cover"
+          5 "Leaflet Page"
+          6 "Media"
+          7 "Lead Artist"
+          8 "Artist"
+          9 "Conductor"
+          10 "Band"
+          11 "Composer"
+          12 "Lyricist"
+          13 "Recording Location"
+          14 "During Recording"
+          15 "During Performance"
+          16 "Movie Screen Capture"
+          17 "Coloured Fish"
+          18 "Illustration"
+          19 "Band Logo"
+          20 "Publisher Logo"))
+
+  (define (picture-kind->string kind)
+    (cond
+      [(string? kind) kind]
+      [(symbol? kind) (string-titlecase (regexp-replace* #rx"-" (symbol->string kind) " "))]
+      [(integer? kind) (hash-ref picture-type-names kind (number->string kind))]
+      [else (raise-argument-error 'make-tags-picture "(or/c string? symbol? integer?)" kind)]))
+
+  (define (make-tags-picture mimetype kind data #:description [description ""])
+    (define bytes
+      (cond
+        [(bytes? data) data]
+        [(is-a? data bitmap%) (bitmap->encoded-bytes data mimetype)]
+        [else (raise-argument-error 'make-tags-picture "(or/c bytes? (is-a?/c bitmap%))" data)]))
+    (make-id3-picture mimetype (picture-kind->string kind) (bytes-length bytes) bytes description))
+
+  (define (make-tags-picture-from-bitmap bm kind #:mimetype [mimetype "image/png"] #:description [description ""])
+    (make-tags-picture mimetype kind bm #:description description))
+
+  (define (open-tag-file file)
+    (let ((tag-file (if (eq? (system-type 'os) 'windows)
+                        (taglib_file_new_wchar file)
+                        (taglib_file_new file))))
+      (cond
+        ((eq? tag-file #f) #f)
+        ((taglib_file_is_valid tag-file) tag-file)
+        (else
+         (taglib_file_free tag-file)
+         #f))
+      )
+    )
+
+  (define (read-property-map tag-file)
+    (define key-store (make-hash))
+    (let* ((keys (taglib_property_keys tag-file))
+           (i 0)
+           (key (and keys (taglib_property_key keys i)))
+           (key-list '()))
+      (while (not (eq? key #f))
+             (set! key-list (append key-list (list (copy-string key))))
+             (set! i (+ i 1))
+             (set! key (taglib_property_key keys i)))
+      (for-each
+       (lambda (key)
+         (let ((props (taglib_property_get tag-file key)))
+           (let* ((vals '())
+                  (i 0)
+                  (val (and props (taglib_property_val props i))))
+             (while (not (eq? val #f))
+                    (set! vals (append vals (list (copy-string val))))
+                    (set! i (+ i 1))
+                    (set! val (taglib_property_val props i)))
+             (when props (taglib_property_free props))
+             (hash-set! key-store (string->symbol (string-downcase key)) vals))))
+       key-list))
+    key-store)
+
+  (define (read-picture tag-file)
+    (let ((p (taglib-get-picture tag-file)))
+      (if (eq? p #f)
+          #f
+          (let ((mimetype (car p))
+                (description (cadr p))
+                (kind (caddr p))
+                (size (cadddr p))
+                (bytes (car (cddddr p))))
+            (make-id3-picture mimetype kind size bytes description)))))
+
+  (define (id3-tags file* #:mode [mode 'read])
+    (define file (file->string file*))
+    (define actual-mode (normal-mode mode))
+    (define read-write? (eq? actual-mode 'read-write))
+    (define valid? #f)
+    (define closed? #t)
+    (define tag-file #f)
+    (define tag #f)
+    (define title "")
+    (define album "")
+    (define artist "")
+    (define comment "")
+    (define year -1)
+    (define genre "")
+    (define track -1)
+    (define length -1)
+    (define sample-rate -1)
+    (define bit-rate -1)
+    (define channels -1)
+    (define key-store (make-hash))
+    (define composer "")
+    (define album-artist "")
+    (define disc-number -1)
+    (define picture #f)
+
+    (define (refresh-derived!)
+      (set! composer (first-property key-store 'composer ""))
+      (set! album-artist (first-property key-store 'albumartist ""))
+      (set! disc-number (first-property-number key-store 'discnumber -1)))
+
+    (define (open-and-read!)
+      (set! tag-file (open-tag-file file))
+      (if (eq? tag-file #f)
+          (begin
             (set! valid? #f)
-            (set! valid? (taglib_file_is_valid tag-file)))
+            (warn-sound "Could not open file ~a" file))
+          (begin
+            (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 +564,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 +582,16 @@
 
     (tags-keys 'keys)
     (tags-ref 'val)
+    (tags-set! 'set!)
+    (tags-set-values! 'set-values!)
+    (tags-append! 'append!)
+    (tags-clear! 'clear!)
 
     (tags-picture 'picture)
-    (tags->hash 'to-hash)
-    )
+    (tags-picture! 'set-picture!)
+    (tags-append-picture! 'append-picture!)
+    (tags-clear-picture! 'clear-picture!)
+    (tags->hash 'to-hash))
 
   (define (tags-picture->bitmap tags)
     (let ((p (tags-picture tags)))
@@ -257,34 +604,27 @@
 
   (define (tags-picture->kind tags)
     (let ((p (tags-picture tags)))
-      (if (eq? p #f)
-          #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 +640,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"))

tests/capabilities-test.rkt

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

tests/flac-tests.rkt

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

tests/opus-tests.rkt

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