mirror of
https://github.com/open-goal/jak-project.git
synced 2024-10-20 21:27:52 -04:00
689 lines
23 KiB
Common Lisp
689 lines
23 KiB
Common Lisp
;;-*-Lisp-*-
|
|
(in-package goal)
|
|
|
|
;; name: merc.gc
|
|
;; name in dgo: merc
|
|
;; dgos: GAME, ENGINE
|
|
|
|
;; This file contains the EE code for MERC
|
|
;; The merc renderer is used to draw characters and other dynamic things.
|
|
;; It supports a number of effects and can interact with other renderers.
|
|
;; It's the most complicated renderer in the game and its code uses almost the entire VU1 code memory.
|
|
|
|
;; The interface with the rest of the art world is merc-ctrl, which is an art-element.
|
|
;; It contains a merc-ctrl-header which has the metadata.
|
|
;; It also has an array of merc-effects which contain the actual data.
|
|
|
|
;; contains the header for the currently logging-in thing.
|
|
(define *merc-ctrl-header* (the-as merc-ctrl-header #f))
|
|
|
|
(defmethod asize-of merc-fragment ((obj merc-fragment))
|
|
"Get the size in memory of a merc-fragment"
|
|
(the-as int (* (-> obj header mm-quadword-size) 16))
|
|
)
|
|
|
|
(defmethod login-adgifs merc-fragment ((obj merc-fragment))
|
|
"Set up a merc-fragment. Does adgifs and eye stuff"
|
|
(let* ((fp-data (merc-fragment-fp-data obj))
|
|
(eye-ctrl (if (nonzero? (-> *merc-ctrl-header* eye-ctrl))
|
|
(-> *merc-ctrl-header* eye-ctrl)
|
|
(the-as merc-eye-ctrl #f)
|
|
)
|
|
)
|
|
(shader (the-as adgif-shader (&+ fp-data 16)))
|
|
)
|
|
(dotimes (s2-0 (the-as int (-> fp-data shader-cnt)))
|
|
(cond
|
|
((and eye-ctrl (= (logand -256 (-> shader texture-id)) #x1cf06f00))
|
|
;; eye slot 0
|
|
(adgif-shader-login shader)
|
|
(let ((eye-tex-block (get-eye-block (-> eye-ctrl eye-slot) 0)))
|
|
(set! (-> shader tex0 tbp0) eye-tex-block)
|
|
)
|
|
(set! (-> shader tex0 tw) 5)
|
|
(set! (-> shader tex0 th) 5)
|
|
(set! (-> shader tex0 tcc) 1)
|
|
(set! (-> shader tex0 tbw) 1)
|
|
(set! (-> shader tex0 psm) 0)
|
|
(set! (-> shader tex1 mxl) 0)
|
|
(set! (-> shader clamp)
|
|
(new 'static 'gs-clamp
|
|
:wms (gs-tex-wrap-mode clamp)
|
|
:wmt (gs-tex-wrap-mode clamp)
|
|
:maxu #x1f
|
|
:maxv #x1f
|
|
)
|
|
)
|
|
)
|
|
((and eye-ctrl (= (logand -256 (-> shader texture-id)) #x1cf07000))
|
|
;; eye slot 1
|
|
(adgif-shader-login shader)
|
|
(let ((eye-tex-block-2 (get-eye-block (-> eye-ctrl eye-slot) 1)))
|
|
(set! (-> shader tex0 tbp0) eye-tex-block-2)
|
|
)
|
|
(set! (-> shader tex0 tw) 5)
|
|
(set! (-> shader tex0 th) 5)
|
|
(set! (-> shader tex0 tcc) 1)
|
|
(set! (-> shader tex0 tbw) 1)
|
|
(set! (-> shader tex0 psm) 0)
|
|
(set! (-> shader tex1 mxl) 0)
|
|
(set! (-> shader clamp)
|
|
(new 'static 'gs-clamp
|
|
:wms (gs-tex-wrap-mode clamp)
|
|
:wmt (gs-tex-wrap-mode clamp)
|
|
:maxu #x1f
|
|
:maxv #x1f
|
|
)
|
|
)
|
|
)
|
|
(else
|
|
;; normal. just login and set tex masks.
|
|
(let ((tex (adgif-shader-login shader)))
|
|
(when tex
|
|
(dotimes (seg 3)
|
|
(logior! (-> *merc-ctrl-header* masks seg) (-> tex masks seg))
|
|
)
|
|
)
|
|
)
|
|
)
|
|
)
|
|
(&+! shader 80)
|
|
)
|
|
)
|
|
(none)
|
|
)
|
|
|
|
(defmethod asize-of merc-fragment-control ((obj merc-fragment-control))
|
|
(the-as int (+ (* (-> obj mat-xfer-count) 2) 4))
|
|
)
|
|
|
|
(defmethod inspect merc-fragment-control ((obj merc-fragment-control))
|
|
"Debug print a merc-fragment-control"
|
|
(format #t "[~8x] ~A~%" obj 'merc-fragment-control)
|
|
(format #t "~Tunsigned-four-count: ~D~%" (-> obj unsigned-four-count))
|
|
(format #t "~Tlump-four-count: ~D~%" (-> obj lump-four-count))
|
|
(format #t "~Tfp-qwc: ~D~%" (-> obj fp-qwc))
|
|
(format #t "~Tmat-xfer-count: ~D~%" (-> obj mat-xfer-count))
|
|
(dotimes (s5-0 (the-as int (-> obj mat-xfer-count)))
|
|
(format #t "~Tmat-dest-data[~d]:~%" s5-0)
|
|
(format #t "~T~Tmatrix-number: ~D~%"(-> obj mat-dest-data s5-0 matrix-number))
|
|
(format #t "~T~Tmatrix-dest: ~D~%" (-> obj mat-dest-data s5-0 matrix-dest))
|
|
)
|
|
obj
|
|
)
|
|
|
|
(defmethod login-adgifs merc-effect ((obj merc-effect))
|
|
"Login everything for this merc-effect."
|
|
|
|
;; login adgifs, if we have them.
|
|
(let ((data (-> obj extra-info)))
|
|
(when (nonzero? data)
|
|
(when (nonzero? (-> data shader-offset))
|
|
(let ((tex (adgif-shader-login
|
|
(the-as
|
|
adgif-shader
|
|
(+ (the-as uint data) (* (-> data shader-offset) 16))
|
|
)
|
|
)
|
|
)
|
|
)
|
|
(when tex
|
|
(dotimes (seg 3)
|
|
(logior! (-> *merc-ctrl-header* masks seg) (-> tex masks seg))
|
|
)
|
|
)
|
|
)
|
|
)
|
|
)
|
|
)
|
|
|
|
;; login fragment geometry and control. ctrls don't need logins
|
|
(let ((ctrl (-> obj frag-ctrl))
|
|
(geo (-> obj frag-geo))
|
|
)
|
|
(dotimes (frag-idx (the-as int (-> obj frag-count)))
|
|
(let ((ctrl-size (asize-of ctrl)))
|
|
(let ((geo-size (asize-of geo)))
|
|
(login-adgifs geo)
|
|
(set! geo (the-as merc-fragment (&+ (the-as pointer geo) geo-size)))
|
|
)
|
|
(set! ctrl (the-as merc-fragment-control (&+ (the-as pointer ctrl) ctrl-size)))
|
|
)
|
|
)
|
|
)
|
|
(none)
|
|
)
|
|
|
|
(defmethod inspect merc-ctrl ((obj merc-ctrl))
|
|
"Print a merc-ctrl"
|
|
(format #t "[~8x] ~A~%" obj (-> obj type))
|
|
(format #t "~Tname: ~A~%" (-> obj name))
|
|
(format #t "~Tlength: ~D~%" (-> obj length))
|
|
(format #t "~Tnum-joints: ~D~%" (-> obj num-joints))
|
|
(format #t "~Textra: ~A~%" (-> obj extra))
|
|
(inspect (-> obj header))
|
|
(dotimes (s5-0 (the-as int (-> obj header effect-count)))
|
|
(inspect (-> obj effect s5-0))
|
|
)
|
|
obj
|
|
)
|
|
|
|
(defmethod mem-usage merc-ctrl ((obj merc-ctrl) (arg0 memory-usage-block) (arg1 int))
|
|
"Compute memory usage stats for a merc-ctrl"
|
|
|
|
;; do extra
|
|
(if (-> obj extra)
|
|
(mem-usage (-> obj extra) arg0 arg1)
|
|
)
|
|
|
|
;; do merc ctrls in each effect:
|
|
(let ((ctrl-mem (+ 32 80 (* (-> obj header effect-count) 32))))
|
|
(dotimes (effect-idx (the-as int (-> obj header effect-count)))
|
|
(let ((fctrl (-> obj effect effect-idx frag-ctrl)))
|
|
(dotimes (frag-idx (the-as int (-> obj effect effect-idx frag-count)))
|
|
(set! ctrl-mem (+ ctrl-mem
|
|
(* (shr (+ (-> fctrl unsigned-four-count) 3) 2) 16)
|
|
(* (shr (+ (-> fctrl lump-four-count) 3) 2) 16)
|
|
(* (-> fctrl fp-qwc) 16)
|
|
(asize-of fctrl)
|
|
)
|
|
)
|
|
(set! fctrl (the-as merc-fragment-control (&+ (the-as pointer fctrl) (asize-of fctrl))))
|
|
)
|
|
)
|
|
)
|
|
(set! (-> arg0 length) (max 76 (-> arg0 length)))
|
|
(set! (-> arg0 data 75 name) "merc-ctrl")
|
|
(+! (-> arg0 data 75 count) 1)
|
|
(+! (-> arg0 data 75 used) ctrl-mem)
|
|
(+! (-> arg0 data 75 total) (logand -16 (+ ctrl-mem 15)))
|
|
)
|
|
|
|
;; do effect blend shapes
|
|
(let ((effect-mem 0))
|
|
(dotimes (effect-idx2 (the-as int (-> obj header effect-count)))
|
|
(when (nonzero? (-> obj effect effect-idx2 blend-frag-count))
|
|
(let ((bctrl (-> obj effect effect-idx2 blend-ctrl)))
|
|
(dotimes (blend-frag-idx (the-as int (-> obj effect effect-idx2 blend-frag-count)) )
|
|
(let ((v1-36 (+ effect-mem
|
|
(* (+ (-> bctrl nonzero-index-count) 1)
|
|
(the-as uint (logand (+ (* (the-as uint 6) (-> bctrl blend-vtx-count)) 15) #xfff0))
|
|
)
|
|
)
|
|
)
|
|
)
|
|
(set! effect-mem (the-as int (+ (-> obj header blend-target-count) 2 v1-36)))
|
|
)
|
|
(set! bctrl (the-as merc-blend-ctrl (&+ (the-as pointer bctrl) (+ (-> obj header blend-target-count) 2))))
|
|
)
|
|
)
|
|
)
|
|
)
|
|
(when (nonzero? effect-mem)
|
|
(set! (-> arg0 length) (max 78 (-> arg0 length)))
|
|
(set! (-> arg0 data 77 name) "blend-shape")
|
|
(+! (-> arg0 data 77 count) 1)
|
|
(+! (-> arg0 data 77 used) effect-mem)
|
|
(+! (-> arg0 data 77 total) (logand -16 (+ effect-mem 15)))
|
|
)
|
|
)
|
|
|
|
;; do eyes.
|
|
(when (nonzero? (-> obj header eye-ctrl))
|
|
(let ((a0-28 (-> obj header eye-ctrl)))
|
|
(set! (-> arg0 length) (max 109 (-> arg0 length)))
|
|
(set! (-> arg0 data 108 name) "eye-anim")
|
|
(+! (-> arg0 data 108 count) 1)
|
|
(let ((v1-47 (asize-of a0-28)))
|
|
(+! (-> arg0 data 108 used) v1-47)
|
|
(+! (-> arg0 data 108 total) (logand -16 (+ v1-47 15)))
|
|
)
|
|
)
|
|
)
|
|
obj
|
|
)
|
|
|
|
(defmethod login merc-ctrl ((obj merc-ctrl))
|
|
"Log in a merc-ctrl."
|
|
|
|
;; so we can find it
|
|
(set! *merc-ctrl-header* (-> obj header))
|
|
|
|
;; clear masks. logging in will set these for textures we need.
|
|
(dotimes (v1-1 3)
|
|
(set! (-> *merc-ctrl-header* masks v1-1) (the-as uint 0))
|
|
)
|
|
|
|
;; login the effects
|
|
(dotimes (effect-idx (the-as int (-> obj header effect-count)))
|
|
(login-adgifs (-> obj effect effect-idx))
|
|
)
|
|
|
|
;; some weird hack to swap two effects.
|
|
(let ((idx-with-bit1 -1)
|
|
(a1-1 (-> obj header effect-count))
|
|
)
|
|
(dotimes (v1-11 (the-as int a1-1))
|
|
(if (logtest? (-> obj effect v1-11 effect-bits) 2)
|
|
(set! idx-with-bit1 v1-11)
|
|
)
|
|
)
|
|
(when (!= idx-with-bit1 -1)
|
|
(let ((v1-16 4)
|
|
(this-effect (-> obj effect idx-with-bit1))
|
|
(last-effect (-> obj effect (+ a1-1 -1)))
|
|
)
|
|
(dotimes (copy-idx v1-16)
|
|
(let ((a3-2 (-> this-effect data copy-idx)))
|
|
(set! (-> this-effect data copy-idx) (-> last-effect data copy-idx))
|
|
(set! (-> last-effect data copy-idx) a3-2)
|
|
)
|
|
)
|
|
)
|
|
)
|
|
)
|
|
|
|
;; login eye.
|
|
(cond
|
|
((zero? (logand -65536 (the-as int (-> obj header eye-ctrl))))
|
|
;; no idea what this is for.
|
|
(set! (-> obj header eye-ctrl) (the-as merc-eye-ctrl 0))
|
|
0
|
|
)
|
|
(else
|
|
(let ((s5-1 (-> obj header eye-ctrl)))
|
|
;; login and set masks
|
|
(dotimes (s4-0 3)
|
|
(let ((v1-25 (adgif-shader-login (-> s5-1 shader s4-0))))
|
|
(when v1-25
|
|
(dotimes (a0-11 3)
|
|
(logior! (-> *merc-ctrl-header* masks a0-11) (-> v1-25 masks a0-11))
|
|
)
|
|
)
|
|
)
|
|
)
|
|
)
|
|
)
|
|
)
|
|
obj
|
|
)
|
|
|
|
(defun-debug merc-stats-display ((arg0 merc-ctrl))
|
|
"Print debug stats to #t."
|
|
(format #t "~30s:" (-> arg0 name))
|
|
(let ((s5-0 (-> arg0 header st-int-scale))
|
|
(s4-0 (ash 1 (- 12 (the-as int (-> arg0 header st-int-scale)))))
|
|
)
|
|
(format #t " ST ~3D, " s4-0)
|
|
(cond
|
|
((>= s5-0 (the-as uint 5))
|
|
(format #t "RANGE ~D+," (/ 128 s4-0))
|
|
)
|
|
((= s5-0 4)
|
|
(format #t "RANGE 0.5+,")
|
|
)
|
|
)
|
|
)
|
|
(dotimes (s5-1 (the-as int (-> arg0 header effect-count)))
|
|
(let ((s3-0 (-> arg0 effect s5-1)))
|
|
(if (nonzero? s5-1)
|
|
(format #t "~48s " " ")
|
|
)
|
|
(let ((a2-4 (-> s3-0 frag-count))
|
|
(s4-1 (-> s3-0 tri-count))
|
|
(f30-0 (the float (-> s3-0 frag-count)))
|
|
(f28-0 (the float (-> s3-0 dvert-count)))
|
|
(f26-0 (the float (-> s3-0 tri-count)))
|
|
)
|
|
(if (>= (/ (+ 50.0 f28-0) f30-0) 50.0)
|
|
(format #t "~3D frags, ~2,,1f dverts/frag " a2-4 (/ f28-0 f30-0))
|
|
(format #t "~3D frags, ~2,,1f ******/**** " a2-4 (/ f28-0 f30-0))
|
|
)
|
|
(format #t "(~4D tris, striplen ~2,,2f, ~2,,1f tris/frag)~%"
|
|
s4-1
|
|
(/ (* 2.0 f26-0) (- f28-0 f26-0))
|
|
(/ f26-0 f30-0)
|
|
)
|
|
)
|
|
)
|
|
)
|
|
(none)
|
|
)
|
|
|
|
(defun-debug merc-stats ()
|
|
"Iterate through all merc-ctrls and print."
|
|
|
|
(dotimes (gp-0 3) ;; levels
|
|
(let ((s5-0 (-> *level* level gp-0 art-group)))
|
|
(when (nonzero? s5-0)
|
|
(dotimes (s4-0 (-> s5-0 art-group-array length)) ;; art-groups
|
|
(let ((s3-0 (-> s5-0 art-group-array s4-0)))
|
|
(dotimes (s2-0 (-> s3-0 length)) ;; arts
|
|
(let* ((s1-0 (-> s3-0 data s2-0))
|
|
(a0-3 (if (and (nonzero? s1-0) (type-type? (-> s1-0 type) merc-ctrl))
|
|
s1-0
|
|
)
|
|
)
|
|
)
|
|
(if a0-3
|
|
(merc-stats-display (the-as merc-ctrl a0-3))
|
|
)
|
|
)
|
|
)
|
|
)
|
|
)
|
|
)
|
|
)
|
|
)
|
|
0
|
|
(none)
|
|
)
|
|
|
|
(defun-debug merc-edge-stats ()
|
|
"Print the longest edges in each."
|
|
(dotimes (gp-0 3)
|
|
(let ((s5-0 (-> *level* level gp-0 art-group)))
|
|
(when (nonzero? s5-0)
|
|
(dotimes (s4-0 (-> s5-0 art-group-array length))
|
|
(let ((s3-0 (-> s5-0 art-group-array s4-0)))
|
|
(dotimes (s2-0 (-> s3-0 length))
|
|
(let* ((s1-0 (-> s3-0 data s2-0))
|
|
(v1-10
|
|
(if (and (nonzero? s1-0) (type-type? (-> s1-0 type) merc-ctrl))
|
|
s1-0
|
|
)
|
|
)
|
|
)
|
|
(if v1-10
|
|
(format
|
|
#t
|
|
"~30s: ~f~%"
|
|
(-> (the-as merc-ctrl v1-10) name)
|
|
(-> (the-as merc-ctrl v1-10) header longest-edge)
|
|
)
|
|
)
|
|
)
|
|
)
|
|
)
|
|
)
|
|
)
|
|
)
|
|
)
|
|
0
|
|
(none)
|
|
)
|
|
|
|
(defun merc-vu1-add-vu-function ((dma dma-packet) (func vu-function) (flush-mode int))
|
|
"Add a function to a dma chain. Return pointer to chain after the upload data."
|
|
(let ((func-data (&-> func data 4))
|
|
(qwc (-> func qlength))
|
|
(dst (-> func origin))
|
|
)
|
|
(while (> qwc 0)
|
|
(let ((qwc-this-time (min 127 qwc))) ;; only 127 at a time
|
|
(set! (-> dma dma)
|
|
(new 'static 'dma-tag
|
|
:id (dma-tag-id ref)
|
|
:qwc qwc-this-time
|
|
:addr (the-as int func-data)
|
|
)
|
|
)
|
|
(set! (-> dma vif0) (new 'static 'vif-tag :cmd (if (zero? flush-mode) (vif-cmd flushe) (vif-cmd flusha))))
|
|
(set! (-> dma vif1)
|
|
(new 'static 'vif-tag
|
|
:cmd (vif-cmd mpg)
|
|
:num (* qwc-this-time 2)
|
|
:imm dst
|
|
)
|
|
)
|
|
(&+! dma 16)
|
|
(&+! func-data (* qwc-this-time 16))
|
|
(set! qwc (- qwc qwc-this-time))
|
|
(+! dst (* qwc-this-time 2))
|
|
)
|
|
)
|
|
)
|
|
(the-as dma-gif-packet dma)
|
|
)
|
|
|
|
(defun merc-vu1-initialize-chain ((arg0 dma-gif-packet))
|
|
"Initialize a merc chain."
|
|
;; upload the function.
|
|
(let ((gp-0 (the-as object (merc-vu1-add-vu-function (the-as dma-packet arg0) merc-vu1-block 1))))
|
|
;; now set up the VIF.
|
|
(set! (-> (the-as dma-gif-packet gp-0) dma-vif dma) (new 'static 'dma-tag :qwc #xa :id (dma-tag-id cnt)))
|
|
(set! (-> (the-as dma-gif-packet gp-0) dma-vif vif0) (new 'static 'vif-tag :imm #x404 :cmd (vif-cmd stcycl)))
|
|
(set! (-> (the-as dma-gif-packet gp-0) dma-vif vif1) (new 'static 'vif-tag :cmd (vif-cmd stmod)))
|
|
(set! (-> (the-as (pointer vif-tag) gp-0) 4) (new 'static 'vif-tag :imm #x1ba :cmd (vif-cmd base)))
|
|
(set! (-> (the-as (pointer vif-tag) gp-0) 5) (new 'static 'vif-tag :imm #xfe46 :cmd (vif-cmd offset)))
|
|
(set! (-> (the-as (pointer vif-tag) gp-0) 6) (new 'static 'vif-tag))
|
|
|
|
;; upload VU low memory
|
|
(set! (-> (the-as (pointer vif-tag) gp-0) 7) (new 'static 'vif-tag :num #x8 :cmd (vif-cmd unpack-v4-32)))
|
|
|
|
;; template:
|
|
(let ((s5-0 (the-as merc-vu1-low-mem (&+ (the-as dma-gif-packet gp-0) 32))))
|
|
(set! (-> s5-0 tri-strip-gif tag)
|
|
(new 'static 'gif-tag64
|
|
:pre #x1
|
|
:prim (new 'static 'gs-prim :prim (gs-prim-type tri-strip) :iip #x1 :tme #x1 :fge #x1)
|
|
:nreg #x3
|
|
)
|
|
)
|
|
(set! (-> s5-0 tri-strip-gif regs)
|
|
(new 'static 'gif-tag-regs
|
|
:regs0 (gif-reg-id st)
|
|
:regs1 (gif-reg-id rgbaq)
|
|
:regs2 (gif-reg-id xyzf2)
|
|
)
|
|
)
|
|
;; what is this, they snuck something in here...
|
|
(set! (-> s5-0 tri-strip-gif word 3)
|
|
(shr (make-u128 0 (shl #x303e4000 32)) 32)
|
|
)
|
|
|
|
(set! (-> s5-0 ad-gif tag) (new 'static 'gif-tag64 :nloop #x5 :nreg #x1))
|
|
(set! (-> s5-0 ad-gif regs) (new 'static 'gif-tag-regs :regs0 (gif-reg-id a+d)))
|
|
(set! (-> s5-0 hvdf-offset quad) (-> *math-camera* hvdf-off quad))
|
|
|
|
(quad-copy! (-> s5-0 perspective) (the-as pointer (-> *math-camera* perspective)) 4)
|
|
(set-vector!
|
|
(-> s5-0 fog)
|
|
(-> *math-camera* pfog0)
|
|
(-> *math-camera* fog-min)
|
|
(-> *math-camera* fog-max)
|
|
0.0
|
|
)
|
|
)
|
|
;; end.
|
|
(let ((v1-20 (-> (the-as (inline-array dma-packet) gp-0) 10)))
|
|
(set! (-> v1-20 dma) (new 'static 'dma-tag :id (dma-tag-id cnt)))
|
|
(set! (-> v1-20 vif0) (new 'static 'vif-tag))
|
|
(set! (-> v1-20 vif1) (new 'static 'vif-tag :cmd (vif-cmd mscal) :msk #x1 :imm #x0))
|
|
(&+ v1-20 16)
|
|
)
|
|
)
|
|
)
|
|
|
|
|
|
(defun merc-vu1-init-buffer ((dma-bucket bucket-id) (test gs-test) (arg2 int))
|
|
"Setup merc DMA buffer."
|
|
|
|
;; This function works differently from most and splices to the beginning of the bucket, as
|
|
;; drawing has already put stuff in buckets.
|
|
;; The advantage of this is that we can check if nothing was drawn, then skip this.
|
|
;; NOTE: This runs as part of display-frame-finish, so after previous DMA is synced.
|
|
|
|
;; grab out bucket directly.
|
|
(let ((bucket (-> *display* frames (-> *display* on-screen) frame bucket-group dma-bucket)))
|
|
;; only if we draw anything.
|
|
(when (!= bucket (-> bucket last))
|
|
(let* ((dma-buf (-> *display* frames (-> *display* on-screen) frame global-buf))
|
|
(draw-data-start (-> dma-buf base)) ;; remember old beginning
|
|
)
|
|
;; set the beginning to be the merc init stuff.
|
|
(set! (-> dma-buf base)
|
|
(the-as pointer (merc-vu1-initialize-chain (the-as dma-gif-packet (-> dma-buf base))))
|
|
)
|
|
;; some other merc setup for the GS.
|
|
(let* ((v1-8 dma-buf)
|
|
(a0-6 (the-as object (-> v1-8 base)))
|
|
)
|
|
(set! (-> (the-as dma-packet a0-6) dma) (new 'static 'dma-tag :qwc #x2 :id (dma-tag-id cnt)))
|
|
(set! (-> (the-as dma-packet a0-6) vif0) (new 'static 'vif-tag))
|
|
(set! (-> (the-as dma-packet a0-6) vif1)
|
|
(new 'static 'vif-tag :imm #x2 :cmd (vif-cmd direct) :msk #x1)
|
|
)
|
|
(set! (-> v1-8 base) (&+ (the-as pointer a0-6) 16))
|
|
)
|
|
(let* ((v1-9 dma-buf)
|
|
(a0-8 (the-as object (-> v1-9 base)))
|
|
)
|
|
(set! (-> (the-as gs-gif-tag a0-8) tag) (new 'static 'gif-tag64 :nloop #x1 :eop #x1 :nreg #x1))
|
|
(set! (-> (the-as gs-gif-tag a0-8) regs)
|
|
(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)
|
|
)
|
|
)
|
|
(set! (-> v1-9 base) (&+ (the-as pointer a0-8) 16))
|
|
)
|
|
(let* ((v1-10 dma-buf)
|
|
(a0-10 (-> v1-10 base))
|
|
)
|
|
(set! (-> (the-as (pointer gs-test) a0-10) 0) test)
|
|
(set! (-> (the-as (pointer gs-reg64) a0-10) 1) (gs-reg64 test-1))
|
|
(set! (-> v1-10 base) (&+ a0-10 16))
|
|
)
|
|
|
|
;; terminate as normal
|
|
(let ((v1-11 (the-as object (-> dma-buf base))))
|
|
(set! (-> (the-as dma-packet v1-11) dma)
|
|
(new 'static 'dma-tag :id (dma-tag-id next) :addr (-> bucket next))
|
|
)
|
|
(set! (-> (the-as dma-packet v1-11) vif0) (new 'static 'vif-tag))
|
|
(set! (-> (the-as dma-packet v1-11) vif1) (new 'static 'vif-tag))
|
|
(set! (-> dma-buf base) (&+ (the-as pointer v1-11) 16))
|
|
)
|
|
|
|
;; but splice the existing chain.
|
|
(set! (-> bucket next) (the-as uint draw-data-start))
|
|
)
|
|
)
|
|
)
|
|
0
|
|
(none)
|
|
)
|
|
|
|
(defun merc-vu1-init-buffers ()
|
|
"Setup merc DMA buffers. Call this _after_ drawing."
|
|
(when (logtest? *vu1-enable-user* (vu1-renderer-mask merc))
|
|
(merc-vu1-init-buffer
|
|
(bucket-id merc-tfrag-tex0)
|
|
(new 'static 'gs-test
|
|
:ate #x1
|
|
:atst (gs-atest greater-equal)
|
|
:aref #x26
|
|
:zte #x1
|
|
:ztst (gs-ztest greater-equal)
|
|
)
|
|
0
|
|
)
|
|
(merc-vu1-init-buffer
|
|
(bucket-id merc-pris0)
|
|
(new 'static 'gs-test
|
|
:ate #x1
|
|
:atst (gs-atest greater-equal)
|
|
:aref #x26
|
|
:zte #x1
|
|
:ztst (gs-ztest greater-equal)
|
|
)
|
|
0
|
|
)
|
|
(merc-vu1-init-buffer
|
|
(bucket-id merc-tfrag-tex1)
|
|
(new 'static 'gs-test
|
|
:ate #x1
|
|
:atst (gs-atest greater-equal)
|
|
:aref #x26
|
|
:zte #x1
|
|
:ztst (gs-ztest greater-equal)
|
|
)
|
|
0
|
|
)
|
|
(merc-vu1-init-buffer
|
|
(bucket-id merc-pris1)
|
|
(new 'static 'gs-test
|
|
:ate #x1
|
|
:atst (gs-atest greater-equal)
|
|
:aref #x26
|
|
:zte #x1
|
|
:ztst (gs-ztest greater-equal)
|
|
)
|
|
0
|
|
)
|
|
(merc-vu1-init-buffer
|
|
(bucket-id merc-alpha-tex)
|
|
(new 'static 'gs-test
|
|
:ate #x1
|
|
:atst (gs-atest greater-equal)
|
|
:aref #x26
|
|
:zte #x1
|
|
:ztst (gs-ztest greater-equal)
|
|
)
|
|
0
|
|
)
|
|
(merc-vu1-init-buffer
|
|
(bucket-id merc-pris-common)
|
|
(new 'static 'gs-test
|
|
:ate #x1
|
|
:atst (gs-atest greater-equal)
|
|
:aref #x26
|
|
:zte #x1
|
|
:ztst (gs-ztest greater-equal)
|
|
)
|
|
0
|
|
)
|
|
(merc-vu1-init-buffer
|
|
(bucket-id merc-water0)
|
|
(new 'static 'gs-test
|
|
:ate #x1
|
|
:atst (gs-atest greater-equal)
|
|
:aref #x80
|
|
:afail #x1
|
|
:zte #x1
|
|
:ztst (gs-ztest greater-equal)
|
|
)
|
|
0
|
|
)
|
|
(merc-vu1-init-buffer
|
|
(bucket-id merc-water1)
|
|
(new 'static 'gs-test
|
|
:ate #x1
|
|
:atst (gs-atest greater-equal)
|
|
:aref #x80
|
|
:afail #x1
|
|
:zte #x1
|
|
:ztst (gs-ztest greater-equal)
|
|
)
|
|
0
|
|
)
|
|
)
|
|
0
|
|
(none)
|
|
)
|