(module libflac-ffi racket/base
  
(require ffi/unsafe
         ffi/unsafe/define
         "private/utils.rkt"
         )

(provide flac-ffi-decoder-handler
         flac-ffi-encoder-handler
         _FLAC__StreamMetadata
         FLAC__StreamMetadata-type
         flac-ffi-meta
         flac-ffi-frame-header
         FLAC__uint32-pointer
         FLAC__int32**
         )


(define lib (get-lib '("libFLAC") '(#f)))
(define-ffi-definer define-libflac lib
  #:default-make-fail make-not-available)

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Some FLAC Constants
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(define FLAC__MAX_CHANNELS 8)
(define FLAC__MAX_FIXED_ORDER 4)

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; FLAC Integer types
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(define _uint32_t _uint32)
(define _uint64_t _uint64)
(define FLAC__uint8 _uint8)
(define FLAC__uint16 _uint16)
(define FLAC__int64 _int64)
(define FLAC__uint64 _uint64)
(define FLAC__uint32 _uint32)
(define FLAC__int32-pointer (_ptr i _int32))
(define FLAC__int32** (_ptr i (_ptr i _int32)))
(define FLAC__uint32-pointer (_ptr i _uint32))
(define FLAC__int64-pointer (_ptr i _int64))
(define FLAC__uint64-pointer (_ptr i _uint64))
(define FLAC__bool _int)
(define FLAC__byte _uint8)
(define FLAC__byte-pointer (_ptr i FLAC__byte))
(define _uint32_1bit_t _uint32)
(define _char _int8)

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; FLAC enumerations
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(define _FLAC__ChannelAssignment
  (_enum '(independent = 0
           left-side = 1
           right-side = 2
           mid-side = 3
           )))

(define _FLAC__FrameNumberType
  (_enum '(frame-number
           sample-number
          )))

(define _FLAC__SubframeType
  (_enum '(constant = 0
           verbatim = 1
           fixed = 2
           lpc = 3
           )))

(define _FLAC__MetadataType
  (_enum '(streaminfo = 0
           padding = 1
           application = 2
           seektable = 3
           vorbis-comment = 4
           cuesheet = 5
           picture = 6
           undefined = 7
           max--metadata-type-code = 126
           )))

(define _FLAC_StreamMetadata_Picture_Type
  (_enum '(other = 0
           file-icon-standard = 1
           file-icon = 2
           front-cover = 3
           back-cover = 4
           leaflet-page = 5
           media = 6
           lead-artist = 7
           artist = 8
           conductor = 9
           band = 10
           composer = 11
           lyricist = 12
           recording-location = 13
           during-recording = 14
           during-performance = 15
           video-screen-capture = 16
           fish = 17
           illustration = 18
           band-logotype = 19
           publisher-logotype = 20
           undefined
           )))

(define _FLAC_StreamDecoderState
  (_enum '(search-for-metadata = 0
           read-metadata
           search-for-frame-sync
           read-frames
           end-of-stream
           ogg-error
           seek-error
           aborted
           memory-allocation-error
           uninitialized
           end-of-link
           )))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; FLAC Frames
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(define-cstruct _FLAC__FrameHeader (
                                   [blocksize _uint32_t]
                                   [sample_rate _uint32_t]
                                   [channels _uint32_t]
                                   [channel_assignment _FLAC__ChannelAssignment]
                                   [bits_per_sample _uint32_t]
                                   [number_type _FLAC__FrameNumberType]
                                   [number (_union _uint32_t _uint64_t)]
                                   [crc FLAC__uint8]
                                   ))

(define (flac-ffi-frame-header frame)
  (let* ((hdr (FLAC__Frame-header frame))
         (h (make-hash)))
    (for-each
     (lambda (e)
       (hash-set! h (car e) (cdr e)))
     (list
      (cons 'blocksize (FLAC__FrameHeader-blocksize hdr))
      (cons 'sample-rate (FLAC__FrameHeader-sample_rate hdr))
      (cons 'channels (FLAC__FrameHeader-channels hdr))
      (cons 'channel-assignment (FLAC__FrameHeader-channel_assignment hdr))
      (cons 'bits-per-sample (FLAC__FrameHeader-bits_per_sample hdr))
      (cons 'number-type (FLAC__FrameHeader-number_type hdr))
      (cons 'number (if (eq? (FLAC__FrameHeader-number_type hdr) 'frame-number)
                        (union-ref (FLAC__FrameHeader-number hdr) 0)
                        (union-ref (FLAC__FrameHeader-number hdr) 1)))
      (cons 'crc (FLAC__FrameHeader-crc hdr)))
     )
    h))

(define-cstruct _FLAC__FrameFooter (
                                   [crc FLAC__uint16]
                                   ))

(define-cstruct _FLAC__Subframe_Constant (
                                          [value FLAC__int64]
                                          ))

(define _FLAC__VerbatimSubframeDataType
  (_enum '(int32
           int64)))

(define-cstruct _FLAC__Subframe_Verbatim (
                                          [data (_union
                                                 FLAC__int32-pointer
                                                 FLAC__int64-pointer
                                                 )]
                                          [data_type _FLAC__VerbatimSubframeDataType]
                                          ))


(define FLAC__EntropyCodingMethodType
  (_enum '(partitioned-rice = 0
           partitioned-rice2 = 1)))

(define-cstruct _FLAC__EntropyCodingMethod_PartitionedRiceContents
  (
   [parameters FLAC__uint32-pointer]
   [raw_bits   FLAC__uint32-pointer]
   [capacity_by_order FLAC__uint32-pointer]
   ))

(define-cstruct _FLAC__EntropyCodingMethod_PartitionedRice
  (
   [order _uint32_t]
   [contents _FLAC__EntropyCodingMethod_PartitionedRiceContents-pointer]
   ))

(define-cstruct _FLAC__EntropyCodingMethod
  (
   [type FLAC__EntropyCodingMethodType]
   [data (_union _FLAC__EntropyCodingMethod_PartitionedRice)]
   ))

(define-cstruct _FLAC__Subframe_Fixed (
                                       [entropy_coding_method _FLAC__EntropyCodingMethod]
                                       [order _uint32_t]
                                       [warmup (_array FLAC__int64 FLAC__MAX_FIXED_ORDER)]
                                       [residual FLAC__int32-pointer]
                                       ))

(define-cstruct _FLAC__Subframe_LPC (
                                     [jaja _int]
                                     ))

(define-cstruct _FLAC__Subframe (
                                [type _FLAC__SubframeType]
                                [data (_union
                                       _FLAC__Subframe_Constant
                                       _FLAC__Subframe_Fixed
                                       _FLAC__Subframe_LPC
                                       _FLAC__Subframe_Verbatim
                                       )]
                                [wated_bits _uint32_t]
                                ))

(define-cstruct _FLAC__Frame (
                            [header _FLAC__FrameHeader]
                            [subframes (_array _FLAC__Subframe FLAC__MAX_CHANNELS)]
                            [footer _FLAC__FrameFooter]
                            ))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; FLAC Metadata 
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(define-cstruct _FLAC__StreamMetadata_StreamInfo
  (
   [min_blocksize _uint32_t]
   [max_blocksize _uint32_t]
   [min_framesize _uint32_t]
   [max_framesize _uint32_t]
   [sample_rate _uint32_t]
   [channels _uint32_t]
   [bits_per_sample _uint32_t]
   [total_samples FLAC__uint64]
   [md5sum (_array FLAC__byte 16)]
   ))

(define (meta-stream-info si . hash)
  (let ((h (if (null? hash) (make-hash) (car hash))))
    (hash-set! h 'min-blocksize (FLAC__StreamMetadata_StreamInfo-min_blocksize si))
    (hash-set! h 'max-blocksize (FLAC__StreamMetadata_StreamInfo-max_blocksize si))
    (hash-set! h 'min-framesize (FLAC__StreamMetadata_StreamInfo-min_framesize si))
    (hash-set! h 'max-framesize (FLAC__StreamMetadata_StreamInfo-max_framesize si))
    (hash-set! h 'sample-rate (FLAC__StreamMetadata_StreamInfo-sample_rate si))
    (hash-set! h 'channels (FLAC__StreamMetadata_StreamInfo-channels si))
    (hash-set! h 'bits-per-sample (FLAC__StreamMetadata_StreamInfo-bits_per_sample si))
    (hash-set! h 'total-samples (FLAC__StreamMetadata_StreamInfo-total_samples si))
    h))

(define-cstruct _FLAC__StreamMetadata_Padding
  (
   [dummy _int]
   ))

(define-cstruct _FLAC__StreamMetadata_Application
  (
   [id (_array FLAC__byte 4)]
   [data FLAC__byte-pointer]
   ))

(define-cstruct _FLAC__StreamMetadata_SeekPoint
  (
   [sample_number FLAC__uint64]
   [stream_offset FLAC__uint64]
   [frame_samples _uint32_t]
   ))

(define-cstruct _FLAC__StreamMetadata_SeekTable
  (
   [num_points _uint32_t]
   [points _FLAC__StreamMetadata_SeekPoint-pointer]
   ))

(define-cstruct _FLAC__StreamMetadata_VorbisComment_Entry
  (
   [length FLAC__uint32]
   [entry FLAC__byte-pointer]
   ))

(define-cstruct _FLAC__StreamMetadata_VorbisComment
  (
   [vendor_string _FLAC__StreamMetadata_VorbisComment_Entry]
   [num_comments FLAC__uint32]
   [comments _FLAC__StreamMetadata_VorbisComment_Entry-pointer]
   ))

(define-cstruct _FLAC__StreamMetadata_CueSheet_Index
  (
   [offset FLAC__uint64]
   [number FLAC__byte]
   ))

(define-cstruct _FLAC__StreamMetadata_CueSheet_Track
  (
   [offset FLAC__uint64]
   [number FLAC__byte]
   [isrc (_array _char 13)]
   [type _uint32_1bit_t]
   [pre_emphasis _uint32_1bit_t]
   [num_indices FLAC__byte]
   [indices _FLAC__StreamMetadata_CueSheet_Index-pointer]
   ))

(define-cstruct _FLAC__StreamMetadata_CueSheet
  (
   [media_catalog_number (_array _char 129)]
   [lead_in FLAC__uint64]
   [is_cd FLAC__bool]
   [num_tracks _uint32_t]
   [tracks _FLAC__StreamMetadata_CueSheet_Track-pointer]
   ))

(define-cstruct _FLAC__StreamMetadata_Picture
  (
   [type _FLAC_StreamMetadata_Picture_Type]
   [mime_type _string/utf-8]
   [description FLAC__byte-pointer]
   [width FLAC__uint32]
   [height FLAC__uint32]
   [depth FLAC__uint32]
   [colors FLAC__uint32]
   [data_length FLAC__uint32]
   [date FLAC__byte-pointer]
   ))

(define-cstruct _FLAC__StreamMetadata_Unknown
  (
   [data FLAC__byte-pointer]
   ))
 

(define-cstruct _FLAC__StreamMetadata
  (
   [type _FLAC__MetadataType]
   [is_last FLAC__bool]
   [length _uint32_t]
   [data (_union
          _FLAC__StreamMetadata_StreamInfo
          _FLAC__StreamMetadata_Padding
          _FLAC__StreamMetadata_Application
          _FLAC__StreamMetadata_SeekTable
          _FLAC__StreamMetadata_VorbisComment
          _FLAC__StreamMetadata_CueSheet
          _FLAC__StreamMetadata_Picture
          _FLAC__StreamMetadata_Unknown
          )]
   ))

 (define (flac-ffi-meta meta)
   (let ((type (FLAC__StreamMetadata-type meta))
         (h (make-hash)))
     (cond
       ([eq? type 'streaminfo]
        (meta-stream-info (union-ref (FLAC__StreamMetadata-data meta) 0) h))
       (else (error (format "Cannot process metadata: ~a" type)))
       )
     h))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; FLAC Generic Pointer Definitions
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(define _FLAC__StreamDecoder-pointer (_cpointer 'flac-streamdecoder))
(define _FLAC__StreamEncoder-pointer (_cpointer 'flac-streamencoder))
(define _FLAC__Data-pointer (_cpointer/null 'flac-client-data))
;(define _FLAC__StreamMetadata-pointer (_cpointer/null 'flac-stream-metadata))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; FLAC Callback function definitions
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

  
;typedef FLAC__StreamDecoderWriteStatus(* FLAC__StreamDecoderWriteCallback) (const FLAC__StreamDecoder *decoder, const FLAC__Frame *frame, const FLAC__int32 *const buffer[], void *client_data)
(define _FLAC__StreamDecoderWriteCallback
  (_fun _FLAC__StreamDecoder-pointer
        _FLAC__Frame-pointer
        FLAC__int32** 
        _FLAC__Data-pointer
        -> _int))

;typedef void(* FLAC__StreamDecoderMetadataCallback) (const FLAC__StreamDecoder *decoder, const FLAC__StreamMetadata *metadata, void *client_data)
(define _FLAC__StreamDecoderMetadataCallback
  (_fun _FLAC__StreamDecoder-pointer
        _FLAC__StreamMetadata-pointer
        _FLAC__Data-pointer
        -> _void))

(define _FLAC__StreamDecoderErrorCallback
  (_fun _FLAC__StreamDecoder-pointer
        _int
        _FLAC__Data-pointer
        -> _void))


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Exported FLAC functions
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(define-libflac FLAC__stream_decoder_new
  (_fun -> _FLAC__StreamDecoder-pointer))

(define-libflac FLAC__stream_decoder_delete
  (_fun _FLAC__StreamDecoder-pointer -> _void))

(define-libflac FLAC__stream_decoder_get_state
  (_fun _FLAC__StreamDecoder-pointer -> _int))

(define states (make-hash))
  (hash-set! states 0 'search-for-metadata)
  (hash-set! states 1 'read-metadata)
  (hash-set! states 2 'search-for-frame-sync)
  (hash-set! states 3 'read-frames)
  (hash-set! states 4 'end-of-stream)
  (hash-set! states 5 'ogg-error)
  (hash-set! states 6 'seek-error)
  (hash-set! states 7 'aborted)
  (hash-set! states 8 'memory-allocation-error)
  (hash-set! states 9 'uninitialized)
  (hash-set! states 10 'end-of-link)

(define (decoder-state int-st)
  (hash-ref states int-st #f))
  

(define-libflac FLAC__stream_decoder_init_file
  (_fun _FLAC__StreamDecoder-pointer
        _string/utf-8
        _FLAC__StreamDecoderWriteCallback
        _FLAC__StreamDecoderMetadataCallback
        _FLAC__StreamDecoderErrorCallback
        _FLAC__Data-pointer  ; Seen by Jens Axel Søgaard - Is already present in FLAC 1.4.3 
        -> _int))

(define-libflac FLAC__stream_decoder_process_single
  (_fun _FLAC__StreamDecoder-pointer
        -> _bool))

(define-libflac FLAC__stream_decoder_process_until_end_of_metadata
  (_fun _FLAC__StreamDecoder-pointer
        -> _bool))

(define-libflac FLAC__stream_decoder_seek_absolute
  (_fun _FLAC__StreamDecoder-pointer FLAC__uint64
          -> _bool))

;FLAC_API FLAC__StreamMetadata *FLAC__metadata_object_clone(const FLAC__StreamMetadata *object);
(define-libflac FLAC__metadata_object_clone
  (_fun _FLAC__StreamMetadata-pointer
        -> _FLAC__StreamMetadata-pointer))
  
;FLAC_API void FLAC__metadata_object_delete(FLAC__StreamMetadata *object);
(define-libflac FLAC__metadata_object_delete
  (_fun _FLAC__StreamMetadata-pointer
        -> _void))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Our interface for decoding to racket
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(define (endian-little? e)
  (cond [(eq? e 'little-endian) #t]
        [(eq? e 'big-endian) #f]
        [(eq? e 'native-endian) (not (system-big-endian?))]
        [else (error (format "unknown endian value: ~a" e))]))

(define (flac-channels->interleaved-buffer buffer block-size channels bits endianness)
  ;; buffer    = FLAC__int32 * const buffer[]
  ;; block-size = samples per channel

  (let* ([bytes    (quotient bits 8)]
         [big?     (not (endian-little? endianness))]
         [buf-size (* block-size channels bytes)]
         [bs       (make-bytes buf-size)]
         ;[out      (malloc buf-size 'atomic-interior)]
         [out-pos  0])

    (for ([k (in-range block-size)])
      (for ([channel (in-range channels)])
        (let* ([chan   (ptr-ref buffer _pointer channel)]
               [sample (ptr-ref chan _int32 k)])
          (integer->int-bytes sample bytes #t big? bs out-pos)
          (set! out-pos (+ out-pos bytes)))))

    ;(memcpy out bs buf-size)
    ;(list out buf-size)
    (list bs buf-size)
    ))
  
(define (copy-flac-frame frame buffer)
  (let* ((h          (flac-ffi-frame-header frame))
         (channels   (hash-ref h 'channels))
         (block-size (hash-ref h 'blocksize))
         (bits       (hash-ref h 'bits-per-sample))
         (endianness 'native-endian)
         (result     (flac-channels->interleaved-buffer
                      buffer block-size channels bits endianness))
         (bs         (car result))
         (buf-size   (cadr result)))
    (hash-set! h 'type 'interleaved)
    (hash-set! h 'endianness endianness)
    (hash-set! h 'bits-per-sample bits)
    (hash-set! h 'sample (hash-ref h 'number))
    (cons h bs)))
  

(define (flac-ffi-decoder-handler)
  (define write-data '())
  (define meta-data '())
  (define error-no -1)
  (define fl #f)
  (define flac-file #f)
  (define client-data #f)
  
  ;(define (write-callback fl frame buffer client-data)
  ;  (set! write-data (append write-data (list (cons frame buffer))))
  ;  0)
  (define (write-callback fl frame buffer client-data)
  (set! write-data (cons (copy-flac-frame frame buffer) write-data))
    0)

  ;(define (meta-callback fl meta client-data)
  ;  (let ((meta-clone (FLAC__metadata_object_clone meta)))
  ;    (unless (eq? meta-clone #f)
  ;      (set! meta-data (append meta-data (list meta-clone))))))
  (define (meta-callback fl meta client-data)
    (let ((meta-clone (FLAC__metadata_object_clone meta)))
      (unless (eq? meta-clone #f)
        (set! meta-data (cons meta-clone meta-data)))))

  (define (error-callback fl errno client-data)
    (set! error-no errno)
    )

  (define (new)
    (dbg-sound "flac-ffi 'new")
    (if (eq? fl #f)
        (set! fl (FLAC__stream_decoder_new))
        (error "flac handler already initialized (new)"))
    fl)

  (define (init file)
    (dbg-sound "flac-ffi 'init")
    (let ((r (FLAC__stream_decoder_init_file
              fl
              file
              write-callback
              meta-callback
              error-callback
              client-data)))
      (set! flac-file file)
      r))

  (define (delete)
    (dbg-sound "flac-ffi 'delete")
    (if (eq? fl #f)
        (error "flac handler has already been deleted")
        (begin
          (FLAC__stream_decoder_delete fl)
          (set! fl #f)))
    )

  (define (process-single)
    (FLAC__stream_decoder_process_single fl))

  (define (int-state)
     (FLAC__stream_decoder_get_state fl))
  
  (define (state)
    (decoder-state (int-state)))

  (define (process-meta-data cb)
    (for-each (lambda (meta-entry)
                (cb meta-entry)
                (FLAC__metadata_object_delete meta-entry))
              (reverse meta-data))
    (set! meta-data '()))

  (define (process-write-data cb)
  (for-each (lambda (d)
              (cb (car d) (cdr d)))
            (reverse write-data))
    (set! write-data '()))

  (define (buffer->vectorlist buffer channels size)
    (letrec ((for-channels
              (lambda (channel)
                (if (< channel channels)
                  (letrec ((v (make-vector size 0))
                           (p (ptr-ref buffer FLAC__int32-pointer channel))
                           (to-vec (lambda (i)
                                     (when (< i size)
                                       (vector-set! v i (ptr-ref p _int32 i))
                                       (to-vec (+ i 1)))))
                           )
                    (to-vec 0)
                    (cons v (for-channels (+ channel 1))))
                  '())))
             )
      (for-channels 0)))

  (define (seek-to-sample sample)
    (FLAC__stream_decoder_seek_absolute fl sample))

  (lambda (cmd . args)
    (cond
      [(eq? cmd 'write-data) write-data]
      [(eq? cmd 'meta-data) meta-data]
      
      [(eq? cmd 'new) (new)]
      [(eq? cmd 'init) (init (car args))]
      [(eq? cmd 'delete) (delete)]
      [(eq? cmd 'process-single) (process-single)]
      [(eq? cmd 'get-buffers) (buffer->vectorlist (car args) (cadr args) (caddr args))]
      
      [(eq? cmd 'int-state) (int-state)]
      [(eq? cmd 'state) (state)]
      
      [(eq? cmd 'has-write-data?) (not (null? write-data))]
      [(eq? cmd 'has-meta-data?) (not (null? meta-data))]
      [(eq? cmd 'has-errno?) (not (= error-no -1))]
      
      [(eq? cmd 'process-meta-data) (process-meta-data (car args))]
      [(eq? cmd 'process-write-data) (process-write-data (car args))]
      [(eq? cmd 'errno) error-no]

      [(eq? cmd 'seek-to-sample) (seek-to-sample (car args))]
      [(eq? cmd 'file) flac-file]
      
      [else (error (format "unknown command ~a" cmd))]
      ))
  )



;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Direct FLAC encoder interface
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(define FLAC__StreamEncoderInitStatus-ok 0)

(define _FLAC__StreamEncoderProgressCallback _pointer)

(define-libflac FLAC__stream_encoder_new
  (_fun -> _FLAC__StreamEncoder-pointer))

(define-libflac FLAC__stream_encoder_delete
  (_fun _FLAC__StreamEncoder-pointer -> _void))

(define-libflac FLAC__stream_encoder_finish
  (_fun _FLAC__StreamEncoder-pointer -> FLAC__bool))

(define-libflac FLAC__stream_encoder_get_state
  (_fun _FLAC__StreamEncoder-pointer -> _int))

(define-libflac FLAC__stream_encoder_set_verify
  (_fun _FLAC__StreamEncoder-pointer FLAC__bool -> FLAC__bool))

(define-libflac FLAC__stream_encoder_set_streamable_subset
  (_fun _FLAC__StreamEncoder-pointer FLAC__bool -> FLAC__bool))

(define-libflac FLAC__stream_encoder_set_channels
  (_fun _FLAC__StreamEncoder-pointer _uint32_t -> FLAC__bool))

(define-libflac FLAC__stream_encoder_set_bits_per_sample
  (_fun _FLAC__StreamEncoder-pointer _uint32_t -> FLAC__bool))

(define-libflac FLAC__stream_encoder_set_sample_rate
  (_fun _FLAC__StreamEncoder-pointer _uint32_t -> FLAC__bool))

(define-libflac FLAC__stream_encoder_set_compression_level
  (_fun _FLAC__StreamEncoder-pointer _uint32_t -> FLAC__bool))

(define-libflac FLAC__stream_encoder_set_blocksize
  (_fun _FLAC__StreamEncoder-pointer _uint32_t -> FLAC__bool))

(define-libflac FLAC__stream_encoder_set_total_samples_estimate
  (_fun _FLAC__StreamEncoder-pointer FLAC__uint64 -> FLAC__bool))

(define-libflac FLAC__stream_encoder_init_file
  (_fun _FLAC__StreamEncoder-pointer
        _string/utf-8
        _FLAC__StreamEncoderProgressCallback
        _FLAC__Data-pointer
        -> _int))

(define-libflac FLAC__stream_encoder_process_interleaved
  (_fun _FLAC__StreamEncoder-pointer _pointer _uint32_t -> FLAC__bool))

(define (hash-ref/default h k default)
  (if (hash-has-key? h k) (hash-ref h k) default))

(define (bool->flac-bool v) (if v 1 0))

(define (native-signed-ref bs start bytes)
  (int-bytes->integer bs #t (system-big-endian?) start (+ start bytes)))

(define (scale-sample sample in-bits out-bits)
  (cond [(> in-bits out-bits) (arithmetic-shift sample (- out-bits in-bits))]
        [(< in-bits out-bits) (arithmetic-shift sample (- out-bits in-bits))]
        [else sample]))

(define (pcm-bytes->flac-int32-pointer buffer size channels in-bits out-bits)
  (let* ((in-bytes (quotient in-bits 8))
         (sample-count (quotient size in-bytes))
         (frame-count (quotient sample-count channels))
         (ptr (malloc _int32 sample-count 'atomic-interior)))
    (for ([i (in-range sample-count)])
      (let* ((off (* i in-bytes))
             (sample (native-signed-ref buffer off in-bytes)))
        (ptr-set! ptr _int32 i (scale-sample sample in-bits out-bits))))
    (values ptr frame-count)))

(define (flac-ffi-encoder-handler)
  (define enc #f)
  (define flac-file #f)
  (define settings #f)

  (define (require-encoder who)
    (when (eq? enc #f) (error who "FLAC encoder is not initialized")))

  (define (new)
    (if (eq? enc #f)
        (begin (set! enc (FLAC__stream_encoder_new)) enc)
        (error 'flac-ffi-encoder-handler "FLAC encoder already initialized")))

  (define (configure h)
    (require-encoder 'flac-encoder-configure)
    (set! settings h)
    (let ((channels (hash-ref h 'channels))
          (sample-rate (hash-ref h 'sample-rate))
          (bits (hash-ref h 'bits-per-sample))
          (compression-level (hash-ref/default h 'compression-level 5))
          (verify? (hash-ref/default h 'verify? #f))
          (streamable-subset? (hash-ref/default h 'streamable-subset? (<= (hash-ref h 'bits-per-sample) 24)))
          (blocksize (hash-ref/default h 'blocksize 0))
          (total-samples (hash-ref/default h 'total-samples #f)))
      (unless (FLAC__stream_encoder_set_channels enc channels) (error 'flac-encoder-configure "could not set channels"))
      (unless (FLAC__stream_encoder_set_sample_rate enc sample-rate) (error 'flac-encoder-configure "could not set sample rate"))
      (unless (FLAC__stream_encoder_set_bits_per_sample enc bits) (error 'flac-encoder-configure "could not set bits per sample"))
      (unless (FLAC__stream_encoder_set_compression_level enc compression-level) (error 'flac-encoder-configure "could not set compression level"))
      (unless (FLAC__stream_encoder_set_verify enc (bool->flac-bool verify?)) (error 'flac-encoder-configure "could not set verify"))
      (unless (FLAC__stream_encoder_set_streamable_subset enc (bool->flac-bool streamable-subset?)) (error 'flac-encoder-configure "could not set streamable subset"))
      (when (and (integer? blocksize) (> blocksize 0))
        (unless (FLAC__stream_encoder_set_blocksize enc blocksize) (error 'flac-encoder-configure "could not set blocksize")))
      (when (and (integer? total-samples) (>= total-samples 0))
        (unless (FLAC__stream_encoder_set_total_samples_estimate enc total-samples) (error 'flac-encoder-configure "could not set total samples estimate")))
      #t))

  (define (init file)
    (require-encoder 'flac-encoder-init)
    (let ((r (FLAC__stream_encoder_init_file enc file #f #f)))
      (set! flac-file file)
      (unless (= r FLAC__StreamEncoderInitStatus-ok)
        (error 'flac-encoder-init "FLAC encoder init failed with status ~a" r))
      #t))

  (define (write buffer size buf-info)
    (require-encoder 'flac-encoder-write)
    (let* ((channels (hash-ref settings 'channels))
           (in-bits (hash-ref/default buf-info 'pcm-bits-per-sample
                                      (hash-ref/default buf-info 'bits-per-sample
                                                        (hash-ref settings 'bits-per-sample))))
           (out-bits (hash-ref settings 'bits-per-sample)))
      (let-values (((ptr frames) (pcm-bytes->flac-int32-pointer buffer size channels in-bits out-bits)))
        (unless (FLAC__stream_encoder_process_interleaved enc ptr frames)
          (error 'flac-encoder-write "FLAC encoder process_interleaved failed, state ~a" (FLAC__stream_encoder_get_state enc)))
        frames)))

  (define (finish)
    (require-encoder 'flac-encoder-finish)
    (FLAC__stream_encoder_finish enc))

  (define (delete)
    (unless (eq? enc #f)
      (FLAC__stream_encoder_delete enc)
      (set! enc #f))
    #t)

  (lambda (cmd . args)
    (cond [(eq? cmd 'new) (new)]
          [(eq? cmd 'configure) (configure (car args))]
          [(eq? cmd 'init) (init (car args))]
          [(eq? cmd 'write) (write (car args) (cadr args) (caddr args))]
          [(eq? cmd 'finish) (finish)]
          [(eq? cmd 'delete) (delete)]
          [(eq? cmd 'state) (and enc (FLAC__stream_encoder_get_state enc))]
          [(eq? cmd 'file) flac-file]
          [(eq? cmd 'settings) settings]
          [else (error (format "unknown FLAC encoder command ~a" cmd))])))


); end of module