jak-project/goal_src/jak3/engine/gfx/hw/gs.gc

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

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

;; +++gs-psm
(defenum gs-psm
  :bitfield #f
  :type uint8
  (ct32 0)
  (ct24 1)
  (ct16 2)
  (ct16s 10)
  (mt8 19)
  (mt4 20)
  (mt8h 27)
  (mt4hl 36)
  (mt4hh 44)
  (mz32 48)
  (mz24 49)
  (mz16 50)
  (mz16s 58)
  )
;; ---gs-psm


;; +++gs-reg
(defenum gs-reg
  :type uint8
  (prim 0)
  (rgbaq 1)
  (st 2)
  (uv 3)
  (xyzf2 4)
  (xyz2 5)
  (tex0-1 6)
  (tex0-2 7)
  (clamp-1 8)
  (clamp-2 9)
  (fog 10)
  (xyzf3 12)
  (xyz3 13)
  (tex1-1 20)
  (tex1-2 21)
  (tex2-1 22)
  (tex2-2 23)
  (xyoffset-1 24)
  (xyoffset-2 25)
  (prmodecont 26)
  (prmode 27)
  (texclut 28)
  (scanmsk 34)
  (miptbp1-1 52)
  (miptbp1-2 53)
  (miptbp2-1 54)
  (miptbp2-2 55)
  (texa 59)
  (fogcol 61)
  (texflush 63)
  (scissor-1 64)
  (scissor-2 65)
  (alpha-1 66)
  (alpha-2 67)
  (dimx 68)
  (dthe 69)
  (colclamp 70)
  (test-1 71)
  (test-2 72)
  (pabe 73)
  (fba-1 74)
  (fba-2 75)
  (frame-1 76)
  (frame-2 77)
  (zbuf-1 78)
  (zbuf-2 79)
  (bitbltbuf 80)
  (trxpos 81)
  (trxreg 82)
  (trxdir 83)
  (hwreg 84)
  (signal 96)
  (finish 97)
  (label 98)
  (hack 127)
  )
;; ---gs-reg


;; +++gs-reg64
(defenum gs-reg64
  :type uint64
  :copy-entries gs-reg
  )
;; ---gs-reg64


;; +++gs-reg32
(defenum gs-reg32
  :type uint32
  :copy-entries gs-reg
  )
;; ---gs-reg32


;; +++gs-prim-type
(defenum gs-prim-type
  :type uint8
  (point 0)
  (line 1)
  (line-strip 2)
  (tri 3)
  (tri-strip 4)
  (tri-fan 5)
  (sprite 6)
  )
;; ---gs-prim-type


;; +++gs-atest
(defenum gs-atest
  :type uint8
  (never 0)
  (always 1)
  (less 2)
  (less-equal 3)
  (equal 4)
  (greater-equal 5)
  (greater 6)
  (not-equal 7)
  )
;; ---gs-atest


;; +++gs-ztest
(defenum gs-ztest
  :type uint8
  (never 0)
  (always 1)
  (greater-equal 2)
  (greater 3)
  )
;; ---gs-ztest


;; +++gs-tex-wrap-mode
(defenum gs-tex-wrap-mode
  :type uint8
  (repeat 0)
  (clamp 1)
  (region-clamp 2)
  (region-repeat 3)
  )
;; ---gs-tex-wrap-mode


;; +++gif-flag
(defenum gif-flag
  :type uint8
  (packed 0)
  (reg-list 1)
  (image 2)
  (disable 3)
  )
;; ---gif-flag


;; +++gif-reg-id
(defenum gif-reg-id
  :type uint8
  (prim 0)
  (rgbaq 1)
  (st 2)
  (uv 3)
  (xyzf2 4)
  (xyz2 5)
  (tex0-1 6)
  (tex0-2 7)
  (clamp-1 8)
  (clamp-2 9)
  (fog 10)
  (xyzf3 12)
  (xyz3 13)
  (a+d 14)
  (nop 15)
  )
;; ---gif-reg-id

(defconstant GIF_REGS_ALL_AD
  (new 'static 'gif-tag-regs
       :regs0 (gif-reg-id a+d)
       :regs1 (gif-reg-id a+d)
       :regs2 (gif-reg-id a+d)
       :regs3 (gif-reg-id a+d)
       :regs4 (gif-reg-id a+d)
       :regs5 (gif-reg-id a+d)
       :regs6 (gif-reg-id a+d)
       :regs7 (gif-reg-id a+d)
       :regs8 (gif-reg-id a+d)
       :regs9 (gif-reg-id a+d)
       :regs10 (gif-reg-id a+d)
       :regs11 (gif-reg-id a+d)
       :regs12 (gif-reg-id a+d)
       :regs13 (gif-reg-id a+d)
       :regs14 (gif-reg-id a+d)
       :regs15 (gif-reg-id a+d)
       )
  )

;; DECOMP BEGINS

(deftype gs-pmode (uint64)
  ((en1   uint8 :offset   0 :size   1)
   (en2   uint8 :offset   1 :size   1)
   (crtmd uint8 :offset   2 :size   3)
   (mmod  uint8 :offset   5 :size   1)
   (amod  uint8 :offset   6 :size   1)
   (slbg  uint8 :offset   7 :size   1)
   (alp   uint8 :offset   8 :size   8)
   )
  )

(deftype gs-smode2 (uint64)
  ((int  uint8 :offset   0 :size   1)
   (ffmd uint8 :offset   1 :size   1)
   (dpms uint8 :offset   2 :size   2)
   )
  )

(defun psm-size ((arg0 gs-psm))
  "Convert texture format to some type of size."
  (cond
    ((= arg0 (gs-psm mt8))
     64
     )
    ((= arg0 (gs-psm mt4))
     32
     )
    ((or (= arg0 (gs-psm ct16)) (= arg0 (gs-psm ct16s)) (= arg0 (gs-psm mz16)) (= arg0 (gs-psm mz16s)))
     128
     )
    (else
      256
      )
    )
  )

(defun psm-page-height ((arg0 gs-psm))
  "Convert texture format to some type of page height."
  (cond
    ((= arg0 (gs-psm mt8))
     64
     )
    ((= arg0 (gs-psm mt4))
     128
     )
    ((or (= arg0 (gs-psm ct16)) (= arg0 (gs-psm ct16s)) (= arg0 (gs-psm mz16)) (= arg0 (gs-psm mz16s)))
     64
     )
    (else
      32
      )
    )
  )

(defun psm->string ((arg0 gs-psm))
  "Get the name of a texture format."
  (case arg0
    (((gs-psm ct24))
     "ct24"
     )
    (((gs-psm mt4))
     "mt4"
     )
    (((gs-psm ct32))
     "ct32"
     )
    (((gs-psm mz16s))
     "mz16s"
     )
    (((gs-psm ct16s))
     "ct16s"
     )
    (((gs-psm mt8))
     "mt8"
     )
    (((gs-psm mt8h))
     "mt8h"
     )
    (((gs-psm mz16))
     "mz16"
     )
    (((gs-psm mz24))
     "mz24"
     )
    (((gs-psm mt4hh))
     "mt4hh"
     )
    (((gs-psm ct16))
     "ct16"
     )
    (((gs-psm mt4hl))
     "mt4hl"
     )
    (((gs-psm mz32))
     "mz32"
     )
    (else
      "*unknown*"
      )
    )
  )

(deftype gs-display-fb (uint64)
  ((fbp uint16 :offset   0 :size   9)
   (fbw uint8  :offset   9 :size   6)
   (psm gs-psm :offset  15 :size   5)
   (dbx uint16 :offset  32 :size  11)
   (dby uint16 :offset  43 :size  11)
   )
  )

(deftype gs-display (uint64)
  "the GS's DISPLAY registers make settings for the display position on the screen regarding
information on Rectangular Area Read Output Circuit n for the PCRTC.
write-only"
  ((dx   uint16 :offset   0 :size  12)
   (dy   uint16 :offset  12 :size  11)
   (magh uint8  :offset  23 :size   4)
   (magv uint8  :offset  27 :size   2)
   (dw   uint16 :offset  32 :size  12)
   (dh   uint16 :offset  44 :size  11)
   )
  )

(deftype gs-bgcolor (uint64)
  "The GS's BGCOLOR register sets the background color of the PCRTC with RGB value.
write-only"
  ((r uint8 :offset   0 :size   8)
   (g uint8 :offset   8 :size   8)
   (b uint8 :offset  16 :size   8)
   )
  )

(deftype gs-csr (uint64)
  "The GS's CSR register sets and obtains various GS statuses.
read-write. The fields have different effects depending on whether they're being read from
or written to.

Bits 5 and 6 (0x20 and 0x40) should be zero."
  ((signal uint8 :offset   0 :size   1)
   (finish uint8 :offset   1 :size   1)
   (hsint  uint8 :offset   2 :size   1)
   (vsint  uint8 :offset   3 :size   1)
   (edwint uint8 :offset   4 :size   1)
   (flush  uint8 :offset   8 :size   1)
   (reset  uint8 :offset   9 :size   1)
   (nfield uint8 :offset  12 :size   1)
   (field  uint8 :offset  13 :size   1)
   (fifo   uint8 :offset  14 :size   2)
   (rev    uint8 :offset  16 :size   8)
   (id     uint8 :offset  24 :size   8)
   )
  )

(deftype gs-bank (structure)
  "Memory layout of the GS's privileged registers (mapped to EE memory).
It is missing the SIGLBLID/LABELID register at 4224 (useless anyway?)"
  ((pmode     gs-pmode)
   (smode2    gs-smode2      :offset  32)
   (dspfb1    gs-display-fb  :offset 112)
   (display1  gs-display     :offset 128)
   (dspfb2    gs-display-fb  :offset 144)
   (display2  gs-display     :offset 160)
   (extbuf    uint64         :offset 176)
   (extdata   uint64         :offset 192)
   (extwrite  uint64         :offset 208)
   (bgcolor   gs-bgcolor     :offset 224)
   (csr       gs-csr         :offset 4096)
   (imr       uint64         :offset 4112)
   (busdir    uint64         :offset 4160)
   )
  )


(deftype gs-frame (uint64)
  ((fbp   uint16 :offset   0 :size   9)
   (fbw   uint8  :offset  16 :size   6)
   (psm   gs-psm :offset  24 :size   6)
   (fbmsk uint32 :offset  32 :size  32)
   )
  )

(deftype gs-zbuf (uint64)
  "The GS's ZBUF registers make various settings regarding Z buffer."
  ((zbp  uint16 :offset   0 :size   9)
   (psm  gs-psm :offset  24 :size   4)
   (zmsk uint8  :offset  32 :size   1)
   )
  )

(deftype gs-xy-offset (uint64)
  "The GS's XYOFFSET registers set the offset value for converting from the primitive coordinate
system to the window coordinate system."
  ((ofx uint16 :offset   0 :size  16)
   (ofy uint16 :offset  32 :size  16)
   )
  )

(deftype gs-scissor (uint64)
  "The GS's SCISSOR registers specify the scissoring area. The coordinate values for
the upper-left/lower-right points of the enabled drawing area are specified by the window
coordinate system."
  ((scax0 uint16 :offset   0 :size  11)
   (scax1 uint16 :offset  16 :size  11)
   (scay0 uint16 :offset  32 :size  11)
   (scay1 uint16 :offset  48 :size  11)
   )
  )

(deftype gs-prmode-cont (uint64)
  "The GS's PRMODECONT register sets whether to use primitive attributes (IIP, TME, FGE, ABE,
AA1, FST, CTXT, FIX) specified by the PRMODE register or the PRIM register."
  ((ac uint8 :offset   0 :size   1)
   )
  )

(deftype gs-color-clamp (uint64)
  "The GS's COLCLAMP register stores settings as to whether clamping for the RGB value of the
pixel is performed."
  ((clamp uint8 :offset   0 :size   1)
   )
  )

(deftype gs-dthe (uint64)
  "The GS's DTHE register stores settings for dithering (performed/not performed)."
  ((dthe uint8 :offset   0 :size   1)
   )
  )

(deftype gs-test (uint64)
  "The GS's TEST register performs settings related to the pixel test."
  ((ate   uint8    :offset   0 :size   1)
   (atst  gs-atest :offset   1 :size   3)
   (aref  uint8    :offset   4 :size   8)
   (afail uint8    :offset  12 :size   2)
   (date  uint8    :offset  14 :size   1)
   (datm  uint8    :offset  15 :size   1)
   (zte   uint8    :offset  16 :size   1)
   (ztst  gs-ztest :offset  17 :size   2)
   )
  )

(deftype gs-prim (uint64)
  ((prim gs-prim-type :offset   0 :size   3)
   (iip  uint8        :offset   3 :size   1)
   (tme  uint8        :offset   4 :size   1)
   (fge  uint8        :offset   5 :size   1)
   (abe  uint8        :offset   6 :size   1)
   (aa1  uint8        :offset   7 :size   1)
   (fst  uint8        :offset   8 :size   1)
   (ctxt uint8        :offset   9 :size   1)
   (fix  uint8        :offset  10 :size   1)
   )
  )

(deftype gs-rgbaq (uint64)
  "The GS's RGBAQ register sets the RGBA value of the vertex and the Q value of the normalized
texture coordinates."
  ((r uint8 :offset   0 :size   8)
   (g uint8 :offset   8 :size   8)
   (b uint8 :offset  16 :size   8)
   (a uint8 :offset  24 :size   8)
   (q float :offset  32 :size  32)
   )
  )

(deftype gs-xyz (uint64)
  ((x uint16 :offset   0 :size  16)
   (y uint16 :offset  16 :size  16)
   (z uint32 :offset  32 :size  32)
   )
  )

(deftype gs-uv (uint64)
  "The GS's UV register specifies the texel coordinate (UV) values of the vertex."
  ((u uint16 :offset   0 :size  16)
   (v uint16 :offset  16 :size  16)
   )
  )

(deftype gs-st (uint64)
  "The GS's ST register sets the S and T values of the vertex texture coordinates.
The value Q is specified by the RGBAQ register."
  ((s float :offset   0 :size  32)
   (t float :offset  32 :size  32)
   )
  )

(deftype gs-xyzf (uint64)
  ((x uint16 :offset   0 :size  16)
   (y uint16 :offset  16 :size  16)
   (z uint32 :offset  32 :size  24)
   (f uint8  :offset  56 :size   8)
   )
  )

(deftype gs-adcmd (structure)
  ((word  uint32    4)
   (quad  uint128   :overlay-at (-> word 0))
   (data  uint64    :overlay-at (-> word 0))
   (cmds  gs-reg64  :overlay-at (-> word 2))
   (cmd   uint8     :overlay-at (-> word 2))
   (x     uint32    :overlay-at (-> word 0))
   (y     uint32    :overlay-at (-> word 1))
   (z     uint32    :overlay-at (-> word 2))
   (w     uint32    :overlay-at (-> word 3))
   )
  )


(deftype gs-trxpos (uint64)
  "The GS's TRXPOS register specifies the position and
scanning direction of the rectangular area
in each buffer where buffer transmission is performed."
  ((ssax uint16 :offset   0 :size  11)
   (ssay uint16 :offset  16 :size  11)
   (dsax uint16 :offset  32 :size  11)
   (dsay uint16 :offset  48 :size  11)
   (dir  uint8  :offset  59 :size   2)
   )
  )

(deftype gs-trxreg (uint64)
  "The GS's TRXREG register specifies the size of the rectangular area, where the transmission
between buffers is implemented, in units of pixels.
The pixel mode must be the one set by the BITBLTBUF register."
  ((rrw uint16 :offset   0 :size  12)
   (rrh uint16 :offset  32 :size  12)
   )
  )

(deftype gs-trxdir (uint64)
  "The GS's TRXDIR register specifies the transmission direction in the transmission between
buffers, and activates transmission.
Appropriate settings must be made by the BITBLTBUF/TRXPOS/TRXREG before activating
the transmission."
  ((xdir uint8 :offset   0 :size   2)
   )
  )

(deftype gs-bitbltbuf (uint64)
  "The GS's BITBLTBUF register stores buffer-related settings for transmission source and
destination during transmission between buffers."
  ((sbp  uint16 :offset   0 :size  14)
   (sbw  uint8  :offset  16 :size   6)
   (spsm uint8  :offset  24 :size   6)
   (dbp  uint16 :offset  32 :size  14)
   (dbw  uint8  :offset  48 :size   6)
   (dpsm gs-psm :offset  56 :size   6)
   )
  )

(deftype gs-tex0 (uint64)
  "The GS's TEX0 registers set various kinds of information regarding the textures to be used."
  ((tbp0 uint16 :offset   0 :size  14)
   (tbw  uint8  :offset  14 :size   6)
   (psm  uint8  :offset  20 :size   6)
   (tw   uint8  :offset  26 :size   4)
   (th   uint8  :offset  30 :size   4)
   (tcc  uint8  :offset  34 :size   1)
   (tfx  uint8  :offset  35 :size   2)
   (cbp  uint16 :offset  37 :size  14)
   (cpsm uint8  :offset  51 :size   4)
   (csm  uint8  :offset  55 :size   1)
   (csa  uint8  :offset  56 :size   5)
   (cld  uint8  :offset  61 :size   3)
   )
  )

(deftype gs-tex1 (uint64)
  "The GS's TEX1 registers set information on the sampling method of the textures."
  ((lcm  uint8 :offset   0 :size   1)
   (mxl  uint8 :offset   2 :size   3)
   (mmag uint8 :offset   5 :size   1)
   (mmin uint8 :offset   6 :size   3)
   (mtba uint8 :offset   9 :size   1)
   (l    uint8 :offset  19 :size   2)
   (k    int16 :offset  32 :size  12)
   )
  )

(deftype gs-texa (uint64)
  "The GS's TEXA register sets the Alpha value to be referred to when the Alpha value of the
texture is not an 8-bit value."
  ((ta0 uint8 :offset   0 :size   8)
   (aem uint8 :offset  15 :size   1)
   (ta1 uint8 :offset  32 :size   8)
   )
  )

(deftype gs-texclut (uint64)
  "The GS's TEXCLUT register specifies the CLUT position in the buffer when the CLUT storage mode
is CSM=1 (CSM2 mode)."
  ((cbw uint8  :offset   0 :size   6)
   (cou uint8  :offset   6 :size   6)
   (cov uint16 :offset  12 :size  10)
   )
  )

(deftype gs-miptbp (uint64)
  "the GS's MIPTBP registers set the buffer pointer and buffer width of textures when performing
MIPMAP. MIPTBP1 sets levels 1 to 3, MIPTBP2 sets levels 4 to 6."
  ((tbp1 uint16 :offset   0 :size  14)
   (tbw1 uint8  :offset  14 :size   6)
   (tbp2 uint16 :offset  20 :size  14)
   (tbw2 uint8  :offset  34 :size   6)
   (tbp3 uint16 :offset  40 :size  14)
   (tbw3 uint8  :offset  54 :size   6)
   )
  )

(deftype gs-alpha (uint64)
  ((a   uint8 :offset   0 :size   2)
   (b   uint8 :offset   2 :size   2)
   (c   uint8 :offset   4 :size   2)
   (d   uint8 :offset   6 :size   2)
   (fix uint8 :offset  32 :size   8)
   )
  )


(deftype gs-clamp (uint64)
  ((wms  gs-tex-wrap-mode :offset   0 :size   2)
   (wmt  gs-tex-wrap-mode :offset   2 :size   2)
   (minu uint16           :offset   4 :size  10)
   (maxu uint16           :offset  14 :size  10)
   (minv uint16           :offset  24 :size  10)
   (maxv uint16           :offset  34 :size  10)
   )
  )

(deftype gs-fog (uint64)
  ((f uint8 :offset  56 :size   8)
   )
  )


(deftype gs-fogcol (uint64)
  ((fcr uint8 :offset   0 :size   8)
   (fcg uint8 :offset   8 :size   8)
   (fcb uint8 :offset  16 :size   8)
   )
  )


(deftype gif-ctrl (uint32)
  ((rst uint8 :offset   0 :size   1)
   (pse uint8 :offset   3 :size   1)
   )
  )

(deftype gif-mode (uint32)
  ((m3r uint8 :offset   0 :size   1)
   (imt uint8 :offset   2 :size   1)
   )
  )

(deftype gif-stat (uint32)
  ((m3r   uint8 :offset   0 :size   1)
   (m3p   uint8 :offset   1 :size   1)
   (imt   uint8 :offset   2 :size   1)
   (pse   uint8 :offset   3 :size   1)
   (ip3   uint8 :offset   5 :size   1)
   (p3q   uint8 :offset   6 :size   1)
   (p2q   uint8 :offset   7 :size   1)
   (p1q   uint8 :offset   8 :size   1)
   (oph   uint8 :offset   9 :size   1)
   (apath uint8 :offset  10 :size   2)
   (dir   uint8 :offset  12 :size   1)
   (fqc   uint8 :offset  24 :size   5)
   )
  )

(deftype gif-cnt (uint32)
  ((loopcnt uint16 :offset   0 :size  15)
   (regcnt  uint8  :offset  16 :size   4)
   (vuaddr  uint16 :offset  20 :size  10)
   )
  )

(deftype gif-p3cnt (uint32)
  ((p3cnt uint16 :offset   0 :size  15)
   )
  )

(deftype gif-p3tag (uint32)
  ((loopcnt uint16 :offset   0 :size  15)
   (eop     uint8  :offset  15 :size   1)
   )
  )

(deftype gif-bank (structure)
  ((ctrl   gif-ctrl   :offset   0)
   (mode   gif-mode   :offset  16)
   (stat   gif-stat   :offset  32)
   (tag0   uint32     :offset  64)
   (tag1   uint32     :offset  80)
   (tag2   uint32     :offset  96)
   (tag3   uint32     :offset 112)
   (cnt    gif-cnt    :offset 128)
   (p3cnt  gif-p3cnt  :offset 144)
   (p3tag  gif-p3tag  :offset 160)
   )
  )


(deftype gif-tag-prim (uint32)
  ((id   uint16   :offset   0 :size  14)
   (pre  uint8    :offset  14 :size   1)
   (prim gs-prim  :offset  15 :size  11)
   (flg  gif-flag :offset  26 :size   2)
   (nreg uint8    :offset  28 :size   4)
   )
  )

(deftype gif-tag-count (uint32)
  ((nloop uint16 :offset   0 :size  15)
   (eop   uint8  :offset  15 :size   1)
   )
  )

(deftype gif-tag64 (uint64)
  ((nloop uint16   :offset   0 :size  15)
   (eop   uint8    :offset  15 :size   1)
   (id    uint16   :offset  32 :size  14)
   (pre   uint8    :offset  46 :size   1)
   (prim  gs-prim  :offset  47 :size  11)
   (flg   gif-flag :offset  58 :size   2)
   (nreg  uint8    :offset  60 :size   4)
   )
  )

(deftype gif-tag (uint128)
  ((nloop  uint16     :offset   0 :size  15)
   (eop    uint8      :offset  15 :size   1)
   (id     uint16     :offset  32 :size  14)
   (pre    uint8      :offset  46 :size   1)
   (prim   uint16     :offset  47 :size  11)
   (flg    gif-flag   :offset  58 :size   2)
   (nreg   uint8      :offset  60 :size   4)
   (regs0  gif-reg-id :offset  64 :size   4)
   (regs1  gif-reg-id :offset  68 :size   4)
   (regs2  gif-reg-id :offset  72 :size   4)
   (regs3  gif-reg-id :offset  76 :size   4)
   (regs4  gif-reg-id :offset  80 :size   4)
   (regs5  gif-reg-id :offset  84 :size   4)
   (regs6  gif-reg-id :offset  88 :size   4)
   (regs7  gif-reg-id :offset  92 :size   4)
   (regs8  gif-reg-id :offset  96 :size   4)
   (regs9  gif-reg-id :offset 100 :size   4)
   (regs10 gif-reg-id :offset 104 :size   4)
   (regs11 gif-reg-id :offset 108 :size   4)
   (regs12 gif-reg-id :offset 112 :size   4)
   (regs13 gif-reg-id :offset 116 :size   4)
   (regs14 gif-reg-id :offset 120 :size   4)
   (regs15 gif-reg-id :offset 124 :size   4)
   )
  )

(deftype gif-tag-regs (uint64)
  ((regs0   gif-reg-id :offset 0  :size 4)
   (regs1   gif-reg-id :offset 4  :size 4)
   (regs2   gif-reg-id :offset 8  :size 4)
   (regs3   gif-reg-id :offset 12  :size 4)
   (regs4   gif-reg-id :offset 16  :size 4)
   (regs5   gif-reg-id :offset 20  :size 4)
   (regs6   gif-reg-id :offset 24  :size 4)
   (regs7   gif-reg-id :offset 28  :size 4)
   (regs8   gif-reg-id :offset 32  :size 4)
   (regs9   gif-reg-id :offset 36 :size 4)
   (regs10  gif-reg-id :offset 40 :size 4)
   (regs11  gif-reg-id :offset 44 :size 4)
   (regs12  gif-reg-id :offset 48 :size 4)
   (regs13  gif-reg-id :offset 52 :size 4)
   (regs14  gif-reg-id :offset 56 :size 4)
   (regs15  gif-reg-id :offset 60 :size 4)
   )
  )

(deftype gif-tag-regs-32 (uint32)
  ((regs0   gif-reg-id :offset 0  :size 4)
   (regs1   gif-reg-id :offset 4  :size 4)
   (regs2   gif-reg-id :offset 8  :size 4)
   (regs3   gif-reg-id :offset 12  :size 4)
   (regs4   gif-reg-id :offset 16  :size 4)
   (regs5   gif-reg-id :offset 20  :size 4)
   (regs6   gif-reg-id :offset 24  :size 4)
   (regs7   gif-reg-id :offset 28  :size 4))
  )

;; we unfortunately kind of need this
(defmacro gif-tag->static-array (tag regs)
  "Allocates a new static array of two uint64's making up the gif-tag and the tag registers"

  `(new 'static 'array uint64 2 ,tag ,regs)
  )

(defmacro gif-prim (prim-type)
  `(new 'static 'gs-prim :prim (gs-prim-type ,prim-type) :iip 1 :abe 1)
  )

(defmacro gs-reg-list (&rest reg-ids)
  "Generate a giftag register descriptor list from reg-ids."

  (let ((reg-count (length reg-ids)))
    (when (> (length reg-ids) 16)
      (ferror "too many regs passed to gs-reg-list")
      )
    (let ((list-to-splice '())
          (cur-lst reg-ids)
          (i -1))

        ;; this is questionable.
        (while (and (not (null? cur-lst)) (< i 15))
          (push! list-to-splice (cons 'gif-reg-id (cons (car cur-lst) '())))
          (push! list-to-splice (string->symbol-format ":regs{}" (inc! i)))
          (pop! cur-lst)
          )

        `(new 'static 'gif-tag-regs
            ,@list-to-splice
            )
        )
  #| ;; the opengoal compiler does not have enough constant propagation for this for now
    (let ((i -1))

      `(the-as gif-tag-regs (logior ,@(apply (lambda (x)
          `(shl (the-as uint (gif-reg-id ,x)) ,(* 4 (inc! i)))
                ) reg-ids)
              ))

      )|#
    )
  )

(deftype gs-gif-tag (structure)
  ((qword  uint128)
   (tag    gif-tag64       :overlay-at qword)
   (regs   gif-tag-regs    :offset   8)
   (dword  uint64        2 :overlay-at qword)
   (word   uint32        4 :overlay-at qword)
   )
  )


;; WARN: Return type mismatch object vs gif-tag.

(define *fog-color* (new 'static 'rgba :r #x80))

(deftype gif-packet (basic)
  "Unused type for building a dynamically sized gif packet."
  ((reg-count  int32)
   (gif-tag    gs-gif-tag  :inline)
   (gif-tag0   uint128     :overlay-at (-> gif-tag qword))
   (args       uint64      1)
   )
  (:methods
    (new (symbol type int) _type_)
    )
  )


(defmethod new gif-packet ((allocation symbol) (type-to-make type) (arg0 int))
  (object-new allocation type-to-make (the-as int (+ (-> type-to-make size) (* (+ arg0 -1) 8))))
  )

(defun open-gif-packet ((arg0 gif-packet))
  "Initialize an existing gif-packet for 0 registers."
  (set! (-> arg0 reg-count) 0)
  (set! (-> arg0 gif-tag regs) (new 'static 'gif-tag-regs))
  arg0
  )

;; WARN: Return type mismatch gif-packet vs none.
(defun add-reg-gif-packet ((arg0 gif-packet) (arg1 int) (arg2 int))
  "Add a register + value to the packet."
  (let ((v1-0 (-> arg0 gif-tag)))
    (logior! (-> v1-0 regs) (ash arg1 (* (-> arg0 reg-count) 4)))
    )
  (set! (-> (&-> arg0 args (-> arg0 reg-count)) 0) (the-as uint arg2))
  (+! (-> arg0 reg-count) 1)
  (none)
  )

(defun close-gif-packet ((arg0 gif-packet) (arg1 int))
  "Finish adding registers."
  (set! (-> arg0 gif-tag tag)
        (new 'static 'gif-tag64 :nloop #x1 :flg (gif-flag reg-list) :eop arg1 :nreg (-> arg0 reg-count))
        )
  arg0
  )

(deftype draw-context (basic)
  ((orgx    int32)
   (orgy    int32)
   (orgz    int32)
   (width   int32)
   (height  int32)
   (color   rgba  4)
   )
  (:methods
    (new (symbol type int int int int rgba) _type_)
    )
  )


(defmethod new draw-context ((allocation symbol) (type-to-make type) (arg0 int) (arg1 int) (arg2 int) (arg3 int) (arg4 rgba))
  (let ((v0-0 (object-new allocation type-to-make (the-as int (-> type-to-make size)))))
    (set! (-> v0-0 orgx) arg0)
    (set! (-> v0-0 orgy) arg1)
    (set! (-> v0-0 orgz) #xffffff)
    (set! (-> v0-0 width) arg2)
    (set! (-> v0-0 height) arg3)
    (set! (-> v0-0 color 0) arg4)
    v0-0
    )
  )

(defun draw-context-set-xy ((arg0 draw-context) (arg1 int) (arg2 int))
  "Set the origin of the draw context."
  (set! (-> arg0 orgx) arg1)
  (set! (-> arg0 orgy) arg2)
  (none)
  )

(deftype gs-packed-rgba (vector4w)
  ((r  int32  :overlay-at (-> data 0))
   (g  int32  :overlay-at (-> data 1))
   (b  int32  :overlay-at (-> data 2))
   (a  int32  :overlay-at (-> data 3))
   )
  )


(deftype gs-packed-xyzw (vector)
  ((ix  int32  :overlay-at (-> data 0))
   (iy  int32  :overlay-at (-> data 1))
   (iz  int32  :overlay-at (-> data 2))
   (iw  int32  :overlay-at (-> data 3))
   )
  )


(deftype gs-packed-stq (vector)
  ((tex-s  float  :overlay-at (-> data 0))
   (tex-t  float  :overlay-at (-> data 1))
   (tex-q  float  :overlay-at (-> data 2))
   )
  )


(deftype gs-packed-uv (vector)
  ((u  int16  :overlay-at (-> data 0))
   (v  int16  :overlay-at (-> data 1))
   )
  )


(deftype gs-packed-gt (structure)
  ((stq   gs-packed-stq   :inline :offset   0)
   (rgba  gs-packed-rgba  :inline :offset  16)
   (xyzw  gs-packed-xyzw  :inline :offset  32)
   )
  )


(deftype gs-packed-gt4 (structure)
  ((data  gs-packed-gt  4 :inline)
   )
  )