diff --git a/ffmpeg-definitions.rkt b/ffmpeg-definitions.rkt index 948263c..c447e0e 100644 --- a/ffmpeg-definitions.rkt +++ b/ffmpeg-definitions.rkt @@ -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))) diff --git a/flac-decoder.rkt b/flac-decoder.rkt index 010e172..71be950 100644 --- a/flac-decoder.rkt +++ b/flac-decoder.rkt @@ -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 diff --git a/libao-async-ffi-racket.rkt b/libao-async-ffi-racket.rkt index e94a924..09f5881 100644 --- a/libao-async-ffi-racket.rkt +++ b/libao-async-ffi-racket.rkt @@ -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 diff --git a/libao.rkt b/libao.rkt index 2e40567..5feba13 100644 --- a/libao.rkt +++ b/libao.rkt @@ -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) diff --git a/libflac-ffi.rkt b/libflac-ffi.rkt index fa7b4e3..bbb8801 100644 --- a/libflac-ffi.rkt +++ b/libflac-ffi.rkt @@ -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) @@ -618,4 +639,5 @@ )) ) -); end of module \ No newline at end of file +); end of module + diff --git a/play-test.rkt b/play-test.rkt index acfa467..b94068f 100644 --- a/play-test.rkt +++ b/play-test.rkt @@ -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))