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

;; name: sprite-distort.gc
;; name in dgo: sprite-distort
;; dgos: GAME

;; DECOMP BEGINS

(deftype sprite-distorter-sine-tables (basic)
  "Table of precomputed sine data for the sprite distorter renderer."
  ((aspx    float)
   (aspy    float)
   (entry   vector      128 :inline)
   (ientry  qword       9 :inline)
   (giftag  gs-gif-tag  :inline)
   (color   qword       :inline)
   )
  )


(kmemopen global "sprite-distort-tables")

(define *sprite-distorter-sine-tables* (new 'global 'sprite-distorter-sine-tables))

(kmemclose)

(defun sprite-distorter-generate-tables ()
  "Regenerate the sprite-distorter-sine-tables for the current camera settings."
  (let ((gp-0 *sprite-distorter-sine-tables*))
    (let ((s3-0 0)
          (s5-0 0)
          (s4-0 3)
          (f28-0 (- (-> *math-camera* perspective rvec x)))
          (f30-0 (- (-> *math-camera* perspective uvec y)))
          )
      (when (or (!= f28-0 (-> gp-0 aspx)) (!= f30-0 (-> gp-0 aspy)))
        (set! (-> gp-0 aspx) f28-0)
        (set! (-> gp-0 aspy) f30-0)
        (while (< s4-0 12)
          (set! (-> gp-0 ientry s5-0 vector4w x) (+ s3-0 352))
          (+! s5-0 1)
          (dotimes (s2-0 s4-0)
            (let ((f26-0 (* 65536.0 (/ (the float s2-0) (the float s4-0)))))
              (set-vector! (-> gp-0 entry s3-0) (* (sin f26-0) f28-0) (* (cos f26-0) f30-0) 0.0 0.0)
              (let ((s3-1 (+ s3-0 1)))
                (set-vector! (-> gp-0 entry s3-1) (* (/ f28-0 512) (sin f26-0)) (* (/ f30-0 512) (cos f26-0)) 0.0 0.0)
                (set! s3-0 (+ s3-1 1))
                )
              )
            )
          (+! s4-0 1)
          )
        (set-vector! (-> gp-0 entry s3-0) 0.0 f30-0 0.0 0.0)
        (let ((v1-20 (+ s3-0 1)))
          (set-vector! (-> gp-0 entry v1-20) 0.0 (/ f30-0 512) 0.0 0.0)
          (+ v1-20 1)
          )
        )
      )
    (set! (-> gp-0 giftag tag) (new 'static 'gif-tag64
                                 :nloop #x1
                                 :eop #x1
                                 :pre #x1
                                 :prim (new 'static 'gs-prim :prim (gs-prim-type tri-strip) :tme #x1)
                                 :nreg #xf
                                 )
          )
    (set! (-> gp-0 giftag regs) (new 'static 'gif-tag-regs
                                  :regs0 (gif-reg-id st)
                                  :regs1 (gif-reg-id rgbaq)
                                  :regs2 (gif-reg-id xyzf2)
                                  :regs3 (gif-reg-id st)
                                  :regs4 (gif-reg-id rgbaq)
                                  :regs5 (gif-reg-id xyzf2)
                                  :regs6 (gif-reg-id st)
                                  :regs7 (gif-reg-id rgbaq)
                                  :regs8 (gif-reg-id xyzf2)
                                  :regs9 (gif-reg-id st)
                                  :regs10 (gif-reg-id rgbaq)
                                  :regs11 (gif-reg-id xyzf2)
                                  :regs12 (gif-reg-id st)
                                  :regs13 (gif-reg-id rgbaq)
                                  :regs14 (gif-reg-id xyzf2)
                                  )
          )
    (set! (-> gp-0 color vector4w x) 128)
    (set! (-> gp-0 color vector4w y) 128)
    (set! (-> gp-0 color vector4w z) 128)
    (set! (-> gp-0 color vector4w w) 128)
    )
  0
  (none)
  )

(define sprite-distort-vu1-block (new 'static 'vu-function #|:length 63 :qlength 32|#))

(defun sprite-init-distorter ((arg0 dma-buffer))
  "Generate DMA to initialize the distort renderer."
  (dma-buffer-add-gs-set arg0
                         (zbuf-1 (new 'static 'gs-zbuf :zbp #x130 :psm (gs-psm ct24) :zmsk #x1))
                         (tex0-1 (new 'static 'gs-tex0 :tbp0 #x3300 :tbw #x8 :tw #x9 :th #x9))
                         (tex1-1 (new 'static 'gs-tex1 :mmag #x1 :mmin #x1))
                         (miptbp1-1 (new 'static 'gs-miptbp))
                         (clamp-1 (new 'static 'gs-clamp
                                    :wms (gs-tex-wrap-mode region-clamp)
                                    :wmt (gs-tex-wrap-mode region-clamp)
                                    :maxu #x1ff
                                    :maxv #x19f
                                    )
                                  )
                         (alpha-1 (new 'static 'gs-alpha :b #x1 :d #x1))
                         )
  ;; send current aspect used by the sine tables (PC only)
  (#when PC_PORT
    (let ((packet (the-as dma-packet (-> arg0 base))))
      (set! (-> packet dma) (new 'static 'dma-tag :id (dma-tag-id cnt) :qwc 1))
      (set! (-> packet vif0) (new 'static 'vif-tag))
      (set! (-> packet vif1) (new 'static 'vif-tag :cmd (vif-cmd pc-port)))
      (&+! (-> arg0 base) 16)
      )
    (let ((aspect-vec (the-as vector (-> arg0 base))))
      (set-vector! aspect-vec
                   (-> *sprite-distorter-sine-tables* aspx)
                   (-> *sprite-distorter-sine-tables* aspy)
                   0.0
                   0.0
                   )
      (&+! (-> arg0 base) 16)
      )
    )
  (let* ((v1-3 arg0)
         (a1-6 (the-as dma-packet (-> v1-3 base)))
         )
    (set! (-> a1-6 dma) (new 'static 'dma-tag
                          :qwc #x8b
                          :id (dma-tag-id ref)
                          :addr (the-as uint (-> *sprite-distorter-sine-tables* entry))
                          )
          )
    (set! (-> a1-6 vif0) (new 'static 'vif-tag :imm #x404 :cmd (vif-cmd stcycl)))
    (set! (-> a1-6 vif1) (new 'static 'vif-tag :imm #x160 :num #x8b :cmd (vif-cmd unpack-v4-32)))
    (set! (-> v1-3 base) (the-as pointer (&+ a1-6 16)))
    )
  (dma-buffer-add-vu-function arg0 sprite-distort-vu1-block 1)
  0
  (none)
  )

;; ERROR: Inline assembly instruction marked with TODO - [TODO.VCLIP]
;; ERROR: Unsupported inline assembly instruction kind - [cfc2.i v1, Clipping]
(defun sprite-draw-distorters ((arg0 dma-buffer))
  "Generate DMA to draw all distort sprites."
  (local-vars
    (v1-15 float)
    (v1-21 float)
    (v1-26 int)
    (v1-65 float)
    (sv-16 sprite-vec-data-2d)
    (sv-32 vector)
    (sv-48 vector)
    )
  (rlet ((acc :class vf)
         (Q :class vf)
         (vf0 :class vf)
         (vf1 :class vf)
         (vf10 :class vf)
         (vf2 :class vf)
         (vf3 :class vf)
         (vf4 :class vf)
         (vf5 :class vf)
         (vf6 :class vf)
         (vf8 :class vf)
         (vf9 :class vf)
         )
    (init-vf0-vector)
    (.lvf vf8 (&-> *math-camera* hmge-scale quad))
    (let ((s0-0 (-> arg0 base))
          (s4-0 0)
          (s5-0 0)
          )
      (&+! (-> arg0 base) 16)
      (let* ((s3-0 *sprite-aux-list*)
             (s2-0 (-> s3-0 entry))
             )
        (dotimes (s1-0 s2-0)
          (let ((v1-5 (-> s3-0 data s1-0)))
            (when (= (-> v1-5 aux-type) (sprite-aux-type distort))
              (set! sv-16 (-> v1-5 vec-data))
              (let ((a0-3 (the-as object (-> arg0 base))))
                (set! sv-32 (the-as vector (&+ (the-as pointer a0-3) 16)))
                (set! sv-48 (the-as vector (&+ (the-as pointer a0-3) 32)))
                (cond
                  ((= (the-as int (-> sv-16 flag-rot-sy y)) 1)
                   (.lvf vf3 (&-> *math-camera* sprite-2d rvec quad))
                   (.lvf vf4 (&-> *math-camera* sprite-2d uvec quad))
                   (.lvf vf5 (&-> *math-camera* sprite-2d fvec quad))
                   (.lvf vf6 (&-> *math-camera* sprite-2d trans quad))
                   (.lvf vf9 (&-> *math-camera* sprite-2d-hvdf quad))
                   (.mov v1-15 vf9)
                   )
                  (else
                    (.lvf vf3 (&-> *math-camera* camera-temp rvec quad))
                    (.lvf vf4 (&-> *math-camera* camera-temp uvec quad))
                    (.lvf vf5 (&-> *math-camera* camera-temp fvec quad))
                    (.lvf vf6 (&-> *math-camera* camera-temp trans quad))
                    (.lvf vf9 (&-> *math-camera* hvdf-off quad))
                    (.mov v1-21 vf9)
                    )
                  )
                (.lvf vf1 (&-> sv-16 x-y-z-sx quad))
                (.lvf vf2 (&-> sv-16 r-g-b-a quad))
                (.mul.w.vf acc vf6 vf0)
                (.add.mul.x.vf acc vf3 vf1 acc)
                (.add.mul.y.vf acc vf4 vf1 acc)
                (.add.mul.z.vf vf1 vf5 vf1 acc)
                (.mul.vf vf10 vf1 vf8)
                (.div.vf Q vf0 vf10 :fsf #b11 :ftf #b11)
                ;; (TODO.VCLIP vf10 vf10) og:preserve-this
                (b! (zero? (-> sv-16 flag-rot-sy x)) cfg-22 :delay (nop!))
                (.wait.vf)
                (.mul.vf.xyz vf1 vf1 Q)
                (.mul.vf.xyz vf2 vf2 Q)
                (set! v1-26 (vu-clip vf10 0)) ;; safe to just drop the higher bits. og:preserve-this
                ;; (.cfc2.i v1-26 Clipping)
                (b! (logtest? v1-26 63) cfg-22 :delay (.add.vf vf1 vf1 vf9))
                (.max.x.vf.w vf1 vf1 vf0)
                (.svf (&-> (the-as vector a0-3) quad) vf1)
                (.svf (&-> sv-48 quad) vf2)
                (set! (-> (the-as vector a0-3) w) 255.0)
                (set! (-> sv-32 x) (+ 0.0009765625 (* 0.001953125 (+ -1792.0 (-> (the-as vector a0-3) x)))))
                (set! (-> sv-32 y) (+ 0.0009765625 (* 0.001953125 (+ -1840.0 (-> (the-as vector a0-3) y)))))
                )
              (set! (-> sv-32 z) 1.0)
              (when (or (< (the-as int (-> sv-16 flag-rot-sy x)) 3) (< 11 (the-as int (-> sv-16 flag-rot-sy x))))
                (format 0 "Turns = ~D!!!~%" (-> sv-16 flag-rot-sy x))
                (set! (-> sv-16 flag-rot-sy x) (the-as float #xb))
                )
              (set! (-> sv-32 w) (-> sv-16 flag-rot-sy x))
              (let* ((f1-4 (- (-> *math-camera* perspective uvec y)))
                     (f2-4 (-> sv-32 y))
                     (f4-0 (+ f2-4 (* (-> sv-48 x) f1-4)))
                     (f3-2 256.0)
                     (f0-9 (-> sv-48 x))
                     )
                (if (< 416.0 f4-0)
                    (set! f3-2 (/ (- 416.0 f2-4) f1-4))
                    )
                (if (< 128.0 f3-2)
                    (set! f3-2 128.0)
                    )
                (when (< f3-2 f0-9)
                  (let ((v1-63 (/ f3-2 f0-9)))
                    (.mov vf1 v1-63)
                    )
                  (.mul.x.vf vf2 vf2 vf1)
                  (.svf (&-> sv-48 quad) vf2)
                  (.mov v1-65 vf2)
                  )
                )
              (&+! (-> arg0 base) 48)
              (+! s4-0 1)
              (when (= s4-0 85)
                (let ((v1-70 (-> arg0 base)))
                  (set! (-> arg0 base) s0-0)
                  (let* ((a0-10 arg0)
                         (a1-3 (the-as dma-packet (-> a0-10 base)))
                         )
                    (set! (-> a1-3 dma) (new 'static 'dma-tag :id (dma-tag-id cnt) :qwc (* 3 s4-0)))
                    (set! (-> a1-3 vif0) (new 'static 'vif-tag))
                    (set! (-> a1-3 vif1)
                          (new 'static 'vif-tag :cmd (vif-cmd unpack-v4-32) :imm (shr (shl (+ (* 3 s5-0) 512) 54) 54) :num (* 3 s4-0))
                          )
                    (set! (-> a0-10 base) (the-as pointer (&+ a1-3 16)))
                    )
                  (set! (-> arg0 base) v1-70)
                  )
                (set! s4-0 0)
                (+! s5-0 85)
                (when (= s5-0 170)
                  (let* ((v1-73 arg0)
                         (a0-11 (the-as dma-packet (-> v1-73 base)))
                         )
                    (set! (-> a0-11 dma) (new 'static 'dma-tag :qwc #x1 :id (dma-tag-id cnt)))
                    (set! (-> a0-11 vif0) (new 'static 'vif-tag))
                    (set! (-> a0-11 vif1) (new 'static 'vif-tag :imm #x1ff :num #x1 :cmd (vif-cmd unpack-v4-32)))
                    (set! (-> v1-73 base) (the-as pointer (&+ a0-11 16)))
                    )
                  (let* ((v1-74 arg0)
                         (a0-13 (the-as vector4w (-> v1-74 base)))
                         )
                    (set! (-> a0-13 x) s5-0)
                    (set! (-> a0-13 y) 0)
                    (set! (-> a0-13 z) 0)
                    (set! (-> a0-13 w) 0)
                    (set! (-> v1-74 base) (the-as pointer (&+ a0-13 16)))
                    )
                  (let* ((v1-75 arg0)
                         (a0-15 (the-as dma-packet (-> v1-75 base)))
                         )
                    (set! (-> a0-15 dma) (new 'static 'dma-tag :id (dma-tag-id cnt)))
                    (set! (-> a0-15 vif0) (new 'static 'vif-tag :cmd (vif-cmd mscalf) :msk #x1))
                    (set! (-> a0-15 vif1) (new 'static 'vif-tag :cmd (vif-cmd flush) :msk #x1))
                    (set! (-> v1-75 base) (the-as pointer (&+ a0-15 16)))
                    )
                  (set! s5-0 0)
                  )
                (set! s0-0 (-> arg0 base))
                (&+! (-> arg0 base) 16)
                )
              )
            )
          (label cfg-22)
          0
          )
        )
      (cond
        ((zero? s4-0)
         (set! (-> arg0 base) s0-0)
         (nop!)
         0
         )
        (else
          (let ((v1-83 (-> arg0 base)))
            (set! (-> arg0 base) s0-0)
            (let* ((a0-17 arg0)
                   (a1-10 (the-as dma-packet (-> a0-17 base)))
                   )
              (set! (-> a1-10 dma) (new 'static 'dma-tag :id (dma-tag-id cnt) :qwc (* 3 s4-0)))
              (set! (-> a1-10 vif0) (new 'static 'vif-tag))
              (set! (-> a1-10 vif1)
                    (new 'static 'vif-tag :cmd (vif-cmd unpack-v4-32) :imm (shr (shl (+ (* 3 s5-0) 512) 54) 54) :num (* 3 s4-0))
                    )
              (set! (-> a0-17 base) (the-as pointer (&+ a1-10 16)))
              )
            (set! (-> arg0 base) v1-83)
            )
          )
        )
      (let ((v1-84 (+ s4-0 s5-0)))
        (when (nonzero? v1-84)
          (let* ((a0-19 arg0)
                 (a1-12 (the-as dma-packet (-> a0-19 base)))
                 )
            (set! (-> a1-12 dma) (new 'static 'dma-tag :qwc #x1 :id (dma-tag-id cnt)))
            (set! (-> a1-12 vif0) (new 'static 'vif-tag))
            (set! (-> a1-12 vif1) (new 'static 'vif-tag :imm #x1ff :num #x1 :cmd (vif-cmd unpack-v4-32)))
            (set! (-> a0-19 base) (the-as pointer (&+ a1-12 16)))
            )
          (let* ((a0-20 arg0)
                 (a1-14 (the-as vector4w (-> a0-20 base)))
                 )
            (set! (-> a1-14 x) v1-84)
            (set! (-> a1-14 y) 0)
            (set! (-> a1-14 z) 0)
            (set! (-> a1-14 w) 0)
            (set! (-> a0-20 base) (the-as pointer (&+ a1-14 16)))
            )
          (let ((v1-86 (the-as dma-packet (-> arg0 base))))
            (set! (-> v1-86 dma) (new 'static 'dma-tag :id (dma-tag-id cnt)))
            (set! (-> v1-86 vif0) (new 'static 'vif-tag :cmd (vif-cmd mscalf) :msk #x1))
            (set! (-> v1-86 vif1) (new 'static 'vif-tag :cmd (vif-cmd flush) :msk #x1))
            (set! (-> arg0 base) (the-as pointer (&+ v1-86 16)))
            )
          )
        )
      )
    0
    (none)
    )
  )
