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
ffmpeg-definitions.rkt
+283 -151
View File
@@ -872,7 +872,33 @@
[(string? filename) filename]
[else #f]))
(define (fill-audio-info! self)
(let* ((ctx (fmpg-instance-format-ctx self))
(info (fmpg-instance-audio-info self)))
(ais-clear! info)
(ais-stream-count! info (count-audio-streams ctx))
(early-return
((best (av_find_best_stream ctx AVMEDIA_TYPE_AUDIO -1 -1 #f 0) ? (< best 0) => #f)
(stream (avformat_stream ctx best) ? (not (a-!nullptr? stream)) => #f)
(par (avstream-codec stream) ? (not (a-!nullptr? par)) => #f)
(codec-type (avcodec-pars-codec_type par) ? (not (= codec-type AVMEDIA_TYPE_AUDIO)) => #f)
(sample-rate (avcodec-pars-sample_rate par) ? (<= sample-rate 0) => #f)
(channels (avcodec-pars-channels par) ? (<= channels 0) => #f)
(stream-seconds (stream_duration_seconds stream))
(seconds (if (< stream-seconds 0.0) (format_duration_seconds ctx) stream-seconds)))
(ais-stream-index! info best)
(ais-rate! info sample-rate)
(ais-channels! info channels)
(ais-duration-ms! info (milliseconds_from_seconds seconds))
(ais-duration-samples! info (samples_from_seconds seconds sample-rate))
#t)
)
)
#|
(define (fill-audio-info! self)
(let* ((ctx (fmpg-instance-format-ctx self))
(info (fmpg-instance-audio-info self)))
@@ -903,7 +929,7 @@
)
)
)
|#
(define (instance-ready? instance)
(and instance
@@ -919,6 +945,35 @@
#t))
(define (init-codec-context! self)
(early-return
((dec (fmpg-instance-decoder self))
(info (fmpg-instance-audio-info self))
(ctx (fmpg-instance-format-ctx self))
(stream-index (ais-stream-index info))
(stream (avformat_stream ctx stream-index) ? (not (a-!nullptr? stream)) => #f)
(par (avstream-codec stream) ? (not (a-!nullptr? par)) => #f)
(codec (let ((c (avcodec_find_decoder (avcodec-pars-codec_id par))))
(ds-codec! dec c)
c)
? (not (a-!nullptr? codec)) => #f)
(codec-ctx (let ((c (avcodec_alloc_context3 codec)))
(ds-codec-ctx! dec c)
c)
? (not (a-!nullptr? codec-ctx)) => #f)
(ret-par (avcodec_parameters_to_context codec-ctx par) ? (< ret-par 0) => #f)
(ret-open (avcodec_open2 codec-ctx codec #f) ? (< ret-open 0) => #f)
(frame (let ((f (av_frame_alloc)))
(ds-frame! dec f)
f)
? (not (a-!nullptr? frame)) => #f))
#t)
)
#|
(define (init-codec-context! self)
(let/assert
((dec (fmpg-instance-decoder self))
@@ -942,8 +997,41 @@
f)
a-!nullptr? #f))
#t))
|#
(define (init-resampler! self)
(early-return
((dec (fmpg-instance-decoder self))
(codec-ctx (ds-codec-ctx dec) ? (not (a-!nullptr? codec-ctx)) => #f)
(par (avcodec_parameters_alloc) ? (not (a-!nullptr? par)) => #f)
(result
(early-return
((ret-par (avcodec_parameters_from_context par codec-ctx) ? (< ret-par 0) => #f)
(layout (AVCodecParameters-ch_layout par))
(channels (AVChannelLayout-nb_channels layout) ? (<= channels 0) => #f)
(rate (avcodec-pars-sample_rate par) ? (<= rate 0) => #f)
(fmt (avcodec-pars-format par))
(ret-swr
(let-values (((ret swr-ctx)
(swr_alloc_set_opts2 (ds-swr-ctx dec)
layout FMPG_OUTPUT_FMT rate
layout fmt rate
0 #f)))
(ds-swr-ctx! dec swr-ctx)
ret)
? (< ret-swr 0) => #f)
(ret-init (swr_init (ds-swr-ctx dec)) ? (< ret-init 0) => #f))
#t)))
(avcodec_parameters_free par)
result
)
)
#|
(define (init-resampler! self)
(let/assert
((dec (fmpg-instance-decoder self))
@@ -968,6 +1056,7 @@
#t)))
(avcodec_parameters_free par)
result)))
|#
(define (init-decoder! self)
(let ((dec (fmpg-instance-decoder self)))
@@ -1006,7 +1095,6 @@
(when (zero? result) (fmpg-close! instance))
result)))
(define (fmpg-close! instance)
(when instance
(free-ffmpeg (fmpg-instance-decoder instance))
@@ -1096,15 +1184,19 @@
(ds-discard-until! dec -1)])))
(values keep-start keep-samples byte-offset dropped-all?)))
(define (call-with-swr-output-buffer max-bytes proc)
(let/assert
((tmp (malloc max-bytes 'raw) a-!nullptr? #f)
(out-planes (malloc _pointer 1 'raw) a-!nullptr? #f))
(ptr-set! out-planes _pointer 0 tmp)
(let ((result (proc tmp out-planes)))
(free out-planes)
(free tmp)
result)))
(early-return
((tmp (malloc max-bytes 'raw) ? (eq? tmp #f) => #f)
(out-planes (malloc _pointer 1 'raw)
? (eq? out-planes #f) => #f
~ (free tmp))
(do (ptr-set! out-planes _pointer 0 tmp))
(result (proc tmp out-planes)))
(free out-planes)
(free tmp)
result)
)
(define (append-converted-frame! self frame)
(let/assert
@@ -1178,7 +1270,7 @@
[else
(av_packet_unref pkt)
(loop)])))))
#|
(define (drain-resampler! self)
(let* ((dec (fmpg-instance-decoder self))
(info (fmpg-instance-audio-info self))
@@ -1189,171 +1281,211 @@
(let loop ((produced 0))
(early-return
((delay (swr_get_delay swr-ctx sample-rate)
? (<= delay 0) -> produced)
(max-bytes (av_samples_get_buffer_size #f channels delay FMPG_OUTPUT_FMT 1)
? (<= max-bytes 0) -> produced)
(tmp (malloc max-bytes 'raw) ? (eq? tmp #f) -> -1)
((delay (swr_get_delay swr-ctx sample-rate)
? (<= delay 0) => produced)
(max-bytes (av_samples_get_buffer_size #f channels delay FMPG_OUTPUT_FMT 1)
? (<= max-bytes 0) => produced)
(tmp (malloc max-bytes 'raw)
? (eq? tmp #f) => -1)
(out-planes (malloc _pointer 1 'raw)
? (eq? out-planes #f) -> -1 ~ (free tmp))
? (eq? out-planes #f) => -1
~ (free tmp))
(do (ptr-set! out-planes _pointer 0 tmp))
(out-samples (swr_convert swr-ctx out-planes delay #f 0)
? (<= out-samples 0) -> produced
~ (begin (free out-planes) (free tmp)))
? (<= out-samples 0) => produced
~ (begin
(free out-planes)
(free tmp)))
(used-bytes (av_samples_get_buffer_size #f channels out-samples FMPG_OUTPUT_FMT 1)
? (< used-bytes 0) -> produced
~ (begin (free out-planes) (free tmp)))
(used-bytes (av_samples_get_buffer_size #f channels out-samples
FMPG_OUTPUT_FMT 1)
? (< used-bytes 0) => produced
~ (begin
(free out-planes)
(free tmp)))
(do (when (pcm-empty? dec)
(let ((start (ds-next-sample-pos dec)))
(ds-start-sample! dec start)
(ds-timecode! dec (/ (exact->inexact start) sample-rate*)))))
(do
(when (pcm-empty? dec)
(let ((start-sample (ds-next-sample-pos dec)))
(ds-start-sample! dec start-sample)
(ds-timecode! dec (/ (exact->inexact start-sample)
sample-rate*)))))
(appended? (append-bytes! dec tmp used-bytes)
? (not appended?) -> -1
~ (begin (free out-planes) (free tmp))))
? (not appended?) => -1
~ (begin
(free out-planes)
(free tmp)))
)
(ds-last-samples! dec (+ (ds-last-samples dec) out-samples))
(ds-next-sample-pos! dec (+ (ds-next-sample-pos dec) out-samples))
(ds-next-sample-pos! dec (+ (ds-next-sample-pos dec)
out-samples))
(free out-planes)
(free tmp))
(free tmp)
(loop 1))
)
)
)
(loop 1)))
(define (fmpg-decode-next! instance)
;; #f = continue, 0/1 = return value.
(define (receive-result! self dec)
(let ((produced (receive-available-frames! self)))
(cond
[(< produced 0) 0]
[(produced-pcm? produced dec) 1]
[else #f])))
(early-return
((? (not (instance-ready? instance)) => 0)
(dec (fmpg-instance-decoder instance))
(do (ds-clear-output! dec))
(received (receive-result! instance dec) ? received => received)
(pkt (av_packet_alloc) ? (eq? pkt #f) => 0)
(packet-result
(let loop ()
(cond
[(ds-eof-seen dec) #f]
[(not (read-selected-audio-packet! instance pkt))
(ds-eof-seen! dec #t)
(av_packet_unref pkt)
#f]
[else
(let ((ret (avcodec_send_packet (ds-codec-ctx dec) pkt)))
(av_packet_unref pkt)
(cond
[(= ret AVERROR_EAGAIN)
(let ((received (receive-result! instance dec)))
(if received received (loop)))]
[(< ret 0) 0]
[else
(let ((received (receive-result! instance dec)))
(if received received (loop)))]))]))
? packet-result => packet-result
~ (av_packet_free pkt))
(do
(av_packet_free pkt))
(drain-result
(and (not (ds-drained dec))
(let ((ret (avcodec_send_packet (ds-codec-ctx dec) #f)))
(cond
[(and (< ret 0) (not (= ret AVERROR_EOF))) 0]
[else (receive-result! instance dec)])))
? drain-result => drain-result)
(produced (drain-resampler! instance)))
(if (produced-pcm? produced dec) 1 0)
)
)
#|
(define (fmpg-decode-next! instance)
;; #f = continue, 0/1 = return value.
(define (receive-result! self dec)
(let ((produced (receive-available-frames! self)))
(cond
[(< produced 0) 0]
[(produced-pcm? produced dec) 1]
[else #f])))
(early-return
((? (not (instance-ready? instance)) => 0)
(dec (fmpg-instance-decoder instance))
(do (ds-clear-output! dec))
(received (receive-result! instance dec) ? received => received)
(pkt (av_packet_alloc) ? (eq? pkt #f) => 0)
(packet-result
(let loop ()
(unless (ds-eof-seen dec)
(cond
[(not (read-selected-audio-packet! instance pkt))
(ds-eof-seen! dec #t)
(av_packet_unref pkt)
#f]
[else
(let ((ret (avcodec_send_packet (ds-codec-ctx dec) pkt)))
(av_packet_unref pkt)
(cond
[(= ret AVERROR_EAGAIN)
(let ((r (receive-result! instance dec))) (if r r (loop)))]
[(< ret 0) 0]
[else
(let ((r (receive-result! instance dec)))
(if r r (loop)))]))])))
? packet-result => packet-result
~ (av_packet_free pkt))
(do (av_packet_free pkt))
(drain-result
(and (not (ds-drained dec))
(let ((ret (avcodec_send_packet (ds-codec-ctx dec) #f)))
(cond
[(and (< ret 0) (not (= ret AVERROR_EOF))) 0]
[else (receive-result! instance dec)])))
? drain-result => drain-result)
(produced (drain-resampler! instance)))
(if (produced-pcm? produced dec) 1 0)
)
)
|#
(define/return (drain-resampler! self) return
(let* ((dec (fmpg-instance-decoder self))
(info (fmpg-instance-audio-info self))
(channels (ais-channels info))
(sample-rate (ais-rate info)))
(define (fmpg-seek-ms! instance target-pos-ms)
(early-return
((? (or (not (instance-ready? instance)) (< target-pos-ms 0)) => 0)
(let loop ((produced 0))
(let ((delay (swr_get_delay (ds-swr-ctx dec) sample-rate)))
(when (<= delay 0) (return produced))
(info (fmpg-instance-audio-info instance))
(dec (fmpg-instance-decoder instance))
(ctx (fmpg-instance-format-ctx instance))
(stream-index (ais-stream-index info))
(let ((max-bytes (av_samples_get_buffer_size #f channels delay FMPG_OUTPUT_FMT 1)))
(when (<= max-bytes 0) (return produced))
(stream (avformat_stream ctx stream-index)
? (not (a-!nullptr? stream)) => 0)
(let* ((tmp (malloc max-bytes 'raw))
(out-planes (malloc _pointer 1 'raw))
(finish (λ (v)
(when (not (eq? out-planes #f)) (free out-planes))
(when (not (eq? tmp #f)) (free tmp))
(return v)))
)
(pos-us (av_rescale target-pos-ms AV_TIME_BASE 1000))
(stream-ts (av_rescale_q pos-us AV_TIME_BASE_Q (avstream-time_base stream)))
(when (or (eq? tmp #f) (eq? out-planes #f)) (finish -1))
(ret-seek (av_seek_frame ctx stream-index stream-ts AVSEEK_FLAG_BACKWARD)
? (< ret-seek 0) => 0)
(ptr-set! out-planes _pointer 0 tmp)
(target-samples (samples_from_seconds (/ target-pos-ms 1000.0) (ais-rate info)))
(let ((out-samples (swr_convert (ds-swr-ctx dec) out-planes delay #f 0)))
(when (<= out-samples 0) (finish produced))
(do (avcodec_flush_buffers (ds-codec-ctx dec))
(swr_close (ds-swr-ctx dec)))
(let ((used-bytes (av_samples_get_buffer_size #f channels out-samples FMPG_OUTPUT_FMT 1)))
(when (< used-bytes 0) (finish produced))
(ret-swr (swr_init (ds-swr-ctx dec))
? (< ret-swr 0) => 0)
(when (pcm-empty? dec)
(ds-start-sample! dec (ds-next-sample-pos dec))
(ds-timecode! dec (/ (exact->inexact (ds-start-sample dec))
(exact->inexact sample-rate))))
(when (not (append-bytes! dec tmp used-bytes)) (finish -1))
(ds-last-samples! dec (+ (ds-last-samples dec) out-samples))
(ds-next-sample-pos! dec (+ (ds-next-sample-pos dec) out-samples))
(free out-planes)
(free tmp)
(loop 1)))))))))
(define/return (fmpg-decode-next! instance) return
(define (receive-or-return! self dec)
(let ((produced (receive-available-frames! self)))
(cond
[(< produced 0) (return 0)]
[(produced-pcm? produced dec) (return 1)]
[else produced])))
(when (not (instance-ready? instance)) (return 0))
(let ((dec (fmpg-instance-decoder instance)))
(ds-clear-output! dec)
(receive-or-return! instance dec)
(let* ((pkt (av_packet_alloc))
(finish (λ (v)
(av_packet_free pkt)
(return v))))
(when (eq? pkt #f) (return 0))
(let loop ()
(unless (ds-eof-seen dec)
(cond
[(not (read-selected-audio-packet! instance pkt))
(ds-eof-seen! dec #t)
(av_packet_unref pkt)]
[else
(let ((ret (avcodec_send_packet (ds-codec-ctx dec) pkt)))
(av_packet_unref pkt)
(cond
[(= ret AVERROR_EAGAIN)
(receive-or-return! instance dec)
(loop)]
[(< ret 0) (finish 0)]
[else
(receive-or-return! instance dec)
(loop)]))])))
(av_packet_free pkt)
(unless (ds-drained dec)
(let ((ret (avcodec_send_packet (ds-codec-ctx dec) #f)))
(when (and (< ret 0) (not (= ret AVERROR_EOF))) (return 0)))
(receive-or-return! instance dec))
(let ((produced (drain-resampler! instance)))
(if (produced-pcm? produced dec) 1 0)))))
(define/return (fmpg-seek-ms! instance target-pos-ms) return
(when (or (not (instance-ready? instance)) (< target-pos-ms 0)) (return 0))
(let/assert
((info (fmpg-instance-audio-info instance))
(dec (fmpg-instance-decoder instance))
(ctx (fmpg-instance-format-ctx instance))
(stream-index (ais-stream-index info))
(stream (avformat_stream ctx stream-index) a-!nullptr? 0)
(pos-us (av_rescale target-pos-ms AV_TIME_BASE 1000))
(stream-ts (av_rescale_q pos-us AV_TIME_BASE_Q (avstream-time_base stream)))
(ret-seek (av_seek_frame ctx stream-index stream-ts AVSEEK_FLAG_BACKWARD) (a->=? 0) 0)
(target-samples (samples_from_seconds (/ target-pos-ms 1000.0) (ais-rate info))))
(avcodec_flush_buffers (ds-codec-ctx dec))
(swr_close (ds-swr-ctx dec))
(let/assert
((ret-swr (swr_init (ds-swr-ctx dec)) (a->=? 0) 0))
(let ((pos (if (>= target-samples 0) target-samples 0)))
(ds-pcm! dec (make-bytes 0))
(ds-last-samples! dec 0)
(ds-start-sample! dec pos)
(ds-next-sample-pos! dec pos)
(ds-discard-until! dec target-samples)
(ds-timecode! dec (/ target-pos-ms 1000.0))
(ds-eof-seen! dec #f)
(ds-drained! dec #f)
1))))
(pos (if (>= target-samples 0) target-samples 0)))
(ds-pcm! dec (make-bytes 0))
(ds-last-samples! dec 0)
(ds-start-sample! dec pos)
(ds-next-sample-pos! dec pos)
(ds-discard-until! dec target-samples)
(ds-timecode! dec (/ target-pos-ms 1000.0))
(ds-eof-seen! dec #f)
(ds-drained! dec #f)
1)
)
(define (fmpg-decoder instance)
(and instance (fmpg-instance-decoder instance)))
flac-decoder.rkt
+38 -103
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,17 +153,18 @@
(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)
@@ -245,4 +179,5 @@
)
)
); end of module
libao-async-ffi-racket.rkt
+13 -5
View File
@@ -33,6 +33,8 @@
ao_sample_queue_len
make-buffer-info
make-BufferInfo_t
ao-playback-buf-ms
ao-set-playback-buf-ms!
)
;; -------------------------------------------------------------------------
@@ -194,7 +196,13 @@
;; Playback buffer to send to libao in milliseconds
;; -------------------------------------------------------------------------
(define ao-buf-ms 1000) ;; Playback buffer of 0.25s
(define ao-buf-ms 350) ;; Playback buffer of 0.35s
(define (ao-playback-buf-ms)
ao-buf-ms)
(define (ao-set-playback-buf-ms! ms)
(set! ao-buf-ms ms))
;; -------------------------------------------------------------------------
;; Sample queue handling
@@ -272,7 +280,7 @@
(reuse-buf h (queue-elem-buf elem))
(when (= (ao-handle-bytes-left h) 0)
(async-channel-put (ao-handle-queue h) cb)
(set-ao-handle-in-queue! h (+ ao-handle-in-queue h) 1)
(set-ao-handle-in-queue! h (+ (ao-handle-in-queue h) 1))
(set-ao-handle-current-elem! h #f))
)
)
@@ -423,8 +431,8 @@
(define (planar-to-interleaved h in-buf info)
;; mem: bytes
;; result: (list bytes output-size)
;; in-buf: mem
;; result: mem
(let* ([in-bytes (mem-bytes in-buf)]
[buf-size (mem-size in-buf)]
@@ -456,7 +464,7 @@
bytes)])
(bytes-copy! out-bytes out-pos in-bytes in-pos (+ in-pos bytes)))))
out out-size)))
out)))
;;; requested bits to device bits
libao.rkt
+7
View File
@@ -31,8 +31,11 @@
ao-valid-format?
ao-handle?
ao-supported-music-format?
ao-playback-buf-ms
ao-set-playback-buf-ms!
)
(define device-number 1)
(define-struct ao-handle (handle-num
@@ -50,6 +53,10 @@
)
(define ao-playback-buf-ms ffi:ao-playback-buf-ms)
(define ao-set-playback-buf-ms! ffi:ao-set-playback-buf-ms!)
(define (ao-supported-music-format? f)
(and (symbol? f)
(or (eq? f 'flac)
libflac-ffi.rkt
+61 -39
View File
@@ -108,21 +108,6 @@
undefined
)))
;typedef enum {
; FLAC__STREAM_DECODER_SEARCH_FOR_METADATA = 0,
; FLAC__STREAM_DECODER_READ_METADATA,
; FLAC__STREAM_DECODER_SEARCH_FOR_FRAME_SYNC,
; FLAC__STREAM_DECODER_READ_FRAME,
; FLAC__STREAM_DECODER_END_OF_STREAM,
; FLAC__STREAM_DECODER_OGG_ERROR,
; FLAC__STREAM_DECODER_SEEK_ERROR,
; FLAC__STREAM_DECODER_ABORTED,
; FLAC__STREAM_DECODER_MEMORY_ALLOCATION_ERROR,
; FLAC__STREAM_DECODER_UNINITIALIZED,
; FLAC__STREAM_DECODER_END_OF_LINK
;} FLAC__StreamDecoderState;
(define _FLAC_StreamDecoderState
(_enum '(search-for-metadata = 0
read-metadata
@@ -247,23 +232,6 @@
;; FLAC Metadata
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;typedef struct FLAC__StreamMetadata {
; FLAC__MetadataType type;
; FLAC__bool is_last;
; uint32_t length;
; union {
; FLAC__StreamMetadata_StreamInfo stream_info;
; FLAC__StreamMetadata_Padding padding;
; FLAC__StreamMetadata_Application application;
; FLAC__StreamMetadata_SeekTable seek_table;
; FLAC__StreamMetadata_VorbisComment vorbis_comment;
; FLAC__StreamMetadata_CueSheet cue_sheet;
; FLAC__StreamMetadata_Picture picture;
; FLAC__StreamMetadata_Unknown unknown;
; } data;
;} FLAC__StreamMetadata;
(define-cstruct _FLAC__StreamMetadata_StreamInfo
(
[min_blocksize _uint32_t]
@@ -498,6 +466,52 @@
;; Our interface for decoding to racket
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(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)
;; 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 (copy-flac-frame frame buffer)
(let* ((h (flac-ffi-frame-header frame))
(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))
(bs (car result))
(buf-size (cadr result)))
(hash-set! h 'type 'interleaved)
(hash-set! h 'endianness endianness)
(hash-set! h 'bits-per-sample bits)
(hash-set! h 'sample (hash-ref h 'number))
(cons h bs)))
(define (flac-ffi-decoder-handler)
(define write-data '())
(define meta-data '())
@@ -506,14 +520,21 @@
(define flac-file #f)
(define client-data #f)
;(define (write-callback fl frame buffer client-data)
; (set! write-data (append write-data (list (cons frame buffer))))
; 0)
(define (write-callback fl frame buffer client-data)
(set! write-data (append write-data (list (cons frame buffer))))
(set! write-data (cons (copy-flac-frame frame buffer) write-data))
0)
;(define (meta-callback fl meta client-data)
; (let ((meta-clone (FLAC__metadata_object_clone meta)))
; (unless (eq? meta-clone #f)
; (set! meta-data (append meta-data (list meta-clone))))))
(define (meta-callback fl meta client-data)
(let ((meta-clone (FLAC__metadata_object_clone meta)))
(unless (eq? meta-clone #f)
(set! meta-data (append meta-data (list meta-clone))))))
(set! meta-data (cons meta-clone meta-data)))))
(define (error-callback fl errno client-data)
(set! error-no errno)
@@ -557,16 +578,16 @@
(decoder-state (int-state)))
(define (process-meta-data cb)
(for-each (λ (meta-entry)
(for-each (lambda (meta-entry)
(cb meta-entry)
(FLAC__metadata_object_delete meta-entry))
meta-data)
(reverse meta-data))
(set! meta-data '()))
(define (process-write-data cb)
(for-each (lambda (d)
(cb (car d) (cdr d)))
write-data)
(for-each (lambda (d)
(cb (car d) (cdr d)))
(reverse write-data))
(set! write-data '()))
(define (buffer->vectorlist buffer channels size)
@@ -619,3 +640,4 @@
)
); end of module
play-test.rkt
+1 -1
View File
@@ -16,7 +16,7 @@
(define test-file3-id 3)
(define test-file4-id 4)
(set! test-file3 (build-path tests "mahler-1.mp3"))
(set! test-file3 (build-path tests "idyll.flac"))
(set! test-file4 (build-path tests "mahler-2.mp3"))
;(define fmt (ao-mk-format 24 48000 2 'big-endian))