hans/gemigreerd-racket-audio
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Audio Encoder laag.

Browse Source
This commit is contained in:
Hans Dijkema
2026-06-08 10:27:05 +02:00
parent 696ef1b978
commit 444d62edac
7 changed files with 836 additions and 1 deletions
Download Patch File Download Diff File Expand all files Collapse all files
opus-encoder.rkt
+192
View File
@@ -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