more defensive constructs with early-return & let-assert
This commit is contained in:
+284
-152
@@ -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))
|
||||
|
||||
(loop 1)))
|
||||
(free tmp)
|
||||
(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)))
|
||||
|
||||
(let loop ((produced 0))
|
||||
(let ((delay (swr_get_delay (ds-swr-ctx dec) sample-rate)))
|
||||
(when (<= delay 0) (return produced))
|
||||
(define (fmpg-seek-ms! instance target-pos-ms)
|
||||
(early-return
|
||||
((? (or (not (instance-ready? instance)) (< target-pos-ms 0)) => 0)
|
||||
|
||||
(let ((max-bytes (av_samples_get_buffer_size #f channels delay FMPG_OUTPUT_FMT 1)))
|
||||
(when (<= max-bytes 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* ((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)))
|
||||
)
|
||||
(stream (avformat_stream ctx stream-index)
|
||||
? (not (a-!nullptr? stream)) => 0)
|
||||
|
||||
(when (or (eq? tmp #f) (eq? out-planes #f)) (finish -1))
|
||||
(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)))
|
||||
|
||||
(ptr-set! out-planes _pointer 0 tmp)
|
||||
(ret-seek (av_seek_frame ctx stream-index stream-ts AVSEEK_FLAG_BACKWARD)
|
||||
? (< ret-seek 0) => 0)
|
||||
|
||||
(let ((out-samples (swr_convert (ds-swr-ctx dec) out-planes delay #f 0)))
|
||||
(when (<= out-samples 0) (finish produced))
|
||||
(target-samples (samples_from_seconds (/ target-pos-ms 1000.0) (ais-rate info)))
|
||||
|
||||
(let ((used-bytes (av_samples_get_buffer_size #f channels out-samples FMPG_OUTPUT_FMT 1)))
|
||||
(when (< used-bytes 0) (finish produced))
|
||||
(do (avcodec_flush_buffers (ds-codec-ctx dec))
|
||||
(swr_close (ds-swr-ctx dec)))
|
||||
|
||||
(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))))
|
||||
(ret-swr (swr_init (ds-swr-ctx dec))
|
||||
? (< ret-swr 0) => 0)
|
||||
|
||||
(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)))
|
||||
|
||||
Reference in New Issue
Block a user