From ddb44e1c41bb3ddbd21430298bab84e048aac874 Mon Sep 17 00:00:00 2001 From: Hans Dijkema Date: Sun, 10 May 2026 01:02:13 +0200 Subject: [PATCH] racket only ffmpeg backend. Now no racket-sound-libs are needed anymore. --- ffmpeg-definitions.rkt | 1253 ++++++++++++++++++++++++++++++++++++ ffmpeg-ffi.rkt | 341 +++------- play-test.rkt | 4 +- private/cstruct-helper.rkt | 102 +++ private/utils.rkt | 109 ++++ 5 files changed, 1556 insertions(+), 253 deletions(-) create mode 100644 private/cstruct-helper.rkt diff --git a/ffmpeg-definitions.rkt b/ffmpeg-definitions.rkt index e76e0ba..7b81477 100644 --- a/ffmpeg-definitions.rkt +++ b/ffmpeg-definitions.rkt @@ -1,7 +1,1260 @@ #lang racket/base + (require ffi/unsafe + ffi/unsafe/define + ffi/unsafe/alloc + (for-syntax racket/base) "private/utils.rkt" + "private/cstruct-helper.rkt" ) +(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 (list (case (system-type 'os) + [(windows) "avutil-60"] + [else "avutil"])) '(#f))) + + +(define libswresample (get-lib (list (case (system-type 'os) + [(windows) "swresample-6"] + [else "swresample"])) '(#f))) + +(define libavcodec (get-lib (list (case (system-type 'os) + [(windows) "avcodec-62"] + [else "avcodec"])) '(#f))) + +(define libavformat (get-lib (list (case (system-type 'os) + [(windows) "avformat-62"] + [else "avformat"])) '(#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 () + ((_ from until 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 58 60 'avutil) +(check-support 60 62 'avcodec) +(check-support 60 62 'avformat) +(check-support 4 6 'swresample) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; 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))) diff --git a/ffmpeg-ffi.rkt b/ffmpeg-ffi.rkt index 3a02a3d..49a2dde 100644 --- a/ffmpeg-ffi.rkt +++ b/ffmpeg-ffi.rkt @@ -1,8 +1,6 @@ -(module ffmpeg_ffi racket/base +(module ffmpeg_ffi_v2 racket/base - (require ffi/unsafe - ffi/unsafe/define - ffi/unsafe/alloc + (require "ffmpeg-definitions.rkt" "private/utils.rkt" ) @@ -10,174 +8,53 @@ fmpg-version ) - ;; The native shim is the new instance-only FFmpeg audio API. It exposes a - ;; single opaque fmpg_instance pointer and keeps stream-index, packets, - ;; decoder state and file metadata inside that instance. The public C header - ;; says that output is always signed 32-bit interleaved PCM and that the - ;; current buffer pointer is valid until the next decode/seek/close/free call. - - ;; Adjust the names below if your shared library has another basename. - ;; get-lib is used in the same style as libmpg123-ffi.rkt. - (when (eq? (system-type 'os) 'windows) - ; preload ffmpeg dlls. - (void - (begin - (get-lib '("avutil-60.dll") '(#f)) - (get-lib '("swresample-6.dll") '(#f)) - (get-lib '("avcodec-62") '(#f)) - (get-lib '("avformat-62.dll") '(#f)) - ) - ) - ) - - (define lib (get-lib '("ffmpeg_audio" "libffmpeg_audio") '(#f))) - - (define-ffi-definer define-ffmpeg-audio lib - #:default-make-fail make-not-available) - - (define _fmpg_instance _pointer) - - (define (fmpg-version) - (let* ((v (fmpg_version)) - (patch (remainder v 256)) - (minor (remainder (quotient v 256) 256)) - (major (quotient v 65536)) - ) - (list major minor patch))) - + ;; Handler adapter for ffmpeg-decoder.rkt. The decoder keeps using the + ;; same command protocol, while this module delegates to ffmpeg-definitions.rkt. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; Native bindings -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - - (define-ffmpeg-audio fmpg_init - (_fun -> _fmpg_instance)) - - (define-ffmpeg-audio fmpg_free - (_fun _fmpg_instance -> _void)) - - (define-ffmpeg-audio fmpg_open_file - (_fun _fmpg_instance _string/utf-8 -> _int)) - - (define-ffmpeg-audio fmpg_close - (_fun _fmpg_instance -> _void)) - - (define-ffmpeg-audio fmpg_is_open - (_fun _fmpg_instance -> _int)) - - (define-ffmpeg-audio fmpg_audio_stream_count - (_fun _fmpg_instance -> _int)) - - (define-ffmpeg-audio fmpg_audio_sample_rate - (_fun _fmpg_instance -> _int)) - - (define-ffmpeg-audio fmpg_audio_channels - (_fun _fmpg_instance -> _int)) - - (define-ffmpeg-audio fmpg_audio_bits_per_sample - (_fun _fmpg_instance -> _int)) - - (define-ffmpeg-audio fmpg_audio_bytes_per_sample - (_fun _fmpg_instance -> _int)) - - (define-ffmpeg-audio fmpg_duration_ms - (_fun _fmpg_instance -> _int64)) - - (define-ffmpeg-audio fmpg_duration_samples - (_fun _fmpg_instance -> _int64)) - - (define-ffmpeg-audio fmpg_file_title - (_fun _fmpg_instance -> _string/utf-8)) - - (define-ffmpeg-audio fmpg_file_author - (_fun _fmpg_instance -> _string/utf-8)) - - (define-ffmpeg-audio fmpg_file_album - (_fun _fmpg_instance -> _string/utf-8)) - - (define-ffmpeg-audio fmpg_file_genre - (_fun _fmpg_instance -> _string/utf-8)) - - (define-ffmpeg-audio fmpg_file_comment - (_fun _fmpg_instance -> _string/utf-8)) - - (define-ffmpeg-audio fmpg_file_copyright - (_fun _fmpg_instance -> _string/utf-8)) - - (define-ffmpeg-audio fmpg_file_year - (_fun _fmpg_instance -> _int)) - - (define-ffmpeg-audio fmpg_file_track - (_fun _fmpg_instance -> _int)) - - (define-ffmpeg-audio fmpg_file_bitrate - (_fun _fmpg_instance -> _int)) - - (define-ffmpeg-audio fmpg_decode_next - (_fun _fmpg_instance -> _int)) - - (define-ffmpeg-audio fmpg_seek_ms - (_fun _fmpg_instance _int64 -> _int)) - - (define-ffmpeg-audio fmpg_buffer - (_fun _fmpg_instance -> _pointer)) - - (define-ffmpeg-audio fmpg_buffer_size - (_fun _fmpg_instance -> _int)) - - (define-ffmpeg-audio fmpg_buffer_samples - (_fun _fmpg_instance -> _int64)) - - (define-ffmpeg-audio fmpg_buffer_start_sample - (_fun _fmpg_instance -> _int64)) - - (define-ffmpeg-audio fmpg_buffer_end_sample - (_fun _fmpg_instance -> _int64)) - - (define-ffmpeg-audio fmpg_sample_position - (_fun _fmpg_instance -> _int64)) - - (define-ffmpeg-audio fmpg_timecode - (_fun _fmpg_instance -> _double)) - - (define-ffmpeg-audio fmpg_ffmpeg_version - (_fun -> _string*/utf-8)) - - (define-ffmpeg-audio fmpg_int_version2string - (_fun _int -> _string*/utf-8)) - - (define-ffmpeg-audio fmpg_compatible_ffmpeg - (_fun -> _int)) - - (define-ffmpeg-audio fmpg_version - (_fun -> _int)) - - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; Our interface for decoding to racket +;; Helpers ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (define (ok? r) (not (= r 0))) - (define (str v) - (if (string? v) v "")) + (define (filename->string filename) + (cond + [(path? filename) (path->string filename)] + [(string? filename) filename] + [else #f])) - (define (known-int64? v) - (and (integer? v) (not (= v -1)))) + (define (fmpg-version) + (ffmpeg-version 'avformat)) (define (copy-current-buffer fh) - (let ((size (fmpg_buffer_size fh))) + (let ((buffer (fmpg-buffer fh)) + (size (fmpg-buffer-size fh))) (cond - ((<= size 0) (values #f 0)) - (else - (let ((src (fmpg_buffer fh))) - (if (eq? src #f) - (error (format "fmpg_buffer: got NULL for ~a bytes" size)) - ;(let ((dst (malloc size 'nonatomic))) - (let ((dst (make-bytes size))) - (memcpy dst src size) - (values dst size)))))))) + [(or (eq? buffer #f) (<= size 0)) (values #f 0)] + [else + (let ((bs (make-bytes size))) + (bytes-copy! bs 0 buffer 0 size) + (values bs size))]))) + + (define (reset-info! set-rate! set-channels! set-sample-bits! + set-sample-bytes! set-pcm-length! set-duration-ms! + set-audio-streams! set-ffmpeg-file! set-current-pcm-pos! + set-bitrate!) + (set-rate! -1) + (set-channels! -1) + (set-sample-bits! -1) + (set-sample-bytes! -1) + (set-pcm-length! -1) + (set-duration-ms! -1) + (set-audio-streams! -1) + (set-ffmpeg-file! "") + (set-current-pcm-pos! 0) + (set-bitrate! -1)) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Handler protocol used by ffmpeg-decoder.rkt +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (define (fmpg-ffi-decoder-handler) @@ -192,23 +69,31 @@ (define audio-streams -1) (define ffmpeg-file "") (define current-pcm-pos 0) - - (define title "") - (define author "") - (define album "") - (define genre "") - (define comment "") - (define copyright "") - (define year -1) - (define track -1) (define bitrate -1) + (define (set-rate! v) (set! rate v)) + (define (set-channels! v) (set! channels v)) + (define (set-sample-bits! v) (set! sample-bits v)) + (define (set-sample-bytes! v) (set! sample-bytes v)) + (define (set-pcm-length! v) (set! pcm-length v)) + (define (set-duration-ms! v) (set! duration-ms v)) + (define (set-audio-streams! v) (set! audio-streams v)) + (define (set-ffmpeg-file! v) (set! ffmpeg-file v)) + (define (set-current-pcm-pos! v) (set! current-pcm-pos v)) + (define (set-bitrate! v) (set! bitrate v)) + + (define (reset!) + (reset-info! set-rate! set-channels! set-sample-bits! + set-sample-bytes! set-pcm-length! set-duration-ms! + set-audio-streams! set-ffmpeg-file! set-current-pcm-pos! + set-bitrate!)) + (define (new) (if (eq? fh #f) (begin - (set! fh (fmpg_init)) + (set! fh (fmpg-init)) (when (eq? fh #f) - (error "fmpg_init: could not allocate ffmpeg instance")) + (error "fmpg-init: could not allocate ffmpeg instance")) #t) (error "ffmpeg handle already initialized, delete it first"))) @@ -216,44 +101,31 @@ (if (eq? fh #f) (error "ffmpeg handle has already been deleted") (begin - (fmpg_free fh) + (fmpg-close! fh) (set! fh #f) - (set! rate -1) - (set! channels -1) - (set! sample-bits -1) - (set! sample-bytes -1) - (set! pcm-length -1) - (set! duration-ms -1) - (set! audio-streams -1) - (set! ffmpeg-file "") - (set! current-pcm-pos 0) + (reset!) #t))) (define (fetch-info) - (set! rate (fmpg_audio_sample_rate fh)) - (set! channels (fmpg_audio_channels fh)) - (set! sample-bits (fmpg_audio_bits_per_sample fh)) - (set! sample-bytes (fmpg_audio_bytes_per_sample fh)) - (set! pcm-length (fmpg_duration_samples fh)) - (set! duration-ms (fmpg_duration_ms fh)) - (set! audio-streams (fmpg_audio_stream_count fh)) - (set! title (str (fmpg_file_title fh))) - (set! author (str (fmpg_file_author fh))) - (set! album (str (fmpg_file_album fh))) - (set! genre (str (fmpg_file_genre fh))) - (set! comment (str (fmpg_file_comment fh))) - (set! copyright (str (fmpg_file_copyright fh))) - (set! year (fmpg_file_year fh)) - (set! track (fmpg_file_track fh)) - (set! bitrate (fmpg_file_bitrate fh))) + (set! rate (fmpg-audio-sample-rate fh)) + (set! channels (fmpg-audio-channels fh)) + (set! sample-bits (fmpg-audio-bits-per-sample fh)) + (set! sample-bytes (fmpg-audio-bytes-per-sample fh)) + (set! pcm-length (fmpg-duration-samples fh)) + (set! duration-ms (fmpg-duration-ms fh)) + (set! audio-streams (fmpg-audio-stream-count fh)) + (set! bitrate (fmpg-file-bitrate fh))) (define (init file) - (unless (ok? (fmpg_open_file fh file)) - (error (format "fmpg_open_file: could not open ~a" file))) - (set! ffmpeg-file (format "~a" file)) - (set! current-pcm-pos 0) - (fetch-info) - #t) + (let ((filename (filename->string file))) + (unless filename + (error (format "fmpg-open-file!: expected path or string, got ~a" file))) + (unless (ok? (fmpg-open-file! fh filename)) + (error (format "fmpg-open-file!: could not open ~a" filename))) + (set! ffmpeg-file filename) + (set! current-pcm-pos 0) + (fetch-info) + #t)) (define (ffmpeg-format cb) (cb current-pcm-pos rate channels sample-bits sample-bytes pcm-length)) @@ -267,76 +139,43 @@ (info-sound "rate : ~a" rate) (info-sound "pcm-length : ~a" pcm-length) (info-sound "duration-ms : ~a" duration-ms) - (info-sound "title : ~a" title) - (info-sound "author : ~a" author) - (info-sound "album : ~a" album) - (info-sound "genre : ~a" genre) - (info-sound "year : ~a" year) - (info-sound "track : ~a" track) (info-sound "bitrate : ~a" bitrate) #t) (define (close) (unless (eq? fh #f) - (when (ok? (fmpg_is_open fh)) - (fmpg_close fh)) - (set! channels -1) - (set! pcm-length -1) - (set! duration-ms -1) - (set! rate -1) - (set! sample-bits -1) - (set! sample-bytes -1) - (set! audio-streams -1) - (set! ffmpeg-file "") + (when (ok? (fmpg-is-open fh)) + (fmpg-close! fh)) + (reset!) #t)) (define (read cb format-cb) - ;; Unlike mpg123, this shim already has a fixed output format after - ;; fmpg_open_file. Still report the format lazily on the first read so - ;; the decoder layer can keep exactly the same structure as mp3-decoder. (when (= current-pcm-pos 0) (ffmpeg-format format-cb)) - (if (ok? (fmpg_decode_next fh)) + (if (ok? (fmpg-decode-next! fh)) (let-values ([(buffer size) (copy-current-buffer fh)]) (cond - ((or (eq? buffer #f) (<= size 0)) - ;; Defensive: fmpg_decode_next should only return 1 when there - ;; is PCM data, but if the native side ever returns an empty - ;; block, simply read again. - (read cb format-cb)) - (else - ;; The start sample is the absolute music position of the first - ;; sample frame in this buffer. This is more useful than the - ;; end position for UI and progress reporting. - (let ((pcm-pos (fmpg_buffer_start_sample fh))) - (set! current-pcm-pos (fmpg_buffer_end_sample fh)) - (cb 'data pcm-pos buffer size))))) + [(or (eq? buffer #f) (<= size 0)) (read cb format-cb)] + [else + (let ((pcm-pos (fmpg-buffer-start-sample fh))) + (set! current-pcm-pos (fmpg-buffer-end-sample fh)) + (cb 'data pcm-pos buffer size))])) (cb 'done -1 #f 0)) #t) (define (seek pcm-pos) (let* ((r (if (and (integer? rate) (> rate 0)) rate 44100)) - (ms (inexact->exact - (round (* 1000.0 (/ pcm-pos r)))))) - (unless (ok? (fmpg_seek_ms fh ms)) - (error (format "fmpg_seek_ms: could not seek to sample ~a (~a ms)" - pcm-pos ms))) - (set! current-pcm-pos (fmpg_sample_position fh)) + (ms (inexact->exact (round (* 1000.0 (/ pcm-pos r)))))) + (unless (ok? (fmpg-seek-ms! fh ms)) + (error (format "fmpg-seek-ms!: could not seek to sample ~a (~a ms)" pcm-pos ms))) + (set! current-pcm-pos (fmpg-sample-position fh)) #t)) (define (tell) - (if (eq? fh #f) 0 (fmpg_sample_position fh))) + (if (eq? fh #f) 0 (fmpg-sample-position fh))) (define (metadata) (let ((h (make-hash))) - (hash-set! h 'title title) - (hash-set! h 'author author) - (hash-set! h 'album album) - (hash-set! h 'genre genre) - (hash-set! h 'comment comment) - (hash-set! h 'copyright copyright) - (hash-set! h 'year year) - (hash-set! h 'track track) (hash-set! h 'bitrate bitrate) (hash-set! h 'duration-ms duration-ms) (hash-set! h 'audio-streams audio-streams) diff --git a/play-test.rkt b/play-test.rkt index 1b00fd3..acfa467 100644 --- a/play-test.rkt +++ b/play-test.rkt @@ -16,8 +16,8 @@ (define test-file3-id 3) (define test-file4-id 4) -(set! test-file3 (build-path tests "idyll.flac")) -(set! test-file4 (build-path tests "idyll.mp3")) +(set! test-file3 (build-path tests "mahler-1.mp3")) +(set! test-file4 (build-path tests "mahler-2.mp3")) ;(define fmt (ao-mk-format 24 48000 2 'big-endian)) ;(define ao-h (ao-open-live #f fmt)) diff --git a/private/cstruct-helper.rkt b/private/cstruct-helper.rkt new file mode 100644 index 0000000..00a4419 --- /dev/null +++ b/private/cstruct-helper.rkt @@ -0,0 +1,102 @@ +#lang racket/base + +(require ffi/unsafe + ffi/unsafe/define + ffi/unsafe/alloc + (for-syntax racket/base) + "utils.rkt" + ) + +(provide make-offsets + def-cstruct + struct-helpers + ) + +(define (make-offsets* defs) + (let ((name-store (make-hash))) + + (define (expand-type n t) + (if (= n 0) + '() + (cons t (expand-type (- n 1) t)))) + + (define (make-types defs idx) + (if (null? defs) + '() + (let ((d (car defs))) + (let ((t (if (list? d) + (if (symbol? (car d)) + (let ((name (car d))) + (hash-set! name-store name (list idx (cadr d))) + (list 1 (cadr d))) + d) + (list 1 d)))) + (append (expand-type (car t) (cadr t)) + (make-types (cdr defs) (+ idx (car t)))))) + )) + + (let ((offsets (compute-offsets (make-types defs 0)))) + (let ((keys (hash-keys name-store)) + (offs (make-hash))) + (for-each (λ (key) + (let* ((idx-t (hash-ref name-store key)) + (idx (car idx-t)) + (t (cadr idx-t))) + (hash-set! offs key (list (list-ref offsets idx) t)) + ) + ) + keys) + offs)))) + + +(define-syntax (make-offset stx) + (syntax-case stx () + ((_ (x t)) + (cond + ((number? (syntax->datum #'x)) #'(list x t)) + (else #'(list 'x t)) + ) + ) + ((_ t) + #'(list 1 t)) + ) + ) + +(define-syntax make-offsets + (syntax-rules () + ((_ a ...) + (make-offsets* (list (make-offset a) ...))))) + +(define-syntax def-cstruct + (syntax-rules () + ((_ name (t ...) offs) + (define-cstruct name + ([t (cadr (hash-ref offs 't)) #:offset (car (hash-ref offs 't))] + ...))) + ) + ) + + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; 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) + ...)))) diff --git a/private/utils.rkt b/private/utils.rkt index 9f616ef..bd1e5c0 100644 --- a/private/utils.rkt +++ b/private/utils.rkt @@ -21,6 +21,17 @@ sync-log-sound integer->int-bytes int-bytes->integer + + let/assert + make-assert + a-eq? a-!eq? + a->? a-<=? a->=? a-integer bs signed? big? start end)))) + + ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + ;; let/assert + ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + + + (define-syntax make-assert + (syntax-rules () + ((_ name not-name pred) + (begin + (define-syntax name + (syntax-rules () + ((_ const) + (λ (x) (pred x const))))) + (define-syntax not-name + (syntax-rules () + ((_ const) + (λ (x) (not (pred x const)))))) + ) + ) + ) + ) + + (make-assert a-eq? a-!eq? eq?) + + (define a-nullptr? (a-eq? #f)) + (define a-!nullptr? (a-!eq? #f)) + + (make-assert a->? a-<=? >) + (make-assert a->=? a-=) + (make-assert a-=? a-!=? =) + + (define a-true? (a-eq? #t)) + (define a-false? (a-eq? #f)) + + (struct exn:let/assert exn (value) #:transparent) + + (define (raise-let/assert v) + (raise (exn:let/assert "let/assert" (current-continuation-marks) v))) + + (define (let/assert-value r) + (exn:let/assert-value r)) + + (define-syntax assert-expr + (syntax-rules () + ((_ expr cond retval) + (let ((a expr)) (if (cond a) a (raise-let/assert retval)))) + ((_ expr) + expr) + ) + ) + + (define-syntax let/assert + (syntax-rules () + ((_ ((v rest ...) ...) b1 ...) + (with-handlers ([exn:let/assert? let/assert-value]) + (let* ((v (assert-expr rest ...)) + ...) + b1 + ... + ) + ) + ) + ) + ) + + ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + ;; define/return + ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + + (struct exn:return exn (value) #:transparent) + + (define (raise-return v) + (raise (exn:return "return" (current-continuation-marks) v))) + + (define (return-value r) + (exn:return-value r)) + + (define-syntax return + (syntax-rules () + ((_ val) + (raise-return val)))) + + (define-syntax define/return + (syntax-rules () + ((_ (name ...) b1 ...) + (define (name ...) + (with-handlers ([exn:return? return-value]) + b1 + ... + ) + ) + ) + ) + ) + + + ) ; end of module