Audio Encoder laag.

audio-encoder.rkt

@@ -0,0 +1,180 @@
+(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-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))
+                                 #f)])
+      (call-with-id3-tags
+       input-file
+       (lambda (src)
+         (call-with-id3-tags
+          output-file
+          (lambda (dst)
+            (when (and (tags-valid? src) (tags-valid? dst))
+              (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)))
+          #:mode 'read-write))
+       #:mode 'read)
+      #t))
+
+  (define (audio-encode input-file output-file settings
+                        #:encoder [explicit-kind #f]
+                        #:copy-tags? [copy-tags? #t])
+    (define-values (kind encoder) (encoder-for-output output-file explicit-kind))
+    (define backend-handle #f)
+    (define format #f)
+    (define output-format #f)
+    (define converter #f)
+    (define frames-written 0)
+
+    (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) settings fmt))
+        (set! backend-handle ((audio-encoder-open encoder) output-file 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-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 (write-converted! input-format buffer buf-len)
+      (ensure-flac-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))
+
+    (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)
+        (write-converted! effective-format buffer buf-len)))
+
+    (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)))))))
+
+    (when copy-tags? (copy-tags! input-file output-file))
+    (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-written frames-written)
+      r))
+
+  ) ; end of module

ffmpeg-definitions.rkt

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

flac-definitions.rkt

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

flac-encoder.rkt

@@ -0,0 +1,82 @@
+(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 (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.
+           (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))))
+           (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

libflac-ffi.rkt

@@ -6,6 +6,7 @@
          )
 
 (provide flac-ffi-decoder-handler
+         flac-ffi-encoder-handler
          _FLAC__StreamMetadata
          FLAC__StreamMetadata-type
          flac-ffi-meta
@@ -371,6 +372,7 @@
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 
 (define _FLAC__StreamDecoder-pointer (_cpointer 'flac-streamdecoder))
+(define _FLAC__StreamEncoder-pointer (_cpointer 'flac-streamencoder))
 (define _FLAC__Data-pointer (_cpointer/null 'flac-client-data))
 ;(define _FLAC__StreamMetadata-pointer (_cpointer/null 'flac-stream-metadata))
 
@@ -639,5 +641,164 @@
       ))
   )
 
+
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; Direct FLAC encoder interface
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(define FLAC__StreamEncoderInitStatus-ok 0)
+
+(define _FLAC__StreamEncoderProgressCallback _pointer)
+
+(define-libflac FLAC__stream_encoder_new
+  (_fun -> _FLAC__StreamEncoder-pointer))
+
+(define-libflac FLAC__stream_encoder_delete
+  (_fun _FLAC__StreamEncoder-pointer -> _void))
+
+(define-libflac FLAC__stream_encoder_finish
+  (_fun _FLAC__StreamEncoder-pointer -> FLAC__bool))
+
+(define-libflac FLAC__stream_encoder_get_state
+  (_fun _FLAC__StreamEncoder-pointer -> _int))
+
+(define-libflac FLAC__stream_encoder_set_verify
+  (_fun _FLAC__StreamEncoder-pointer FLAC__bool -> FLAC__bool))
+
+(define-libflac FLAC__stream_encoder_set_streamable_subset
+  (_fun _FLAC__StreamEncoder-pointer FLAC__bool -> FLAC__bool))
+
+(define-libflac FLAC__stream_encoder_set_channels
+  (_fun _FLAC__StreamEncoder-pointer _uint32_t -> FLAC__bool))
+
+(define-libflac FLAC__stream_encoder_set_bits_per_sample
+  (_fun _FLAC__StreamEncoder-pointer _uint32_t -> FLAC__bool))
+
+(define-libflac FLAC__stream_encoder_set_sample_rate
+  (_fun _FLAC__StreamEncoder-pointer _uint32_t -> FLAC__bool))
+
+(define-libflac FLAC__stream_encoder_set_compression_level
+  (_fun _FLAC__StreamEncoder-pointer _uint32_t -> FLAC__bool))
+
+(define-libflac FLAC__stream_encoder_set_blocksize
+  (_fun _FLAC__StreamEncoder-pointer _uint32_t -> FLAC__bool))
+
+(define-libflac FLAC__stream_encoder_set_total_samples_estimate
+  (_fun _FLAC__StreamEncoder-pointer FLAC__uint64 -> FLAC__bool))
+
+(define-libflac FLAC__stream_encoder_init_file
+  (_fun _FLAC__StreamEncoder-pointer
+        _string/utf-8
+        _FLAC__StreamEncoderProgressCallback
+        _FLAC__Data-pointer
+        -> _int))
+
+(define-libflac FLAC__stream_encoder_process_interleaved
+  (_fun _FLAC__StreamEncoder-pointer _pointer _uint32_t -> FLAC__bool))
+
+(define (hash-ref/default h k default)
+  (if (hash-has-key? h k) (hash-ref h k) default))
+
+(define (bool->flac-bool v) (if v 1 0))
+
+(define (native-signed-ref bs start bytes)
+  (integer-bytes->integer bs #t (system-big-endian?) start (+ start bytes)))
+
+(define (scale-sample sample in-bits out-bits)
+  (cond [(> in-bits out-bits) (arithmetic-shift sample (- out-bits in-bits))]
+        [(< in-bits out-bits) (arithmetic-shift sample (- out-bits in-bits))]
+        [else sample]))
+
+(define (pcm-bytes->flac-int32-pointer buffer size channels in-bits out-bits)
+  (let* ((in-bytes (quotient in-bits 8))
+         (sample-count (quotient size in-bytes))
+         (frame-count (quotient sample-count channels))
+         (ptr (malloc _int32 sample-count 'atomic-interior)))
+    (for ([i (in-range sample-count)])
+      (let* ((off (* i in-bytes))
+             (sample (native-signed-ref buffer off in-bytes)))
+        (ptr-set! ptr _int32 i (scale-sample sample in-bits out-bits))))
+    (values ptr frame-count)))
+
+(define (flac-ffi-encoder-handler)
+  (define enc #f)
+  (define flac-file #f)
+  (define settings #f)
+
+  (define (require-encoder who)
+    (when (eq? enc #f) (error who "FLAC encoder is not initialized")))
+
+  (define (new)
+    (if (eq? enc #f)
+        (begin (set! enc (FLAC__stream_encoder_new)) enc)
+        (error 'flac-ffi-encoder-handler "FLAC encoder already initialized")))
+
+  (define (configure h)
+    (require-encoder 'flac-encoder-configure)
+    (set! settings h)
+    (let ((channels (hash-ref h 'channels))
+          (sample-rate (hash-ref h 'sample-rate))
+          (bits (hash-ref h 'bits-per-sample))
+          (compression-level (hash-ref/default h 'compression-level 5))
+          (verify? (hash-ref/default h 'verify? #f))
+          (streamable-subset? (hash-ref/default h 'streamable-subset? (<= (hash-ref h 'bits-per-sample) 24)))
+          (blocksize (hash-ref/default h 'blocksize 0))
+          (total-samples (hash-ref/default h 'total-samples #f)))
+      (unless (FLAC__stream_encoder_set_channels enc channels) (error 'flac-encoder-configure "could not set channels"))
+      (unless (FLAC__stream_encoder_set_sample_rate enc sample-rate) (error 'flac-encoder-configure "could not set sample rate"))
+      (unless (FLAC__stream_encoder_set_bits_per_sample enc bits) (error 'flac-encoder-configure "could not set bits per sample"))
+      (unless (FLAC__stream_encoder_set_compression_level enc compression-level) (error 'flac-encoder-configure "could not set compression level"))
+      (unless (FLAC__stream_encoder_set_verify enc (bool->flac-bool verify?)) (error 'flac-encoder-configure "could not set verify"))
+      (unless (FLAC__stream_encoder_set_streamable_subset enc (bool->flac-bool streamable-subset?)) (error 'flac-encoder-configure "could not set streamable subset"))
+      (when (and (integer? blocksize) (> blocksize 0))
+        (unless (FLAC__stream_encoder_set_blocksize enc blocksize) (error 'flac-encoder-configure "could not set blocksize")))
+      (when (and (integer? total-samples) (>= total-samples 0))
+        (unless (FLAC__stream_encoder_set_total_samples_estimate enc total-samples) (error 'flac-encoder-configure "could not set total samples estimate")))
+      #t))
+
+  (define (init file)
+    (require-encoder 'flac-encoder-init)
+    (let ((r (FLAC__stream_encoder_init_file enc file #f #f)))
+      (set! flac-file file)
+      (unless (= r FLAC__StreamEncoderInitStatus-ok)
+        (error 'flac-encoder-init "FLAC encoder init failed with status ~a" r))
+      #t))
+
+  (define (write buffer size buf-info)
+    (require-encoder 'flac-encoder-write)
+    (let* ((channels (hash-ref settings 'channels))
+           (in-bits (hash-ref/default buf-info 'pcm-bits-per-sample
+                                      (hash-ref/default buf-info 'bits-per-sample
+                                                        (hash-ref settings 'bits-per-sample))))
+           (out-bits (hash-ref settings 'bits-per-sample)))
+      (let-values (((ptr frames) (pcm-bytes->flac-int32-pointer buffer size channels in-bits out-bits)))
+        (unless (FLAC__stream_encoder_process_interleaved enc ptr frames)
+          (error 'flac-encoder-write "FLAC encoder process_interleaved failed, state ~a" (FLAC__stream_encoder_get_state enc)))
+        frames)))
+
+  (define (finish)
+    (require-encoder 'flac-encoder-finish)
+    (FLAC__stream_encoder_finish enc))
+
+  (define (delete)
+    (unless (eq? enc #f)
+      (FLAC__stream_encoder_delete enc)
+      (set! enc #f))
+    #t)
+
+  (lambda (cmd . args)
+    (cond [(eq? cmd 'new) (new)]
+          [(eq? cmd 'configure) (configure (car args))]
+          [(eq? cmd 'init) (init (car args))]
+          [(eq? cmd 'write) (write (car args) (cadr args) (caddr args))]
+          [(eq? cmd 'finish) (finish)]
+          [(eq? cmd 'delete) (delete)]
+          [(eq? cmd 'state) (and enc (FLAC__stream_encoder_get_state enc))]
+          [(eq? cmd 'file) flac-file]
+          [(eq? cmd 'settings) settings]
+          [else (error (format "unknown FLAC encoder command ~a" cmd))])))
+
+
 ); end of module
 

opus-encoder.rkt

@@ -0,0 +1,192 @@
+(module opus-encoder racket/base
+
+  (require ffi/unsafe
+           "private/utils.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 only feeds interleaved signed 16-bit PCM to ope_encoder_write().
+
+  (define libopusenc
+    (get-lib (case (system-type 'os)
+               [(windows) '("opusenc")]
+               [else '("opusenc" "libopusenc")])
+             '(#f)))
+
+  (define _OggOpusComments (_cpointer/null 'ogg-opus-comments))
+  (define _OggOpusEnc (_cpointer/null 'ogg-opus-enc))
+
+  (define (ffi-proc name type)
+    (and libopusenc
+         (with-handlers ([exn:fail? (lambda (_) #f)])
+           (get-ffi-obj name libopusenc type))))
+
+  (define ope_comments_create (ffi-proc "ope_comments_create" (_fun -> _OggOpusComments)))
+  (define ope_comments_destroy (ffi-proc "ope_comments_destroy" (_fun _OggOpusComments -> _void)))
+  (define ope_comments_add (ffi-proc "ope_comments_add" (_fun _OggOpusComments _string/utf-8 _string/utf-8 -> _int)))
+  (define ope_comments_add_picture_from_memory
+    (ffi-proc "ope_comments_add_picture_from_memory" (_fun _OggOpusComments _bytes _size _int _string/utf-8 -> _int)))
+  (define ope_encoder_create_file
+    (ffi-proc "ope_encoder_create_file"
+              (_fun _string/utf-8 _OggOpusComments _int32 _int _int (err : (_ptr o _int))
+                    -> (enc : _OggOpusEnc)
+                    -> (values enc err))))
+  (define ope_encoder_write (ffi-proc "ope_encoder_write" (_fun _OggOpusEnc _bytes _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 libopusenc ope_comments_create ope_comments_destroy ope_encoder_create_file
+         ope_encoder_write 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 (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 (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))
+      (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 (opus-encoder-open output-file settings format)
+    (unless (opus-encoder-available?) (error 'opus-encoder-open "libopusenc 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)
+      (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)
+    (integer-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 (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)
+    (let* ((in-bytes (quotient in-bits 8))
+           (sample-count (quotient size in-bytes))
+           (out (make-bytes (* sample-count 2))))
+      (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))
+
+  (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))
+
+  (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

private/pcm-converter.rkt

@@ -0,0 +1,177 @@
+(module pcm-converter racket/base
+
+  (require ffi/unsafe
+           "../ffmpeg-definitions.rkt")
+
+  (provide pcm-conversion-needed?
+           make-pcm-converter
+           pcm-converter?
+           pcm-converter-input-format
+           pcm-converter-output-format
+           pcm-converter-convert
+           pcm-converter-drain
+           pcm-converter-close!)
+
+  (define S32-BYTES 4)
+
+  (define-struct pcm-converter (swr-ctx in-layout out-layout input-format output-format channels in-rate out-rate closed?)
+    #:mutable
+    #:constructor-name make-raw-pcm-converter)
+
+  (define (hash-ref/default h k default)
+    (if (and (hash? h) (hash-has-key? h k)) (hash-ref h k) default))
+
+  (define (copy-hash h)
+    (let ((out (make-hash)))
+      (when (hash? h)
+        (for-each (lambda (k) (hash-set! out k (hash-ref h k))) (hash-keys h)))
+      out))
+
+  (define (native-signed-ref bs start bytes)
+    (integer-bytes->integer bs #t (system-big-endian?) start (+ start bytes)))
+
+  (define (native-signed-set! bs start bytes value)
+    (integer->integer-bytes value bytes #t (system-big-endian?) bs start))
+
+  (define (clamp-s32 v)
+    (cond [(< v -2147483648) -2147483648]
+          [(> v 2147483647) 2147483647]
+          [else v]))
+
+  (define (expand-sample-to-s32 sample in-bits)
+    (clamp-s32 (if (< in-bits 32) (arithmetic-shift sample (- 32 in-bits)) sample)))
+
+  (define (pcm-bytes->s32-bytes buffer size in-bits)
+    (cond [(= in-bits 32) (if (= size (bytes-length buffer)) buffer (subbytes buffer 0 size))]
+          [else
+           (let* ((in-bytes (quotient in-bits 8))
+                  (sample-count (quotient size in-bytes))
+                  (out (make-bytes (* sample-count S32-BYTES))))
+             (for ([i (in-range sample-count)])
+               (let* ((in-off (* i in-bytes))
+                      (out-off (* i S32-BYTES))
+                      (sample (native-signed-ref buffer in-off in-bytes)))
+                 (native-signed-set! out out-off S32-BYTES (expand-sample-to-s32 sample in-bits))))
+             out)]))
+
+  (define (bytes->native bs size)
+    (let ((p (malloc size 'atomic-interior)))
+      (memcpy p 0 bs 0 size)
+      p))
+
+  (define (native->bytes p size)
+    (let ((bs (make-bytes size)))
+      (memcpy bs 0 p 0 size)
+      bs))
+
+  (define (make-plane ptr)
+    (let ((planes (malloc _pointer 1 'atomic-interior)))
+      (ptr-set! planes _pointer 0 ptr)
+      planes))
+
+  (define (target-sample-rate settings input-format)
+    (hash-ref/default settings 'target-sample-rate
+                      (hash-ref/default settings 'sample-rate
+                                        (hash-ref input-format 'sample-rate))))
+
+  (define (target-channels settings input-format)
+    (hash-ref/default settings 'target-channels
+                      (hash-ref/default settings 'channels
+                                        (hash-ref input-format 'channels))))
+
+  (define (target-bits settings input-format)
+    (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)))))
+
+  (define (make-output-format input-format settings)
+    (let* ((out (copy-hash input-format))
+           (in-rate (hash-ref input-format 'sample-rate))
+           (out-rate (target-sample-rate settings input-format))
+           (total (hash-ref/default input-format 'total-samples #f)))
+      (hash-set! out 'sample-rate out-rate)
+      (hash-set! out 'channels (target-channels settings input-format))
+      (hash-set! out 'bits-per-sample (target-bits settings input-format))
+      (hash-set! out 'pcm-bits-per-sample 32)
+      (hash-set! out 'type 'interleaved)
+      (hash-set! out 'endianness 'native-endian)
+      (when (and (integer? total) (>= total 0) (integer? in-rate) (> in-rate 0))
+        (hash-set! out 'total-samples (inexact->exact (round (* total (/ out-rate in-rate))))))
+      out))
+
+  (define (pcm-conversion-needed? input-format settings)
+    (let ((in-rate (hash-ref input-format 'sample-rate))
+          (in-channels (hash-ref input-format 'channels))
+          (out-rate (target-sample-rate settings input-format))
+          (out-channels (target-channels settings input-format)))
+      (or (not (= in-rate out-rate))
+          (not (= in-channels out-channels)))))
+
+  (define (make-pcm-converter input-format settings)
+    (let* ((channels-in (hash-ref input-format 'channels))
+           (channels-out (target-channels settings input-format))
+           (rate-in (hash-ref input-format 'sample-rate))
+           (rate-out (target-sample-rate settings input-format))
+           (in-layout (ffmpeg-make-default-channel-layout channels-in))
+           (out-layout (ffmpeg-make-default-channel-layout channels-out)))
+      (let-values (((ret ctx) (swr_alloc_set_opts2 #f
+                                                   out-layout AV_SAMPLE_FMT_S32 rate-out
+                                                   in-layout AV_SAMPLE_FMT_S32 rate-in
+                                                   0 #f)))
+        (when (< ret 0) (error 'make-pcm-converter "swr_alloc_set_opts2 failed: ~a" ret))
+        (let ((ret-init (swr_init ctx)))
+          (when (< ret-init 0) (error 'make-pcm-converter "swr_init failed: ~a" ret-init))
+          (make-raw-pcm-converter ctx in-layout out-layout input-format (make-output-format input-format settings)
+                                  channels-out rate-in rate-out #f)))))
+
+  (define (ensure-open! c who)
+    (when (or (not (pcm-converter? c)) (pcm-converter-closed? c))
+      (error who "PCM converter is closed")))
+
+  (define (convert* c in-bytes in-samples)
+    (let* ((channels (pcm-converter-channels c))
+           (max-out-samples (swr_get_out_samples (pcm-converter-swr-ctx c) in-samples)))
+      (cond [(<= max-out-samples 0) (values #"" 0)]
+            [else
+             (let* ((out-size (* max-out-samples channels S32-BYTES))
+                    (out-ptr (malloc out-size 'atomic-interior))
+                    (out-planes (make-plane out-ptr))
+                    (in-ptr (and in-bytes (bytes->native in-bytes (bytes-length in-bytes))))
+                    (in-planes (and in-ptr (make-plane in-ptr)))
+                    (out-samples (swr_convert (pcm-converter-swr-ctx c) out-planes max-out-samples in-planes in-samples)))
+               (when (< out-samples 0) (error 'pcm-converter-convert "swr_convert failed: ~a" out-samples))
+               (values (native->bytes out-ptr (* out-samples channels S32-BYTES)) out-samples))])))
+
+  (define (pcm-converter-convert c buffer size buf-info)
+    (ensure-open! c 'pcm-converter-convert)
+    (let* ((in-bits (hash-ref/default buf-info 'bits-per-sample (hash-ref (pcm-converter-input-format c) 'bits-per-sample)))
+           (in-bytes (quotient in-bits 8))
+           (in-channels (hash-ref (pcm-converter-input-format c) 'channels))
+           (in-samples (quotient (quotient size in-bytes) in-channels))
+           (s32 (pcm-bytes->s32-bytes buffer size in-bits)))
+      (convert* c s32 in-samples)))
+
+  (define (pcm-converter-drain c)
+    (ensure-open! c 'pcm-converter-drain)
+    (let* ((ctx (pcm-converter-swr-ctx c))
+           (delay (swr_get_delay ctx (pcm-converter-out-rate c)))
+           (channels (pcm-converter-channels c)))
+      (cond [(<= delay 0) (values #"" 0)]
+            [else
+             (let* ((out-size (* delay channels S32-BYTES))
+                    (out-ptr (malloc out-size 'atomic-interior))
+                    (out-planes (make-plane out-ptr))
+                    (out-samples (swr_convert ctx out-planes delay #f 0)))
+               (when (< out-samples 0) (error 'pcm-converter-drain "swr_convert drain failed: ~a" out-samples))
+               (values (native->bytes out-ptr (* out-samples channels S32-BYTES)) out-samples))])))
+
+  (define (pcm-converter-close! c)
+    (when (and (pcm-converter? c) (not (pcm-converter-closed? c)))
+      (set-pcm-converter-swr-ctx! c (swr_free (pcm-converter-swr-ctx c)))
+      (ffmpeg-channel-layout-uninit! (pcm-converter-in-layout c))
+      (ffmpeg-channel-layout-uninit! (pcm-converter-out-layout c))
+      (set-pcm-converter-closed?! c #t))
+    #t)
+
+  ) ; end of module