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

;; name: prim.gc
;; name in dgo: prim
;; dgos: GAME

;; for now, I made the DMA generation mips2c
;; it's probably possible to rewrite in GOAL, or just totally redo.
;; we'll have to see how much is drawn with this.
;; somewhat annoyingly, it seems to resue generic buckets...

;; DECOMP BEGINS

(define *prim-work*
  (new 'static 'prim-work
    :vertex-tmpl (new 'static 'inline-array dma-packet 3
      (new 'static 'dma-packet
        :dma (new 'static 'dma-tag :id (dma-tag-id cnt))
        :vif1 (new 'static 'vif-tag :imm #x9 :cmd (vif-cmd unpack-v4-32))
        )
      (new 'static 'dma-packet
        :dma (new 'static 'dma-tag :id (dma-tag-id cnt))
        :vif1 (new 'static 'vif-tag :imm #x120 :cmd (vif-cmd unpack-v4-32))
        )
      (new 'static 'dma-packet
        :dma (new 'static 'dma-tag :id (dma-tag-id cnt))
        :vif1 (new 'static 'vif-tag :imm #x237 :cmd (vif-cmd unpack-v4-32))
        )
      )
    :control-tmpl (new 'static 'inline-array dma-packet 2
      (new 'static 'dma-packet
        :dma (new 'static 'dma-tag :qwc #xc :id (dma-tag-id cnt))
        :vif1 (new 'static 'vif-tag :imm #x345 :num #xc :cmd (vif-cmd unpack-v4-32))
        )
      (new 'static 'dma-packet
        :dma (new 'static 'dma-tag :qwc #xc :id (dma-tag-id cnt))
        :vif1 (new 'static 'vif-tag :imm #x363 :num #xc :cmd (vif-cmd unpack-v4-32))
        )
      )
    :giftag (new 'static 'generic-gif-tag
      :fan-prim (new 'static 'gif-tag-prim
        :pre #x1
        :prim (new 'static 'gs-prim :prim (gs-prim-type tri-fan) :iip #x1 :tme #x1 :fge #x1 :abe #x1)
        :nreg #x3
        )
      :str-prim (new 'static 'gif-tag-prim
        :pre #x1
        :prim (new 'static 'gs-prim :prim (gs-prim-type tri-strip) :iip #x1 :tme #x1 :fge #x1 :abe #x1)
        :nreg #x3
        )
      :regs (new 'static 'gif-tag-regs-32 :regs0 (gif-reg-id st) :regs1 (gif-reg-id rgbaq) :regs2 (gif-reg-id xyzf2))
      :num-strips #x1
      )
    :call-scissor (new 'static 'dma-packet
      :dma (new 'static 'dma-tag :id (dma-tag-id cnt))
      :vif0 (new 'static 'vif-tag :imm #x6 :cmd (vif-cmd mscalf) :msk #x1)
      )
    :call-noclip (new 'static 'dma-packet
      :dma (new 'static 'dma-tag :id (dma-tag-id cnt))
      :vif0 (new 'static 'vif-tag :imm #x8 :cmd (vif-cmd mscalf) :msk #x1)
      )
    :mask (new 'static 'vector4w :x -2 :y -1 :z -1)
    )
  )

(defmethod reset! ((this prim-work))
  "Reset all pending vertex/control data."
  (dotimes (v1-0 68)
    (let ((a1-2 (-> this sinks v1-0)))
      (set! (-> a1-2 vertex-count) (the-as uint 0))
      (set! (-> a1-2 control-count) (the-as uint 0))
      )
    0
    )
  0
  (none)
  )

(defmethod generate-dma! ((this prim-strip) (arg0 matrix))
  "Generate DMA for prim rendering."
  (local-vars
    (a3-6 uint128)
    (a3-13 uint128)
    (a3-14 uint128)
    (t0-13 uint128)
    (t0-14 uint128)
    (t1-4 uint128)
    (t1-5 uint128)
    (t2-0 uint128)
    (t2-1 uint128)
    )
  (rlet ((vf1 :class vf)
         (vf10 :class vf)
         (vf11 :class vf)
         (vf12 :class vf)
         (vf13 :class vf)
         (vf14 :class vf)
         (vf15 :class vf)
         (vf16 :class vf)
         (vf2 :class vf)
         (vf3 :class vf)
         (vf4 :class vf)
         (vf5 :class vf)
         (vf6 :class vf)
         (vf7 :class vf)
         (vf8 :class vf)
         (vf9 :class vf)
         )
    (let ((v1-5 (-> *display* frames (-> *display* on-screen) global-buf))
          (a0-4 (/ (+ (-> this num-verts) 79) (the-as uint 80)))
          )
      (cond
        ((< (the-as uint (+ (* (the-as uint 144) (-> this num-verts)) (* a0-4 128)))
            (the-as uint (&- (-> v1-5 end) (the-as uint (-> v1-5 base))))
            )
         (let* ((a1-5 (lookup-texture-by-id (-> this tex-id)))
                (s3-0 *prim-work*)
                (s2-0 (-> s3-0 sinks (-> this sink)))
                (s4-0 (-> *display* frames (-> *display* on-screen) global-buf))
                (s5-0 (-> s4-0 base))
                )
           (set! (-> s3-0 in-verts) (the-as int (-> this num-verts)))
           (set! (-> s3-0 vert-ptr) (-> this data))
           (let ((v1-20 (if (logtest? (-> this flags) (prim-flags alpha-blend-enable))
                            1
                            0
                            )
                        )
                 (a0-11 (if (logtest? (-> this flags) (prim-flags texture-enable))
                            1
                            0
                            )
                        )
                 (a2-3 (if (logtest? (-> this flags) (prim-flags fog-enable))
                           1
                           0
                           )
                       )
                 )
             (set! (-> s3-0 giftag fan-prim)
                   (new 'static 'gif-tag-prim
                     :pre #x1
                     :nreg #x3
                     :prim (new 'static 'gs-prim :prim (gs-prim-type tri-fan) :iip #x1 :abe v1-20 :tme a0-11 :fge a2-3)
                     )
                   )
             (set! (-> s3-0 giftag str-prim)
                   (new 'static 'gif-tag-prim
                     :pre #x1
                     :nreg #x3
                     :prim (new 'static 'gs-prim :prim (gs-prim-type tri-strip) :iip #x1 :abe v1-20 :tme a0-11 :fge a2-3)
                     )
                   )
             )
           (when a1-5
             (let ((v1-28 (-> this level)))
               (-> this texture-index)
               (let ((a0-17 (+ (-> this texture-index) 12)))
                 (dotimes (a2-7 3)
                   (let ((a3-5 (-> v1-28 texture-mask a0-17 mask quad))
                         (t0-9 (-> a1-5 masks data a2-7 mask quad))
                         )
                     (.por a3-6 a3-5 t0-9)
                     )
                   (set! (-> v1-28 texture-mask a0-17 mask quad) a3-6)
                   )
                 )
               )
             (adgif-shader<-texture-simple! (-> s3-0 shader) a1-5)
             (set! (-> s3-0 shader clamp) (-> this clamp))
             (set! (-> s3-0 shader clamp-reg) (gs-reg64 clamp-1))
             (set! (-> s3-0 shader alpha) (the-as gs-miptbp (-> this alpha)))
             (set! (-> s3-0 shader reg-4) (gs-reg alpha-1))
             (.lvf vf1 (&-> arg0 rvec quad))
             (.lvf vf2 (&-> arg0 uvec quad))
             (.lvf vf3 (&-> arg0 fvec quad))
             (.lvf vf4 (&-> arg0 trans quad))
             (.lvf vf5 (&-> s3-0 shader quad 0 quad))
             (.lvf vf6 (&-> s3-0 shader quad 1 quad))
             (.lvf vf7 (&-> s3-0 shader quad 2 quad))
             (.lvf vf8 (&-> s3-0 shader quad 3 quad))
             (.lvf vf9 (&-> s3-0 shader quad 4 quad))
             (.lvf vf10 (&-> s3-0 giftag qword quad))
             (.lvf vf11 (&-> this adnops 0 quad))
             (.lvf vf12 (&-> this adnops 1 quad))
             (while (< 2 (-> s3-0 in-verts))
               (set! (-> s3-0 num-verts) (min 80 (-> s3-0 in-verts)))
               (let* ((a0-20 (-> s3-0 control-tmpl (logand (-> s2-0 control-count) 1)))
                      (v1-41 (-> s4-0 base))
                      (a0-21 (-> a0-20 quad))
                      (a1-6 (the-as object (&+ v1-41 16)))
                      (v1-42 (-> s3-0 num-verts))
                      )
                 (set! (-> (the-as (pointer uint128) a1-6) -1) a0-21)
                 (.svf (&-> (the-as (inline-array prim-vertex) a1-6) 0 stq quad) vf1)
                 (.svf (&-> (the-as (inline-array prim-vertex) a1-6) 0 pos quad) vf2)
                 (.svf (&-> (the-as (inline-array prim-vertex) a1-6) 1 stq quad) vf3)
                 (.svf (&-> (the-as (inline-array prim-vertex) a1-6) 1 pos quad) vf4)
                 (.svf (&-> (the-as (inline-array prim-vertex) a1-6) 2 stq quad) vf10)
                 (.svf (&-> (the-as (inline-array prim-vertex) a1-6) 2 pos quad) vf11)
                 (.svf (&-> (the-as (inline-array prim-vertex) a1-6) 3 stq quad) vf12)
                 (set! (-> (the-as (inline-array prim-vertex) a1-6) 2 pos w) (the-as float v1-42))
                 (.svf (&-> (the-as (inline-array prim-vertex) a1-6) 3 pos quad) vf5)
                 (.svf (&-> (the-as (inline-array prim-vertex) a1-6) 4 stq quad) vf6)
                 (.svf (&-> (the-as (inline-array prim-vertex) a1-6) 4 pos quad) vf7)
                 (.svf (&-> (the-as (inline-array prim-vertex) a1-6) 5 stq quad) vf8)
                 (.svf (&-> (the-as (inline-array prim-vertex) a1-6) 5 pos quad) vf9)
                 (set! (-> (the-as (inline-array prim-vertex) a1-6) 4 col) (the-as rgba (logior v1-42 #x8000)))
                 (set! (-> s4-0 base) (the-as pointer (-> (the-as (inline-array prim-vertex) a1-6) 6)))
                 (let ((a0-28 (-> s3-0 vertex-tmpl (mod (-> s2-0 vertex-count) (the-as uint 3)))))
                   (let ((a1-9 (* 3 v1-42)))
                     (set! (-> a0-28 dma qwc) a1-9)
                     (set! (-> a0-28 vif1 num) a1-9)
                     )
                   (let ((a2-13 (the-as object (-> s4-0 base)))
                         (a3-11 (-> a0-28 quad))
                         (a0-29 (-> s3-0 mask quad))
                         (a1-13 (-> s3-0 vert-ptr))
                         )
                     (nop!)
                     (set! (-> (the-as (inline-array prim-vertex) a2-13) 0 stq quad) a3-11)
                     (let ((a2-14 (the-as (object object) (-> (the-as (inline-array prim-vertex) a2-13) 0 pos))))
                       (set! (-> s4-0 base) (the-as pointer a2-14))
                       (nop!)
                       (label cfg-16)
                       (nop!)
                       (let ((t0-12 (the-as uint128 (-> a1-13 0 stq w))))
                         (nop!)
                         (let ((a3-12 (the-as uint128 (-> a1-13 1 stq w))))
                           (.pextlb t0-13 0 t0-12)
                           (.lvf vf15 (&-> a1-13 0 stq quad))
                           (.pextlh t0-14 0 t0-13)
                           (.lvf vf16 (&-> a1-13 1 stq quad))
                           (.pextlb a3-13 0 a3-12)
                           )
                         )
                       (.lvf vf13 (&-> a1-13 0 pos quad))
                       (.pextlh a3-14 0 a3-13)
                       (.lvf vf14 (&-> a1-13 1 pos quad))
                       (vftoi12.xyzw vf15 vf15)
                       (set! (-> (the-as (inline-array prim-vertex) a2-14) 0 pos quad) t0-14)
                       (vftoi12.xyzw vf16 vf16)
                       (set! (-> (the-as (inline-array prim-vertex) a2-14) 2 stq quad) a3-14)
                       (nop!)
                       (let ((t0-15 (the-as number (-> a1-13 0 stq z))))
                         (nop!)
                         (let ((a3-15 (the-as number (-> a1-13 1 stq z))))
                           (set! a1-13 (the-as (inline-array prim-vertex) (-> a1-13 2)))
                           (.mov t2-0 vf15)
                           (+! v1-42 -2)
                           (.mov t1-4 vf16)
                           (.pand t2-1 t2-0 a0-29)
                           (.svf (&-> (the-as (inline-array prim-vertex) a2-14) 1 stq quad) vf13)
                           (.pand t1-5 t1-4 a0-29)
                           (.svf (&-> (the-as (inline-array prim-vertex) a2-14) 2 pos quad) vf14)
                           (let ((t0-16 (logior (the-as int t2-1) (the-as int t0-15))))
                             (nop!)
                             (let ((a3-16 (logior (the-as int t1-5) (the-as int a3-15))))
                               (nop!)
                               (set! (-> (the-as (inline-array prim-vertex) a2-14) 0 stq quad) (the-as uint128 t0-16))
                               (set! a2-14 (the-as (object object) (-> (the-as (inline-array prim-vertex) a2-14) 3)))
                               (b! (> v1-42 0) cfg-16 :delay (set! (-> (the-as (pointer uint128) a2-14) -3) (the-as uint128 a3-16)))
                               )
                             )
                           )
                         )
                       )
                     )
                   )
                 )
               (&+! (-> s4-0 base) (* 48 (-> s3-0 num-verts)))
               (set! (-> (the-as (pointer uint128) (-> s4-0 base))) (-> s3-0 call-scissor quad))
               (&+! (-> s4-0 base) 16)
               (+! (-> s3-0 in-verts) -78)
               (set! (-> s3-0 vert-ptr) (the-as (inline-array prim-vertex) (-> s3-0 vert-ptr 78)))
               (+! (-> s2-0 vertex-count) 1)
               (+! (-> s2-0 control-count) 1)
               )
             )
           (when (not (paused?))
             (when (logtest? (-> this flags) (prim-flags pf3))
               (when (not (logtest? (-> this flags) (prim-flags pf4)))
                 (set! (-> this num-verts) (the-as uint 0))
                 0
                 )
               (logclear! (-> this flags) (prim-flags pf4))
               )
             )
           (let ((a3-17 (-> s4-0 base)))
             (when (!= s5-0 a3-17)
               (let ((v1-69 (the-as object (-> s4-0 base))))
                 (set! (-> (the-as dma-packet v1-69) dma) (new 'static 'dma-tag :id (dma-tag-id next)))
                 (set! (-> (the-as dma-packet v1-69) vif0) (new 'static 'vif-tag))
                 (set! (-> (the-as dma-packet v1-69) vif1) (new 'static 'vif-tag))
                 (set! (-> s4-0 base) (&+ (the-as pointer v1-69) 16))
                 )
               (dma-bucket-insert-tag
                 (-> *display* frames (-> *display* on-screen) bucket-group)
                 (-> this bucket)
                 s5-0
                 (the-as (pointer dma-tag) a3-17)
                 )
               )
             )
           )
         )
        (else
          (format *stdcon* "Out of DMA buffer for prim rendering~%")
          )
        )
      )
    0
    (none)
    )
  )

(defmethod setup-dma-and-tex ((this prim-strip) (arg0 draw-control))
  "Set up the bucket, prim sink, and texture."
  (let ((s5-0 (-> *level* level (-> arg0 level-index))))
    (let ((s2-0 (-> s5-0 draw-index))
          (s4-0 (-> arg0 default-texture-page))
          )
      (let ((s3-0 (vu1-bucket-map s2-0 (the-as int s4-0) (merc-mode mercneric2)))
            (v1-3 (vu1-bucket-map s2-0 (the-as int s4-0) (merc-mode mm5)))
            )
        (set! (-> this bucket) s3-0)
        (set! (-> this sink) (the-as uint v1-3))
        )
      (set! (-> this level) s5-0)
      (set! (-> this texture-index) s4-0)
      )
    (when (not (logtest? (-> this flags) (prim-flags no-texture-name)))
      (set! (-> this tex-id)
            (lookup-level-texture-id-by-name (the-as string (-> this tex-name)) s5-0 (the-as int (-> this texture-index)))
            )
      (logior! (-> this flags) (prim-flags no-texture-name))
      )
    )
  0
  (none)
  )

(defun prim-engine-execute ()
  "Generate all prim DMA."
  (when (logtest? (-> *display* vu1-enable-user) (vu1-renderer-mask generic))
    (when (not (get-menu-mode *blit-displays-work*))
      (let* ((gp-0 *prim-engine*)
             (s5-0 (-> *math-camera* camera-temp))
             (v1-9 (-> gp-0 alive-list next0))
             (s4-0 (-> (the-as connection v1-9) next0))
             )
        (while (!= v1-9 (-> gp-0 alive-list-end))
          (-> (the-as connection v1-9) param1)
          (generate-dma! (the-as prim-strip (-> (the-as connection v1-9) param2)) s5-0)
          (set! v1-9 s4-0)
          (set! s4-0 (-> s4-0 next0))
          )
        )
      )
    )
  0
  (none)
  )