1265 lines
39 KiB
Racket
1265 lines
39 KiB
Racket
#lang racket/base
|
|
|
|
(require ffi/unsafe
|
|
ffi/unsafe/define
|
|
ffi/unsafe/alloc
|
|
(for-syntax racket/base)
|
|
"private/utils.rkt"
|
|
"private/cstruct-helper.rkt"
|
|
let-assert
|
|
define-return
|
|
)
|
|
|
|
(provide fmpg-init
|
|
fmpg-open-file!
|
|
fmpg-close!
|
|
fmpg-is-open
|
|
fmpg-audio-stream-count
|
|
fmpg-audio-sample-rate
|
|
fmpg-audio-channels
|
|
fmpg-audio-bits-per-sample
|
|
fmpg-audio-bytes-per-sample
|
|
fmpg-duration-ms
|
|
fmpg-duration-samples
|
|
fmpg-file-bitrate
|
|
fmpg-decode-next!
|
|
fmpg-seek-ms!
|
|
fmpg-buffer
|
|
fmpg-buffer-size
|
|
fmpg-buffer-start-sample
|
|
fmpg-buffer-end-sample
|
|
fmpg-sample-position
|
|
ffmpeg-version)
|
|
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
;; C - Types & Functions
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
|
|
;;;; Helpers for constants
|
|
|
|
(define (mktag a b c d)
|
|
(bitwise-ior (char->integer a)
|
|
(arithmetic-shift (char->integer b) 8)
|
|
(arithmetic-shift (char->integer c) 16)
|
|
(arithmetic-shift (char->integer d) 24)))
|
|
|
|
(define (fferrtag a b c d)
|
|
(- (mktag a b c d)))
|
|
|
|
(define (AVERROR e) (* -1 e))
|
|
|
|
;;;; Constants
|
|
|
|
(define-cstruct _AVRational
|
|
([num _int]
|
|
[den _int]
|
|
)
|
|
)
|
|
|
|
(define EAGAIN 11) ; from errno.h
|
|
|
|
(define INT_MAX (sub1 (arithmetic-shift 1 31)))
|
|
(define AV_NOPTS_VALUE #x8000000000000000)
|
|
|
|
(define AV_TIME_BASE 1000000)
|
|
(define AV_TIME_BASE_Q (make-AVRational 1 AV_TIME_BASE))
|
|
|
|
(define AVSEEK_FLAG_BACKWARD 1)
|
|
|
|
(define AVERROR_EAGAIN (AVERROR EAGAIN))
|
|
(define AVERROR_EOF (fferrtag #\E #\O #\F #\space))
|
|
|
|
(define _AVCodec (_cpointer/null 'AVCodec))
|
|
(define _AVCodecContext (_cpointer/null 'AVCodecContext))
|
|
(define _SwrContext (_cpointer/null 'SwrContext))
|
|
|
|
;;;; enum constants
|
|
|
|
(define AV_SAMPLE_FMT_NONE -1)
|
|
(define AV_SAMPLE_FMT_S32 2)
|
|
|
|
(define AVMEDIA_TYPE_AUDIO 1)
|
|
|
|
;;;; potential enum types
|
|
|
|
(define _AVCodecID _int)
|
|
(define _AVMediaType _int)
|
|
(define _AVSampleFormat _int)
|
|
|
|
;;;; struct types and partial struct types.
|
|
;;;; the least necessary for ffmpeg and wrappers
|
|
|
|
|
|
(define-cstruct _AVChannelLayout
|
|
([order _int] ; enum AVChannelOrder
|
|
[nb_channels _int]
|
|
[u (_union _uint64 _pointer)]
|
|
[opaque _pointer]
|
|
)
|
|
)
|
|
|
|
; _AVCodecParameters:
|
|
; codec_type : AVMediaType
|
|
; codec_id : int / AVCodecID
|
|
; ch_layout : AVChannelLayout
|
|
; sample_rate : int
|
|
|
|
(def-cstruct
|
|
_AVCodecParameters
|
|
(codec_type codec_id format ch_layout sample_rate)
|
|
(make-offsets (codec_type _AVMediaType)
|
|
(codec_id _AVCodecID)
|
|
|
|
;; codec_tag, extradata, extradata_size,
|
|
;; coded_side_data, nb_coded_side_data
|
|
_int32 _pointer _int _pointer _int
|
|
|
|
;; AVCodecParameters.format
|
|
;; audio: enum AVSampleFormat
|
|
(format _AVSampleFormat)
|
|
|
|
_int64 ; bit_rate
|
|
(6 _int)
|
|
(2 _AVRational)
|
|
(7 _int)
|
|
|
|
(ch_layout _AVChannelLayout)
|
|
(sample_rate _int))
|
|
)
|
|
|
|
(define (avcodec-pars-codec_id s)
|
|
(AVCodecParameters-codec_id s))
|
|
|
|
(define (avcodec-pars-codec_type s)
|
|
(AVCodecParameters-codec_type s))
|
|
|
|
(define (avcodec-pars-sample_rate s)
|
|
(AVCodecParameters-sample_rate s))
|
|
|
|
(define (avcodec-pars-channels s)
|
|
(AVChannelLayout-nb_channels
|
|
(AVCodecParameters-ch_layout s)))
|
|
|
|
(define (avcodec-pars-format s)
|
|
(AVCodecParameters-format s))
|
|
|
|
; _AVStream:
|
|
; codecpar : AVCodecParameters*
|
|
; time_base : AVRational
|
|
; duration : int64
|
|
|
|
(def-cstruct
|
|
_AVStream
|
|
(codec time_base duration)
|
|
(make-offsets _pointer (2 _int) (codec _AVCodecParameters-pointer) _pointer (time_base _AVRational) _int64 (duration _int64))
|
|
)
|
|
|
|
(define (avstream-codec s)
|
|
(AVStream-codec s))
|
|
|
|
(define (avstream-duration s)
|
|
(AVStream-duration s))
|
|
|
|
(define (avstream-time_base s)
|
|
(AVStream-time_base s))
|
|
|
|
; _AVFormatContext:
|
|
; nb_streams : uint/int
|
|
; streams : AVStream**
|
|
; duration : int64
|
|
; bit_rate : int64
|
|
|
|
(def-cstruct
|
|
_AVFormatContext
|
|
(nb_streams streams duration bit_rate)
|
|
(make-offsets (5 _pointer) _int (nb_streams _int) (streams _pointer) _uint _pointer _uint _pointer _string*/utf-8 _int64 (duration _int64) (bit_rate _int64))
|
|
)
|
|
|
|
(define (avformat_nb_streams s)
|
|
(AVFormatContext-nb_streams s))
|
|
|
|
(define (avformat_stream s i)
|
|
(let ((streams-ptr (AVFormatContext-streams s)))
|
|
(ptr-ref streams-ptr _AVStream-pointer i)
|
|
))
|
|
|
|
(define (avformat_duration s)
|
|
(AVFormatContext-duration s))
|
|
|
|
(define (avformat_bit_rate s)
|
|
(AVFormatContext-bit_rate s))
|
|
|
|
; AVFrame
|
|
; data
|
|
; nb_samples
|
|
; best_effort_timestamp
|
|
|
|
(def-cstruct
|
|
_AVFrame
|
|
(data nb_samples sample_rate best_effort_timestamp)
|
|
(make-offsets
|
|
(data _pointer)
|
|
(7 _pointer) ; data
|
|
(8 _int) ; linesize
|
|
_pointer ; extended-data
|
|
(2 _int) ; width, height
|
|
(nb_samples _int) ; nb_samples
|
|
(2 _int) ; format / enum Picturetype
|
|
_AVRational ; sample_aspect_ratio;
|
|
(2 _int64) ; pts / pkt_dts
|
|
_AVRational ; time_base
|
|
_int ; quality
|
|
_pointer ; opaque
|
|
_int ; repeat_pict
|
|
(sample_rate _int); sample_rate
|
|
(8 _pointer) ; AVBufferRef *buf[AV_NUM_DATA_POINTERS];
|
|
_pointer ; AVBufferRef **extended_buf;
|
|
_int ; int nb_extended_buf;
|
|
_pointer ; AVFrameSideData **side_data;
|
|
_int ; nb_side_data;
|
|
(6 _int) ; flags / color_range / color_primaries / color_trc / colorspace / chroma_location
|
|
(best_effort_timestamp _int64) ; best_effort_timestamp
|
|
))
|
|
|
|
(define (avframe-data frame)
|
|
;; swr_convert wil const uint8_t **.
|
|
;; AVFrame begint met uint8_t *data[8], dus de frame pointer zelf
|
|
;; is het adres van data[0].
|
|
frame)
|
|
|
|
(define (avframe-data0 frame)
|
|
;; Alleen als je ooit de eerste plane pointer zelf nodig hebt.
|
|
(AVFrame-data frame))
|
|
|
|
(define (avframe-nb-samples frame)
|
|
(AVFrame-nb_samples frame))
|
|
|
|
(define (avframe-best-effort-timestamp frame)
|
|
(AVFrame-best_effort_timestamp frame))
|
|
|
|
; AVPacket
|
|
; stream_index
|
|
|
|
(def-cstruct
|
|
_AVPacket
|
|
(stream_index)
|
|
(make-offsets
|
|
_pointer ; buf
|
|
_int64 ; pts
|
|
_int64 ; dts
|
|
_pointer ; data
|
|
_int ; size
|
|
(stream_index _int)))
|
|
|
|
(define (avpacket-stream-index pkt)
|
|
(AVPacket-stream_index pkt))
|
|
|
|
;;;; Needed functions for audio decoder
|
|
|
|
(define libavutil (get-lib (case (system-type 'os)
|
|
[(windows) '("avutil-60")]
|
|
[else '("avutil" "libavutil")]) '(#f)))
|
|
|
|
|
|
(define libswresample (get-lib (case (system-type 'os)
|
|
[(windows) '("swresample-6")]
|
|
[else '("swresample" "libswresample")]) '(#f)))
|
|
|
|
(define libavcodec (get-lib (case (system-type 'os)
|
|
[(windows) '("avcodec-62")]
|
|
[else '("avcodec" "libavcodec")]) '(#f)))
|
|
|
|
(define libavformat (get-lib (case (system-type 'os)
|
|
[(windows) '("avformat-62")]
|
|
[else '("avformat" "libavformat")]) '(#f)))
|
|
|
|
|
|
(define-ffi-definer def-avutil libavutil #:default-make-fail make-not-available)
|
|
(define-ffi-definer def-swresample libswresample #:default-make-fail make-not-available)
|
|
(define-ffi-definer def-avcodec libavcodec #:default-make-fail make-not-available)
|
|
(define-ffi-definer def-avformat libavformat #:default-make-fail make-not-available)
|
|
|
|
(def-avutil avutil_version (_fun -> _uint))
|
|
(def-avcodec avcodec_version (_fun -> _uint))
|
|
(def-avformat avformat_version (_fun -> _uint))
|
|
(def-swresample swresample_version (_fun -> _uint))
|
|
|
|
(def-avcodec avcodec_free_context/raw (_fun (_ptr io _AVCodecContext)
|
|
-> (p : _AVCodecContext)
|
|
-> p ) #:c-id avcodec_free_context)
|
|
|
|
|
|
(define (avcodec_free_context ctx)
|
|
(if ctx
|
|
(begin (avcodec_free_context/raw ctx) #f)
|
|
#f))
|
|
|
|
(def-swresample swr_free/raw (_fun (_ptr io _SwrContext)
|
|
-> (p : _SwrContext)
|
|
-> p) #:c-id swr_free)
|
|
|
|
(define (swr_free ctx)
|
|
(if ctx
|
|
(begin (swr_free/raw ctx) #f)
|
|
#f))
|
|
|
|
(def-avformat avformat_close_input/raw (_fun (_ptr io _AVFormatContext-pointer/null)
|
|
-> (p : _AVFormatContext-pointer/null)
|
|
-> p) #:c-id avformat_close_input)
|
|
|
|
(define (avformat_close_input inp)
|
|
(if inp
|
|
(begin (avformat_close_input/raw inp) #f)
|
|
#f))
|
|
|
|
(def-avformat av_find_best_stream
|
|
(_fun _AVFormatContext-pointer
|
|
_AVMediaType
|
|
_int
|
|
_int
|
|
_pointer ; AVCodec **decoder_ret, hier gewoon #f meegeven
|
|
_int
|
|
-> _int))
|
|
|
|
(def-avcodec avcodec_find_decoder
|
|
(_fun _AVCodecID -> _AVCodec))
|
|
|
|
(def-avcodec avcodec_alloc_context3
|
|
(_fun _AVCodec -> _AVCodecContext))
|
|
|
|
(def-avcodec avcodec_parameters_to_context
|
|
(_fun _AVCodecContext
|
|
_AVCodecParameters-pointer
|
|
-> _int))
|
|
|
|
(def-avcodec avcodec_open2
|
|
(_fun _AVCodecContext
|
|
_AVCodec
|
|
_pointer ; AVDictionary **options, hier nullptr/#f
|
|
-> _int))
|
|
|
|
(def-avutil av_frame_alloc
|
|
(_fun -> _AVFrame-pointer/null))
|
|
|
|
(def-avutil av_frame_unref
|
|
(_fun _AVFrame-pointer -> _void))
|
|
|
|
(def-avutil av_frame_free/raw
|
|
(_fun (_ptr io _AVFrame-pointer/null)
|
|
-> (p : _AVFrame-pointer/null)
|
|
-> p) #:c-id av_frame_free)
|
|
|
|
(define (av_frame_free frm)
|
|
(if frm
|
|
(begin (av_frame_free/raw frm) #f)
|
|
#f))
|
|
|
|
(def-swresample swr_alloc_set_opts2
|
|
(_fun (ps : (_ptr io _SwrContext))
|
|
_AVChannelLayout-pointer ; out_ch_layout
|
|
_AVSampleFormat ; out_sample_fmt
|
|
_int ; out_sample_rate
|
|
_AVChannelLayout-pointer ; in_ch_layout
|
|
_AVSampleFormat ; in_sample_fmt
|
|
_int ; in_sample_rate
|
|
_int ; log_offset
|
|
_pointer ; log_ctx
|
|
-> (r : _int)
|
|
-> (values r ps)))
|
|
|
|
(def-swresample swr_init
|
|
(_fun _SwrContext -> _int))
|
|
|
|
(def-avcodec avcodec_parameters_alloc
|
|
(_fun -> _AVCodecParameters-pointer/null))
|
|
|
|
(def-avcodec avcodec_parameters_from_context
|
|
(_fun _AVCodecParameters-pointer
|
|
_AVCodecContext
|
|
-> _int))
|
|
|
|
(def-avcodec avcodec_parameters_free/raw
|
|
(_fun (_ptr io _AVCodecParameters-pointer/null)
|
|
-> (p : _AVCodecParameters-pointer/null)
|
|
-> p) #:c-id avcodec_parameters_free)
|
|
|
|
(define (avcodec_parameters_free par)
|
|
(if par
|
|
(begin (avcodec_parameters_free/raw par) #f)
|
|
#f))
|
|
|
|
(def-avformat avformat_open_input
|
|
(_fun (ctx : (_ptr io _AVFormatContext-pointer/null))
|
|
_string/utf-8 ; filename
|
|
_pointer ; AVInputFormat *fmt, hier #f
|
|
_pointer ; AVDictionary **options, hier #f
|
|
-> (r : _int)
|
|
-> (values r ctx)))
|
|
|
|
(def-avformat avformat_find_stream_info
|
|
(_fun _AVFormatContext-pointer
|
|
_pointer ; AVDictionary **options, hier #f
|
|
-> _int))
|
|
|
|
(def-avutil av_frame_get_best_effort_timestamp
|
|
(_fun _AVFrame-pointer -> _int64))
|
|
|
|
|
|
(def-swresample swr_get_out_samples
|
|
(_fun _SwrContext _int -> _int))
|
|
|
|
(def-swresample swr_convert
|
|
(_fun _SwrContext _pointer _int _pointer _int -> _int))
|
|
|
|
(def-swresample swr_get_delay
|
|
(_fun _SwrContext _int64 -> _int64))
|
|
|
|
(def-avutil av_samples_get_buffer_size
|
|
(_fun _pointer _int _int _AVSampleFormat _int -> _int))
|
|
|
|
(def-avcodec avcodec_receive_frame
|
|
(_fun _AVCodecContext _AVFrame-pointer -> _int))
|
|
|
|
(def-avformat av_read_frame
|
|
(_fun _AVFormatContext-pointer _AVPacket-pointer -> _int))
|
|
|
|
(def-avcodec av_packet_alloc
|
|
(_fun -> _AVPacket-pointer/null))
|
|
|
|
(def-avcodec av_packet_unref
|
|
(_fun _AVPacket-pointer -> _void))
|
|
|
|
(def-avcodec av_packet_free/raw
|
|
(_fun (_ptr io _AVPacket-pointer/null)
|
|
-> (p : _AVPacket-pointer/null)
|
|
-> p) #:c-id av_packet_free)
|
|
|
|
(define (av_packet_free pkg)
|
|
(if pkg
|
|
(begin (av_packet_free/raw pkg) #f)
|
|
#f))
|
|
|
|
(def-avcodec avcodec_send_packet
|
|
(_fun _AVCodecContext _AVPacket-pointer/null -> _int))
|
|
|
|
(def-avutil av_rescale
|
|
(_fun _int64 _int64 _int64 -> _int64))
|
|
|
|
(def-avutil av_rescale_q
|
|
(_fun _int64 _AVRational _AVRational -> _int64))
|
|
|
|
(def-avformat av_seek_frame
|
|
(_fun _AVFormatContext-pointer _int _int64 _int -> _int))
|
|
|
|
(def-avcodec avcodec_flush_buffers
|
|
(_fun _AVCodecContext -> _void))
|
|
|
|
(def-swresample swr_close
|
|
(_fun _SwrContext -> _void))
|
|
|
|
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
;; Version check
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
|
|
(define avutil-version-major (quotient (avutil_version) 65536))
|
|
(define avcodec-version-major (quotient (avcodec_version) 65536))
|
|
(define avformat-version-major (quotient (avformat_version) 65536))
|
|
(define swresample-version-major (quotient (swresample_version) 65536))
|
|
|
|
(define (ffmpeg-version lib)
|
|
(let ((v (λ (v) (list (quotient v 65536) (remainder (quotient v 256) 256) (remainder v 256)))))
|
|
(cond ((eq? lib 'avutil) (v (avutil_version)))
|
|
((eq? lib 'avcodec) (v (avcodec_version)))
|
|
((eq? lib 'avformat) (v (avformat_version)))
|
|
((or (eq? lib 'swr)
|
|
(eq? lib 'swresample)) (v (swresample_version)))
|
|
(else (error (format "Unknown library '~a" lib)))
|
|
)
|
|
)
|
|
)
|
|
|
|
(define (ffmpeg-version-string lib)
|
|
(apply format (cons "~a.~a.~a" (ffmpeg-version lib))))
|
|
|
|
;; Support ffmpeg 6, 7 and 8
|
|
|
|
(define-syntax check-support
|
|
(syntax-rules ()
|
|
((_ lib version-hash)
|
|
(let ((from (car (hash-ref version-hash lib)))
|
|
(until (cadr (hash-ref version-hash lib))))
|
|
(let ((major-version (car (ffmpeg-version lib))))
|
|
(cond
|
|
((or (< major-version from) (> major-version until))
|
|
(error
|
|
(format "Unsupported major version of ffmpeg library ~a: ~a (~a).\nSupported range: ~a - ~a"
|
|
'lib major-version (ffmpeg-version-string lib) from until)))
|
|
(else
|
|
(info-sound "Supported ffmpeg library ~a - version ~a between ~a and ~a"
|
|
lib (ffmpeg-version-string lib) from until)
|
|
)
|
|
)
|
|
)
|
|
)
|
|
)
|
|
)
|
|
)
|
|
|
|
(check-support 'avutil valid-ffmpeg-versions)
|
|
(check-support 'avcodec valid-ffmpeg-versions)
|
|
(check-support 'avformat valid-ffmpeg-versions)
|
|
(check-support 'swresample valid-ffmpeg-versions)
|
|
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
;; Constants
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
|
|
(define FMPG_OUTPUT_BITS 32)
|
|
(define FMPG_OUTPUT_BYTES 4)
|
|
(define FMPG_OUTPUT_FMT AV_SAMPLE_FMT_S32)
|
|
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
;; Internal structures for ffmpeg decoding
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
|
|
(define-syntax def-struct-helpers
|
|
(syntax-rules ()
|
|
((_ (struct-get get struct-set set))
|
|
(begin
|
|
(define get struct-get)
|
|
(define set struct-set))
|
|
)
|
|
((_ (struct-get get))
|
|
(define get struct-get)
|
|
)
|
|
)
|
|
)
|
|
|
|
(define-syntax struct-helpers
|
|
(syntax-rules ()
|
|
((_ a ...)
|
|
(begin
|
|
(def-struct-helpers a)
|
|
...))))
|
|
|
|
|
|
;;;;;;;;;; audio-info-storage
|
|
|
|
(define-struct audio-info-storage
|
|
(audio-stream-count
|
|
selected-stream-index
|
|
|
|
sample-rate
|
|
channels
|
|
|
|
duration-ms
|
|
duration-samples
|
|
)
|
|
#:mutable
|
|
#:transparent
|
|
)
|
|
|
|
|
|
(struct-helpers
|
|
(audio-info-storage-audio-stream-count ais-stream-count
|
|
set-audio-info-storage-audio-stream-count! ais-stream-count!)
|
|
(audio-info-storage-selected-stream-index ais-stream-index
|
|
set-audio-info-storage-selected-stream-index! ais-stream-index!)
|
|
(audio-info-storage-sample-rate ais-rate
|
|
set-audio-info-storage-sample-rate! ais-rate!)
|
|
(audio-info-storage-channels ais-channels
|
|
set-audio-info-storage-channels! ais-channels!)
|
|
(audio-info-storage-duration-ms ais-duration-ms
|
|
set-audio-info-storage-duration-ms! ais-duration-ms!)
|
|
(audio-info-storage-duration-samples ais-duration-samples
|
|
set-audio-info-storage-duration-samples! ais-duration-samples!)
|
|
)
|
|
|
|
|
|
(define (ais-clear! s)
|
|
(ais-stream-count! s 0)
|
|
(ais-stream-index! s -1)
|
|
(ais-rate! s 0)
|
|
(ais-channels! s 0)
|
|
(ais-duration-ms! s -1)
|
|
(ais-duration-samples! s -1)
|
|
)
|
|
|
|
(define (new-audio-info-storage)
|
|
(let ((a (make-audio-info-storage 0 -1 0 0 -1 -1)))
|
|
a))
|
|
|
|
;;;;;;;;;;; decoder storage
|
|
|
|
(define-struct decoder-storage
|
|
(codec ; _AVCodec - Not owned by decoder-storage, global pointer
|
|
codec-ctx ; _AVCodecContext
|
|
frame ; _AVFrame
|
|
swr-ctx ; _SwrContext
|
|
|
|
pcm ; bytes (maybe bytes-buffer)
|
|
|
|
eof-seen ; boolean
|
|
decoder-drained ; boolean
|
|
|
|
timecode ; double
|
|
|
|
last-samples ; integer
|
|
buffer-start-sample ; integer
|
|
next-sample-position ; integer
|
|
|
|
discard-until-sample ; integer
|
|
)
|
|
#:mutable
|
|
#:transparent
|
|
)
|
|
|
|
(define (pcm-empty? dec)
|
|
(zero? (bytes-length (ds-pcm dec))))
|
|
|
|
(define (pcm-present? dec)
|
|
(positive? (bytes-length (ds-pcm dec))))
|
|
|
|
(define (produced-pcm? produced dec)
|
|
(and (> produced 0) (pcm-present? dec)))
|
|
|
|
|
|
(struct-helpers
|
|
(decoder-storage-codec ds-codec set-decoder-storage-codec! ds-codec!)
|
|
(decoder-storage-codec-ctx ds-codec-ctx set-decoder-storage-codec-ctx! ds-codec-ctx!)
|
|
(decoder-storage-frame ds-frame set-decoder-storage-frame! ds-frame!)
|
|
(decoder-storage-swr-ctx ds-swr-ctx set-decoder-storage-swr-ctx! ds-swr-ctx!)
|
|
(decoder-storage-pcm ds-pcm set-decoder-storage-pcm! ds-pcm!)
|
|
(decoder-storage-eof-seen ds-eof-seen set-decoder-storage-eof-seen! ds-eof-seen!)
|
|
(decoder-storage-decoder-drained ds-drained set-decoder-storage-decoder-drained! ds-drained!)
|
|
(decoder-storage-timecode ds-timecode set-decoder-storage-timecode! ds-timecode!)
|
|
(decoder-storage-last-samples ds-last-samples set-decoder-storage-last-samples! ds-last-samples!)
|
|
(decoder-storage-buffer-start-sample ds-start-sample
|
|
set-decoder-storage-buffer-start-sample! ds-start-sample!)
|
|
(decoder-storage-next-sample-position ds-next-sample-pos
|
|
set-decoder-storage-next-sample-position! ds-next-sample-pos!)
|
|
(decoder-storage-discard-until-sample ds-discard-until
|
|
set-decoder-storage-discard-until-sample! ds-discard-until!)
|
|
)
|
|
|
|
(define (free-ffmpeg s)
|
|
(when s
|
|
(ds-codec-ctx! s (avcodec_free_context (ds-codec-ctx s)))
|
|
(ds-frame! s (av_frame_free (ds-frame s)))
|
|
(ds-swr-ctx! s (swr_free (ds-swr-ctx s)))
|
|
|
|
(reset-decoder-storage! s)
|
|
)
|
|
)
|
|
|
|
(define (ds-clear-output! s)
|
|
(ds-pcm! s (make-bytes 0))
|
|
(ds-last-samples! s 0)
|
|
(ds-start-sample! s (ds-next-sample-pos s))
|
|
)
|
|
|
|
(define (reset-decoder-storage! s)
|
|
(ds-codec! s #f)
|
|
(ds-pcm! s (make-bytes 0))
|
|
(ds-eof-seen! s #f)
|
|
(ds-drained! s #f)
|
|
(ds-timecode! s 0.0)
|
|
(ds-last-samples! s 0)
|
|
(ds-start-sample! s 0)
|
|
(ds-next-sample-pos! s 0)
|
|
(ds-discard-until! s -1))
|
|
|
|
(define (new-decoder-storage)
|
|
(let ((ds (make-decoder-storage #f #f #f #f
|
|
(make-bytes 0)
|
|
#f #f
|
|
0.0
|
|
0 0 0 -1)))
|
|
(register-finalizer ds
|
|
(λ (s) (free-ffmpeg s)))
|
|
ds))
|
|
|
|
;;;;;;;;;;;;;; fmpg-instance
|
|
|
|
(define-struct fmpg-instance
|
|
(opened ; boolean
|
|
format-ctx ; AVFormatContext
|
|
audio-info ; audio-info-storage
|
|
decoder ; decoder-storage
|
|
)
|
|
#:mutable
|
|
#:transparent
|
|
)
|
|
|
|
(define (new-fmpg-instance)
|
|
(let ((i (make-fmpg-instance #f #f (new-audio-info-storage) (new-decoder-storage))))
|
|
(register-finalizer i
|
|
(λ (i)
|
|
(let ((ctx (fmpg-instance-format-ctx i)))
|
|
(when ctx
|
|
(set-fmpg-instance-format-ctx! i (avformat_close_input ctx))))
|
|
(set-fmpg-instance-audio-info! i #f)
|
|
(set-fmpg-instance-decoder! i #f))
|
|
)
|
|
i))
|
|
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
;; Helper functions for ffmpeg decoding
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
|
|
(define-syntax av_q2d
|
|
(syntax-rules ()
|
|
((_ a)
|
|
(exact->inexact (/ (AVRational-num a) (AVRational-den a)))
|
|
)
|
|
)
|
|
)
|
|
|
|
(define (count-audio-streams avformat-ctx)
|
|
(if (eq? avformat-ctx #f)
|
|
0
|
|
(let ((count 0)
|
|
(nb_streams (avformat_nb_streams avformat-ctx))
|
|
(i 0)
|
|
)
|
|
(while (< i nb_streams)
|
|
(let* ((stream (avformat_stream avformat-ctx i))
|
|
(par (avstream-codec stream))
|
|
)
|
|
(unless (eq? par #f)
|
|
(let ((codec-type (avcodec-pars-codec_type par)))
|
|
(when (= codec-type AVMEDIA_TYPE_AUDIO)
|
|
(set! count (+ count 1))
|
|
)
|
|
)
|
|
)
|
|
)
|
|
(set! i (+ i 1))
|
|
)
|
|
count)
|
|
)
|
|
)
|
|
|
|
(define (milliseconds_from_seconds seconds)
|
|
(if (< seconds 0.0)
|
|
-1
|
|
(inexact->exact (round (+ (* seconds 1000.0) 0.5)))))
|
|
|
|
|
|
(define (samples_from_seconds seconds sample-rate)
|
|
(if (or (< seconds 0.0) (<= sample-rate 0))
|
|
-1
|
|
(inexact->exact (round (+ (* seconds sample-rate) 0.5)))))
|
|
|
|
(define (stream_duration_seconds stream)
|
|
(if (eq? stream #f)
|
|
-1.0
|
|
(if (= (avstream-duration stream) AV_NOPTS_VALUE)
|
|
-1.0
|
|
(* (avstream-duration stream) (av_q2d (avstream-time_base stream)))
|
|
)
|
|
)
|
|
)
|
|
|
|
(define (format_duration_seconds ctx)
|
|
(if (eq? ctx #f)
|
|
-1
|
|
(if (= (avformat_duration ctx) AV_NOPTS_VALUE)
|
|
-1.0
|
|
(exact->inexact (/ (avformat_duration ctx) AV_TIME_BASE))
|
|
)
|
|
)
|
|
)
|
|
|
|
(define (timestamp_to_samples timestamp stream sample_rate)
|
|
(if (or (eq? stream #f) (= timestamp AV_NOPTS_VALUE) (<= sample_rate 0))
|
|
-1
|
|
(let ((seconds (exact->inexact
|
|
(* timestamp (av_q2d (avstream-time_base stream))))))
|
|
(samples_from_seconds seconds sample_rate))))
|
|
|
|
(define (filename->string filename)
|
|
(cond
|
|
[(path? filename) (path->string filename)]
|
|
[(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))
|
|
|
|
(let/assert
|
|
((best (av_find_best_stream ctx AVMEDIA_TYPE_AUDIO -1 -1 #f 0) (a->=? 0) #f)
|
|
(stream (avformat_stream ctx best) a-!nullptr? #f)
|
|
(par (avstream-codec stream) a-!nullptr? #f)
|
|
(codec-type (avcodec-pars-codec_type par) (a-=? AVMEDIA_TYPE_AUDIO) #f)
|
|
(sample-rate (avcodec-pars-sample_rate par) (a->? 0) #f)
|
|
(channels (avcodec-pars-channels par) (a->? 0) #f)
|
|
(stream-seconds (stream_duration_seconds stream))
|
|
(seconds (if (< stream-seconds 0.0)
|
|
(format_duration_seconds ctx)
|
|
stream-seconds))
|
|
)
|
|
(begin
|
|
(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 (instance-ready? instance)
|
|
(and instance
|
|
(fmpg-instance-opened instance)
|
|
(fmpg-instance-format-ctx instance)
|
|
(let ((info (fmpg-instance-audio-info instance)))
|
|
(and info
|
|
(>= (ais-stream-index info) 0)))
|
|
(let ((dec (fmpg-instance-decoder instance)))
|
|
(and dec
|
|
(ds-codec-ctx dec)
|
|
(ds-swr-ctx dec)))
|
|
#t))
|
|
|
|
|
|
(define (init-codec-context! self)
|
|
(let/assert
|
|
((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) a-!nullptr? #f)
|
|
(par (avstream-codec stream) a-!nullptr? #f)
|
|
(codec (let ((c (avcodec_find_decoder (avcodec-pars-codec_id par))))
|
|
(ds-codec! dec c)
|
|
c)
|
|
a-!nullptr? #f)
|
|
(codec-ctx (let ((c (avcodec_alloc_context3 codec)))
|
|
(ds-codec-ctx! dec c)
|
|
c)
|
|
a-!nullptr? #f)
|
|
(ret-par (avcodec_parameters_to_context codec-ctx par) (a->=? 0) #f)
|
|
(ret-open (avcodec_open2 codec-ctx codec #f) (a->=? 0) #f)
|
|
(frame (let ((f (av_frame_alloc)))
|
|
(ds-frame! dec f)
|
|
f)
|
|
a-!nullptr? #f))
|
|
#t))
|
|
|
|
|
|
(define (init-resampler! self)
|
|
(let/assert
|
|
((dec (fmpg-instance-decoder self))
|
|
(codec-ctx (ds-codec-ctx dec) a-!nullptr? #f)
|
|
(par (avcodec_parameters_alloc) a-!nullptr? #f))
|
|
(let ((result
|
|
(let/assert
|
|
((ret-par (avcodec_parameters_from_context par codec-ctx) (a->=? 0) #f)
|
|
(layout (AVCodecParameters-ch_layout par))
|
|
(channels (AVChannelLayout-nb_channels layout) (a->? 0) #f)
|
|
(rate (avcodec-pars-sample_rate par) (a->? 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)
|
|
(a->=? 0) #f)
|
|
(ret-init (swr_init (ds-swr-ctx dec)) (a->=? 0) #f))
|
|
#t)))
|
|
(avcodec_parameters_free par)
|
|
result)))
|
|
|
|
(define (init-decoder! self)
|
|
(let ((dec (fmpg-instance-decoder self)))
|
|
(free-ffmpeg dec)
|
|
(reset-decoder-storage! dec)
|
|
(and (init-codec-context! self)
|
|
(init-resampler! self))))
|
|
|
|
(define (fmpg-init)
|
|
(with-handlers ([exn:fail? (lambda (e) #f)])
|
|
(new-fmpg-instance)))
|
|
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
;; API
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
|
|
(define (fmpg-open-file! instance filename)
|
|
(let/assert
|
|
((instance instance a-!nullptr? 0)
|
|
(opened (fmpg-instance-opened instance) a-false? 0)
|
|
(old-ctx (fmpg-instance-format-ctx instance) a-nullptr? 0)
|
|
(filename (filename->string filename) string? 0))
|
|
(let ((result
|
|
(let/assert
|
|
((ret-open (let-values (((r ctx) (avformat_open_input #f filename #f #f)))
|
|
(set-fmpg-instance-format-ctx! instance ctx)
|
|
r)
|
|
(a->=? 0) 0)
|
|
(ctx (fmpg-instance-format-ctx instance) a-!nullptr? 0)
|
|
(ret-info (avformat_find_stream_info ctx #f) (a->=? 0) 0)
|
|
(info-ok (fill-audio-info! instance) a-true? 0)
|
|
(dec-ok (init-decoder! instance) a-true? 0))
|
|
(begin
|
|
(set-fmpg-instance-opened! instance #t)
|
|
1))))
|
|
(when (zero? result) (fmpg-close! instance))
|
|
result)))
|
|
|
|
|
|
(define (fmpg-close! instance)
|
|
(when instance
|
|
(free-ffmpeg (fmpg-instance-decoder instance))
|
|
(set-fmpg-instance-format-ctx! instance
|
|
(avformat_close_input
|
|
(fmpg-instance-format-ctx instance)))
|
|
(set-fmpg-instance-opened! instance #f)
|
|
(let ((info (fmpg-instance-audio-info instance)))
|
|
(when info (ais-clear! info)))))
|
|
|
|
|
|
(define (fmpg-is-open instance)
|
|
(if (instance-ready? instance) 1 0))
|
|
|
|
(define (fmpg-audio-stream-count instance)
|
|
(if (and instance
|
|
(fmpg-instance-opened instance))
|
|
(ais-stream-count (fmpg-instance-audio-info instance))
|
|
0))
|
|
|
|
(define (fmpg-audio-sample-rate instance)
|
|
(if (instance-ready? instance)
|
|
(ais-rate (fmpg-instance-audio-info instance))
|
|
0))
|
|
|
|
(define (fmpg-audio-channels instance)
|
|
(if (instance-ready? instance)
|
|
(ais-channels (fmpg-instance-audio-info instance))
|
|
0))
|
|
|
|
(define (fmpg-audio-bits-per-sample instance)
|
|
FMPG_OUTPUT_BITS)
|
|
|
|
(define (fmpg-audio-bytes-per-sample instance)
|
|
FMPG_OUTPUT_BYTES)
|
|
|
|
(define (fmpg-duration-ms instance)
|
|
(if (instance-ready? instance)
|
|
(ais-duration-ms (fmpg-instance-audio-info instance))
|
|
-1))
|
|
|
|
(define (fmpg-duration-samples instance)
|
|
(if (instance-ready? instance)
|
|
(ais-duration-samples (fmpg-instance-audio-info instance))
|
|
-1))
|
|
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
;; Decoding
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
|
|
(define (append-bytes! dec src nbytes)
|
|
(cond
|
|
[(zero? nbytes) #t]
|
|
[else
|
|
(let/assert
|
|
((src src a-!nullptr? #f)
|
|
(pcm (ds-pcm dec))
|
|
(old-size (bytes-length pcm))
|
|
(new-size (+ old-size nbytes) (a-<=? INT_MAX) #f))
|
|
(let ((new-pcm (make-bytes new-size)))
|
|
(bytes-copy! new-pcm 0 pcm 0 old-size)
|
|
(memcpy new-pcm old-size src 0 nbytes)
|
|
(ds-pcm! dec new-pcm)
|
|
#t))]))
|
|
|
|
|
|
(define (select-frame-range! dec frame-start out-samples channels)
|
|
(let ((keep-start frame-start)
|
|
(keep-samples out-samples)
|
|
(byte-offset 0)
|
|
(dropped-all? #f))
|
|
(when (>= (ds-discard-until dec) 0)
|
|
(let* ((target (ds-discard-until dec))
|
|
(frame-end (+ frame-start out-samples)))
|
|
(cond
|
|
[(<= frame-end target)
|
|
(ds-next-sample-pos! dec frame-end)
|
|
(set! keep-samples 0)
|
|
(set! dropped-all? #t)]
|
|
[else
|
|
(when (< frame-start target)
|
|
(let ((drop (- target frame-start)))
|
|
(when (and (> drop 0) (< drop out-samples))
|
|
(set! byte-offset (* drop channels FMPG_OUTPUT_BYTES))
|
|
(set! keep-samples (- out-samples drop))
|
|
(set! keep-start target))))
|
|
(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)))
|
|
|
|
(define (append-converted-frame! self frame)
|
|
(let/assert
|
|
((dec (fmpg-instance-decoder self))
|
|
(info (fmpg-instance-audio-info self))
|
|
(channels (ais-channels info))
|
|
(sample-rate (ais-rate info))
|
|
(nb-samples (avframe-nb-samples frame)))
|
|
(cond
|
|
[(or (<= channels 0) (<= nb-samples 0)) #t]
|
|
[else
|
|
(let/assert
|
|
((max-out-samples (swr_get_out_samples (ds-swr-ctx dec) nb-samples) (a->? 0) #f)
|
|
(max-bytes (av_samples_get_buffer_size #f channels max-out-samples FMPG_OUTPUT_FMT 1) (a->? 0) #f))
|
|
(call-with-swr-output-buffer
|
|
max-bytes
|
|
(lambda (tmp out-planes)
|
|
(let/assert
|
|
((out-samples (swr_convert (ds-swr-ctx dec) out-planes max-out-samples
|
|
(avframe-data frame) nb-samples)
|
|
(a->=? 0) #f)
|
|
(used-bytes (av_samples_get_buffer_size #f channels out-samples FMPG_OUTPUT_FMT 1) (a->=? 0) #f)
|
|
(stream-index (ais-stream-index info))
|
|
(stream (avformat_stream (fmpg-instance-format-ctx self) stream-index) a-!nullptr? #f)
|
|
(frame-start0 (timestamp_to_samples (avframe-best-effort-timestamp frame) stream sample-rate))
|
|
(frame-start (if (< frame-start0 0) (ds-next-sample-pos dec) frame-start0)))
|
|
(let-values (((keep-start keep-samples byte-offset dropped-all?)
|
|
(select-frame-range! dec frame-start out-samples channels)))
|
|
(cond
|
|
[dropped-all? #t]
|
|
[(<= keep-samples 0)
|
|
(ds-next-sample-pos! dec (+ frame-start out-samples))
|
|
#t]
|
|
[else
|
|
(when (pcm-empty? dec)
|
|
(ds-start-sample! dec keep-start)
|
|
(ds-timecode! dec (/ (exact->inexact keep-start) (exact->inexact sample-rate))))
|
|
(let ((keep-bytes (* keep-samples channels FMPG_OUTPUT_BYTES)))
|
|
(let/assert
|
|
((ok? (append-bytes! dec (ptr-add tmp byte-offset) keep-bytes) (a-!eq? #f) #f))
|
|
(ds-last-samples! dec (+ (ds-last-samples dec) keep-samples))
|
|
(ds-next-sample-pos! dec (+ keep-start keep-samples))
|
|
#t))]))))))])))
|
|
|
|
|
|
(define (receive-available-frames! self)
|
|
(let ((dec (fmpg-instance-decoder self)) (produced 0))
|
|
(let loop ()
|
|
(let ((ret (avcodec_receive_frame (ds-codec-ctx dec) (ds-frame dec))))
|
|
(cond
|
|
[(= ret AVERROR_EAGAIN) produced]
|
|
[(= ret AVERROR_EOF) (ds-drained! dec #t) produced]
|
|
[(< ret 0) -1]
|
|
[else
|
|
(let ((ok? (append-converted-frame! self (ds-frame dec))))
|
|
(av_frame_unref (ds-frame dec))
|
|
(if ok?
|
|
(begin
|
|
(when (> (ds-last-samples dec) 0) (set! produced 1))
|
|
(loop))
|
|
-1))])))))
|
|
|
|
|
|
(define (read-selected-audio-packet! self pkt)
|
|
(let ((wanted-stream (ais-stream-index (fmpg-instance-audio-info self))))
|
|
(let loop ()
|
|
(let ((ret (av_read_frame (fmpg-instance-format-ctx self) pkt)))
|
|
(cond
|
|
[(< ret 0) #f]
|
|
[(= (avpacket-stream-index pkt) wanted-stream) #t]
|
|
[else
|
|
(av_packet_unref pkt)
|
|
(loop)])))))
|
|
|
|
(define/return (drain-resampler! self)
|
|
(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))
|
|
|
|
(let ((max-bytes (av_samples_get_buffer_size #f channels delay FMPG_OUTPUT_FMT 1)))
|
|
(when (<= max-bytes 0) (return produced))
|
|
|
|
(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)))
|
|
)
|
|
|
|
(when (or (eq? tmp #f) (eq? out-planes #f)) (finish -1))
|
|
|
|
(ptr-set! out-planes _pointer 0 tmp)
|
|
|
|
(let ((out-samples (swr_convert (ds-swr-ctx dec) out-planes delay #f 0)))
|
|
(when (<= out-samples 0) (finish produced))
|
|
|
|
(let ((used-bytes (av_samples_get_buffer_size #f channels out-samples FMPG_OUTPUT_FMT 1)))
|
|
(when (< used-bytes 0) (finish produced))
|
|
|
|
(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 (receive-or-return! self dec)
|
|
(let ((produced (receive-available-frames! self)))
|
|
(cond
|
|
[(< produced 0) (return 0)]
|
|
[(produced-pcm? produced dec) (return 1)]
|
|
[else produced])))
|
|
|
|
|
|
(define/return (fmpg-decode-next! instance)
|
|
(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)
|
|
(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))))
|
|
|
|
|
|
(define (fmpg-decoder instance)
|
|
(and instance (fmpg-instance-decoder instance)))
|
|
|
|
(define (fmpg-buffer instance)
|
|
(let ((dec (fmpg-decoder instance)))
|
|
(if (and dec (not (pcm-empty? dec))) (ds-pcm dec) #f)))
|
|
|
|
(define (fmpg-buffer-size instance)
|
|
(let ((dec (fmpg-decoder instance)))
|
|
(if dec
|
|
(let ((n (bytes-length (ds-pcm dec))))
|
|
(if (> n INT_MAX) 0 n))
|
|
0)))
|
|
|
|
(define (fmpg-buffer-samples instance)
|
|
(let ((dec (fmpg-decoder instance)))
|
|
(if dec (ds-last-samples dec) 0)))
|
|
|
|
(define (fmpg-buffer-start-sample instance)
|
|
(let ((dec (fmpg-decoder instance)))
|
|
(if dec (ds-start-sample dec) 0)))
|
|
|
|
(define (fmpg-buffer-end-sample instance)
|
|
(let ((dec (fmpg-decoder instance)))
|
|
(if dec (+ (ds-start-sample dec) (ds-last-samples dec)) 0)))
|
|
|
|
(define (fmpg-sample-position instance)
|
|
(let ((dec (fmpg-decoder instance)))
|
|
(if dec (ds-next-sample-pos dec) 0)))
|
|
|
|
(define (fmpg-timecode instance)
|
|
(let ((dec (fmpg-decoder instance)))
|
|
(if dec (ds-timecode dec) 0.0)))
|
|
|
|
(define (fmpg-file-bitrate instance)
|
|
(let ((ctx (and instance (fmpg-instance-format-ctx instance))))
|
|
(if ctx
|
|
(let ((br (avformat_bit_rate ctx)))
|
|
(if (> br 0) br -1))
|
|
-1)))
|