;;-*-Lisp-*-
(in-package goal)
(bundles "ENGINE.CGO" "GAME.CGO")
(require "engine/gfx/sprite/sprite.gc")
(require "engine/gfx/math-camera.gc")

;; The sprite-distort is a VU1 renderer.
;; It likely does some of the effects with sprites.

;; DECOMP BEGINS

;; Scratch information used by the sprite-distorter.
(deftype sprite-distorter-sine-tables (basic)
  ((aspx   float)
   (aspy   float)
   (entry  vector 128 :inline)
   (ientry qword 9 :inline)
   (giftag gs-gif-tag :inline)
   (color  qword :inline)))

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

(defun sprite-distorter-generate-tables ()
  "Regenerate sprite-distorter tables.  This should be done whenever the aspect ratio changes"
  (let ((tables *sprite-distorter-sine-tables*))
    (let ((entry-index 0)
          (ientry-index 0)
          (iterations 3)
          ;; get camera aspect
          (cam-aspx (- (-> *math-camera* perspective vector 0 x)))
          (cam-aspy (- (-> *math-camera* perspective vector 1 y))))
      ;; regenerate if aspect ratio changed
      ;; og:preserve-this Fix intermittent crash on start up due to a race with the DMA
      (when #t
        (set! (-> tables aspx) cam-aspx)
        (set! (-> tables aspy) cam-aspy)
        (while (< iterations 12)
          ;; set ientry
          (set! (-> tables ientry ientry-index vector4w x) (+ entry-index 352)) ;; 352 = tables.entry in VU
          (+! ientry-index 1)
          ;; set entries
          (dotimes (i iterations)
            (let ((f26-0 (* 65536.0 (/ (the float i) (the float iterations)))))
              (set-vector! (-> tables entry entry-index) (* (sin f26-0) cam-aspx) (* (cos f26-0) cam-aspy) 0.0 0.0)
              (let ((s3-1 (+ entry-index 1)))
                (set-vector! (-> tables entry s3-1) (* 0.001953125 cam-aspx (sin f26-0)) (* 0.00390625 cam-aspy (cos f26-0)) 0.0 0.0)
                (set! entry-index (+ s3-1 1)))))
          (+! iterations 1))
        ;; final entry pair
        (set-vector! (-> tables entry entry-index) 0.0 cam-aspy 0.0 0.0)
        (let ((v1-17 (+ entry-index 1)))
          (set-vector! (-> tables entry v1-17) 0.0 (* 0.00390625 cam-aspy) 0.0 0.0)
          (+ v1-17 1) ;; ?
          )))
    ;; set up giftag
    (set! (-> tables 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 up registers
    (set! (-> tables 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 color
    (set! (-> tables color vector4w x) 128)
    (set! (-> tables color vector4w y) 128)
    (set! (-> tables color vector4w z) 128)
    (set! (-> tables color vector4w w) 128))
  0
  (none))

;; we need to at least put something here so dma-buffer-add-vu-function doesn't crash.
(define sprite-distort-vu1-block (new 'static 'vu-function))

(defun sprite-init-distorter ((dma-buff dma-buffer) (frame-base-pointer uint))
  "Set up DMA for setting up the sprite-distorter renderer"
  ;;(format #t "distorter: ~d~%" (-> *sprite-aux-list* entry))
  ;; set up GS registers
  (dma-buffer-add-gs-set dma-buff
                         ;; dont update zbuffer
                         (zbuf-1 (new 'static 'gs-zbuf :zbp #x1c0 :psm (gs-psm ct24) :zmsk 1))
                         ;; use framebuffer as texture
                         (tex0-1 (new 'static 'gs-tex0 :tbw #x8 :tw #x9 :th #x8 :tbp0 (* frame-base-pointer 32)))
                         ;; bilinear filtering
                         (tex1-1 (new 'static 'gs-tex1 :mmag 1 :mmin 1))
                         ;; mipmapping
                         (miptbp1-1 (new 'static 'gs-miptbp))
                         ;; set texture wrap mode to clamp
                         (clamp-1 (new 'static
                                       'gs-clamp
                                       :wms (gs-tex-wrap-mode region-clamp)
                                       :wmt (gs-tex-wrap-mode region-clamp)
                                       :maxu #x1ff
                                       :maxv (-> *video-parms* screen-masky)))
                         ;; blend source and framebuffer RGB
                         (alpha-1 (new 'static 'gs-alpha :b 1 :d 1)))
  ;; send current aspect used by the sine tables (PC only)
  (#when PC_PORT
    (let ((packet (the-as dma-packet (-> dma-buff 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)))
      (&+! (-> dma-buff base) 16))
    (let ((aspect-vec (the-as vector (-> dma-buff base))))
      (set-vector! aspect-vec (-> *sprite-distorter-sine-tables* aspx) (-> *sprite-distorter-sine-tables* aspy) 0.0 0.0)
      (&+! (-> dma-buff base) 16)))
  ;; send distorter sine tables
  (dma-buffer-add-ref-vif2 dma-buff
                           #x8b
                           (-> *sprite-distorter-sine-tables* entry)
                           (new 'static 'vif-tag :imm #x404 :cmd (vif-cmd stcycl))
                           (new 'static 'vif-tag :imm #x160 :num #x8b :cmd (vif-cmd unpack-v4-32)))
  ;; load VU1 code
  (dma-buffer-add-vu-function dma-buff sprite-distort-vu1-block 1)
  0
  (none))

(defun sprite-draw-distorters ((arg0 dma-buffer))
  "Set up DMA for the sprite-distorter renderer"
  (local-vars (v1-25 int) (sv-16 sprite-vec-data-2d) (sv-32 pointer) (sv-48 pointer))
  (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)
          (set! sv-16 (-> s3-0 data s1-0))
          (let ((a0-1 (the-as object (-> arg0 base))))
            (set! sv-32 (&+ (the-as pointer a0-1) 16))
            (set! sv-48 (&+ (the-as pointer a0-1) 32))
            (cond
              ((= (-> sv-16 matrix) 1)
               (.lvf vf3 (&-> *math-camera* sprite-2d vector 0 quad))
               (.lvf vf4 (&-> *math-camera* sprite-2d vector 1 quad))
               (.lvf vf5 (&-> *math-camera* sprite-2d vector 2 quad))
               (.lvf vf6 (&-> *math-camera* sprite-2d vector 3 quad))
               (.lvf vf9 (&-> *math-camera* sprite-2d-hvdf quad)))
              (else
               (.lvf vf3 (&-> *math-camera* camera-temp vector 0 quad))
               (.lvf vf4 (&-> *math-camera* camera-temp vector 1 quad))
               (.lvf vf5 (&-> *math-camera* camera-temp vector 2 quad))
               (.lvf vf6 (&-> *math-camera* camera-temp vector 3 quad))
               (.lvf vf9 (&-> *math-camera* hvdf-off quad))))
            (.lvf vf1 (&-> sv-16 x-y-z-sx quad))
            (.lvf vf2 (&-> sv-16 color 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)
            (b! (zero? (-> sv-16 flag)) cfg-21)
            (.wait.vf)
            (.mul.vf.xyz vf1 vf1 Q)
            (.mul.vf.xyz vf2 vf2 Q)
            ;;(.cfc2.i v1-25 Clipping)
            (set! v1-25 (vu-clip vf10 0)) ;; safe to just drop the higher bits.
            (b! (logtest? v1-25 63) cfg-21 :delay (.add.vf vf1 vf1 vf9))
            (.max.x.vf.w vf1 vf1 vf0)
            (.svf (&-> (the-as vector a0-1) quad) vf1)
            (.svf (&-> (the-as vector sv-48) quad) vf2)
            (set! (-> (the-as vector a0-1) w) 255.0)
            (set! (-> (the-as (pointer float) sv-32)) (* 0.001953125 (+ -1792.0 (-> (the-as vector a0-1) x))))
            (set! (-> (the-as vector sv-32) y)
                  (* 0.00390625 (+ -2048.0 (the float (-> *video-parms* screen-hy)) (-> (the-as vector a0-1) y)))))
          (set! (-> (the-as vector sv-32) z) 1.0)
          (when (or (< (-> sv-16 flag) 3) (< 11 (-> sv-16 flag)))
            (format 0 "Turns = ~D!!!~%" (-> sv-16 flag))
            (set! (-> (the-as (pointer int32) sv-16) 4) 11))
          (set! (-> (the-as (pointer int32) sv-32) 3) (-> sv-16 flag))
          (let* ((f0-7 (- (-> *math-camera* perspective vector 1 y)))
                 (f2-4 (-> (the-as vector sv-32) y))
                 (f4-0 (+ f2-4 (* (-> (the-as (pointer float) sv-48)) f0-7)))
                 (f3-0 256.0)
                 (f1-7 (-> (the-as (pointer float) sv-48))))
            (if (< (the float (-> *video-parms* screen-sy)) f4-0)
              (set! f3-0 (/ (- (the float (-> *video-parms* screen-sy)) f2-4) f0-7)))
            (if (< 128.0 f3-0) (set! f3-0 128.0))
            (when (< f3-0 f1-7)
              (let ((v1-55 (/ f3-0 f1-7))) (.mov vf1 v1-55))
              (.mul.x.vf vf2 vf2 vf1)
              (.svf (&-> (the-as vector sv-48) quad) vf2)))
          (&+! (-> arg0 base) 48)
          (+! s4-0 1)
          (when (= s4-0 85)
            (let ((v1-62 (-> arg0 base)))
              (set! (-> arg0 base) s0-0)
              (let* ((a0-8 arg0)
                     (a1-3 (the-as object (-> a0-8 base))))
                (set! (-> (the-as dma-packet a1-3) dma) (new 'static 'dma-tag :id (dma-tag-id cnt) :qwc (* 3 s4-0)))
                (set! (-> (the-as dma-packet a1-3) vif0) (new 'static 'vif-tag))
                (set! (-> (the-as dma-packet 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-8 base) (&+ (the-as pointer a1-3) 16)))
              (set! (-> arg0 base) v1-62))
            (set! s4-0 0)
            (+! s5-0 85)
            (when (= s5-0 170)
              (let* ((v1-65 arg0)
                     (a0-9 (the-as object (-> v1-65 base))))
                (set! (-> (the-as dma-packet a0-9) dma) (new 'static 'dma-tag :qwc #x1 :id (dma-tag-id cnt)))
                (set! (-> (the-as dma-packet a0-9) vif0) (new 'static 'vif-tag))
                (set! (-> (the-as dma-packet a0-9) vif1) (new 'static 'vif-tag :imm #x1ff :num #x1 :cmd (vif-cmd unpack-v4-32)))
                (set! (-> v1-65 base) (&+ (the-as pointer a0-9) 16)))
              (let* ((v1-66 arg0)
                     (a0-11 (the-as object (-> v1-66 base))))
                (set! (-> (the-as vector4w a0-11) x) s5-0)
                (set! (-> (the-as vector4w a0-11) y) 0)
                (set! (-> (the-as vector4w a0-11) z) 0)
                (set! (-> (the-as vector4w a0-11) w) 0)
                (set! (-> v1-66 base) (&+ (the-as pointer a0-11) 16)))
              (let* ((v1-67 arg0)
                     (a0-13 (the-as object (-> v1-67 base))))
                (set! (-> (the-as dma-packet a0-13) dma) (new 'static 'dma-tag :id (dma-tag-id cnt)))
                (set! (-> (the-as dma-packet a0-13) vif0) (new 'static 'vif-tag :cmd (vif-cmd mscalf) :msk #x1))
                (set! (-> (the-as dma-packet a0-13) vif1) (new 'static 'vif-tag :cmd (vif-cmd flush) :msk #x1))
                (set! (-> v1-67 base) (&+ (the-as pointer a0-13) 16)))
              (set! s5-0 0))
            (set! s0-0 (-> arg0 base))
            (&+! (-> arg0 base) 16))
          (label cfg-21)))
      (cond
        ((zero? s4-0) (set! (-> arg0 base) s0-0) (nop!) 0)
        (else
         (let ((v1-74 (-> arg0 base)))
           (set! (-> arg0 base) s0-0)
           (let* ((a0-15 arg0)
                  (a1-10 (the-as object (-> a0-15 base))))
             (set! (-> (the-as dma-packet a1-10) dma) (new 'static 'dma-tag :id (dma-tag-id cnt) :qwc (* 3 s4-0)))
             (set! (-> (the-as dma-packet a1-10) vif0) (new 'static 'vif-tag))
             (set! (-> (the-as dma-packet 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-15 base) (&+ (the-as pointer a1-10) 16)))
           (set! (-> arg0 base) v1-74))))
      (let ((v1-75 (+ s4-0 s5-0)))
        (when (nonzero? v1-75)
          (let* ((a0-17 arg0)
                 (a1-12 (the-as object (-> a0-17 base))))
            (set! (-> (the-as dma-packet a1-12) dma) (new 'static 'dma-tag :qwc #x1 :id (dma-tag-id cnt)))
            (set! (-> (the-as dma-packet a1-12) vif0) (new 'static 'vif-tag))
            (set! (-> (the-as dma-packet a1-12) vif1) (new 'static 'vif-tag :imm #x1ff :num #x1 :cmd (vif-cmd unpack-v4-32)))
            (set! (-> a0-17 base) (&+ (the-as pointer a1-12) 16)))
          (let* ((a0-18 arg0)
                 (a1-14 (the-as object (-> a0-18 base))))
            (set! (-> (the-as vector4w a1-14) x) v1-75)
            (set! (-> (the-as vector4w a1-14) y) 0)
            (set! (-> (the-as vector4w a1-14) z) 0)
            (set! (-> (the-as vector4w a1-14) w) 0)
            (set! (-> a0-18 base) (&+ (the-as pointer a1-14) 16)))
          (let ((v1-77 (the-as object (-> arg0 base))))
            (set! (-> (the-as dma-packet v1-77) dma) (new 'static 'dma-tag :id (dma-tag-id cnt)))
            (set! (-> (the-as dma-packet v1-77) vif0) (new 'static 'vif-tag :cmd (vif-cmd mscalf) :msk #x1))
            (set! (-> (the-as dma-packet v1-77) vif1) (new 'static 'vif-tag :cmd (vif-cmd flush) :msk #x1))
            (set! (-> arg0 base) (&+ (the-as pointer v1-77) 16))))))
    0
    (none)))

;; og:preserve-this Fix intermittent crash on start up due to a race with the DMA
(sprite-distorter-generate-tables)
