mirror of
https://github.com/open-goal/jak-project
synced 2026-06-20 08:13:33 -04:00
Hat Kid
93afb02cf4
This includes all the collision stuff needed to spawn `target`, decompiles the sparticle code and adds some of the PC hacks needed for merc to run (it doesn't work quite right and looks bad, likely due to a combination of code copied from Jak 2 and the time of day hacks). There are a bunch of temporary hacks (see commits) in place to prevent the game from crashing quite as much, but it is still extremely prone to doing so due to lots of missing functions/potentially bad decomp. --------- Co-authored-by: water <awaterford111445@gmail.com>
713 lines
27 KiB
Common Lisp
713 lines
27 KiB
Common Lisp
;;-*-Lisp-*-
|
|
(in-package goal)
|
|
|
|
;; name: bsp.gc
|
|
;; name in dgo: bsp
|
|
;; dgos: GAME
|
|
|
|
;; DECOMP BEGINS
|
|
|
|
;; WARN: Return type mismatch bsp-header vs none.
|
|
(defun mem-usage-bsp-tree ((arg0 bsp-header) (arg1 bsp-node) (arg2 memory-usage-block) (arg3 int))
|
|
"Recursively compute memory usage of bsp-tree."
|
|
(cond
|
|
((zero? arg1)
|
|
)
|
|
(else
|
|
(+! (-> arg2 data 61 count) 1)
|
|
(let ((v1-3 20))
|
|
(+! (-> arg2 data 61 used) v1-3)
|
|
(+! (-> arg2 data 61 total) v1-3)
|
|
)
|
|
(if (zero? (-> arg1 front-box-min w))
|
|
(mem-usage-bsp-tree arg0 (-> arg0 nodes (-> arg1 front)) arg2 arg3)
|
|
)
|
|
(when (zero? (-> arg1 back-box-min w))
|
|
(if (> (-> arg1 back) 0)
|
|
(mem-usage-bsp-tree arg0 (-> arg0 nodes (-> arg1 back)) arg2 arg3)
|
|
)
|
|
)
|
|
)
|
|
)
|
|
(none)
|
|
)
|
|
|
|
(defmethod mem-usage ((this bsp-header) (usage memory-usage-block) (flags int))
|
|
(set! (-> usage work-bsp) this)
|
|
(when (nonzero? (-> this info))
|
|
(set! (-> usage length) (max 86 (-> usage length)))
|
|
(set! (-> usage data 85 name) "array")
|
|
(+! (-> usage data 85 count) 1)
|
|
(let ((v1-8 (asize-of (-> this info))))
|
|
(+! (-> usage data 85 used) v1-8)
|
|
(+! (-> usage data 85 total) (logand -16 (+ v1-8 15)))
|
|
)
|
|
)
|
|
(if (nonzero? (-> this drawable-trees))
|
|
(mem-usage (-> this drawable-trees) usage flags)
|
|
)
|
|
(if (nonzero? (-> this collide-hash))
|
|
(mem-usage (-> this collide-hash) usage flags)
|
|
)
|
|
(set! (-> usage length) (max 66 (-> usage length)))
|
|
(set! (-> usage data 44 name) "entity")
|
|
(set! (-> usage data 45 name) "camera")
|
|
(set! (-> usage data 65 name) "pat")
|
|
(set! (-> usage data 61 name) "bsp-node")
|
|
(set! (-> usage length) (max 60 (-> usage length)))
|
|
(set! (-> usage data 59 name) "bsp-main")
|
|
(+! (-> usage data 59 count) 1)
|
|
(let ((v1-31 400))
|
|
(+! (-> usage data 59 used) v1-31)
|
|
(+! (-> usage data 59 total) (logand -16 (+ v1-31 15)))
|
|
)
|
|
(set! (-> usage length) (max 63 (-> usage length)))
|
|
(set! (-> usage data 62 name) "bsp-leaf-vis-self")
|
|
(+! (-> usage data 62 count) 1)
|
|
(let ((v1-40 (-> this visible-list-length)))
|
|
(+! (-> usage data 62 used) v1-40)
|
|
(+! (-> usage data 62 total) (logand -16 (+ v1-40 15)))
|
|
)
|
|
(set! (-> usage length) (max 61 (-> usage length)))
|
|
(set! (-> usage data 60 name) "bsp-misc")
|
|
(+! (-> usage data 60 count) 1)
|
|
(let ((v1-50 (* (-> this texture-remap-table-len) 8)))
|
|
(+! (-> usage data 60 used) v1-50)
|
|
(+! (-> usage data 60 total) (logand -16 (+ v1-50 15)))
|
|
)
|
|
(set! (-> usage length) (max 61 (-> usage length)))
|
|
(set! (-> usage data 60 name) "bsp-misc")
|
|
(+! (-> usage data 60 count) 1)
|
|
(let ((v1-60 (* (-> this texture-page-count) 4)))
|
|
(+! (-> usage data 60 used) v1-60)
|
|
(+! (-> usage data 60 total) (logand -16 (+ v1-60 15)))
|
|
)
|
|
(when (nonzero? (-> this unknown-basic))
|
|
(set! (-> usage length) (max 61 (-> usage length)))
|
|
(set! (-> usage data 60 name) "bsp-misc")
|
|
(+! (-> usage data 60 count) 1)
|
|
(let ((v1-72 (asize-of (-> this unknown-basic))))
|
|
(+! (-> usage data 60 used) v1-72)
|
|
(+! (-> usage data 60 total) (logand -16 (+ v1-72 15)))
|
|
)
|
|
)
|
|
(when (nonzero? (-> this actor-birth-order))
|
|
(set! (-> usage length) (max 61 (-> usage length)))
|
|
(set! (-> usage data 60 name) "bsp-misc")
|
|
(+! (-> usage data 60 count) 1)
|
|
(let ((v1-85 (* (-> this actors length) 4)))
|
|
(+! (-> usage data 60 used) v1-85)
|
|
(+! (-> usage data 60 total) (logand -16 (+ v1-85 15)))
|
|
)
|
|
)
|
|
(+! (-> usage data 65 count) (-> this pat-length))
|
|
(let ((v1-92 (* (-> this pat-length) 4)))
|
|
(+! (-> usage data 65 used) v1-92)
|
|
(+! (-> usage data 65 total) (logand -16 (+ v1-92 15)))
|
|
)
|
|
(if (nonzero? (-> this hfrag-drawable))
|
|
(mem-usage (-> this hfrag-drawable) usage flags)
|
|
)
|
|
(when (nonzero? (-> this region-trees))
|
|
(let* ((s3-0 (-> this region-trees length))
|
|
(s2-0 0)
|
|
(a0-40 (-> this region-trees s2-0))
|
|
)
|
|
(while (< s2-0 s3-0)
|
|
(mem-usage a0-40 usage (logior flags 128))
|
|
(+! s2-0 1)
|
|
(set! a0-40 (-> this region-trees s2-0))
|
|
)
|
|
)
|
|
)
|
|
(let ((s3-1 (-> this cameras)))
|
|
(when (nonzero? s3-1)
|
|
(dotimes (s2-1 (-> s3-1 length))
|
|
(mem-usage (-> s3-1 s2-1) usage (logior flags 256))
|
|
)
|
|
)
|
|
)
|
|
(if (nonzero? (-> this nodes))
|
|
(mem-usage-bsp-tree this (-> this nodes 0) usage flags)
|
|
)
|
|
this
|
|
)
|
|
|
|
(defmethod login ((this bsp-header))
|
|
"Initialize the object after it is loaded."
|
|
(if (nonzero? (-> this drawable-trees))
|
|
(login (-> this drawable-trees))
|
|
)
|
|
(set! (-> this level tfrag-gs-test)
|
|
(if (logtest? (-> this texture-flags 0) (texture-page-flag alpha-enable))
|
|
(new 'static 'gs-test :ate #x1 :atst (gs-atest always) :zte #x1 :ztst (gs-ztest greater-equal))
|
|
(new 'static 'gs-test
|
|
:ate #x1
|
|
:atst (gs-atest greater-equal)
|
|
:aref #x26
|
|
:zte #x1
|
|
:ztst (gs-ztest greater-equal)
|
|
)
|
|
)
|
|
)
|
|
(if (nonzero? (-> this hfrag-drawable))
|
|
(login (-> this hfrag-drawable))
|
|
)
|
|
this
|
|
)
|
|
|
|
(define *test-shrub* 0)
|
|
|
|
(defmethod draw ((this bsp-header))
|
|
"Draw the drawable, and typically its children.
|
|
This usually means adding stuff to a list to be drawn later, rather than expensive drawing here."
|
|
|
|
;; og:preserve-this
|
|
;; a lot re-written here.
|
|
(local-vars (a3-4 uint128) (a3-5 uint128))
|
|
|
|
(let ((v1-0 (-> this level)))
|
|
(when (-> v1-0 render?)
|
|
(set! *draw-index* (-> v1-0 draw-index))
|
|
(set! (-> *prototype-tie-work* mood) (-> v1-0 mood-context))
|
|
|
|
;; no more artist subdivide settings??
|
|
|
|
(let ((a2-0 (/ (+ (-> this visible-list-length) 15) 16)))
|
|
;; upload vis bits, though I think nothing uses this.
|
|
(__mem-move
|
|
(-> (scratchpad-object terrain-context) work background vis-list)
|
|
(-> v1-0 vis-bits)
|
|
(the uint (* 16 a2-0)))
|
|
; (dma-send-to-spr-no-flush
|
|
; (the-as uint (+ #x3800 #x70000000))
|
|
; (the-as uint (-> v1-0 vis-bits))
|
|
; (the-as uint a2-0)
|
|
; #f
|
|
; )
|
|
)
|
|
|
|
;; debug option to flip visibilty
|
|
(when *artist-flip-visible*
|
|
(let ((v1-6 (/ (+ (-> this visible-list-length) 15) 16))
|
|
(a0-10 (-> (scratchpad-object terrain-context) work background vis-list))
|
|
(a1-4 (-> this all-visible-list))
|
|
)
|
|
(dotimes (a2-1 v1-6)
|
|
(let ((a3-3 (-> (the-as (pointer uint128) (+ (the-as uint a0-10) (* a2-1 16))))))
|
|
(.pnor a3-4 a3-3 0)
|
|
)
|
|
(let ((t0-2 (-> (the-as (pointer uint128) (&+ a1-4 (* a2-1 16))))))
|
|
(.pand a3-5 a3-4 t0-2)
|
|
)
|
|
(set! (-> (the-as (pointer uint128) (+ (the-as uint a0-10) (* a2-1 16)))) a3-5)
|
|
)
|
|
)
|
|
)
|
|
|
|
;; load registers. I believe that very very old stuff used this in Jak 1's development,
|
|
;; but now this is mostly unused. The sphere-cull, guard-band-cull functions rely on these
|
|
;; being loaded. The only known use is for culling the drawable-error spheres.
|
|
(let ((at-0 *math-camera*))
|
|
(with-vf (vf16 vf17 vf18 vf19 vf20 vf21 vf22 vf23 vf24 vf25 vf26 vf27 vf28 vf29 vf30 vf31)
|
|
:rw 'write
|
|
(.lvf vf16 (&-> at-0 plane 0 quad))
|
|
(.lvf vf17 (&-> at-0 plane 1 quad))
|
|
(.lvf vf18 (&-> at-0 plane 2 quad))
|
|
(.lvf vf19 (&-> at-0 plane 3 quad))
|
|
(.lvf vf20 (&-> at-0 shrub-mat vector 0 quad))
|
|
(.lvf vf21 (&-> at-0 shrub-mat vector 1 quad))
|
|
(.lvf vf22 (&-> at-0 shrub-mat vector 2 quad))
|
|
(.lvf vf23 (&-> at-0 shrub-mat trans quad))
|
|
(.lvf vf24 (&-> at-0 camera-rot vector 0 quad))
|
|
(.lvf vf25 (&-> at-0 camera-rot vector 1 quad))
|
|
(.lvf vf26 (&-> at-0 camera-rot vector 2 quad))
|
|
(.lvf vf27 (&-> at-0 camera-rot trans quad))
|
|
(.lvf vf28 (&-> at-0 camera-temp vector 0 quad))
|
|
(.lvf vf29 (&-> at-0 camera-temp vector 1 quad))
|
|
(.lvf vf30 (&-> at-0 camera-temp vector 2 quad))
|
|
(.lvf vf31 (&-> at-0 camera-temp trans quad))
|
|
)
|
|
)
|
|
|
|
(if (nonzero? (-> this drawable-trees))
|
|
(draw (-> this drawable-trees))
|
|
)
|
|
)
|
|
)
|
|
0
|
|
(none)
|
|
)
|
|
|
|
(defmethod debug-draw ((this bsp-header))
|
|
"Debug-draw a drawable and its children. Typically uses the debug-draw functions."
|
|
|
|
;; This is mostly useless, as almost nothing has debug-draw methods that do anything.
|
|
;; tfrag/tie might, but they rely on "debug" data in the level that is not present.
|
|
|
|
(let ((v1-0 (-> this level)))
|
|
(set! *draw-index* (-> v1-0 draw-index))
|
|
(set! (-> *prototype-tie-work* mood) (-> v1-0 mood-context))
|
|
(let ((a2-0 (/ (+ (-> this visible-list-length) 15) 16)))
|
|
(__mem-move
|
|
(-> (scratchpad-object terrain-context) work background vis-list)
|
|
(-> v1-0 vis-bits)
|
|
(the uint (* a2-0 16)))
|
|
|
|
; (dma-send-to-spr-no-flush
|
|
; (the-as uint (+ #x3800 #x70000000))
|
|
; (the-as uint (-> v1-0 vis-bits))
|
|
; (the-as uint a2-0)
|
|
; #f
|
|
; )
|
|
)
|
|
)
|
|
|
|
(let ((at-0 *math-camera*))
|
|
(with-vf (vf16 vf17 vf18 vf19 vf20 vf21 vf22 vf23 vf24 vf25 vf26 vf27 vf28 vf29 vf30 vf31)
|
|
:rw 'write
|
|
(.lvf vf16 (&-> at-0 plane 0 quad))
|
|
(.lvf vf17 (&-> at-0 plane 1 quad))
|
|
(.lvf vf18 (&-> at-0 plane 2 quad))
|
|
(.lvf vf19 (&-> at-0 plane 3 quad))
|
|
(.lvf vf20 (&-> at-0 shrub-mat vector 0 quad))
|
|
(.lvf vf21 (&-> at-0 shrub-mat vector 1 quad))
|
|
(.lvf vf22 (&-> at-0 shrub-mat vector 2 quad))
|
|
(.lvf vf23 (&-> at-0 shrub-mat trans quad))
|
|
(.lvf vf24 (&-> at-0 camera-rot vector 0 quad))
|
|
(.lvf vf25 (&-> at-0 camera-rot vector 1 quad))
|
|
(.lvf vf26 (&-> at-0 camera-rot vector 2 quad))
|
|
(.lvf vf27 (&-> at-0 camera-rot trans quad))
|
|
(.lvf vf28 (&-> at-0 camera-temp vector 0 quad))
|
|
(.lvf vf29 (&-> at-0 camera-temp vector 1 quad))
|
|
(.lvf vf30 (&-> at-0 camera-temp vector 2 quad))
|
|
(.lvf vf31 (&-> at-0 camera-temp trans quad))
|
|
)
|
|
)
|
|
|
|
(if (nonzero? (-> this drawable-trees))
|
|
(debug-draw (-> this drawable-trees))
|
|
)
|
|
0
|
|
(none)
|
|
|
|
)
|
|
|
|
(defmethod collect-stats ((this bsp-header))
|
|
"Collect triangle/perf statistics for rendering.
|
|
This is only called when viewing stats.
|
|
The vis-bits and culling registers are loaded during this time."
|
|
(let ((v1-0 (-> this level))
|
|
(a2-0 (/ (+ (-> this visible-list-length) 15) 16))
|
|
)
|
|
(__mem-move
|
|
(-> (scratchpad-object terrain-context) work background vis-list)
|
|
(-> v1-0 vis-bits)
|
|
(the uint (* a2-0 16)))
|
|
; (dma-send-to-spr-no-flush
|
|
; (the-as uint (+ #x3800 #x70000000))
|
|
; (the-as uint (-> v1-0 vis-bits))
|
|
; (the-as uint a2-0)
|
|
; #f
|
|
; )
|
|
)
|
|
|
|
;; these are actually used to cull stuff for computing stats.
|
|
;; interestingly, while tfrag/tie/shrub drawing is in the "background" system,
|
|
;; their stat collection is still in drawable.
|
|
(let ((at-0 *math-camera*))
|
|
(with-vf (vf16 vf17 vf18 vf19 vf20 vf21 vf22 vf23 vf24 vf25 vf26 vf27 vf28 vf29 vf30 vf31)
|
|
:rw 'write
|
|
(.lvf vf16 (&-> at-0 plane 0 quad))
|
|
(.lvf vf17 (&-> at-0 plane 1 quad))
|
|
(.lvf vf18 (&-> at-0 plane 2 quad))
|
|
(.lvf vf19 (&-> at-0 plane 3 quad))
|
|
(.lvf vf20 (&-> at-0 shrub-mat vector 0 quad))
|
|
(.lvf vf21 (&-> at-0 shrub-mat vector 1 quad))
|
|
(.lvf vf22 (&-> at-0 shrub-mat vector 2 quad))
|
|
(.lvf vf23 (&-> at-0 shrub-mat trans quad))
|
|
(.lvf vf24 (&-> at-0 camera-rot vector 0 quad))
|
|
(.lvf vf25 (&-> at-0 camera-rot vector 1 quad))
|
|
(.lvf vf26 (&-> at-0 camera-rot vector 2 quad))
|
|
(.lvf vf27 (&-> at-0 camera-rot trans quad))
|
|
(.lvf vf28 (&-> at-0 camera-temp vector 0 quad))
|
|
(.lvf vf29 (&-> at-0 camera-temp vector 1 quad))
|
|
(.lvf vf30 (&-> at-0 camera-temp vector 2 quad))
|
|
(.lvf vf31 (&-> at-0 camera-temp trans quad))
|
|
)
|
|
)
|
|
(if (nonzero? (-> this drawable-trees))
|
|
(collect-stats (-> this drawable-trees))
|
|
)
|
|
(if (nonzero? (-> this hfrag-drawable))
|
|
(collect-stats (-> this hfrag-drawable))
|
|
)
|
|
0
|
|
(none)
|
|
)
|
|
|
|
;; ERROR: Unsupported inline assembly instruction kind - [srl t3, t3, 24]
|
|
;; ERROR: Unsupported inline assembly instruction kind - [srl t2, t2, 24]
|
|
(defun bsp-camera-asm ((arg0 bsp-header) (arg1 vector))
|
|
"Determine which 'bsp' leaf cell the camera is in, for precomputed vis.
|
|
The result is stored in the bsp itself."
|
|
(local-vars
|
|
(a2-1 object)
|
|
(a3-0 uint128)
|
|
(a3-1 uint128)
|
|
(a3-2 uint128)
|
|
(a3-3 uint128)
|
|
(t0-5 uint)
|
|
(t2-1 uint)
|
|
(t3-1 int)
|
|
(t4-0 uint128)
|
|
(t5-0 uint128)
|
|
(t6-0 uint128)
|
|
(t7-0 uint128)
|
|
)
|
|
(rlet ((Q :class vf)
|
|
(vf0 :class vf)
|
|
(vf1 :class vf)
|
|
(vf2 :class vf)
|
|
(vf3 :class vf)
|
|
)
|
|
(init-vf0-vector)
|
|
(nop!)
|
|
(.lvf vf3 (&-> arg0 bsp-scale quad))
|
|
(let ((v1-0 (the-as object (-> arg0 nodes))))
|
|
(.lvf vf1 (&-> arg1 quad))
|
|
(.lvf vf2 (&-> arg0 bsp-offset quad))
|
|
(.sub.vf vf1 vf1 vf2 :mask #b111)
|
|
(.div.vf Q vf0 vf3 :fsf #b11 :ftf #b0)
|
|
(.wait.vf)
|
|
(.mul.vf vf1 vf1 Q :mask #b1)
|
|
(.div.vf Q vf0 vf3 :fsf #b11 :ftf #b1)
|
|
(.wait.vf)
|
|
(.mul.vf vf1 vf1 Q :mask #b10)
|
|
(.div.vf Q vf0 vf3 :fsf #b11 :ftf #b10)
|
|
(.wait.vf)
|
|
(.mul.vf vf1 vf1 Q :mask #b100)
|
|
(let ((a1-1 #xffffff)
|
|
(a2-0 (the-as uint 0))
|
|
)
|
|
(vftoi15.xyzw vf1 vf1)
|
|
(.mov a3-0 vf1)
|
|
(.pw.sra a3-1 a3-0 15)
|
|
(.ppach a3-2 (the-as uint128 0) a3-1)
|
|
(.ppacb a3-3 (the-as uint128 0) a3-2)
|
|
(let ((a3-4 (the-as uint128 (logand (the-as int a3-3) a1-1))))
|
|
(label cfg-1)
|
|
(let ((t1-1 (the-as bsp-node (&+ (the-as pointer v1-0) (+ (* a2-0 16) (* a2-0 4))))))
|
|
(nop!)
|
|
(let ((t3-0 (the-as uint128 (-> t1-1 front-box-min clr))))
|
|
(.pcgtb t6-0 t3-0 a3-4)
|
|
(let ((t0-2 (the-as uint128 (-> t1-1 front-box-max clr))))
|
|
(.pcgtb t4-0 t0-2 a3-4)
|
|
)
|
|
(let ((t2-0 (the-as uint128 (-> t1-1 back-box-min clr))))
|
|
(.pcgtb t7-0 t2-0 a3-4)
|
|
(let ((t0-3 (the-as uint128 (-> t1-1 back-box-max clr))))
|
|
(.pcgtb t5-0 t0-3 a3-4)
|
|
)
|
|
(let* ((t0-4 (-> t1-1 front))
|
|
(t6-1 (lognot (the-as int t6-0)))
|
|
(t7-1 (lognot (the-as int t7-0)))
|
|
(t4-1 (logand t6-1 (the-as int t4-0)))
|
|
(t5-1 (logand t7-1 (the-as int t5-0)))
|
|
(t4-2 (logand t4-1 a1-1))
|
|
(t5-2 (logand t5-1 a1-1))
|
|
)
|
|
;(.srl t3-1 (the-as uint t3-0) 24)
|
|
(set! t3-1 (logand #xffffffff (shr t3-0 24)))
|
|
(let ((t1-2 (the-as bsp-node (-> t1-1 back))))
|
|
(b! (= t4-2 a1-1) cfg-4 :delay
|
|
;(.srl t2-1 (the-as int t2-0) 24)
|
|
(set! t2-1 (the uint (logand #xffffffff (shr t2-0 24))))
|
|
)
|
|
(b! (= t5-2 a1-1) cfg-7 :delay (set! t0-5 (the-as uint 1)))
|
|
(b! #t cfg-11 :delay (set! (-> arg0 cam-outside-bsp) t0-5))
|
|
(label cfg-4)
|
|
(b! (zero? t3-1) cfg-1 :likely-delay (set! a2-0 (the uint t0-4)))
|
|
(let ((v1-1 a2-0))
|
|
(set! (-> arg0 cam-using-back) (the-as uint 0))
|
|
(b! #t cfg-10 :delay (set! a2-1 t0-4))
|
|
(label cfg-7)
|
|
(b! (zero? t2-1) cfg-1 :likely-delay (set! a2-0 (the-as uint t1-2)))
|
|
(set! v1-1 a2-0)
|
|
(set! a2-1 t1-2)
|
|
(set! (-> arg0 cam-using-back) (the-as uint 1))
|
|
(label cfg-10)
|
|
(set! (-> arg0 current-leaf-idx) (the-as uint a2-1))
|
|
(set! (-> arg0 cam-box-idx) (the-as uint v1-1))
|
|
)
|
|
)
|
|
)
|
|
)
|
|
)
|
|
)
|
|
)
|
|
)
|
|
)
|
|
(set! (-> arg0 cam-outside-bsp) (the-as uint 0))
|
|
(label cfg-11)
|
|
0
|
|
(none)
|
|
)
|
|
)
|
|
|
|
(defmethod collect-regions ((this bsp-header) (arg0 sphere) (arg1 int) (arg2 region-prim-list))
|
|
"Fill the region-prim-list with regions that intersect the sphere."
|
|
(let ((s3-0 (-> this region-trees)))
|
|
(dotimes (s2-0 (-> s3-0 length))
|
|
;; note: the use of arg1 here is a bug. it's ignored, so it doesn't matter
|
|
(collect-regions (-> s3-0 s2-0) arg0 arg1 arg2)
|
|
)
|
|
)
|
|
0
|
|
(none)
|
|
)
|
|
|
|
(defun print-collide-stats ()
|
|
(format *stdcon* "~0k~%count cycles instr icache dcache vu0/to/from~%")
|
|
(print-to-stream (-> *perf-stats* data 3) "collide" *stdcon*)
|
|
(print-to-stream (-> *perf-stats* data 4) "collide-list" *stdcon*)
|
|
(print-to-stream (-> *perf-stats* data 5) "collide-fill" *stdcon*)
|
|
(format *stdcon* "~0k---------------------------------------------------------------~%")
|
|
(format *stdcon* "~0kcalls = ~d~%" (-> *collide-stats* calls))
|
|
(format
|
|
*stdcon*
|
|
"~0kspheres = ~d~256hspheres/call = ~f~%"
|
|
(-> *collide-stats* spheres)
|
|
(/ (the float (-> *collide-stats* spheres)) (the float (-> *collide-stats* calls)))
|
|
)
|
|
(format
|
|
*stdcon*
|
|
"~0knodes = ~d~256hnodes/call = ~f~%"
|
|
(-> *collide-stats* nodes)
|
|
(/ (the float (-> *collide-stats* nodes)) (the float (-> *collide-stats* calls)))
|
|
)
|
|
(format
|
|
*stdcon*
|
|
"~0kfrags = ~d~256hfrags/call = ~f~%"
|
|
(-> *collide-stats* frags)
|
|
(/ (the float (-> *collide-stats* frags)) (the float (-> *collide-stats* calls)))
|
|
)
|
|
(format
|
|
*stdcon*
|
|
"~0ktris = ~d~256htris/frag = ~f~%"
|
|
(-> *collide-stats* tris)
|
|
(/ (the float (-> *collide-stats* tris)) (the float (-> *collide-stats* frags)))
|
|
)
|
|
(format
|
|
*stdcon*
|
|
"~0koutput = ~d~256houtput/call = ~f~%"
|
|
(-> *collide-stats* output)
|
|
(/ (the float (-> *collide-stats* output)) (the float (-> *collide-stats* calls)))
|
|
)
|
|
(format *stdcon* "~0k---------------------------------------------------------------~%")
|
|
(let ((gp-0 (stopwatch-elapsed-ticks (the-as stopwatch (&-> *collide-stats* junk 1))))
|
|
(s4-0 (stopwatch-elapsed-ticks (the-as stopwatch (&-> *collide-stats* junk 9))))
|
|
(s5-0 (stopwatch-elapsed-ticks (the-as stopwatch (&-> *collide-stats* junk 17))))
|
|
)
|
|
(format *stdcon* "~0ktotal-target ~D~%" gp-0)
|
|
(format *stdcon* "~0ktarget-cache-fill ~D ~0,,2f%~%" s4-0 (/ (* 100.0 (the float s4-0)) (the float gp-0)))
|
|
(format *stdcon* "~0ktarget-ray-poly ~D ~0,,2f%~%" s5-0 (/ (* 100.0 (the float s5-0)) (the float gp-0)))
|
|
)
|
|
(set! (-> *collide-stats* calls) (the-as uint 0))
|
|
(set! (-> *collide-stats* spheres) (the-as uint 0))
|
|
(set! (-> *collide-stats* nodes) (the-as uint 0))
|
|
(set! (-> *collide-stats* frags) (the-as uint 0))
|
|
(set! (-> *collide-stats* tris) (the-as uint 0))
|
|
(set! (-> *collide-stats* output) (the-as uint 0))
|
|
(stopwatch-init (the-as stopwatch (&-> *collide-stats* junk 1)))
|
|
(stopwatch-init (the-as stopwatch (&-> *collide-stats* junk 9)))
|
|
(stopwatch-init (the-as stopwatch (&-> *collide-stats* junk 17)))
|
|
0
|
|
(none)
|
|
)
|
|
|
|
;; WARN: Return type mismatch uint vs texture-id.
|
|
(defun level-remap-texture ((arg0 texture-id))
|
|
"Level tpages combine the tpages of many individual actors.
|
|
Given a texture ID for a texture in an individual actor,
|
|
determine the texture ID for this texture in the level's
|
|
combined page."
|
|
(let ((v1-1 (-> *level* log-in-level-bsp)))
|
|
(when v1-1
|
|
(let* ((a3-0 (-> v1-1 texture-remap-table-len))
|
|
(v1-2 (the-as object (-> v1-1 texture-remap-table)))
|
|
(t0-0 (the-as (pointer uint64) v1-2))
|
|
(a1-1 (the-as uint #xfffffff8))
|
|
(a2-1 (logand (new 'static 'texture-id :index #xfff :page #xfff) arg0))
|
|
(a3-2 (the-as object (&+ t0-0 (* a3-0 8))))
|
|
)
|
|
(label cfg-2)
|
|
(b! (= v1-2 a3-2) cfg-8 :delay (nop!))
|
|
(let ((t0-3 (the-as object (logand (/ (+ (the-as int v1-2) (the-as int a3-2)) 2) a1-1))))
|
|
(let ((t1-1 (- (-> (the-as (pointer uint32) t0-3) 0) a2-1)))
|
|
(b! (zero? t1-1) cfg-7 :delay (nop!))
|
|
(b! (< (the-as int t1-1) 0) cfg-6 :delay (nop!))
|
|
)
|
|
(b! #t cfg-2 :delay (set! a3-2 (the-as (pointer uint64) t0-3)))
|
|
(label cfg-6)
|
|
(b! #t cfg-2 :delay (set! v1-2 (+ (the-as int t0-3) 8)))
|
|
(label cfg-7)
|
|
(set! arg0 (the-as texture-id (logior (-> (the-as (pointer uint32) t0-3) 1) 20)))
|
|
)
|
|
)
|
|
(label cfg-8)
|
|
0
|
|
)
|
|
)
|
|
(the-as texture-id arg0)
|
|
)
|
|
|
|
(defun build-masks ((arg0 bsp-header))
|
|
"Allocate and assign texture masks, and closest object arrays.
|
|
These are used at runtime to only upload the texture chunks and
|
|
mip levels that are actually needed."
|
|
(let ((v1-0 (-> arg0 drawable-trees))
|
|
(s2-0 (-> arg0 tfrag-mask-count))
|
|
(s3-0 (-> arg0 shrub-mask-count))
|
|
(s4-0 (-> arg0 alpha-mask-count))
|
|
(gp-0 (-> arg0 water-mask-count))
|
|
)
|
|
(when (zero? (+ s2-0 s3-0 s4-0 gp-0))
|
|
(dotimes (a0-5 (-> v1-0 length))
|
|
(let ((a1-2 (-> v1-0 trees a0-5)))
|
|
(cond
|
|
((= (-> a1-2 type) drawable-tree-tfrag)
|
|
(let* ((a2-5 (-> (the-as drawable-tree-tfrag a1-2) arrays (+ (-> (the-as drawable-tree-tfrag a1-2) length) -1)))
|
|
(a1-4 (-> a2-5 length))
|
|
(a2-6 (-> (the-as drawable-inline-array-tfrag a2-5) data))
|
|
)
|
|
(dotimes (a3-1 a1-4)
|
|
(set! (-> a2-6 0 texture-masks-index) (the-as uint s2-0))
|
|
(+! s2-0 1)
|
|
(set! a2-6 (the-as (inline-array tfragment) (-> a2-6 1)))
|
|
)
|
|
)
|
|
)
|
|
((= (-> a1-2 type) drawable-tree-tfrag-trans)
|
|
(let* ((a2-13
|
|
(-> (the-as drawable-tree-tfrag-trans a1-2) arrays (+ (-> (the-as drawable-tree-tfrag-trans a1-2) length) -1))
|
|
)
|
|
(a1-7 (-> a2-13 length))
|
|
(a2-14 (-> (the-as drawable-inline-array-tfrag a2-13) data))
|
|
)
|
|
(dotimes (a3-3 a1-7)
|
|
(set! (-> a2-14 0 texture-masks-index) (the-as uint s4-0))
|
|
(+! s4-0 1)
|
|
(set! a2-14 (the-as (inline-array tfragment) (-> a2-14 1)))
|
|
)
|
|
)
|
|
)
|
|
((= (-> a1-2 type) drawable-tree-tfrag-water)
|
|
(let* ((a2-21
|
|
(-> (the-as drawable-tree-tfrag-water a1-2) arrays (+ (-> (the-as drawable-tree-tfrag-water a1-2) length) -1))
|
|
)
|
|
(a1-10 (-> a2-21 length))
|
|
(a2-22 (-> (the-as drawable-inline-array-tfrag a2-21) data))
|
|
)
|
|
(dotimes (a3-5 a1-10)
|
|
(set! (-> a2-22 0 texture-masks-index) (the-as uint gp-0))
|
|
(+! gp-0 1)
|
|
(set! a2-22 (the-as (inline-array tfragment) (-> a2-22 1)))
|
|
)
|
|
)
|
|
)
|
|
((= (-> a1-2 type) drawable-tree-instance-tie)
|
|
(let* ((a1-13 (-> (the-as drawable-tree-instance-tie a1-2) prototypes prototype-array-tie))
|
|
(a2-26 (-> a1-13 length))
|
|
)
|
|
(dotimes (a3-7 a2-26)
|
|
(cond
|
|
((logtest? (-> a1-13 array-data a3-7 flags) (prototype-flags tpage-water))
|
|
(set! (-> a1-13 array-data a3-7 texture-masks-index) (the-as uint gp-0))
|
|
(+! gp-0 1)
|
|
)
|
|
((logtest? (-> a1-13 array-data a3-7 flags) (prototype-flags tpage-alpha))
|
|
(set! (-> a1-13 array-data a3-7 texture-masks-index) (the-as uint s4-0))
|
|
(+! s4-0 1)
|
|
)
|
|
(else
|
|
(set! (-> a1-13 array-data a3-7 texture-masks-index) (the-as uint s2-0))
|
|
(+! s2-0 1)
|
|
)
|
|
)
|
|
)
|
|
)
|
|
)
|
|
((= (-> a1-2 type) drawable-tree-instance-shrub)
|
|
(let* ((a2-30 (-> (the-as drawable-tree-instance-shrub a1-2) info prototype-inline-array-shrub))
|
|
(a1-16 (-> a2-30 length))
|
|
(a2-31 (-> a2-30 data))
|
|
)
|
|
(dotimes (a3-9 a1-16)
|
|
(set! (-> a2-31 0 texture-masks-index) (the-as uint s3-0))
|
|
(+! s3-0 1)
|
|
(set! a2-31 (the-as (inline-array prototype-bucket-shrub) (-> a2-31 1)))
|
|
)
|
|
)
|
|
)
|
|
)
|
|
)
|
|
)
|
|
)
|
|
(when (nonzero? s2-0)
|
|
(set! (-> arg0 tfrag-masks) (new 'loading-level 'texture-masks-array (the-as int s2-0)))
|
|
(set! (-> arg0 tfrag-closest) (the-as (pointer float) (malloc 'loading-level (the-as int (* s2-0 4)))))
|
|
(let ((v1-5 (-> arg0 tfrag-masks)))
|
|
(dotimes (a0-8 (the-as int s2-0))
|
|
(let ((a1-24 (-> v1-5 data a0-8)))
|
|
(dotimes (a2-34 3)
|
|
(set! (-> a1-24 data a2-34 mask quad) (the-as uint128 0))
|
|
)
|
|
)
|
|
)
|
|
)
|
|
)
|
|
(when (nonzero? s3-0)
|
|
(set! (-> arg0 shrub-masks) (new 'loading-level 'texture-masks-array (the-as int s3-0)))
|
|
(set! (-> arg0 shrub-closest) (the-as (pointer float) (malloc 'loading-level (the-as int (* s3-0 4)))))
|
|
(let ((v1-10 (-> arg0 shrub-masks)))
|
|
(dotimes (a0-11 (the-as int s3-0))
|
|
(let ((a1-32 (-> v1-10 data a0-11)))
|
|
(dotimes (a2-36 3)
|
|
(set! (-> a1-32 data a2-36 mask quad) (the-as uint128 0))
|
|
)
|
|
)
|
|
)
|
|
)
|
|
)
|
|
(when (nonzero? s4-0)
|
|
(set! (-> arg0 alpha-masks) (new 'loading-level 'texture-masks-array (the-as int s4-0)))
|
|
(set! (-> arg0 alpha-closest) (the-as (pointer float) (malloc 'loading-level (the-as int (* s4-0 4)))))
|
|
(let ((v1-15 (-> arg0 alpha-masks)))
|
|
(dotimes (a0-14 (the-as int s4-0))
|
|
(let ((a1-40 (-> v1-15 data a0-14)))
|
|
(dotimes (a2-38 3)
|
|
(set! (-> a1-40 data a2-38 mask quad) (the-as uint128 0))
|
|
)
|
|
)
|
|
)
|
|
)
|
|
)
|
|
(when (nonzero? gp-0)
|
|
(set! (-> arg0 water-masks) (new 'loading-level 'texture-masks-array (the-as int gp-0)))
|
|
(set! (-> arg0 water-closest) (the-as (pointer float) (malloc 'loading-level (the-as int (* gp-0 4)))))
|
|
(let ((v1-20 (-> arg0 water-masks)))
|
|
(dotimes (a0-17 (the-as int gp-0))
|
|
(let ((a1-48 (-> v1-20 data a0-17)))
|
|
(dotimes (a2-40 3)
|
|
(set! (-> a1-48 data a2-40 mask quad) (the-as uint128 0))
|
|
)
|
|
)
|
|
)
|
|
)
|
|
)
|
|
)
|
|
0
|
|
(none)
|
|
)
|