;;-*-Lisp-*-
(in-package goal)

;; name: merc-blend-shape.gc
;; name in dgo: merc-blend-shape
;; dgos: GAME

(define-extern setup-blerc-chains (function merc-ctrl (pointer int16) dma-buffer none))

;; when true, uses the PC float blerc implementation.
(define *use-fp-blerc* #t)

(defun process-drawable-might-need-blerc? ((pd process-drawable))
  "Annoyingly, some warp object have blend shape anims, like the hiphog mirror.
   These are never drawn with PC-merc (it doesn't support warp), so we still
   need to the PS2-style blerc for generic. This function sees if this process-drawable
   might be warp."
  (let ((draw (-> pd draw)))
    (if (or (zero? draw) (not draw))
        (return #f)
        )
    (let ((geo (-> draw mgeo)))
      (if (or (zero? geo) (not geo))
          (return #f)
          )

    (dotimes (effect-idx (-> geo header effect-count))
      (when (= (-> geo effect effect-idx texture-index) (tpage-category warp))
           (return #t)
          )
      )
    )
    )

  #f
  )

;; DECOMP BEGINS

(define *stats-blerc* #f)

(deftype blerc-block-header (structure)
  ((tag        generic-merc-tag  :inline)
   (vtx-count  uint32)
   (overlap    uint32)
   (lump-dest  uint32)
   (lump-qwc   uint32)
   )
  )


(deftype blerc-block (structure)
  ((output  uint8               848)
   (header  blerc-block-header  :inline)
   )
  )


(deftype blerc-dcache (structure)
  ((repl-mult  vector  40 :inline)
   )
  )


(deftype blerc-globals (structure)
  ((first             uint32)
   (next              uint32)
   (min-val           int16)
   (max-val           int16)
   (fragment-count    int32)
   (vtx-count         int32)
   (target-vtx-count  int32)
   )
  )


(define *blerc-globals* (new 'global 'blerc-globals))

(deftype blerc-context (structure)
  ((block-a  blerc-block  :inline)
   (dummy    uint8        7312)
   (block-b  blerc-block  :inline)
   )
  )


(defun-debug blerc-stats-init ()
  (when *stats-blerc*
    (when (nonzero? (-> *blerc-globals* fragment-count))
      (format *stdcon* "~%BLERC (merc blend target) STATS~%")
      (format
        *stdcon*
        "  ~D fragments, ~D vertices~%"
        (-> *blerc-globals* fragment-count)
        (-> *blerc-globals* vtx-count)
        )
      (format
        *stdcon*
        "  ~D blend target computations (~F average)~%"
        (-> *blerc-globals* target-vtx-count)
        (/ (the float (-> *blerc-globals* target-vtx-count)) (the float (-> *blerc-globals* vtx-count)))
        )
      (if (< (-> *blerc-globals* min-val) 0)
          (format *stdcon* "MINIMUM OUT OF RANGE: ~D~%" (-> *blerc-globals* min-val))
          )
      (if (< 255 (-> *blerc-globals* max-val))
          (format *stdcon* "MAXIMUM OUT OF RANGE: ~D~%" (-> *blerc-globals* max-val))
          )
      )
    (let ((a0-7 *blerc-globals*))
      (set! (-> a0-7 min-val) 255)
      (set! (-> a0-7 max-val) 0)
      (set! (-> a0-7 fragment-count) 0)
      (set! (-> a0-7 vtx-count) 0)
      (set! (-> a0-7 target-vtx-count) 0)
      )
    )
  0
  (none)
  )

(defun blerc-init ()
  (blerc-stats-init)
  (let ((v1-0 *blerc-globals*))
    (set! (-> v1-0 first) (the-as uint 0))
    (set! (-> v1-0 next) (the-as uint 0))
    )
  0
  (none)
  )

;; ERROR: function was not converted to expressions. Cannot decompile.

;; ERROR: function has no type analysis. Cannot decompile.

;; ERROR: function has no type analysis. Cannot decompile.

(def-mips2c blerc-execute (function none))

;; WARN: Return type mismatch int vs object.
(defun merc-blend-shape ((arg0 process-drawable))
  (with-profiler 'merc *profile-merc-color*
    (let* ((v1-1 (-> arg0 skel float-channels))
          (a2-0 (cond
                  ((> v1-1 0)
                    (-> arg0 skel channel (+ v1-1 -1 (-> arg0 skel active-channels)))
                    )
                  (else
                    (let ((v1-7 (-> arg0 skel root-channel))
                          (a0-5 (-> arg0 skel effect))
                          )
                      (-> v1-7 (if a0-5
                                    (-> a0-5 channel-offset)
                                    0
                                    )
                          )
                      )
                    )
                  )
                )
          (a3-0 (-> a2-0 frame-group))
          (a1-0 (new 'stack-no-clear 'array 'int16 128))
          (disable-blerc? (and *use-fp-blerc* (not (process-drawable-might-need-blerc? arg0))))
          )
      (when (and a3-0 (and (> (-> arg0 skel active-channels) 0)
                          (zero? (-> arg0 draw cur-lod))
                          (logtest? (-> arg0 skel status) (joint-control-status blend-shape))
                          )
                )
        (cond
          ((and (-> arg0 skel override) (!= (-> arg0 skel override 0) 0.0))
           (let* ((a0-12 (-> arg0 draw mgeo))
                   (v1-20 (-> a0-12 header blend-target-count))
                   (a2-2 (-> arg0 skel override))
                   )
             (when (nonzero? v1-20)
               (dotimes (a3-1 (the-as int v1-20))
                 (set! (-> a1-0 a3-1) (the int (* 8192.0 (-> a2-2 (+ a3-1 1)))))
                 )
               (when (not disable-blerc?)
                 (setup-blerc-chains a0-12 a1-0 (-> *display* frames (-> *display* on-screen) global-buf))
                 )
               (logior! (-> arg0 skel status) (joint-control-status blend-shape-valid))
               ;; og:preserve-this changed so we don't skip the profiler bar end
               ; (return (the-as object #f))
               (goto end)
               )
             )
          )
          (else
            (let ((t2-0 (-> a3-0 blend-shape-anim)))
              (when t2-0
                (let ((a0-14 (-> arg0 draw mgeo)))
                  (let* ((v1-33 (-> a0-14 header blend-target-count))
                        (t0-8 (-> a2-0 frame-num))
                        (t1-2 (the int t0-8))
                        (a2-6 (&+ t2-0 (* (the-as uint t1-2) v1-33)))
                        )
                    (cond
                      ((< t1-2 (the-as int (+ (-> a3-0 frames num-frames) -1)))
                      (let* ((a3-6 (&+ a2-6 v1-33))
                              (t0-9 (* 64.0 (- t0-8 (the float t1-2))))
                              (t1-4 (- 64.0 t0-9))
                              )
                        (dotimes (t2-2 (the-as int v1-33))
                          (set! (-> a1-0 t2-2) (the int (+ 0.5
                                                            (* (the float (+ (-> (the-as (pointer uint8) (&+ a3-6 t2-2))) -64)) t0-9)
                                                            (* (the float (+ (-> (the-as (pointer uint8) (&+ a2-6 t2-2))) -64)) t1-4)
                                                            )
                                                    )
                                )
                          )
                        )
                      )
                      (else
                        (dotimes (a3-7 (the-as int v1-33))
                          (set! (-> a1-0 a3-7) (the-as int (* (+ (-> (the-as (pointer uint8) (&+ a2-6 a3-7))) -64) 64)))
                          )
                        )
                      )
                    )
                  (when (not disable-blerc?)
                    (setup-blerc-chains a0-14 a1-0 (-> *display* frames (-> *display* on-screen) global-buf))
                    )
                  )
                (logior! (-> arg0 skel status) (joint-control-status blend-shape-valid))
                ;; og:preserve-this changed so we don't skip the profiler bar end
                ;; (return (the-as object #f))
                (goto end)
                )
              )
            )
          )
        )
      (when (logtest? (-> arg0 skel status) (joint-control-status blend-shape-valid))
        (logclear! (-> arg0 skel status) (joint-control-status blend-shape-valid))
        (when (not disable-blerc?)
          (setup-blerc-chains
            (-> arg0 draw lod-set lod 0 geo)
            (new 'static 'array int16 40 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0)
            (-> *display* frames (-> *display* on-screen) global-buf)
            )
          )
        )
      )
    (label end)
    )
  0
  )

(def-mips2c setup-blerc-chains-for-one-fragment (function object object object object object object object))

(defun setup-blerc-chains ((arg0 merc-ctrl) (arg1 (pointer int16)) (arg2 dma-buffer))
  (local-vars
    (sv-16 uint)
    (sv-20 pointer)
    (sv-24 merc-effect)
    (sv-28 uint)
    (sv-32 object)
    (sv-48 int)
    (sv-64 int)
    )
  (set! sv-16 (-> arg0 header effect-count))
  (let ((s3-0 (-> arg0 header blend-target-count))
        (v1-1 (-> arg2 base))
        )
    (set! sv-20 (&+ v1-1 0))
    (let ((a2-1 (the-as object (&+ v1-1 16))))
      (if (zero? (-> *blerc-globals* first))
          (set! (-> *blerc-globals* first) (the-as uint a2-1))
          )
      (dotimes (s2-0 (the-as int sv-16))
        (set! sv-24 (-> arg0 effect s2-0))
        (set! sv-28 (-> sv-24 blend-frag-count))
        (when (nonzero? sv-28)
          (let ((v1-15 (the-as object (-> sv-24 frag-geo)))
                (s1-0 (the-as structure (-> sv-24 frag-ctrl)))
                (s0-0 (the-as object (-> sv-24 blend-data)))
                )
            (set! sv-32 (-> sv-24 blend-ctrl))
            (set! sv-48 0)
            (while (< sv-48 (the-as int sv-28))
              (set! sv-64 (+ (the-as int v1-15)
                             (logand (* (+ (-> (the-as merc-fragment-control s1-0) unsigned-four-count) 3) 4) #xfff0)
                             )
                    )
              (if (nonzero? (-> (the-as (pointer uint8) sv-32) 0))
                  (set! a2-1 (setup-blerc-chains-for-one-fragment s3-0 arg1 a2-1 s0-0 sv-32 sv-64))
                  )
              (let ((a0-14 (logand (+ (* (the-as uint 6) (-> (the-as merc-blend-ctrl sv-32) blend-vtx-count)) 15) #xfff0)))
                (set! v1-15
                      (+ sv-64
                         (logand (* (+ (-> (the-as merc-fragment-control s1-0) lump-four-count) 3) 4) #xfff0)
                         (* (-> (the-as merc-fragment-control s1-0) fp-qwc) 16)
                         )
                      )
                ;; og:preserve-this
                (set! s1-0 (&+ s1-0 (* (-> (the-as merc-fragment-control s1-0) mat-xfer-count) 2) 4))
                (set! s0-0
                      (+ (the-as int s0-0) (* (the-as uint a0-14) (+ (-> (the-as merc-blend-ctrl sv-32) nonzero-index-count) 1)))
                      )
                )
              (set! sv-32 (+ (the-as int sv-32) s3-0 2))
              (the-as int sv-32)
              (set! sv-48 (+ sv-48 1))
              )
            )
          )
        )
      (set! (-> (the-as (pointer int64) sv-20)) (logior #x20000000 (shr (shl (the-as int a2-1) 33) 1)))
      (set! (-> (the-as (pointer uint32) sv-20) 2) (the-as uint 0))
      (set! (-> (the-as (pointer uint32) sv-20) 3) (the-as uint 0))
      (set! (-> arg2 base) (the-as pointer a2-1))
      )
    )
  0
  (none)
  )
