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

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

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

;; Types for the GS - the PS2's GPU.
;; These are used when creating GS packets to be sent to the GIF
;; or for directly interfacing with the memory-mapped GS control registers.

;; the GS's PMODE register makes various settings for the PCRTC.
(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)
   )
  :flag-assert #x900000008
  )

;; the GS's SMODE2 register makes settings related to PCRTC video synchronization.
(deftype gs-smode2 (uint64)
  ((int   uint8 :offset 0 :size 1)
   (ffmd  uint8 :offset 1 :size 1)
   (dpms  uint8 :offset 2 :size 2)
   )
  :flag-assert #x900000008
  )

;; texture formats
(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)
    )

(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."
  (enum->string gs-psm arg0)
  )


(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)
  )

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

;; the GS's DISPFB registers make settings for the frame buffer regarding information on
;; Rectangular Area Read Output Circuit n for the PCRTC.
;; write-only
(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)
   )
  :flag-assert #x900000008
  )

;; 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
(deftype gs-display (uint64)
  ((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)
   )
  :flag-assert #x900000008
  )

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

;; 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
(deftype gs-csr (uint64)
  ((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)
   )
  :flag-assert #x900000008
  )

;; memory layout of the GS's privileged registers (mapped to EE memory)
;; it is missing the SIGLBLID/LABELID register at 4224 (useless anyway?)
(deftype gs-bank (structure)
  ((pmode    gs-pmode  :offset-assert 0)
   (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)
   )
  :method-count-assert 9
  :size-assert         #x1048
  :flag-assert         #x900001048
  )

;; the GS's FRAME registers store various settings related to the frame buffer.
(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)
   )
  :flag-assert #x900000008
  )

;; the GS's ZBUF registers make various settings regarding Z buffer.
(deftype gs-zbuf (uint64)
  ((zbp   uint16 :offset 0  :size 9)
   (psm   gs-psm :offset 24 :size 4)
   (zmsk  uint8  :offset 32 :size 1)
   )
  :flag-assert #x900000008
  )
;; the GS's XYOFFSET registers set the offset value for converting from the primitive coordinate
;; system to the window coordinate system.
(deftype gs-xy-offset (uint64)
  ((ofx  uint16 :offset 0  :size 16)
   (ofy  uint16 :offset 32 :size 16)
   )
  :flag-assert #x900000008
  )
;; 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.
(deftype gs-scissor (uint64)
  ((scax0  uint16 :offset 0  :size 11)
   (scax1  uint16 :offset 16 :size 11)
   (scay0  uint16 :offset 32 :size 11)
   (scay1  uint16 :offset 48 :size 11)
   )
  :flag-assert #x900000008
  )
;; 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.
(deftype gs-prmode-cont (uint64)
  ((ac  uint8 :offset 0 :size 1))
  :flag-assert #x900000008
  )
;; the GS's COLCLAMP register stores settings as to whether clamping for the RGB value of the
;; pixel is performed.
(deftype gs-color-clamp (uint64)
  ((clamp  uint8 :offset 0 :size 1))
  :flag-assert #x900000008
  )
;; the GS's DTHE register stores settings for dithering (performed/not performed).
(deftype gs-dthe (uint64)
  ((dthe  uint8 :offset 0 :size 1))
  :flag-assert #x900000008
  )

(defenum gs-atest
  :type uint8
  (never 0)
  (always 1)
  (less 2)
  (less-equal 3)
  (equal 4)
  (greater-equal 5)
  (greater 6)
  (not-equal 7)
  )
(defenum gs-ztest
  :type uint8
  (never 0)
  (always 1)
  (greater-equal 2)
  (greater 3)
  )
;; the GS's TEST register performs settings related to the pixel test.
(deftype gs-test (uint64)
  ((ate    uint8 :offset 0  :size 1) ;; alpha test enable
   (atst   gs-atest :offset 1  :size 3) ;; alpha test method
   (aref   uint8 :offset 4  :size 8) ;; alpha val reference
   (afail  uint8 :offset 12 :size 2) ;; processing method on alpha test fail
   (date   uint8 :offset 14 :size 1) ;; dest alpha test enable
   (datm   uint8 :offset 15 :size 1) ;; dest alpha test mode
   (zte    uint8 :offset 16 :size 1) ;; depth test enable
   (ztst   gs-ztest :offset 17 :size 2) ;; depth test method
   )
  :flag-assert #x900000008
  )

(defenum gs-prim-type
  :type uint8
  (point 0)
  (line 1)
  (line-strip 2)
  (tri 3)
  (tri-strip 4)
  (tri-fan 5)
  (sprite 6)
  )
;; the GS's PRIM register specifies the types of drawing primitives and various attributes, and
;; initializes the contents of the vertex queue.
(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)
   )
  :flag-assert #x900000008
  )
;; the GS's RGBAQ register sets the RGBA value of the vertex and the Q value of the normalized
;; texture coordinates.
(deftype gs-rgbaq (uint64)
  ((r  uint8 :offset 0  :size 8)
   (g  uint8 :offset 8  :size 8)
   (b  uint8 :offset 16 :size 8)
   (a  uint8 :offset 24 :size 8) ;; 0x80 --> 1.0
   (q  float :offset 32 :size 32) ;; affects some LOD behavior apparently?
   )
  :flag-assert #x900000008
  )
;; GS XYZ registers
(deftype gs-xyz (uint64)
  ((x  uint16 :offset 0  :size 16) ;; Q4 fixed point
   (y  uint16 :offset 16 :size 16) ;; Q4 fixed point
   (z  uint32 :offset 32 :size 32)
   )
  :flag-assert #x900000008
  )
;; the GS's UV register specifies the texel coordinate (UV) values of the vertex.
(deftype gs-uv (uint64)
  ((u  uint16 :offset 0  :size 14) ;; Q4 fixed point
   (v  uint16 :offset 16 :size 14) ;; Q4 fixed point
   )
  :flag-assert #x900000008
  )
;; 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.
(deftype gs-st (uint64)
  ((s  float :offset 0  :size 32)
   (t  float :offset 32 :size 32)
   )
  :flag-assert #x900000008
  )
;; GS XYZF registers
(deftype gs-xyzf (uint64)
  ((x  uint16 :offset 0  :size 16) ;; Q4 fixed point
   (y  uint16 :offset 16 :size 16) ;; Q4 fixed point
   (z  uint32 :offset 32 :size 24)
   (f  uint8  :offset 56 :size 8) ;; fog coeff
   )
  :flag-assert #x900000008
  )
;; the GS's TRXPOS register specifies the position and scanning direction of the rectangular area
;; in each buffer where buffer transmission is performed.
(deftype gs-trxpos (uint64)
  ((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)
   )
  :flag-assert #x900000008
  )
;; 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.
(deftype gs-trxreg (uint64)
  ((rrw  uint16 :offset 0  :size 12)
   (rrh  uint16 :offset 32 :size 12)
   )
  :flag-assert #x900000008
  )
;; 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.
(deftype gs-trxdir (uint64)
  ((xdir  uint8 :offset 0 :size 2))
  :flag-assert #x900000008
  )
;; the GS's BITBLTBUF register stores buffer-related settings for transmission source and
;; destination during transmission between buffers.
(deftype gs-bitbltbuf (uint64)
  ((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  uint8  :offset 56 :size 6)
   )
  :flag-assert #x900000008
  )
;; the GS's TEX0 registers set various kinds of information regarding the textures to be used.
(deftype gs-tex0 (uint64)
  ((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)
   )
  :flag-assert #x900000008
  )
;; the GS's TEX1 registers set information on the sampling method of the textures.
(deftype gs-tex1 (uint64)
  ((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)
   )
  :flag-assert #x900000008
  )
;; 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.
(deftype gs-texa (uint64)
  ((ta0  uint8 :offset 0  :size 8)
   (aem  uint8 :offset 15 :size 1)
   (ta1  uint8 :offset 32 :size 8)
   )
  :flag-assert #x900000008
  )
;; the GS's TEXCLUT register specifies the CLUT position in the buffer when the CLUT storage mode
;; is CSM=1 (CSM2 mode).
(deftype gs-texclut (uint64)
  ((cbw  uint8  :offset 0  :size 6)
   (cou  uint8  :offset 6  :size 6)
   (cov  uint16 :offset 12 :size 10)
   )
  :flag-assert #x900000008
  )
;; 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.
(deftype gs-miptbp (uint64)
  ((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)
   )
  :flag-assert #x900000008
  )
;; the GS's ALPHA registers define the blend function of alpha blending
(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)
   )
  :flag-assert #x900000008
  )
;; the GS's CLAMP registers set the texture's wrap mode (repeating or clamping) for both S and T.
(defenum gs-tex-wrap-mode
  :type uint8
  (repeat 0)
  (clamp 1)
  (region-clamp 2)
  (region-repeat 3)
  )

(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)
   )
  :flag-assert #x900000008
  )

(deftype gs-fog (uint64)
  ((f  uint8 :offset 56 :size 8))
  :flag-assert #x900000008
  )

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

(deftype gif-ctrl (uint32)
  ((rst  uint8 :offset 0 :size 1)
   (pse  uint8 :offset 3 :size 1)
   )
  :flag-assert #x900000004
  )
(deftype gif-mode (uint32)
  ((m3r  uint8 :offset 0 :size 1)
   (imt  uint8 :offset 2 :size 1)
   )
  :flag-assert #x900000004
  )
(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)
   )
  :flag-assert #x900000004
  )
(deftype gif-cnt (uint32)
  ((loopcnt  uint16 :offset 0  :size 15)
   (regcnt   uint8  :offset 16 :size 4)
   (vuaddr   uint16 :offset 20 :size 10)
   )
  :flag-assert #x900000004
  )
(deftype gif-p3cnt (uint32)
  ((p3cnt  uint16 :offset 0 :size 15))
  :flag-assert #x900000004
  )
(deftype gif-p3tag (uint32)
  ((loopcnt  uint16 :offset 0  :size 15)
   (eop      uint8  :offset 15 :size 1)
   )
  :flag-assert #x900000004
  )

(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)
   )
  :method-count-assert 9
  :size-assert         #xa4
  :flag-assert         #x9000000a4
  )

(deftype gif-tag-prim (uint32)
  ()
  :flag-assert #x900000004
  )
(deftype gif-tag-count (uint32)
  ()
  :flag-assert #x900000004
  )

(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)
  )

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

(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))
  :flag-assert #x900000008
  )

(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)
   )
  :flag-assert #x900000010
  )

(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)
   )
  )

;; 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   :offset-assert 0) ;; is "qword" and inline? in game
   (tag   gif-tag64      :offset 0)
   (regs  gif-tag-regs   :offset 8)
   (dword uint64 2       :offset 0)
   (word  uint32 4       :offset 0)
   )
  :method-count-assert 9
  :size-assert         #x10
  :flag-assert         #x900000010
  )

(defmethod inspect gif-tag ((obj gif-tag))
  (format #t "[~8x] gif-tag~%" obj)
  (format #t "~Tnloop: ~4d~%" (-> obj nloop))
  (format #t "~Teop  : ~4d~%" (-> obj eop))
  (format #t "~Tid   : ~4d~%" (-> obj id))
  (format #t "~Tpre  : ~4d~%" (-> obj pre))
  (format #t "~Tprim : ~4d~%" (-> obj prim))
  (format #t "~Tflg  : ~4d~%" (-> obj flg))
  (format #t "~Tnreg : ~4d~%" (-> obj nreg))
  (format #t "~Tregs0 : ~4d~%" (-> obj regs0))
  (format #t "~Tregs1 : ~4d~%" (-> obj regs1))
  (format #t "~Tregs2 : ~4d~%" (-> obj regs2))
  (format #t "~Tregs3 : ~4d~%" (-> obj regs3))
  (format #t "~Tregs4 : ~4d~%" (-> obj regs4))
  (format #t "~Tregs5 : ~4d~%" (-> obj regs5))
  (format #t "~Tregs6 : ~4d~%" (-> obj regs6))
  (format #t "~Tregs7 : ~4d~%" (-> obj regs7))
  (format #t "~Tregs8 : ~4d~%" (-> obj regs8))
  (format #t "~Tregs9 : ~4d~%" (-> obj regs9))
  (format #t "~Tregs10: ~4d~%" (-> obj regs10))
  (format #t "~Tregs11: ~4d~%" (-> obj regs11))
  (format #t "~Tregs12: ~4d~%" (-> obj regs12))
  (format #t "~Tregs13: ~4d~%" (-> obj regs13))
  (format #t "~Tregs14: ~4d~%" (-> obj regs14))
  (format #t "~Tregs15: ~4d~%" (-> obj regs15))
  ;; original function failed to return this.
  obj
  )

;; some nice blue. probably the same as the fog color for geyser/sandover/etc.
;; "default" fog color when resetting registers
(define *fog-color* #xc88029)

;; set up a DMA buffer. This will hold a message to set the GS state to normal.
;; these regs are NOT the ones mapped in the EE memory, but other internal GS registers.
(define *default-regs-buffer* (new 'global 'dma-buffer 1024))

(defun default-buffer-init ((buff dma-buffer))
  "Set some GS registers back to default values. Ends with a ret dma-tag.
   This is intended to live in its own separate dma-buffer and not be added
   to the global buffer.  Calling this will reset this dma-buffer."

  ;; reset the buffer.
  (let ((buff-ptr buff))
    (set! (-> buff-ptr base) (-> buff-ptr data))
    (set! (-> buff-ptr end)
          (&-> buff-ptr data-buffer (-> buff-ptr allocated-length))
          )
    )

  ;; set up a GIF transfer
  (dma-buffer-add-gs-set-flusha buff
              (alpha-1 (new 'static 'gs-alpha :b 1 :d 1))
              (zbuf-1 (new 'static 'gs-zbuf :zbp #x1c0 :psm (gs-psm ct24)))
              (test-1 (new 'static 'gs-test :atst (gs-atest not-equal) :zte #x1 :ztst (gs-ztest greater-equal)))
              (pabe 0)
              (clamp-1 (new 'static 'gs-clamp :wms (gs-tex-wrap-mode clamp) :wmt (gs-tex-wrap-mode clamp)))
              (tex1-1 (new 'static 'gs-tex1 :mmag 1 :mmin 1))
              (texa (new 'static 'gs-texa :ta1 #x80))
              (texclut (new 'static 'gs-texclut :cbw 4))
              (fogcol *fog-color*)
              )

  ;; return dma-tag.
  (dma-buffer-add-ret buff)
  (none)
  )


(default-buffer-init *default-regs-buffer*)


;; This isn't a dynamic type in the type system, but it's used as one.
;; the array at the end is used as a dynamic array.
;; NOTE - this gif-packet stuff seems unused. Instead dma-gif-packet is used.
;; this seems to use 128-bit integer values, but the compiler gets confused sometimes??

;; This stuff could be used like this:
;; - new gif-packet
;; - open-gif-packet
;; - add-reg-gif-packet to add a register
;; - close-gif-packet
;; now you have a reglist gs packet.

(deftype gif-packet (basic)
  ((reg-count int32     :offset-assert 4)
   (gif-tag gs-gif-tag :inline :offset-assert 16)
   (gif-tag0  uint128   :offset 16)
   (args      uint64 1 :offset-assert 32) ;; there's one here already.
   )
  (:methods
   (new (symbol type int) _type_ 0)
   )
  :method-count-assert 9
  :size-assert         #x28
  :flag-assert         #x900000028
  )

(defmethod new gif-packet ((allocation symbol) (type-to-make type) (arg0 int))
  "Make a new gif packet with enough room for arg0 64-bit args"
  (object-new allocation type-to-make
   (the-as int (+ (-> type-to-make size) (shl (+ arg0 -1) 3)))
   )
  )

(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
  )

(defun add-reg-gif-packet ((packet gif-packet) (reg-idx int) (reg-val int))
  "Add a register to the packet"
  (let ((tag (-> packet gif-tag)))
    ;; shift the register index into the right slot
    (logior!
     (-> tag regs)
     (the-as uint (ash reg-idx (* (-> packet reg-count) 4)))
     )
    )
  ;; set register value and increment count.
  (set! (-> packet args (-> packet reg-count)) (the-as uint reg-val))
  (set! (-> packet reg-count) (+ (-> packet reg-count) 1))
  (none)
  )

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


(deftype draw-context (basic)
  ((orgx   int32   :offset-assert 4)
   (orgy   int32   :offset-assert 8)
   (orgz   int32   :offset-assert 12)
   (width  int32   :offset-assert 16)
   (height int32   :offset-assert 20)
   (color  rgba  4 :offset-assert 24)
   )
  (:methods
   (new (symbol type int int int int rgba) _type_ 0)
   )
  :method-count-assert 9
  :size-assert         #x28
  :flag-assert         #x900000028
  )

(defmethod new draw-context ((allocation symbol)
                             (type-to-make type)
                             (org-x int)
                             (org-y int)
                             (width int)
                             (height int)
                             (color-0 rgba)
                             )
  "Allocate and initialize a draw-context"
  (let ((obj (object-new allocation type-to-make (the-as int (-> type-to-make size)))))
    (let ((v1-3 (the int (* (the float org-y) (-> *video-parms* relative-y-scale))))
          (a0-2 (the int (* (the float height) (-> *video-parms* relative-y-scale))))
          )
      (set! (-> obj orgx) org-x)
      (set! (-> obj orgy) v1-3)
      (set! (-> obj orgz) #xffffff)
      (set! (-> obj width) width)
      (set! (-> obj height) a0-2)
      )
    (set! (-> obj color 0) color-0)
    obj
    )
  )

(defun draw-context-set-xy ((arg0 draw-context) (x int) (y int))
  "Set the origin of the draw context, scaling by relative-y-scale as needed."
  (local-vars (v0-0 int))
  (set! v0-0 (the int (* (the float y) (-> *video-parms* relative-y-scale))))
  (set! (-> arg0 orgx) x)
  (set! (-> arg0 orgy) v0-0)
  (none)
  )