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

soxr

Browse Source
This commit is contained in:
Hans Dijkema
2026-06-10 01:42:08 +02:00
parent 4f95e57a96
commit 5c719ea4a0
10 changed files with 681 additions and 72 deletions
Download Patch File Download Diff File Expand all files Collapse all files
private/pcm-converter.rkt
+21 -58
View File
@@ -2,7 +2,7 @@
(require ffi/unsafe
"utils.rkt"
"../ffmpeg-definitions.rkt")
"../resampler.rkt")
(provide pcm-conversion-needed?
make-pcm-converter
@@ -15,7 +15,7 @@
(define S32-BYTES 4)
(define-struct pcm-converter (swr-ctx in-layout out-layout input-format output-format channels in-rate out-rate closed?)
(define-struct pcm-converter (resampler input-format output-format channels in-rate out-rate closed?)
#:mutable
#:constructor-name make-raw-pcm-converter)
@@ -32,7 +32,7 @@
(int-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))
(integer->int-bytes value bytes #t (system-big-endian?) bs start))
(define (clamp-s32 v)
(cond [(< v -2147483648) -2147483648]
@@ -55,21 +55,6 @@
(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 (source-value v source)
(if (eq? v 'source) source v))
@@ -123,36 +108,26 @@
(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)))))
(quality (hash-ref/default settings 'resampler-quality 'hq))
(phase (hash-ref/default settings 'resampler-phase 'linear))
(steep? (hash-ref/default settings 'resampler-steep-filter? #f))
(out-format (make-output-format input-format settings)))
(unless (= channels-in channels-out)
(error 'make-pcm-converter
"SoXR PCM converter only supports unchanged channel count; got input ~a and output ~a"
channels-in channels-out))
(let ((r (make-resampler rate-in rate-out channels-in
#:input-format 's32
#:output-format 's32
#:quality quality
#:phase phase
#:steep-filter? steep?)))
(make-raw-pcm-converter r input-format out-format 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)))
@@ -160,27 +135,15 @@
(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)))
(resampler-convert (pcm-converter-resampler c) s32 (* in-samples in-channels S32-BYTES))))
(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))])))
(resampler-drain (pcm-converter-resampler c)))
(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))
(resampler-close! (pcm-converter-resampler c))
(set-pcm-converter-closed?! c #t))
#t)
private/utils.rkt
+6 -4
View File
@@ -178,14 +178,14 @@
(loop (+ n 1) (cons (number->string n) acc)))))
(define (ffmpeg-lib-versions kind)
(case (system-type 'os)
(case (system-type 'os*)
[(linux)
(let ((v (hash-ref valid-ffmpeg-versions kind)))
(versions-high-to-low (car v) (cadr v)))]
[else '(#f)]))
(define (linux-lib-versions versions [default '(#f)])
(case (system-type 'os)
(case (system-type 'os*)
[(linux) versions]
[else default]))
@@ -213,7 +213,7 @@
"
" libavcodec60 libavutil58 libswresample4 libavformat60 \
"
" libogg0 libopus0 libopusenc0 libopusfile0 libtag1v5
" libogg0 libopus0 libopusenc0 libopusfile0 libsoxr0 libtag1v5
"
"
"
@@ -223,7 +223,7 @@
"
"libavutil-dev, libswresample-dev, libavformat-dev, libogg-dev,
"
"libopus-dev, libopusenc-dev, libopusfile-dev and libtag1-dev.
"libopus-dev, libopusenc-dev, libopusfile-dev, libsoxr-dev and libtag1-dev.
"
"
"
@@ -244,6 +244,8 @@
" brew install opus
"
" brew install libopusenc
"
" brew install libsoxr
"
" brew install taglib
"