Files
2026-06-10 01:42:08 +02:00

151 lines
6.4 KiB
Racket

(module pcm-converter racket/base
(require ffi/unsafe
"utils.rkt"
"../resampler.rkt")
(provide pcm-conversion-needed?
make-pcm-converter
pcm-converter?
pcm-converter-input-format
pcm-converter-output-format
pcm-converter-convert
pcm-converter-drain
pcm-converter-close!)
(define S32-BYTES 4)
(define-struct pcm-converter (resampler input-format output-format channels in-rate out-rate closed?)
#:mutable
#:constructor-name make-raw-pcm-converter)
(define (hash-ref/default h k default)
(if (and (hash? h) (hash-has-key? h k)) (hash-ref h k) default))
(define (copy-hash h)
(let ((out (make-hash)))
(when (hash? h)
(for-each (lambda (k) (hash-set! out k (hash-ref h k))) (hash-keys h)))
out))
(define (native-signed-ref bs start bytes)
(int-bytes->integer bs #t (system-big-endian?) start (+ start bytes)))
(define (native-signed-set! bs start bytes value)
(integer->int-bytes value bytes #t (system-big-endian?) bs start))
(define (clamp-s32 v)
(cond [(< v -2147483648) -2147483648]
[(> v 2147483647) 2147483647]
[else v]))
(define (expand-sample-to-s32 sample in-bits)
(clamp-s32 (if (< in-bits 32) (arithmetic-shift sample (- 32 in-bits)) sample)))
(define (pcm-bytes->s32-bytes buffer size in-bits)
(cond [(= in-bits 32) (if (= size (bytes-length buffer)) buffer (subbytes buffer 0 size))]
[else
(let* ((in-bytes (quotient in-bits 8))
(sample-count (quotient size in-bytes))
(out (make-bytes (* sample-count S32-BYTES))))
(for ([i (in-range sample-count)])
(let* ((in-off (* i in-bytes))
(out-off (* i S32-BYTES))
(sample (native-signed-ref buffer in-off in-bytes)))
(native-signed-set! out out-off S32-BYTES (expand-sample-to-s32 sample in-bits))))
out)]))
(define (source-value v source)
(if (eq? v 'source) source v))
(define (target-sample-rate settings input-format)
(source-value
(hash-ref/default settings 'target-sample-rate
(hash-ref/default settings 'sample-rate
(hash-ref input-format 'sample-rate)))
(hash-ref input-format 'sample-rate)))
(define (target-channels settings input-format)
(source-value
(hash-ref/default settings 'target-channels
(hash-ref/default settings 'channels
(hash-ref input-format 'channels)))
(hash-ref input-format 'channels)))
(define (target-bits settings input-format)
(let ((source-bits (let ((bits (hash-ref/default input-format 'bits-per-sample 24)))
(if (and (integer? bits) (<= bits 24)) bits 24))))
(source-value
(hash-ref/default settings 'target-bits-per-sample
(hash-ref/default settings 'bits-per-sample source-bits))
source-bits)))
(define (make-output-format input-format settings)
(let* ((out (copy-hash input-format))
(in-rate (hash-ref input-format 'sample-rate))
(out-rate (target-sample-rate settings input-format))
(total (hash-ref/default input-format 'total-samples #f)))
(hash-set! out 'sample-rate out-rate)
(hash-set! out 'channels (target-channels settings input-format))
(hash-set! out 'bits-per-sample (target-bits settings input-format))
(hash-set! out 'pcm-bits-per-sample 32)
(hash-set! out 'type 'interleaved)
(hash-set! out 'endianness 'native-endian)
(when (and (integer? total) (>= total 0) (integer? in-rate) (> in-rate 0))
(hash-set! out 'total-samples (inexact->exact (round (* total (/ out-rate in-rate))))))
out))
(define (pcm-conversion-needed? input-format settings)
(let ((in-rate (hash-ref input-format 'sample-rate))
(in-channels (hash-ref input-format 'channels))
(out-rate (target-sample-rate settings input-format))
(out-channels (target-channels settings input-format)))
(or (not (= in-rate out-rate))
(not (= in-channels out-channels)))))
(define (make-pcm-converter input-format settings)
(let* ((channels-in (hash-ref input-format 'channels))
(channels-out (target-channels settings input-format))
(rate-in (hash-ref input-format 'sample-rate))
(rate-out (target-sample-rate settings input-format))
(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 (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)))
(in-bytes (quotient in-bits 8))
(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)))
(resampler-convert (pcm-converter-resampler c) s32 (* in-samples in-channels S32-BYTES))))
(define (pcm-converter-drain c)
(ensure-open! c 'pcm-converter-drain)
(resampler-drain (pcm-converter-resampler c)))
(define (pcm-converter-close! c)
(when (and (pcm-converter? c) (not (pcm-converter-closed? c)))
(resampler-close! (pcm-converter-resampler c))
(set-pcm-converter-closed?! c #t))
#t)
) ; end of module