Audio Encoder laag.
This commit is contained in:
@@ -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
|
||||
Reference in New Issue
Block a user