#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)))