(module opusfile-decoder racket/base

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

  (provide opusfile-open
           opusfile-valid?
           opusfile-read
           opusfile-stop
           opusfile-seek
           opusfile-available?
           current-opusfile-output-format
           opusfile-output-format?)

  ;; Xiph libopusfile backend for Ogg Opus streams.
  ;;
  ;; By default this backend uses op_read(), which returns signed 16-bit
  ;; interleaved PCM.  That is the most efficient path for direct libao
  ;; playback.  For users who prefer the wider decoder output path, set
  ;; current-opusfile-output-format to 's24.  In that mode the backend uses
  ;; op_read_float() and converts the interleaved float output to packed signed
  ;; 24-bit PCM in native byte order.
  ;;
  ;; Opus decode output is always 48 kHz PCM.  The original input rate, if
  ;; present in metadata, is not the actual decoder output rate.


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

  (define libopus (get-lib (case (system-type 'os)
                             [(windows) '("opus")]
                             [else      '("opus" "libopus")])
                           '(#f)))
  
  (define libopusfile (get-lib (case (system-type 'os)
                                 [(windows) '("opusfile")]
                                 [else      '("opusfile" "libopusfile")])
                               '(#f)))

  (define _OggOpusFile _pointer)

  (define default-frames-per-read 4096)
  (define opus-sample-rate 48000)

  (define (opusfile-output-format? v)
    (or (eq? v 's16) (eq? v 's24)))

  (define cur-output-format 's16)

  (define (current-opusfile-output-format . args)
    (unless (null? args)
      (if (or (> (length args) 1)
              (not (opusfile-output-format? (car args))))
          (raise-argument-error 'current-opusfile-output-format
                                "(or/c 's16 's24)")
          (set! cur-output-format (car args))))
    cur-output-format)

  (define (opus-bits-per-sample)
    (case (current-opusfile-output-format)
      [(s16) 16]
      [(s24) 24]))

  (define (opus-bytes-per-sample)
    (case (current-opusfile-output-format)
      [(s16) 2]
      [(s24) 3]))

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

  (define op_open_file
    (ffi-proc "op_open_file"
              (_fun _path (err : (_ptr o _int))
                    -> (r : _OggOpusFile)
                    -> (values r err))))

  (define op_free
    (ffi-proc "op_free"
              (_fun _OggOpusFile -> _void)))

  (define op_channel_count
    (ffi-proc "op_channel_count"
              (_fun _OggOpusFile _int -> _int)))

  (define op_pcm_total
    (ffi-proc "op_pcm_total"
              (_fun _OggOpusFile _int -> _int64)))

  (define op_pcm_seek
    (ffi-proc "op_pcm_seek"
              (_fun _OggOpusFile _int64 -> _int)))

  (define op_read
    (ffi-proc "op_read"
              (_fun _OggOpusFile _bytes _int (li : (_ptr o _int))
                    -> (r : _int)
                    -> (values r li))))

  (define op_read_float
    (ffi-proc "op_read_float"
              (_fun _OggOpusFile _pointer _int (li : (_ptr o _int))
                    -> (r : _int)
                    -> (values r li))))

  (define (opusfile-available?)
    (and libopusfile
         op_open_file
         op_free
         op_channel_count
         op_pcm_total
         op_pcm_seek
         op_read
         op_read_float
         #t))

  (define-struct opusfile-handle
    (of cb-info cb-audio
        (stop #:mutable)
        (seek #:mutable)
        (reading #:mutable)
        (format #:mutable)
        (pcm-pos #:mutable))
    #:transparent)

  (define (raise-opus who fmt . args)
    (apply error who fmt args))

  (define (check-libopusfile who)
    (unless (opusfile-available?)
      (raise-opus who "libopusfile could not be loaded")))

  (define (correct-format-hash h)
    (unless (hash-ref h 'sample-rate #f)
      (hash-set! h 'sample-rate opus-sample-rate))
    (unless (hash-ref h 'bits-per-sample #f)
      (hash-set! h 'bits-per-sample (opus-bits-per-sample)))
    (unless (hash-ref h 'bytes-per-sample #f)
      (hash-set! h 'bytes-per-sample (opus-bytes-per-sample)))
    (unless (hash-ref h 'sample-format #f)
      (hash-set! h 'sample-format (current-opusfile-output-format)))
    (unless (hash-ref h 'total-samples #f)
      (hash-set! h 'total-samples 0)
      (hash-set! h 'duration 0)))

  (define (report-format handle)
    (let ((cb (opusfile-handle-cb-info handle)))
      (when (procedure? cb)
        (cb (opusfile-handle-format handle)))))

  (define (make-format channels total-samples)
    (let ((h (make-hash)))
      (hash-set! h 'duration (if (and (integer? total-samples) (>= total-samples 0))
                                 (exact->inexact (/ total-samples opus-sample-rate))
                                 0.0))
      (hash-set! h 'sample-rate opus-sample-rate)
      (hash-set! h 'channels channels)
      (hash-set! h 'bits-per-sample (opus-bits-per-sample))
      (hash-set! h 'bytes-per-sample (opus-bytes-per-sample))
      (hash-set! h 'sample-format (current-opusfile-output-format))
      (hash-set! h 'total-samples total-samples)
      h))

  (define (give-audio handle buffer size)
    (let ((h (opusfile-handle-format handle)))
      (correct-format-hash h)
      (hash-set! h 'sample (opusfile-handle-pcm-pos handle))
      (hash-set! h 'current-time (exact->inexact (/ (opusfile-handle-pcm-pos handle)
                                                    opus-sample-rate)))
      ((opusfile-handle-cb-audio handle) h buffer size)))

  (define s24-pos-scale #x7FFFFF)
  (define s24-neg-scale #x800000)

  (define (clip-sample x)
    (cond [(< x -1.0) -1.0]
          [(> x 1.0) 1.0]
          [else x]))

  (define (float->s24 x)
    (let ((y (clip-sample x)))
      (if (negative? y)
          (inexact->exact (round (* y s24-neg-scale)))
          (inexact->exact (round (* y s24-pos-scale))))))

  (define (write-s24-native! bs offset sample)
    (let ((v (if (negative? sample) (+ sample #x1000000) sample)))
      (if (system-big-endian?)
          (begin
            (bytes-set! bs offset (bitwise-and (arithmetic-shift v -16) #xFF))
            (bytes-set! bs (+ offset 1) (bitwise-and (arithmetic-shift v -8) #xFF))
            (bytes-set! bs (+ offset 2) (bitwise-and v #xFF)))
          (begin
            (bytes-set! bs offset (bitwise-and v #xFF))
            (bytes-set! bs (+ offset 1) (bitwise-and (arithmetic-shift v -8) #xFF))
            (bytes-set! bs (+ offset 2) (bitwise-and (arithmetic-shift v -16) #xFF))))))

  (define (opusfile-valid? audio-file)
    (and (opusfile-available?)
         (file-exists? audio-file)
         #t))

  (define (opusfile-open audio-file* cb-stream-info cb-audio)
    (check-libopusfile 'opusfile-open)
    (let ((audio-file (if (path? audio-file*)
                          (path->string audio-file*)
                          audio-file*)))
      (if (file-exists? audio-file)
          (let-values (((of err) (op_open_file audio-file)))
            (if of
                (let* ((channels (op_channel_count of -1))
                       (total-samples (op_pcm_total of -1))
                       (fmt (make-format channels total-samples))
                       (h (make-opusfile-handle of cb-stream-info cb-audio #f #f #f fmt 0)))
                  (report-format h)
                  h)
                (raise-opus 'opusfile-open
                            "could not open Opus file ~a; opusfile error code: ~a"
                            audio-file err)))
          #f)))

  (define (handle-pending-seek! handle)
    (unless (eq? (opusfile-handle-seek handle) #f)
      (let ((sample (opusfile-handle-seek handle)))
        (dbg-sound "Seeking opusfile to sample ~a" sample)
        (let ((r (op_pcm_seek (opusfile-handle-of handle) sample)))
          (when (negative? r)
            (err-sound "opusfile seek error: ~a" r))
          (when (not (negative? r))
            (set-opusfile-handle-pcm-pos! handle sample)))
        (set-opusfile-handle-seek! handle #f))))

  (define (read-s16 handle channels)
    (let* ((max-samples (* default-frames-per-read channels))
           (buffer (make-bytes (* max-samples 2))))
      (let-values (((read-frames link-index)
                    (op_read (opusfile-handle-of handle) buffer max-samples)))
        (cond [(negative? read-frames)
               (values read-frames #f 0)]
              [(zero? read-frames)
               (values 0 #f 0)]
              [else
               (let* ((read-samples (* read-frames channels))
                      (read-bytes (* read-samples 2))
                      (out (if (= read-bytes (bytes-length buffer)) buffer (subbytes buffer 0 read-bytes))))
                 (values read-frames out read-bytes))]))))

  (define (read-s24 handle channels)
    (let* ((max-samples (* default-frames-per-read channels))
           (float-buffer (malloc _float max-samples 'atomic-interior)))
      (let-values (((read-frames link-index)
                    (op_read_float (opusfile-handle-of handle) float-buffer max-samples)))
        (cond [(negative? read-frames)
               (values read-frames #f 0)]
              [(zero? read-frames)
               (values 0 #f 0)]
              [else
               (let* ((read-samples (* read-frames channels))
                      (out (make-bytes (* read-samples 3))))
                 (for ([i (in-range read-samples)])
                   (write-s24-native! out (* i 3) (float->s24 (ptr-ref float-buffer _float i))))
                 (values read-frames out (bytes-length out)))]))))

  (define (read-audio-buffer handle channels)
    (case (current-opusfile-output-format)
      [(s16) (read-s16 handle channels)]
      [(s24) (read-s24 handle channels)]))

  (define (opusfile-read handle)
    (set-opusfile-handle-stop! handle #f)
    (set-opusfile-handle-reading! handle #t)
    (let loop ()
      (cond
        [(opusfile-handle-stop handle)
         (dbg-sound "Stopping opusfile decoding")
         (set-opusfile-handle-reading! handle #f)
         'stopped-reading]
        [else
         (handle-pending-seek! handle)
         (let ((channels (hash-ref (opusfile-handle-format handle) 'channels 2)))
           (let-values (((read-frames out read-bytes) (read-audio-buffer handle channels)))
             (cond [(negative? read-frames)
                    (err-sound "opusfile decode error: ~a" read-frames)
                    (set-opusfile-handle-stop! handle #t)
                    (loop)]
                   [(zero? read-frames)
                    (set-opusfile-handle-stop! handle #t)
                    (loop)]
                   [else
                    (give-audio handle out read-bytes)
                    (set-opusfile-handle-pcm-pos! handle (+ (opusfile-handle-pcm-pos handle) read-frames))
                    (loop)])))]))
    (op_free (opusfile-handle-of handle))
    (set-opusfile-handle-reading! handle #f))

  (define (opusfile-seek handle percentage)
    (let* ((fmt (opusfile-handle-format handle))
           (total-samples (hash-ref fmt 'total-samples 0)))
      (unless (or (eq? total-samples #f) (= total-samples -1) (= total-samples 0))
        (let* ((percentage (max 0 (min 100 percentage)))
               (sample (inexact->exact
                        (round (* (exact->inexact (/ percentage 100.0))
                                  total-samples)))))
          (set-opusfile-handle-seek! handle sample)))))

  (define (opusfile-stop handle)
    (set-opusfile-handle-stop! handle #t)
    (while (opusfile-handle-reading handle)
           (sleep 0.01)))

  ) ; end of module