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

more defensive constructs with early-return & let-assert

Browse Source
This commit is contained in:
Hans Dijkema
2026-05-12 11:34:56 +02:00
parent 61d87ba543
commit 89592ddea9
6 changed files with 406 additions and 302 deletions
Download Patch File Download Diff File Expand all files Collapse all files
flac-decoder.rkt
+39 -104
View File
@@ -3,7 +3,9 @@
(require ffi/unsafe
"libflac-ffi.rkt"
"flac-definitions.rkt"
"private/utils.rkt")
"private/utils.rkt"
let-assert
)
(provide flac-open
flac-valid?
@@ -26,15 +28,16 @@
(define (flac-open flac-file* cb-stream-info cb-audio)
(let ((flac-file (if (path? flac-file*) (path->string flac-file*) flac-file*)))
(if (file-exists? flac-file)
(let ((handler (flac-ffi-decoder-handler)))
(handler 'new)
(handler 'init flac-file)
(let ((h (make-flac-handle handler)))
(set-flac-handle-cb-stream-info! h cb-stream-info)
(set-flac-handle-cb-audio! h cb-audio)
h))
#f)))
(and (string? flac-file)
(file-exists? flac-file)
(let ((handler (flac-ffi-decoder-handler)))
(let/assert
((dec (handler 'new) a-!nullptr? #f)
(ret (handler 'init flac-file) zero? (begin (handler 'delete) #f)))
(let ((h (make-flac-handle handler)))
(set-flac-handle-cb-stream-info! h cb-stream-info)
(set-flac-handle-cb-audio! h cb-audio)
h))))))
(define (flac-stream-state handle)
((flac-handle-ffi-decoder-handler handle) 'state))
@@ -44,94 +47,23 @@
(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])
(define (process-frame handle h mem-out)
(let* ([cb-audio (flac-handle-cb-audio handle)]
[type (hash-ref h 'number-type)]
[buf-size (bytes-length mem-out)])
(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)])
(hash-set! h 'duration (flac-duration handle))
(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! last-buffer mem-out)
(set! last-buf-len buf-size)
(set! out-pos (+ out-pos bytes)))))
(hash-set! kinds type #t)
(list mem-out buf-size)))
|#
(when (procedure? cb-audio)
(cb-audio h mem-out buf-size))
(define (flac-channels->interleaved-buffer buffer block-size channels bits endianness)
;; buffer = FLAC__int32 * const buffer[]
;; block-size = samples per channel
(let* ([bytes (quotient bits 8)]
[big? (not (endian-little? endianness))]
[buf-size (* block-size channels bytes)]
[bs (make-bytes buf-size)]
;[out (malloc buf-size 'atomic-interior)]
[out-pos 0])
(for ([k (in-range block-size)])
(for ([channel (in-range channels)])
(let* ([chan (ptr-ref buffer _pointer channel)]
[sample (ptr-ref chan _int32 k)])
(integer->int-bytes sample bytes #t big? bs out-pos)
(set! out-pos (+ out-pos bytes)))))
;(memcpy out bs buf-size)
;(list out buf-size)
(list bs buf-size)
))
(define (process-frame handle frame buffer)
(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))
(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 mem-out buf-size))
#t))
#t))
(define (process-meta handle meta)
(let ((type (FLAC__StreamMetadata-type meta)))
@@ -186,9 +118,10 @@
)
(when (ffi-handler 'has-write-data?)
(ffi-handler 'process-write-data
(lambda (frame buffer)
(process-frame handle frame buffer)))
(lambda (h mem-out)
(process-frame handle h mem-out)))
)
(if (eq? st 'end-of-stream)
(begin
(set-flac-handle-reading! handle #f)
@@ -220,19 +153,20 @@
(flac-handle-stream-info handle))
#f)))
(define (flac-seek handle percentage)
(dbg-sound "seek to percentage ~a" percentage)
(let ((ffi-handler (flac-handle-ffi-decoder-handler handle)))
(let ((total-samples (flac-total-samples handle)))
(unless (eq? total-samples #f)
(let ((sample (inexact->exact (round (* (exact->inexact (/ percentage 100.0)) total-samples)))))
(ffi-handler 'seek-to-sample sample))
)
)
)
)
(let* ((ffi-handler (flac-handle-ffi-decoder-handler handle))
(total-samples (flac-total-samples handle)))
(and total-samples
(> total-samples 0)
(let* ((percentage (max 0 (min 100 percentage)))
(sample (inexact->exact
(round (* (/ percentage 100.0) total-samples))))
(sample (min sample (- total-samples 1))))
(ffi-handler 'seek-to-sample sample)))))
(define (flac-stop handle)
(let ((ct (current-milliseconds)))
(dbg-sound "requesting stop at: ~a" ct)
@@ -244,5 +178,6 @@
(dbg-sound "flac-stop took: ~a ms" (- ct* ct)))
)
)
); end of module