Encoder testing

2026-06-08 12:14:32 +02:00
parent 444d62edac
commit d6aa880104
6 changed files with 261 additions and 61 deletions
@@ -119,17 +119,17 @@
      (ensure-open! fmt)
      (set! frames-written (+ frames-written ((audio-encoder-write encoder) backend-handle fmt buffer buf-len))))

-    (define (ensure-flac-converter! input-format)
-      ;; FLAC encoding may be used as a sample-rate conversion target, for example
-      ;; 96 kHz -> 48 kHz.  That conversion is not a property of libFLAC itself;
-      ;; it must happen on the decoded PCM stream before process_interleaved.
-      (when (and (eq? kind 'flac)
-                 (eq? converter #f)
-                 (pcm-conversion-needed? input-format settings))
-        (set! converter (make-pcm-converter input-format settings))))
+    (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 settings)
+          (set! converter (make-pcm-converter input-format settings)))))

    (define (write-converted! input-format buffer buf-len)
-      (ensure-flac-converter! input-format)
+      (ensure-converter! input-format)
      (cond [converter
             (let-values (((out out-samples) (pcm-converter-convert converter buffer buf-len input-format)))
               (when (> out-samples 0)
@@ -0,0 +1,158 @@
+#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 "?"))
+      "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 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))))
+  result)
+
+(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?))))
+
+(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))))
@@ -31,6 +31,9 @@
                 (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]
@@ -41,13 +44,18 @@
           (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.
-           (rate (hash-ref/default h 'target-sample-rate
-                                   (hash-ref/default h 'sample-rate (hash-ref format 'sample-rate))))
-           (channels (hash-ref/default h 'target-channels
-                                       (hash-ref/default h 'channels (hash-ref format 'channels))))
-           (bits0 (hash-ref/default h 'target-bits-per-sample
-                                    (hash-ref/default h 'bits-per-sample
-                                                      (hash-ref/default format 'bits-per-sample 24))))
+           (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)
@@ -703,7 +703,7 @@
 (define (bool->flac-bool v) (if v 1 0))

 (define (native-signed-ref bs start bytes)
-  (integer-bytes->integer bs #t (system-big-endian?) start (+ 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))]
@@ -11,11 +11,28 @@
           opus-encoder-finish)

  ;; libopusenc handles the Ogg container, OpusHead and OpusTags.  The Racket
-  ;; side only feeds interleaved signed 16-bit PCM to ope_encoder_write().
+  ;; side feeds interleaved floating-point PCM to ope_encoder_write_float().
+  ;; The input rate passed to ope_encoder_create_file is the source PCM rate;
+  ;; libopusenc performs the required Opus resampling internally.
+
+  ;; Load libogg and libopus explicitly before libopusenc.  This matters on
+  ;; Windows, where libopusenc.dll may not reliably find its dependent DLLs
+  ;; unless they have already been resolved through the same search path.
+  (define libogg
+    (get-lib (case (system-type 'os)
+               [(windows) '("ogg")]
+               [else      '("ogg" "libogg")])
+             '(#f)))
+
+  (define libopus
+    (get-lib (case (system-type 'os)
+               [(windows) '("opus")]
+               [else      '("opus" "libopus")])
+             '(#f)))

  (define libopusenc
    (get-lib (case (system-type 'os)
-               [(windows) '("opusenc")]
+               [(windows) '("libopusenc")]
               [else      '("opusenc" "libopusenc")])
             '(#f)))

@@ -37,7 +54,7 @@
              (_fun _string/utf-8 _OggOpusComments _int32 _int _int (err : (_ptr o _int))
                    -> (enc : _OggOpusEnc)
                    -> (values enc err))))
-  (define ope_encoder_write (ffi-proc "ope_encoder_write" (_fun _OggOpusEnc _bytes _int -> _int)))
+  (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)))
@@ -56,8 +73,8 @@
  (define OPUS_SIGNAL_MUSIC 3002)

  (define (opus-encoder-available?)
-    (and libopusenc ope_comments_create ope_comments_destroy ope_encoder_create_file
-         ope_encoder_write ope_encoder_drain ope_encoder_destroy ope_strerror #t))
+    (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)

@@ -89,21 +106,24 @@
                 (complexity . 10)
                 (comment-padding . 512))))

-  (define (valid-opus-rate? rate)
-    (or (= rate 8000) (= rate 12000) (= rate 16000) (= rate 24000) (= rate 48000)))
-
  (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 (hash-ref/default h 'sample-rate (hash-ref format 'sample-rate)))
-           (channels (hash-ref/default h 'channels (hash-ref format 'channels))))
-      (unless (valid-opus-rate? rate)
-        (error 'opus-encoder-open "Opus input sample rate must be 8000, 12000, 16000, 24000 or 48000 Hz; got ~a. Resample before calling libopusenc." rate))
+           (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)
@@ -137,7 +157,8 @@
                    (hash-keys ch))))))

  (define (opus-encoder-open output-file settings format)
-    (unless (opus-encoder-available?) (error 'opus-encoder-open "libopusenc could not be loaded"))
+    (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)))
@@ -151,35 +172,38 @@
        (make-opus-encoder-handle enc comments resolved format file))))

  (define (native-signed-ref bs start bytes)
-    (integer-bytes->integer bs #t (system-big-endian?) start (+ 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->s16 sample in-bits)
-    (cond [(> in-bits 16) (arithmetic-shift sample (- 16 in-bits))]
-          [(< in-bits 16) (arithmetic-shift sample (- 16 in-bits))]
-          [else sample]))
+  (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 (write-s16-native! out offset sample)
-    (integer->integer-bytes sample 2 #t (system-big-endian?) out offset))
-
-  (define (pcm-bytes->s16 buffer size in-bits)
+  (define (pcm-bytes->float-pointer buffer size in-bits)
    (let* ((in-bytes (quotient in-bits 8))
           (sample-count (quotient size in-bytes))
-           (out (make-bytes (* sample-count 2))))
+           (ptr (malloc _float sample-count 'atomic-interior)))
      (for ([i (in-range sample-count)])
        (let* ((in-off (* i in-bytes))
-               (out-off (* i 2))
               (sample (native-signed-ref buffer in-off in-bytes)))
-          (write-s16-native! out out-off (sample->s16 sample in-bits))))
-      out))
+          (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 'bits-per-sample 16))
-           (pcm (if (= in-bits 16) buffer (pcm-bytes->s16 buffer buf-len in-bits)))
-           (frames (quotient (quotient (bytes-length pcm) 2) channels)))
-      (check-ope 'opus-encoder-write (ope_encoder_write (opus-encoder-handle-enc handle) pcm frames))
-      frames))
+           (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
@@ -1,7 +1,8 @@
 (module pcm-converter racket/base

  (require ffi/unsafe
-           "../ffmpeg-definitions.rkt")
+           "../ffmpeg-definitions.rkt"
+           "utils.rkt")

  (provide pcm-conversion-needed?
           make-pcm-converter
@@ -28,7 +29,7 @@
      out))

  (define (native-signed-ref bs start bytes)
-    (integer-bytes->integer bs #t (system-big-endian?) start (+ start bytes)))
+    (int-bytes->integer bs #t (system-big-endian?) start (+ start bytes)))

  (define (native-signed-set! bs start bytes value)
    (integer->integer-bytes value bytes #t (system-big-endian?) bs start))
@@ -69,21 +70,30 @@
      (ptr-set! planes _pointer 0 ptr)
      planes))

+  (define (source-value v source)
+    (if (eq? v 'source) source v))
+
  (define (target-sample-rate settings input-format)
+    (source-value
     (hash-ref/default settings 'target-sample-rate
                       (hash-ref/default settings 'sample-rate
-                                        (hash-ref input-format 'sample-rate))))
+                                         (hash-ref input-format 'sample-rate)))
+     (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)))
+     (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
-                                        (let ((bits (hash-ref/default input-format 'bits-per-sample 24)))
-                                          (if (and (integer? bits) (<= bits 24)) bits 24)))))
+                         (hash-ref/default settings 'bits-per-sample source-bits))
+       source-bits)))

  (define (make-output-format input-format settings)
    (let* ((out (copy-hash input-format))