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