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

racket version of async C backend

Browse Source
This commit is contained in:
Hans Dijkema
2026-05-03 10:13:28 +02:00
parent 856c790257
commit 92227133ff
5 changed files with 1090 additions and 30 deletions
Download Patch File Download Diff File Expand all files Collapse all files
flac-decoder.rkt
+61 -15
View File
@@ -43,25 +43,70 @@
(define kinds (make-hash))
(define last-buffer #f)
(define last-buf-len #f)
(define (endian-little? e)
(cond [(eq? e 'little-endian) #t]
[(eq? e 'big-endian) #f]
[(eq? e 'native-endian) (not (system-big-endian?))]
[else (error (format "unknown endian value: ~a" e))]))
(define (flac-channels->interleaved-buffer buffer block-size channels bits endianness)
(let* ([bytes (quotient bits 8)]
[little? (endian-little? endianness)]
[buf-size (* block-size channels bytes)]
[mem-out (malloc buf-size 'atomic)]
[out-pos 0])
(for ([k (in-range block-size)])
(for ([channel (in-range channels)])
(let* ([channel-ptr (ptr-ref buffer _pointer channel)]
[sample (ptr-ref channel-ptr _int32 k)])
(if little?
(for ([j (in-range bytes)])
(ptr-set! mem-out _uint8 (+ out-pos j)
(bitwise-and
(arithmetic-shift sample (* -8 j))
#xff)))
(for ([j (in-range bytes)])
(ptr-set! mem-out _uint8 (+ out-pos j)
(bitwise-and
(arithmetic-shift sample
(* -8 (- bytes j 1)))
#xff))))
(set! out-pos (+ out-pos bytes)))))
(list mem-out buf-size)))
(define (process-frame handle frame buffer)
(let* ((h (flac-ffi-frame-header frame))
(cb-audio (flac-handle-cb-audio handle))
(ffi (flac-handle-ffi-decoder-handler handle))
(type (hash-ref h 'number-type))
(channels (hash-ref h 'channels))
(block-size (hash-ref h 'blocksize)))
(let* ([h (flac-ffi-frame-header frame)]
[cb-audio (flac-handle-cb-audio handle)]
[type (hash-ref h 'number-type)]
[channels (hash-ref h 'channels)]
[block-size (hash-ref h 'blocksize)]
[bits (hash-ref h 'bits-per-sample)]
[endianness 'native-endian]
[result (flac-channels->interleaved-buffer
buffer block-size channels bits endianness)]
[mem-out (car result)]
[buf-size (cadr result)])
(hash-set! h 'duration (flac-duration handle))
(let ((sample (hash-ref h 'number)))
(hash-set! h 'sample sample))
(set! last-buffer buffer)
(set! last-buf-len block-size)
(hash-set! h 'sample (hash-ref h 'number))
(hash-set! h 'type 'interleaved)
(hash-set! h 'endianness endianness)
(hash-set! h 'bits-per-sample bits)
(set! last-buffer mem-out)
(set! last-buf-len buf-size)
(hash-set! kinds type #t)
(when (procedure? cb-audio)
(cb-audio h buffer block-size))
)
#t
)
(cb-audio h mem-out buf-size))
#t))
(define (process-meta handle meta)
(let ((type (FLAC__StreamMetadata-type meta)))
@@ -74,13 +119,14 @@
(hash-ref mh 'min-framesize) (hash-ref mh 'max-framesize)
(hash-ref mh 'sample-rate)
(hash-ref mh 'channels)
(hash-ref mh 'bits-per-sample)
32 ; (hash-ref mh 'bits-per-sample)
(hash-ref mh 'total-samples))))
(let ((duration (exact->inexact
(/ (hash-ref mh 'total-samples)
(hash-ref mh 'sample-rate)))))
(hash-set! mh 'duration duration))
(set-flac-handle-stream-info! handle si)
(hash-set! mh 'bits-per-sample 32) ; Flac works internally 32 bits.
(let ((cb (flac-handle-cb-stream-info handle)))
(when (procedure? cb)
(cb mh))))))