(module opus-encoder racket/base

  (require ffi/unsafe
           "private/utils.rkt")

  (provide opus-encoder-available?
           opus-encoder-default-settings
           opus-encoder-prepare-settings
           opus-encoder-open
           opus-encoder-write
           opus-encoder-finish)

  ;; libopusenc handles the Ogg container, OpusHead and OpusTags.  The Racket
  ;; side only feeds interleaved signed 16-bit PCM to ope_encoder_write().

  (define libopusenc
    (get-lib (case (system-type 'os)
               [(windows) '("opusenc")]
               [else '("opusenc" "libopusenc")])
             '(#f)))

  (define _OggOpusComments (_cpointer/null 'ogg-opus-comments))
  (define _OggOpusEnc (_cpointer/null 'ogg-opus-enc))

  (define (ffi-proc name type)
    (and libopusenc
         (with-handlers ([exn:fail? (lambda (_) #f)])
           (get-ffi-obj name libopusenc type))))

  (define ope_comments_create (ffi-proc "ope_comments_create" (_fun -> _OggOpusComments)))
  (define ope_comments_destroy (ffi-proc "ope_comments_destroy" (_fun _OggOpusComments -> _void)))
  (define ope_comments_add (ffi-proc "ope_comments_add" (_fun _OggOpusComments _string/utf-8 _string/utf-8 -> _int)))
  (define ope_comments_add_picture_from_memory
    (ffi-proc "ope_comments_add_picture_from_memory" (_fun _OggOpusComments _bytes _size _int _string/utf-8 -> _int)))
  (define ope_encoder_create_file
    (ffi-proc "ope_encoder_create_file"
              (_fun _string/utf-8 _OggOpusComments _int32 _int _int (err : (_ptr o _int))
                    -> (enc : _OggOpusEnc)
                    -> (values enc err))))
  (define ope_encoder_write (ffi-proc "ope_encoder_write" (_fun _OggOpusEnc _bytes _int -> _int)))
  (define ope_encoder_drain (ffi-proc "ope_encoder_drain" (_fun _OggOpusEnc -> _int)))
  (define ope_encoder_destroy (ffi-proc "ope_encoder_destroy" (_fun _OggOpusEnc -> _void)))
  (define ope_strerror (ffi-proc "ope_strerror" (_fun _int -> _string/utf-8)))
  (define ope_encoder_ctl/int (ffi-proc "ope_encoder_ctl" (_fun #:varargs-after 2 _OggOpusEnc _int _int -> _int)))

  (define OPUS_SET_BITRATE_REQUEST 4002)
  (define OPUS_SET_VBR_REQUEST 4006)
  (define OPUS_SET_COMPLEXITY_REQUEST 4010)
  (define OPUS_SET_VBR_CONSTRAINT_REQUEST 4020)
  (define OPUS_SET_SIGNAL_REQUEST 4024)
  (define OPUS_SET_LSB_DEPTH_REQUEST 4036)
  (define OPE_SET_COMMENT_PADDING_REQUEST 14004)

  (define OPUS_AUTO -1000)
  (define OPUS_SIGNAL_VOICE 3001)
  (define OPUS_SIGNAL_MUSIC 3002)

  (define (opus-encoder-available?)
    (and libopusenc ope_comments_create ope_comments_destroy ope_encoder_create_file
         ope_encoder_write ope_encoder_drain ope_encoder_destroy ope_strerror #t))

  (define-struct opus-encoder-handle (enc comments settings format file) #:transparent)

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

  (define (copy-hash h)
    (let ((out (make-hash)))
      (for-each (lambda (k) (hash-set! out k (hash-ref h k))) (hash-keys h))
      out))

  (define (hash-merge base override)
    (let ((out (copy-hash base)))
      (when (hash? override)
        (for-each (lambda (k) (hash-set! out k (hash-ref override k))) (hash-keys override)))
      out))

  (define (opus-error-message code)
    (if ope_strerror (ope_strerror code) (format "libopusenc error ~a" code)))

  (define (check-ope who r)
    (when (negative? r) (error who "~a" (opus-error-message r)))
    r)

  (define (opus-encoder-default-settings)
    (make-hash '((bitrate . 160000)
                 (vbr? . #t)
                 (constrained-vbr? . #f)
                 (complexity . 10)
                 (comment-padding . 512))))

  (define (valid-opus-rate? rate)
    (or (= rate 8000) (= rate 12000) (= rate 16000) (= rate 24000) (= rate 48000)))

  (define (signal->int v)
    (cond [(or (eq? v 'auto) (eq? v #f)) OPUS_AUTO]
          [(eq? v 'voice) OPUS_SIGNAL_VOICE]
          [(eq? v 'music) OPUS_SIGNAL_MUSIC]
          [else (raise-argument-error 'opus-signal "(or/c 'auto 'voice 'music)" v)]))

  (define (opus-encoder-prepare-settings settings format)
    (let* ((h (hash-merge (opus-encoder-default-settings) settings))
           (rate (hash-ref/default h 'sample-rate (hash-ref format 'sample-rate)))
           (channels (hash-ref/default h 'channels (hash-ref format 'channels))))
      (unless (valid-opus-rate? rate)
        (error 'opus-encoder-open "Opus input sample rate must be 8000, 12000, 16000, 24000 or 48000 Hz; got ~a. Resample before calling libopusenc." rate))
      (when (> channels 2)
        (error 'opus-encoder-open "this first direct libopusenc backend only supports mono/stereo input; got ~a channels" channels))
      (hash-set! h 'sample-rate rate)
      (hash-set! h 'channels channels)
      (hash-set! h 'family 0)
      h))

  (define (apply-ctl! enc request value who)
    (when ope_encoder_ctl/int
      (check-ope who (ope_encoder_ctl/int enc request value))))

  (define (apply-settings! enc settings)
    (apply-ctl! enc OPUS_SET_BITRATE_REQUEST (hash-ref settings 'bitrate) 'opus-bitrate)
    (apply-ctl! enc OPUS_SET_VBR_REQUEST (if (hash-ref/default settings 'vbr? #t) 1 0) 'opus-vbr)
    (apply-ctl! enc OPUS_SET_VBR_CONSTRAINT_REQUEST (if (hash-ref/default settings 'constrained-vbr? #f) 1 0) 'opus-constrained-vbr)
    (apply-ctl! enc OPUS_SET_COMPLEXITY_REQUEST (hash-ref/default settings 'complexity 10) 'opus-complexity)
    (apply-ctl! enc OPE_SET_COMMENT_PADDING_REQUEST (hash-ref/default settings 'comment-padding 512) 'opus-comment-padding)
    (when (hash-has-key? settings 'signal)
      (apply-ctl! enc OPUS_SET_SIGNAL_REQUEST (signal->int (hash-ref settings 'signal)) 'opus-signal))
    (when (hash-has-key? settings 'lsb-depth)
      (apply-ctl! enc OPUS_SET_LSB_DEPTH_REQUEST (hash-ref settings 'lsb-depth) 'opus-lsb-depth)))

  (define (add-comments! comments settings)
    (when (hash-has-key? settings 'comments)
      (let ((ch (hash-ref settings 'comments)))
        (when (hash? ch)
          (for-each (lambda (k)
                      (let ((v (hash-ref ch k)))
                        (when (string? v)
                          (check-ope 'opus-comment (ope_comments_add comments (string-upcase (symbol->string k)) v)))))
                    (hash-keys ch))))))

  (define (opus-encoder-open output-file settings format)
    (unless (opus-encoder-available?) (error 'opus-encoder-open "libopusenc could not be loaded"))
    (let* ((file (if (path? output-file) (path->string output-file) output-file))
           (resolved (opus-encoder-prepare-settings settings format))
           (comments (ope_comments_create)))
      (add-comments! comments resolved)
      (let-values (((enc err) (ope_encoder_create_file file comments
                                                       (hash-ref resolved 'sample-rate)
                                                       (hash-ref resolved 'channels)
                                                       (hash-ref resolved 'family))))
        (unless enc (error 'opus-encoder-open "could not create Opus file ~a: ~a" file (opus-error-message err)))
        (apply-settings! enc resolved)
        (make-opus-encoder-handle enc comments resolved format file))))

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

  (define (sample->s16 sample in-bits)
    (cond [(> in-bits 16) (arithmetic-shift sample (- 16 in-bits))]
          [(< in-bits 16) (arithmetic-shift sample (- 16 in-bits))]
          [else sample]))

  (define (write-s16-native! out offset sample)
    (integer->integer-bytes sample 2 #t (system-big-endian?) out offset))

  (define (pcm-bytes->s16 buffer size in-bits)
    (let* ((in-bytes (quotient in-bits 8))
           (sample-count (quotient size in-bytes))
           (out (make-bytes (* sample-count 2))))
      (for ([i (in-range sample-count)])
        (let* ((in-off (* i in-bytes))
               (out-off (* i 2))
               (sample (native-signed-ref buffer in-off in-bytes)))
          (write-s16-native! out out-off (sample->s16 sample in-bits))))
      out))

  (define (opus-encoder-write handle buf-info buffer buf-len)
    (let* ((settings (opus-encoder-handle-settings handle))
           (channels (hash-ref settings 'channels))
           (in-bits (hash-ref/default buf-info 'bits-per-sample 16))
           (pcm (if (= in-bits 16) buffer (pcm-bytes->s16 buffer buf-len in-bits)))
           (frames (quotient (quotient (bytes-length pcm) 2) channels)))
      (check-ope 'opus-encoder-write (ope_encoder_write (opus-encoder-handle-enc handle) pcm frames))
      frames))

  (define (opus-encoder-finish handle)
    (dynamic-wind
     void
     (lambda () (check-ope 'opus-encoder-finish (ope_encoder_drain (opus-encoder-handle-enc handle))))
     (lambda ()
       (ope_encoder_destroy (opus-encoder-handle-enc handle))
       (ope_comments_destroy (opus-encoder-handle-comments handle)))))

  ) ; end of module