268 lines
13 KiB
Racket
268 lines
13 KiB
Racket
(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")])
|
|
'(#f)))
|
|
|
|
(define libopus
|
|
(get-lib (case (system-type 'os)
|
|
[(windows) '("opus")]
|
|
[else '("opus" "libopus")])
|
|
'(#f)))
|
|
|
|
(define libopusenc
|
|
(get-lib (case (system-type 'os)
|
|
[(windows) '("libopusenc")]
|
|
[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_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
|