mirror of
https://github.com/open-goal/jak-project
synced 2026-08-20 22:35:07 -04:00
water111
1584 lines
81 KiB
Common Lisp
1584 lines
81 KiB
Common Lisp
;;-*-Lisp-*-
|
|
(in-package goal)
|
|
(bundles "ENGINE.CGO" "GAME.CGO")
|
|
(require "engine/engine/engines.gc")
|
|
(require "engine/gfx/tie/tie-methods.gc")
|
|
(require "engine/level/load-boundary.gc")
|
|
(require "engine/gfx/mood/time-of-day.gc")
|
|
(require "engine/gfx/shadow/shadow-cpu.gc")
|
|
(require "engine/gfx/generic/generic.gc")
|
|
(require "engine/collide/collide-shape.gc")
|
|
(require "engine/gfx/generic/generic-merc.gc")
|
|
|
|
;; DECOMP BEGINS
|
|
|
|
;; A drawable is the common interface for renderer leaves, flat arrays, and the interior nodes of
|
|
;; the draw trees. The base methods do no work so a tree traversal can dispatch without first
|
|
;; identifying the concrete child type.
|
|
;;
|
|
;; Camera side-plane coefficients are transposed across four vectors: each vector supplies one
|
|
;; coefficient for all four planes. VU0 therefore classifies a sphere or segment against every side
|
|
;; plane in parallel. The guard planes enclose a wider volume and distinguish geometry that can be
|
|
;; accepted directly from geometry that needs clipping.
|
|
|
|
(#when PC_PORT
|
|
(defun sphere-cull ((sphere vector))
|
|
"Test sphere against the four current view-frustum side planes. Return true unless the sphere
|
|
lies wholly outside any plane; the EE entry uses plane coefficients left in vf16-vf19 by its
|
|
caller."
|
|
;; The PC renderers perform their own visibility rejection.
|
|
#t))
|
|
|
|
;; Each caller loads vf16-vf19 with the transposed side-plane coefficients before entering the
|
|
;; traversal. Each result lane is the signed center distance plus the sphere radius.
|
|
(#unless PC_PORT
|
|
(defun sphere-cull ((sphere vector))
|
|
"Return true when the sphere intersects every current view-frustum half-space."
|
|
(local-vars (dist-bits uint128) (outside-bits uint128) (packed-outside uint128))
|
|
(rlet ((acc :reg acc)
|
|
(vu-zero :reg vf0)
|
|
(sphere-center-radius :reg vf10)
|
|
(plane-x :reg vf16)
|
|
(plane-y :reg vf17)
|
|
(plane-z :reg vf18)
|
|
(plane-offset :reg vf19)
|
|
(plane-distances :reg vf9))
|
|
(l.vf sphere-center-radius sphere)
|
|
(mul.x.vf acc plane-x sphere-center-radius)
|
|
(add.mul.y.vf acc plane-y sphere-center-radius acc)
|
|
(add.mul.z.vf acc plane-z sphere-center-radius acc)
|
|
(sub.mul.w.vf plane-distances plane-offset vu-zero acc)
|
|
(add.w.vf plane-distances plane-distances sphere-center-radius)
|
|
(m dist-bits plane-distances)
|
|
(pcgt.w outside-bits 0 dist-bits)
|
|
(ppach packed-outside 0 outside-bits)
|
|
(zero? (the-as int packed-outside)))))
|
|
|
|
(#when PC_PORT
|
|
(defun guard-band-cull ((sphere vector))
|
|
"Return true when the sphere crosses an expanded guard-plane boundary and therefore needs
|
|
clipping."
|
|
(local-vars (v1-0 uint128) (v1-1 uint128) (v1-2 uint128))
|
|
(rlet ((acc :class vf)
|
|
(vf0 :class vf)
|
|
(vf10 :class vf)
|
|
(vf20 :class vf)
|
|
(vf21 :class vf)
|
|
(vf22 :class vf)
|
|
(vf23 :class vf)
|
|
(vf9 :class vf))
|
|
(init-vf0-vector)
|
|
;; og:preserve-this manually added
|
|
(let ((at-0 *math-camera*))
|
|
(.lvf vf20 (&-> at-0 guard-plane 0 quad))
|
|
(.lvf vf21 (&-> at-0 guard-plane 1 quad))
|
|
(.lvf vf22 (&-> at-0 guard-plane 2 quad))
|
|
(.lvf vf23 (&-> at-0 guard-plane 3 quad)))
|
|
(.lvf vf10 (&-> sphere quad))
|
|
(.mul.x.vf acc vf20 vf10)
|
|
(.add.mul.y.vf acc vf21 vf10 acc)
|
|
(.add.mul.z.vf acc vf22 vf10 acc)
|
|
(.sub.mul.w.vf vf9 vf23 vf0 acc)
|
|
(.sub.w.vf vf9 vf9 vf10)
|
|
(.mov v1-0 vf9)
|
|
(.pcgtw v1-1 0 v1-0)
|
|
(.ppach v1-2 (the-as uint128 0) v1-1)
|
|
(nonzero? (the-as int v1-2)))))
|
|
|
|
;; dma-add-process-drawable leaves the transposed guard planes in vf20-vf23. Subtracting the radius
|
|
;; identifies a sphere which is not wholly inside the expanded volume.
|
|
(#unless PC_PORT
|
|
(defun guard-band-cull ((sphere vector))
|
|
"Return true when the sphere crosses an expanded guard-plane boundary and therefore needs
|
|
clipping."
|
|
(local-vars (dist-bits uint128) (outside-bits uint128) (packed-outside uint128))
|
|
(rlet ((acc :reg acc)
|
|
(vu-zero :reg vf0)
|
|
(sphere-center-radius :reg vf10)
|
|
(plane-x :reg vf20)
|
|
(plane-y :reg vf21)
|
|
(plane-z :reg vf22)
|
|
(plane-offset :reg vf23)
|
|
(plane-distances :reg vf9))
|
|
(l.vf sphere-center-radius sphere)
|
|
(mul.x.vf acc plane-x sphere-center-radius)
|
|
(add.mul.y.vf acc plane-y sphere-center-radius acc)
|
|
(add.mul.z.vf acc plane-z sphere-center-radius acc)
|
|
(sub.mul.w.vf plane-distances plane-offset vu-zero acc)
|
|
(sub.w.vf plane-distances plane-distances sphere-center-radius)
|
|
(m dist-bits plane-distances)
|
|
(pcgt.w outside-bits 0 dist-bits)
|
|
(ppach packed-outside 0 outside-bits)
|
|
(nonzero? (the-as int packed-outside)))))
|
|
|
|
(defun sphere-in-view-frustum? ((sphere sphere))
|
|
"Return true unless sphere lies wholly outside one of *math-camera*'s four view-frustum side
|
|
planes."
|
|
(local-vars (distance-bits uint128) (outside-bits uint128) (packed-outside uint128))
|
|
(rlet ((acc :class vf)
|
|
(vf0 :class vf)
|
|
(vf1 :class vf)
|
|
(vf2 :class vf)
|
|
(vf3 :class vf)
|
|
(vf4 :class vf)
|
|
(vf5 :class vf)
|
|
(vf6 :class vf))
|
|
(init-vf0-vector)
|
|
(let ((view-camera *math-camera*))
|
|
(.lvf vf6 (&-> sphere quad))
|
|
(.lvf vf1 (&-> view-camera plane 0 quad))
|
|
(.lvf vf2 (&-> view-camera plane 1 quad))
|
|
(.lvf vf3 (&-> view-camera plane 2 quad))
|
|
(.lvf vf4 (&-> view-camera plane 3 quad)))
|
|
(.mul.x.vf acc vf1 vf6)
|
|
(.add.mul.y.vf acc vf2 vf6 acc)
|
|
(.add.mul.z.vf acc vf3 vf6 acc)
|
|
(.sub.mul.w.vf vf5 vf4 vf0 acc)
|
|
(.add.w.vf vf5 vf5 vf6)
|
|
(.mov distance-bits vf5)
|
|
(.pcgtw outside-bits 0 distance-bits)
|
|
(.ppach packed-outside (the-as uint128 0) outside-bits)
|
|
(zero? (the-as int packed-outside))))
|
|
|
|
(defun line-in-view-frustum? ((start vector) (end vector))
|
|
"Conservatively test the segment from start to end against the four view-frustum side planes.
|
|
Return false only when both endpoints lie outside the same plane."
|
|
(local-vars
|
|
(start-distance-bits uint128)
|
|
(start-outside-bits uint128)
|
|
(start-outside-mask uint128)
|
|
(end-distance-bits uint128)
|
|
(end-outside-bits uint128)
|
|
(end-outside-mask uint128))
|
|
(rlet ((acc :class vf)
|
|
(vf0 :class vf)
|
|
(vf10 :class vf)
|
|
(vf16 :class vf)
|
|
(vf17 :class vf)
|
|
(vf18 :class vf)
|
|
(vf19 :class vf)
|
|
(vf9 :class vf))
|
|
(init-vf0-vector)
|
|
(let ((view-camera *math-camera*))
|
|
(.lvf vf9 (&-> start quad))
|
|
(.lvf vf10 (&-> end quad))
|
|
(.lvf vf16 (&-> view-camera plane 0 quad))
|
|
(.lvf vf17 (&-> view-camera plane 1 quad))
|
|
(.lvf vf18 (&-> view-camera plane 2 quad))
|
|
(.lvf vf19 (&-> view-camera plane 3 quad)))
|
|
(.mul.x.vf acc vf16 vf9)
|
|
(.add.mul.y.vf acc vf17 vf9 acc)
|
|
(.add.mul.z.vf acc vf18 vf9 acc)
|
|
(.sub.mul.w.vf vf9 vf19 vf0 acc)
|
|
(.mul.x.vf acc vf16 vf10)
|
|
(.add.mul.y.vf acc vf17 vf10 acc)
|
|
(.add.mul.z.vf acc vf18 vf10 acc)
|
|
(.sub.mul.w.vf vf10 vf19 vf0 acc)
|
|
(.mov start-distance-bits vf9)
|
|
(.pcgtw start-outside-bits 0 start-distance-bits)
|
|
(.ppach start-outside-mask (the-as uint128 0) start-outside-bits)
|
|
(.mov end-distance-bits vf10)
|
|
(.pcgtw end-outside-bits 0 end-distance-bits)
|
|
(.ppach end-outside-mask (the-as uint128 0) end-outside-bits)
|
|
(not (logtest? (the-as int start-outside-mask) (the-as int end-outside-mask)))))
|
|
|
|
(#when PC_PORT
|
|
(defun vis-cull ((id int))
|
|
"Return the visibility bit for draw-node id from the current scratchpad visibility list."
|
|
;; Error spheres are debug-only on PC, where the visibility list is not kept in scratchpad.
|
|
#t))
|
|
|
|
(#unless PC_PORT
|
|
(defun vis-cull ((id int))
|
|
"Return the visibility bit for draw-node id from the current scratchpad visibility list."
|
|
;; Draw-node bits are stored most-significant-bit first within each signed byte.
|
|
(rlet ((scratch-base)
|
|
(byte-address)
|
|
(vis-byte)
|
|
(bit-index)
|
|
(shifted-byte))
|
|
(lui scratch-base #x7000)
|
|
(sra byte-address id 3)
|
|
(add byte-address byte-address scratch-base)
|
|
(l.b vis-byte byte-address #x38b0)
|
|
(and.i bit-index id 7)
|
|
(add.i bit-index bit-index 56)
|
|
(sll.v shifted-byte vis-byte bit-index)
|
|
(< shifted-byte 0))))
|
|
|
|
(defun error-sphere ((item drawable-error) (name string))
|
|
"When artist error spheres are enabled and item passes visibility and frustum culling, draw its
|
|
red bounding sphere and label it with name."
|
|
(when *artist-error-spheres*
|
|
(when (vis-cull (-> item id))
|
|
(when (sphere-cull (-> item bsphere))
|
|
(add-debug-sphere #t (bucket-id debug) (-> item bsphere) (-> item bsphere w) (new 'static 'rgba :r #x80 :a #x80))
|
|
(add-debug-text-3d #t (bucket-id debug-no-zbuf) name (-> item bsphere) (font-color white) (the-as vector2h #f)))))
|
|
0
|
|
(none))
|
|
|
|
(defmethod login ((this drawable))
|
|
"Initialize a drawable after its linked data has been loaded."
|
|
this)
|
|
|
|
(defmethod draw ((this drawable) (draw-data drawable) (frame display-frame))
|
|
"Submit this drawable's work for the current display frame."
|
|
0
|
|
(none))
|
|
|
|
(defmethod collide-with-box ((this drawable) (count int) (result collide-list))
|
|
"Traverse count contiguous siblings beginning at this and append collision
|
|
geometry intersecting the active collision box to result."
|
|
0
|
|
(none))
|
|
|
|
(defmethod collide-y-probe ((this drawable) (count int) (result collide-list))
|
|
"Traverse count contiguous siblings beginning at this and append collision
|
|
geometry intersecting the active vertical probe to result."
|
|
0
|
|
(none))
|
|
|
|
(defmethod collide-ray ((this drawable) (count int) (result collide-list))
|
|
"Traverse count contiguous siblings beginning at this and append collision geometry
|
|
intersecting the active swept-sphere ray to result."
|
|
0
|
|
(none))
|
|
|
|
(defmethod collect-ambients ((this drawable) (query-sphere sphere) (count int) (result ambient-list))
|
|
"Traverse count contiguous siblings beginning at this and append ambient
|
|
objects overlapping query-sphere to result."
|
|
0
|
|
(none))
|
|
|
|
(defmethod collect-stats ((this drawable))
|
|
"Accumulate this drawable's renderer statistics."
|
|
0
|
|
(none))
|
|
|
|
(defmethod debug-draw ((this drawable) (draw-data drawable) (frame display-frame))
|
|
"Submit debug geometry for this drawable."
|
|
0
|
|
(none))
|
|
|
|
(defmethod draw ((this drawable-error) (item drawable-error) (frame display-frame))
|
|
"Draw item's labeled error sphere for frame."
|
|
(error-sphere item (-> item name))
|
|
(none))
|
|
|
|
(defmethod unpack-vis ((this drawable) (destination (pointer int8)) (source (pointer int8)))
|
|
"Decode this drawable's visibility bytes into destination and return the advanced source pointer."
|
|
source)
|
|
|
|
(define *edit-instance* (the-as string #f))
|
|
|
|
(when *debug-segment*
|
|
(define *instance-mem-usage* (new 'debug 'memory-usage-block)))
|
|
|
|
(defun-debug find-instance-by-name ((name string))
|
|
"Search every active level's shrub and TIE prototype arrays for name. Return the matching
|
|
prototype bucket, or false when no prototype matches."
|
|
(dotimes (level-index (-> *level* length))
|
|
(let ((active-level (-> *level* level level-index)))
|
|
(when (= (-> active-level status) 'active)
|
|
(let ((drawable-trees (-> active-level bsp drawable-trees)))
|
|
(dotimes (tree-index (-> drawable-trees length))
|
|
(let ((tree (-> drawable-trees trees tree-index)))
|
|
(case (-> tree type)
|
|
((drawable-tree-instance-shrub)
|
|
(let ((shrub-prototypes (-> (the-as drawable-tree-instance-shrub tree) info prototype-inline-array-shrub)))
|
|
(dotimes (prototype-index (-> shrub-prototypes length))
|
|
(if (string= name (-> shrub-prototypes data prototype-index name)) (return (-> shrub-prototypes data prototype-index))))))
|
|
((drawable-tree-instance-tie)
|
|
(let ((tie-prototypes (-> (the-as drawable-tree-instance-tie tree) prototypes prototype-array-tie)))
|
|
(dotimes (prototype-index (-> tie-prototypes length))
|
|
(if (string= name (-> tie-prototypes array-data prototype-index name))
|
|
(return (-> tie-prototypes array-data prototype-index)))))))))))))
|
|
(the-as prototype-bucket #f))
|
|
|
|
(defun-debug find-instance-by-index ((tree-type type) (prototype-index int) (bsp-filter bsp-header))
|
|
"Search active levels, optionally restricted to bsp-filter, for a shrub or TIE tree of tree-type
|
|
and return prototype-index from its prototype array. Return false when no tree matches;
|
|
prototype-index is not bounds checked."
|
|
(dotimes (level-index (-> *level* length))
|
|
(let ((active-level (-> *level* level level-index)))
|
|
(when (= (-> active-level status) 'active)
|
|
(let ((level-bsp (-> active-level bsp)))
|
|
(when (or (not bsp-filter) (= level-bsp bsp-filter))
|
|
(let ((drawable-trees (-> level-bsp drawable-trees)))
|
|
(dotimes (tree-index (-> drawable-trees length))
|
|
(let ((tree (-> drawable-trees trees tree-index)))
|
|
(case (-> tree type)
|
|
((drawable-tree-instance-shrub)
|
|
(when (= tree-type (-> tree type))
|
|
(let ((shrub-prototypes (-> (the-as drawable-tree-instance-shrub tree) info prototype-inline-array-shrub)))
|
|
(return (-> shrub-prototypes data prototype-index)))))
|
|
((drawable-tree-instance-tie)
|
|
(when (= tree-type (-> tree type))
|
|
(let ((tie-prototypes (-> (the-as drawable-tree-instance-tie tree) prototypes prototype-array-tie)))
|
|
(return (-> tie-prototypes array-data prototype-index))))))))))))))
|
|
(the-as prototype-bucket #f))
|
|
|
|
(defun-debug prototype-bucket-type ((prototype prototype-bucket))
|
|
"Classify prototype from the type of geometry slot 1, returning instance-shrubbery or
|
|
instance-tie."
|
|
(case (-> prototype geometry 1 type)
|
|
((prototype-shrubbery shrubbery) instance-shrubbery)
|
|
((prototype-tie prototype-tie tie-fragment) instance-tie)))
|
|
|
|
(defun-debug prototype-bucket-recalc-fields ((prototype prototype-bucket))
|
|
"Recompute prototype's derived LOD distances after editing its near or far plane. TIE places the
|
|
mid plane one third of the way from near to far; shrub preserves its mid plane and uses the full
|
|
near-to-far span for rdists.x. Update the reciprocal band lengths, set the near stiffening distance
|
|
to half the near plane, and return prototype."
|
|
(case (prototype-bucket-type prototype)
|
|
((instance-shrubbery) (set! (-> prototype rdists x) (/ 1.0 (- (-> prototype dists w) (-> prototype dists x)))))
|
|
(else
|
|
(set! (-> prototype dists z)
|
|
(+ (-> prototype dists x) (* 0.33333334 (- (-> prototype dists w) (-> prototype dists x)))))
|
|
(set! (-> prototype rdists x) (/ 1.0 (- (-> prototype dists z) (-> prototype dists x))))))
|
|
(set! (-> prototype rdists z) (/ 1.0 (- (-> prototype dists w) (-> prototype dists z))))
|
|
(set! (-> prototype dists y) (/ (-> prototype dists x) 2))
|
|
(set! (-> prototype rdists y) (/ 1.0 (-> prototype dists y)))
|
|
prototype)
|
|
|
|
(#unless PC_PORT
|
|
(defun-debug draw-instance-info ((output string))
|
|
"When instance statistics are enabled and *edit-instance* names a prototype, print its memory
|
|
use, LOD distances, instance counts, and per-geometry triangle, displayed-vertex, strip-length, and
|
|
texture statistics to output. Do nothing when the selection is absent."
|
|
(local-vars
|
|
(lod int)
|
|
(last-lod int)
|
|
(tie-triangle-count int)
|
|
(tie-displayed-vertex-count int)
|
|
(tie-texture-count int)
|
|
(visible-instance-count int))
|
|
(when (and *display-instance-info* *edit-instance*)
|
|
(let ((prototype (find-instance-by-name *edit-instance*)))
|
|
(when prototype
|
|
(let ((instance-type (prototype-bucket-type prototype)))
|
|
(let ((geometry-bytes 0))
|
|
0
|
|
(cond
|
|
((= instance-type instance-shrubbery) (set! geometry-bytes 595))
|
|
((= instance-type instance-tie)
|
|
(reset! *instance-mem-usage*)
|
|
(dotimes (s4-1 4)
|
|
(when (nonzero? (-> prototype geometry s4-1))
|
|
(let* ((a0-4 (-> prototype geometry s4-1))
|
|
(t9-3 (method-of-object a0-4 mem-usage))
|
|
(a1-0 *instance-mem-usage*)
|
|
(v1-16 s4-1))
|
|
(t9-3 a0-4
|
|
a1-0
|
|
(the-as mem-usage-flags
|
|
(logior (cond
|
|
((= v1-16 1) 4)
|
|
((= v1-16 2) 8)
|
|
((= v1-16 3) 16)
|
|
(else 0))
|
|
2))))))
|
|
(set! geometry-bytes (+ (calculate-total *instance-mem-usage*) 580))))
|
|
(mem-usage prototype (reset! *instance-mem-usage*) (mem-usage-flags))
|
|
(let ((prototype-bytes (calculate-total *instance-mem-usage*)))
|
|
(format output
|
|
"~%~A ~A b @ #x~X ~,,2fK/~,,2fK~%"
|
|
instance-type
|
|
(-> prototype name)
|
|
prototype
|
|
(* 0.0009765625 (the float prototype-bytes))
|
|
(* 0.0009765625 (the float geometry-bytes)))))
|
|
(format output "near: ~m mid: ~m far: ~m~%" (-> prototype dists x) (-> prototype dists z) (-> prototype dists w))
|
|
(let ((total-triangles 0)
|
|
(total-displayed-vertices 0))
|
|
(cond
|
|
((= instance-type instance-shrubbery)
|
|
(let ((estimated-cost 0.0))
|
|
(format output
|
|
"usage: vis: ~D shurb: ~D trans-shrub ~D bill: ~D in level: ~D~%"
|
|
(-> prototype count 0)
|
|
(-> prototype count 1)
|
|
(-> prototype count 2)
|
|
(-> prototype count 3)
|
|
(-> prototype in-level))
|
|
(format output "~%frag# tris dverts strlen tex~%")
|
|
(let ((shrub-geometry (-> prototype geometry 1))
|
|
(shrub-instance-count (+ (-> prototype count 1) (-> prototype count 2))))
|
|
(dotimes (fragment-index (-> (the-as drawable-group shrub-geometry) length))
|
|
(let ((shrub-triangle-count (shrub-num-tris (the-as shrubbery (+ (+ (* fragment-index 32) 32) (the-as int shrub-geometry)))))
|
|
(shrub-displayed-vertex-count (-> (the-as prototype-shrubbery (+ (the-as uint shrub-geometry) (* fragment-index 32))) data 0 header data 2))
|
|
(shrub-texture-count (-> (the-as prototype-shrubbery (+ (the-as uint shrub-geometry) (* fragment-index 32))) data 0 header data 0)))
|
|
(format output
|
|
"~5D ~4D ~5D ~6f ~D~%"
|
|
fragment-index
|
|
shrub-triangle-count
|
|
shrub-displayed-vertex-count
|
|
(/ (* 2.0 (the float shrub-triangle-count)) (the float (- shrub-displayed-vertex-count shrub-triangle-count)))
|
|
shrub-texture-count)
|
|
(+! total-triangles shrub-triangle-count)
|
|
(+! total-displayed-vertices shrub-displayed-vertex-count)
|
|
(set! estimated-cost
|
|
(+ 29.0
|
|
(* 5.5 (the float (- shrub-displayed-vertex-count shrub-triangle-count)))
|
|
(* 22.0 (the float shrub-texture-count))
|
|
(* 8.0 (the float shrub-displayed-vertex-count))
|
|
(* 53.0 (the float (/ (+ shrub-instance-count 9) (the-as uint 10))))
|
|
(* (the float shrub-instance-count)
|
|
(+ 15.0 (* 5.0 (the float shrub-texture-count)) (* 13.5 (the float shrub-displayed-vertex-count))))
|
|
estimated-cost))))
|
|
(format output
|
|
"total ~4D ~5D ~6f ~D speed: ~f~%"
|
|
total-triangles
|
|
total-displayed-vertices
|
|
(/ (* 2.0 (the float total-triangles)) (the float (- total-displayed-vertices total-triangles)))
|
|
(-> prototype utextures)
|
|
(/ estimated-cost (* (the float shrub-instance-count) (the float total-triangles)))))))
|
|
((= instance-type instance-tie)
|
|
(set! visible-instance-count 0)
|
|
(let ((displayed-triangle-total 0)
|
|
(displayed-vertex-total 0)
|
|
(texture-total 0))
|
|
(format output "~%level visible frags tris dverts strlen tex ttris~%")
|
|
(set! lod 1)
|
|
(set! last-lod 3)
|
|
(while (>= last-lod lod)
|
|
(let ((tie-geometry (-> prototype geometry lod)))
|
|
(set! tie-triangle-count 0)
|
|
(set! tie-displayed-vertex-count 0)
|
|
(set! tie-texture-count 0)
|
|
(dotimes (fragment-index (-> (the-as prototype-tie tie-geometry) length))
|
|
(+! tie-triangle-count (l.hu (+ (the-as uint tie-geometry) (* fragment-index 64) 68)))
|
|
(+! tie-displayed-vertex-count (l.hu (+ (the-as uint tie-geometry) (* fragment-index 64) 70)))
|
|
(+! tie-texture-count (l.hu (+ (the-as uint tie-geometry) (* fragment-index 64) 60))))
|
|
(+! visible-instance-count (-> prototype count lod))
|
|
(format output
|
|
"~5D ~7D ~5D ~5D"
|
|
lod
|
|
(-> prototype count lod)
|
|
(-> (the-as prototype-tie tie-geometry) length)
|
|
tie-triangle-count))
|
|
(format output
|
|
" ~5D ~6f ~3D ~5D~%"
|
|
tie-displayed-vertex-count
|
|
(/ (* 2.0 (the float tie-triangle-count)) (the float (- tie-displayed-vertex-count tie-triangle-count)))
|
|
tie-texture-count
|
|
(* (the-as uint tie-triangle-count) (-> prototype count lod)))
|
|
(+! displayed-triangle-total (* (the-as uint tie-triangle-count) (-> prototype count lod)))
|
|
(+! displayed-vertex-total (* (the-as uint tie-displayed-vertex-count) (-> prototype count lod)))
|
|
(+! total-triangles tie-triangle-count)
|
|
(+! total-displayed-vertices tie-displayed-vertex-count)
|
|
(+! texture-total tie-texture-count)
|
|
(+! lod 1))
|
|
(format output "total ~7D/~3D ~5D" visible-instance-count (-> prototype in-level) total-triangles)
|
|
(format output
|
|
" ~5D ~6f ~3D ~5D~%"
|
|
total-displayed-vertices
|
|
(/ (* 2.0 (the float displayed-triangle-total)) (the float (- displayed-vertex-total displayed-triangle-total)))
|
|
texture-total
|
|
displayed-triangle-total)))))))))
|
|
(none)))
|
|
|
|
;; The default dma-add-func for a process-drawable's draw-control (set in initialize-skeleton). Called
|
|
;; once per actor during foreground drawing to: (1) frustum-cull the actor by its bounding sphere,
|
|
;; (2) compute its lighting (sample the level's time-of-day light-group, blend between two lights across
|
|
;; shadow boundaries, and fold in color-mult/color-emissive), (3) pick the LOD level by camera distance,
|
|
;; (4) register which texture pages/levels the actor needs, and finally (5) call draw-bones to emit the
|
|
;; merc skeletal-mesh DMA. Returns early (#f) whenever the actor is culled or too far for its max LOD.
|
|
;; The lighting/clip/LOD math is all done in VU0 macro-ops on the scratchpad for speed.
|
|
(defun dma-add-process-drawable ((actor process-drawable) (control draw-control) (flag symbol) (dma-buf dma-buffer))
|
|
"Cull actor by its bounding sphere, select and smoothly blend its time-of-day lighting and shadow
|
|
contribution, choose a distance LOD, register the required texture masks, set clipping and draw
|
|
status flags, and submit its bones to dma-buf. Queue a matrix refresh when changing to a
|
|
higher-detail skeleton. flag is the unused connection payload."
|
|
(local-vars (v1-37 float))
|
|
(rlet ((acc :class vf)
|
|
(Q :class vf)
|
|
(vf0 :class vf)
|
|
(vf15 :class vf)
|
|
(vf16 :class vf)
|
|
(vf17 :class vf)
|
|
(vf18 :class vf)
|
|
(vf19 :class vf)
|
|
(vf2 :class vf)
|
|
(vf20 :class vf)
|
|
(vf21 :class vf)
|
|
(vf22 :class vf)
|
|
(vf23 :class vf)
|
|
(vf24 :class vf)
|
|
(vf25 :class vf)
|
|
(vf26 :class vf)
|
|
(vf27 :class vf)
|
|
(vf28 :class vf)
|
|
(vf29 :class vf)
|
|
(vf3 :class vf)
|
|
(vf4 :class vf)
|
|
(vf5 :class vf))
|
|
(init-vf0-vector)
|
|
(logclear! (-> control status) (draw-status was-drawn))
|
|
(when (not (logtest? (-> control status) (draw-status hidden no-anim no-skeleton-update)))
|
|
;; og:preserve-this scratchpad
|
|
(let ((bounds-sphere (-> (scratchpad-object terrain-context) work foreground joint-work temp-mtx vector 2))
|
|
(scratch-lights (the-as vu-lights (-> (scratchpad-object terrain-context) work foreground joint-work temp-mtx vector 3)))
|
|
(time-of-day *time-of-day-context*))
|
|
(.lvf vf16 (&-> control origin quad))
|
|
(.lvf vf17 (&-> control bounds quad))
|
|
(.mul.x.vf.w vf16 vf16 vf0)
|
|
(.add.vf vf16 vf16 vf17)
|
|
(.svf (&-> bounds-sphere quad) vf16)
|
|
(.lvf vf28 (&-> control color-mult quad))
|
|
(.lvf vf29 (&-> control color-emissive quad))
|
|
(when (sphere-in-view-frustum? (the-as sphere bounds-sphere))
|
|
(case (-> control global-effect)
|
|
(((draw-effect title))
|
|
(when (not (-> time-of-day title-updated))
|
|
(set! (-> time-of-day title-updated) #t)
|
|
(let ((s0-0 (-> *math-camera* inv-camera-rot))
|
|
(a1-1 (new 'stack-no-clear 'vector))
|
|
(s1-0 (new 'stack-no-clear 'vector)))
|
|
(set-vector! a1-1 0.612 0.5 -0.612 0.0)
|
|
(set-vector! s1-0 -0.696 0.174 0.696 0.0)
|
|
(vector-matrix*! (the-as vector (-> time-of-day title-light-group)) a1-1 s0-0)
|
|
(vector-matrix*! (-> time-of-day title-light-group dir1 direction) s1-0 s0-0))
|
|
(set-vector! (-> *time-of-day-context* current-shadow) 0.612 -0.5 -0.612 1.0))
|
|
(vu-lights<-light-group! scratch-lights (-> time-of-day title-light-group)))
|
|
(else
|
|
(let ((target-light-interp (-> control secondary-interp))
|
|
(current-light-interp (-> control current-secondary-interp))
|
|
(shadow-mask (-> control shadow-mask))
|
|
(light-level-index (-> control level-index))
|
|
(selected-light (-> time-of-day light-group (-> *target* draw light-index)))
|
|
(blended-light (new 'stack-no-clear 'light-group)))
|
|
(cond
|
|
((= (-> control light-index) 255))
|
|
((= light-level-index 2) (set! selected-light (-> time-of-day light-group (-> control light-index))))
|
|
(else (set! selected-light (-> time-of-day moods light-level-index light-group (-> control light-index)))))
|
|
(when (not (or (= light-level-index 2) (zero? shadow-mask)))
|
|
(let* ((shadow-mask-0 (-> time-of-day light-masks-0 light-level-index))
|
|
(shadow-mask-1 (-> time-of-day light-masks-1 light-level-index))
|
|
(shadow-interp (-> time-of-day light-interp light-level-index))
|
|
(a0-13 (logand shadow-mask-0 shadow-mask))
|
|
(v1-18 (logand shadow-mask-1 shadow-mask)))
|
|
(cond
|
|
((and (zero? a0-13) (zero? v1-18)))
|
|
(else
|
|
(set! target-light-interp
|
|
(cond
|
|
((and (nonzero? a0-13) (nonzero? v1-18)) 1.0)
|
|
((zero? a0-13)
|
|
(quad-copy! (the-as pointer blended-light) (the-as pointer selected-light) 12)
|
|
(set! selected-light blended-light)
|
|
(set! (-> selected-light dir1 levels x) 0.0)
|
|
shadow-interp)
|
|
(else
|
|
(quad-copy! (the-as pointer blended-light) (the-as pointer selected-light) 12)
|
|
(set! selected-light blended-light)
|
|
(set! (-> selected-light dir0 levels x) 0.0)
|
|
(- 1.0 shadow-interp))))))))
|
|
(if *teleport* (set! current-light-interp target-light-interp))
|
|
(when (not (or (paused?) (= target-light-interp current-light-interp)))
|
|
(let ((f0-15 (- current-light-interp target-light-interp)))
|
|
(set! current-light-interp
|
|
(cond
|
|
((< (fabs f0-15) 0.2) target-light-interp)
|
|
((< f0-15 0.0) (+ 0.2 current-light-interp))
|
|
(else (+ -0.2 current-light-interp)))))
|
|
(set! (-> control current-secondary-interp) current-light-interp))
|
|
(cond
|
|
((= current-light-interp 0.0) (vu-lights<-light-group! scratch-lights selected-light))
|
|
(else
|
|
(if (!= selected-light blended-light) (quad-copy! (the-as pointer blended-light) (the-as pointer selected-light) 12))
|
|
(let ((f0-20 (- 1.0 current-light-interp)))
|
|
(set! (-> blended-light dir0 levels x) (* (-> blended-light dir0 levels x) f0-20))
|
|
(set! (-> blended-light dir0 levels y) (* (-> blended-light dir0 levels y) f0-20))
|
|
(set! (-> blended-light dir1 levels x) (* (-> blended-light dir1 levels x) f0-20))
|
|
(set! (-> blended-light dir1 levels y) (* (-> blended-light dir1 levels y) f0-20))
|
|
(set! (-> blended-light dir2 levels x) (* (-> blended-light dir2 levels x) f0-20))
|
|
(set! (-> blended-light dir2 levels y) (* (-> blended-light dir2 levels y) f0-20)))
|
|
(vu-lights<-light-group! scratch-lights blended-light))))
|
|
(.lvf vf2 (&-> scratch-lights color 0 quad))
|
|
(.lvf vf3 (&-> scratch-lights color 1 quad))
|
|
(.lvf vf4 (&-> scratch-lights color 2 quad))
|
|
(.lvf vf5 (&-> scratch-lights ambient quad))
|
|
(.mul.vf vf5 vf5 vf28)
|
|
(.mul.vf vf2 vf2 vf28)
|
|
(.mul.vf vf3 vf3 vf28)
|
|
(.mul.vf vf4 vf4 vf28)
|
|
(.add.vf vf5 vf5 vf29)
|
|
(.svf (&-> scratch-lights color 0 quad) vf2)
|
|
(.svf (&-> scratch-lights color 1 quad) vf3)
|
|
(.svf (&-> scratch-lights color 2 quad) vf4)
|
|
(.svf (&-> scratch-lights ambient quad) vf5)
|
|
(.mov v1-37 vf5)))
|
|
(if *display-lights* (add-debug-lights #t (bucket-id debug) (-> time-of-day light-group 0 lights) (-> control origin)))
|
|
(let ((at-0 *math-camera*))
|
|
(.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 guard-plane 0 quad))
|
|
(.lvf vf21 (&-> at-0 guard-plane 1 quad))
|
|
(.lvf vf22 (&-> at-0 guard-plane 2 quad))
|
|
(.lvf vf23 (&-> at-0 guard-plane 3 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 vector 3 quad)))
|
|
(let ((camera-space-position (-> (scratchpad-object terrain-context) work foreground joint-work joint-stack data 1 vector 1)))
|
|
(.lvf vf15 (&-> bounds-sphere quad))
|
|
(.mul.w.vf acc vf27 vf0)
|
|
(.add.mul.x.vf acc vf24 vf15 acc)
|
|
(.add.mul.y.vf acc vf25 vf15 acc)
|
|
(.add.mul.z.vf.xyz vf15 vf26 vf15 acc)
|
|
(.mul.vf vf28 vf15 vf15)
|
|
(.max.w.vf vf29 vf0 vf0)
|
|
(.add.y.vf acc vf28 vf28)
|
|
(.add.mul.z.vf.x vf28 vf29 vf28 acc)
|
|
(.sqrt.vf Q vf28 :ftf #b0)
|
|
(.sub.w.vf.w vf28 vf0 vf15)
|
|
(.wait.vf)
|
|
(.add.vf.w vf15 vf28 Q)
|
|
(.svf (&-> camera-space-position quad) vf15)
|
|
(when (< 0.0 (+ (-> camera-space-position z) (-> control bounds w)))
|
|
(let ((lod-to-use 0))
|
|
(let ((camera-distance (-> camera-space-position w)))
|
|
(when (nonzero? (-> control lod-set max-lod))
|
|
(cond
|
|
((>= (-> control force-lod) 0)
|
|
(set! lod-to-use (-> control force-lod))
|
|
;; og:preserve-this lod hacks
|
|
(if (#if (not PC_PORT)
|
|
(< (-> control lod-set lod (-> control lod-set max-lod) dist) camera-distance)
|
|
(and (-> *pc-settings* ps2-lod-dist?) (< (-> control lod-set lod (-> control lod-set max-lod) dist) camera-distance)))
|
|
(return #f)))
|
|
(else
|
|
(while (and (< lod-to-use (-> control lod-set max-lod)) (< (-> control lod-set lod lod-to-use dist) camera-distance))
|
|
(+! lod-to-use 1)))))
|
|
;; og:preserve-this lod hacks!
|
|
(with-pc
|
|
(if (not (-> *pc-settings* ps2-lod-dist?))
|
|
(set! lod-to-use (minmax (-> *pc-settings* lod-force-actor) 0 (-> control lod-set max-lod)))))
|
|
;; og:preserve-this lod hacks
|
|
(if (#if (not PC_PORT)
|
|
(and (< (-> control lod-set lod lod-to-use dist) camera-distance) (< (-> control force-lod) 0))
|
|
(and (-> *pc-settings* ps2-lod-dist?)
|
|
(< (-> control lod-set lod lod-to-use dist) camera-distance)
|
|
(< (-> control force-lod) 0)))
|
|
(return #f))
|
|
(let ((v1-64 (-> control sink-group level))
|
|
(a0-26 (+ (-> control sink-group merc-sink foreground-texture-page) 6)))
|
|
(when (#if (not PC_PORT)
|
|
(not (logtest? (-> control status) (draw-status do-not-check-distance)))
|
|
(and (-> *pc-settings* ps2-lod-dist?) (not (logtest? (-> control status) (draw-status do-not-check-distance)))))
|
|
(if (< camera-distance (-> v1-64 closest-object a0-26)) (set! (-> v1-64 closest-object a0-26) camera-distance))
|
|
(when (and (!= a0-26 6) (!= (-> control level-index) 2))
|
|
(let ((a1-45 (cond
|
|
((< 102400.0 camera-distance) (-> control mgeo header masks 0))
|
|
((< 81920.0 camera-distance) (-> control mgeo header masks 1))
|
|
(else (-> control mgeo header masks 2)))))
|
|
(logior! (-> v1-64 texture-mask a0-26) a1-45)))))
|
|
(if (or (guard-band-cull bounds-sphere) (< camera-distance (* 1.2 (-> *math-camera* d))))
|
|
(logior! (-> control status) (draw-status needs-clip))
|
|
(logclear! (-> control status) (draw-status needs-clip)))
|
|
(logior! (-> control status) (draw-status was-drawn))
|
|
(if (logtest? (-> control status) (draw-status skip-bones)) (return #f))
|
|
(draw-bones control dma-buf camera-distance))
|
|
(when (and (< lod-to-use (-> control cur-lod)) (logtest? (-> control status) (draw-status has-joint-channels)))
|
|
;; og:preserve-this added this check for PC port to prevent memory corruption
|
|
(if (< (-> *matrix-engine* length) MATRIX_ENGINE_AMOUNT)
|
|
(let ((v1-82 *matrix-engine*)) (set! (-> v1-82 (-> v1-82 length)) (process->handle actor)) (+! (-> v1-82 length) 1))))
|
|
(lod-set! control lod-to-use)))))))
|
|
0
|
|
(none)))
|
|
|
|
(define *hud-lights* (new 'global 'vu-lights))
|
|
|
|
(set-vector! (-> *hud-lights* direction 0) 1.0 0.0 0.0 1.0)
|
|
|
|
(set-vector! (-> *hud-lights* direction 1) 0.0 1.0 0.0 1.0)
|
|
|
|
(set-vector! (-> *hud-lights* direction 2) 0.0 0.0 1.0 1.0)
|
|
|
|
(set-vector! (-> *hud-lights* color 0) 0.0 0.0 0.0 1.0)
|
|
|
|
(set-vector! (-> *hud-lights* color 1) 0.0 0.0 0.0 1.0)
|
|
|
|
(set-vector! (-> *hud-lights* color 2) 0.5 0.5 0.5 1.0)
|
|
|
|
(set-vector! (-> *hud-lights* ambient) 0.5 0.5 0.5 1.0)
|
|
|
|
(defun dma-add-process-drawable-hud ((actor process-drawable) (control draw-control) (flag symbol) (dma-buf dma-buffer))
|
|
"Draw actor at LOD 0 with *hud-lights*. Skip hidden or disabled controls, copy the fixed lights to
|
|
foreground scratchpad, mark the actor drawn, and submit its HUD bones to dma-buf; flag is unused."
|
|
(logclear! (-> control status) (draw-status was-drawn))
|
|
(when (not (logtest? (-> control status) (draw-status hidden no-anim no-skeleton-update)))
|
|
(let ((scratch-lights (the-as vu-lights (+ 64 (scratchpad-object int))))
|
|
(hud-lights *hud-lights*))
|
|
(vector-copy! (-> scratch-lights direction 0) (-> hud-lights direction 0))
|
|
(vector-copy! (-> scratch-lights direction 1) (-> hud-lights direction 1))
|
|
(vector-copy! (-> scratch-lights direction 2) (-> hud-lights direction 2))
|
|
(vector-copy! (-> scratch-lights color 0) (-> hud-lights color 0))
|
|
(vector-copy! (-> scratch-lights color 1) (-> hud-lights color 1))
|
|
(vector-copy! (-> scratch-lights color 2) (-> hud-lights color 2))
|
|
(vector-copy! (-> scratch-lights ambient) (-> hud-lights ambient)))
|
|
(lod-set! control 0)
|
|
(logior! (-> control status) (draw-status was-drawn))
|
|
(draw-bones-hud control dma-buf))
|
|
0
|
|
(none))
|
|
|
|
;; og:preserve-this added
|
|
(defun dma-add-process-drawable-hud-merc ((actor process-drawable) (control draw-control) (flag symbol) (dma-buf dma-buffer))
|
|
"PC Merc variant of HUD submission: draw actor at LOD 0 with *hud-lights*, mark it drawn, and
|
|
submit HUD Merc bones to dma-buf unless its control is hidden or disabled; flag is unused."
|
|
(logclear! (-> control status) (draw-status was-drawn))
|
|
(when (not (logtest? (-> control status) (draw-status hidden no-anim no-skeleton-update)))
|
|
(let ((vu-lights (scratchpad-object vu-lights :offset 64))
|
|
(hud-lights *hud-lights*))
|
|
(vector-copy! (-> vu-lights direction 0) (-> hud-lights direction 0))
|
|
(vector-copy! (-> vu-lights direction 1) (-> hud-lights direction 1))
|
|
(vector-copy! (-> vu-lights direction 2) (-> hud-lights direction 2))
|
|
(vector-copy! (-> vu-lights color 0) (-> hud-lights color 0))
|
|
(vector-copy! (-> vu-lights color 1) (-> hud-lights color 1))
|
|
(vector-copy! (-> vu-lights color 2) (-> hud-lights color 2))
|
|
(vector-copy! (-> vu-lights ambient) (-> hud-lights ambient)))
|
|
(lod-set! control 0)
|
|
(logior! (-> control status) (draw-status was-drawn))
|
|
(draw-bones-hud-merc control dma-buf))
|
|
(none))
|
|
|
|
(defun add-process-drawable ((actor process-drawable) (control draw-control) (flag symbol) (dma-buf dma-buffer))
|
|
"Invoke control's configured DMA submission function for actor, forwarding flag and dma-buf."
|
|
((-> control dma-add-func) actor control flag dma-buf)
|
|
(none))
|
|
|
|
;; The sink address is the 96-byte level-group header, the selected 2608-byte level record, its
|
|
;; foreground-sink-group at byte 176, and the selected 32-byte sink.
|
|
(defun foreground-engine-execute ((draw-engine engine) (frame display-frame) (level-index int) (sink-index int))
|
|
"Execute one foreground draw engine for level-index and sink-index. Initialize bone DMA with the
|
|
selected level foreground sink, invoke the actor connections, finish the Merc stream, account Merc
|
|
and Generic DMA use, cue Generic Merc, and advance the shadow queue. frame is retained by the
|
|
draw-engine interface although this function uses the current display buffers."
|
|
(let ((merc-dma-start (-> *display* frames (-> *display* on-screen) frame global-buf base)))
|
|
(if *debug-segment*
|
|
(add-frame (-> *display* frames (-> *display* on-screen) frame profile-bar 0)
|
|
'draw
|
|
(new 'static 'rgba :r #x40 :b #x40 :a #x80)))
|
|
(let ((sink-group (+ (+ (* sink-index 32) 272 (* 2608 level-index)) (the-as int *level*)))
|
|
(global-buf (-> frame global-buf)))
|
|
;; Make the two indexed cache selections containing the packet head visible to DMA.
|
|
(#unless PC_PORT
|
|
(let ((cache-base (-> global-buf base))) (sync.l) (cache dxwbin cache-base 0) (sync.l) (cache dxwbin cache-base 1))
|
|
(sync.l))
|
|
0
|
|
(bones-init global-buf (the-as dma-foreground-sink-group sink-group))
|
|
(execute-connections draw-engine global-buf))
|
|
(bones-wrapup)
|
|
(if *debug-segment*
|
|
(add-frame (-> *display* frames (-> *display* on-screen) frame profile-bar 0)
|
|
'draw
|
|
(new 'static 'rgba :r #xbe :g #x55 :b #x82 :a #x80)))
|
|
(let ((dma-usage *dma-mem-usage*))
|
|
(when (nonzero? dma-usage)
|
|
(set! (-> dma-usage length) (max 36 (-> dma-usage length)))
|
|
(set! (-> dma-usage data 35 name) "pris-fragment")
|
|
(+! (-> dma-usage data 35 count) 1)
|
|
(+! (-> dma-usage data 35 used)
|
|
(&- (-> *display* frames (-> *display* on-screen) frame global-buf base) (the-as uint merc-dma-start)))
|
|
(set! (-> dma-usage data 35 total) (-> dma-usage data 35 used)))))
|
|
(when (logtest? *vu1-enable-user* (vu1-renderer-mask generic))
|
|
(when (nonzero? (-> *merc-globals* first))
|
|
(let ((generic-dma-start (-> *display* frames (-> *display* on-screen) frame global-buf base)))
|
|
(let ((generic-sink (-> (the-as (pointer uint32) (+ (the-as uint *level*) (* 2608 level-index) (* sink-index 32))) 69)))
|
|
(generic-merc-add-to-cue (the-as generic-dma-foreground-sink generic-sink)))
|
|
(let ((dma-usage *dma-mem-usage*))
|
|
(when (nonzero? dma-usage)
|
|
(set! (-> dma-usage length) (max 87 (-> dma-usage length)))
|
|
(set! (-> dma-usage data 86 name) "pris-generic")
|
|
(+! (-> dma-usage data 86 count) 1)
|
|
(+! (-> dma-usage data 86 used)
|
|
(&- (-> *display* frames (-> *display* on-screen) frame global-buf base) (the-as uint generic-dma-start)))
|
|
(set! (-> dma-usage data 86 total) (-> dma-usage data 86 used)))))))
|
|
(when #t
|
|
(let ((shadow-queue *shadow-queue*)) (+! (-> shadow-queue cur-run) 1)))
|
|
0
|
|
(none))
|
|
|
|
(defun-debug main-debug-hook ()
|
|
"Execute debug-engine connections during gameplay; skip them while the master mode is menu or
|
|
progress."
|
|
(when (not (or (= *master-mode* 'menu) (= *master-mode* 'progress)))
|
|
(execute-connections *debug-engine* #f)
|
|
;; (draw-instance-info *stdcon*)
|
|
)
|
|
(none))
|
|
|
|
(define *debug-hook* main-debug-hook)
|
|
|
|
(define *add-sphere* #f)
|
|
|
|
(define *generic-effect-mode* 0)
|
|
|
|
(defun real-main-draw-hook ()
|
|
"Build one frame's renderer DMA lists, dispatching the active background, foreground, shadow,
|
|
particle, sprite, HUD, and debug draw systems."
|
|
(when *slow-frame-rate*
|
|
(dotimes (delay-index (#if PC_PORT 50000000 #xc3500))
|
|
(nop!)
|
|
(nop!)
|
|
(nop!)
|
|
(nop!)
|
|
(nop!)
|
|
(nop!)))
|
|
"Function to be executed to set up for engine dma" ;; accidental docstring from the original game
|
|
;; update render enables from the debug menu
|
|
(set! *vu1-enable-user* *vu1-enable-user-menu*)
|
|
(set! *texture-enable-user* *texture-enable-user-menu*)
|
|
;; reset and display dma memory stats.
|
|
(when *debug-segment*
|
|
(when (or *stats-memory* *stats-memory-short*)
|
|
(dotimes (level-index (-> *level* length))
|
|
(let ((active-level (-> *level* level level-index)))
|
|
(if (= (-> active-level status) 'active) (print-mem-usage (compute-memory-usage active-level #f) active-level *stdcon*)))))
|
|
(reset! *dma-mem-usage*))
|
|
(#unless PC_PORT
|
|
(shrub-make-perspective-matrix (-> *math-camera* shrub-mat)))
|
|
;; initialize dma buckets that are generic sinks.
|
|
;; other renderers may output to these, so do them first.
|
|
(generic-init-buffers)
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
;; texture uploads
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
;; next we use the texture system to build DMA commands to load texture.
|
|
;; internally, add-tex-to-dma! has special logic to avoid loading textures
|
|
;; that won't be used. (though it's pretty basic, it doesn't actually track per-texture usage)
|
|
;; level tfrag's upload if the level is running.
|
|
(with-profiler "texture-upload"
|
|
(when (logtest? *texture-enable-user* 1)
|
|
(dotimes (level-index (-> *level* length))
|
|
(let ((active-level (-> *level* level level-index)))
|
|
(if (= (-> active-level status) 'active) (add-tex-to-dma! *texture-pool* active-level 0)))))
|
|
;; level pris's upload if the level is running.
|
|
(when (logtest? *texture-enable-user* 2)
|
|
(dotimes (level-index (-> *level* length))
|
|
(let ((active-level (-> *level* level level-index)))
|
|
(if (= (-> active-level status) 'active) (add-tex-to-dma! *texture-pool* active-level 1)))))
|
|
;; level shrubs upload if the level is loading.
|
|
(when (logtest? *texture-enable-user* 4)
|
|
(dotimes (level-index (-> *level* length))
|
|
(let ((active-level (-> *level* level level-index)))
|
|
(if (= (-> active-level status) 'active) (add-tex-to-dma! *texture-pool* active-level 2)))))
|
|
;; alpha and common.
|
|
(when (logtest? *texture-enable-user* 8)
|
|
(let ((uploaded-common #f))
|
|
(dotimes (level-index (-> *level* length))
|
|
(let ((active-level (-> *level* level level-index)))
|
|
(when (= (-> active-level status) 'active)
|
|
(add-tex-to-dma! *texture-pool* active-level 3)
|
|
(when (not uploaded-common)
|
|
(upload-one-common! *texture-pool* (-> *level* level0))
|
|
(set! uploaded-common #t)))))
|
|
(when (not uploaded-common)
|
|
(upload-one-common! *texture-pool* (-> *level* level0))
|
|
#t)))
|
|
;; water.
|
|
(when (logtest? *texture-enable-user* 16)
|
|
(dotimes (level-index (-> *level* length))
|
|
(let ((active-level (-> *level* level level-index)))
|
|
(if (= (-> active-level status) 'active) (add-tex-to-dma! *texture-pool* active-level 4))))))
|
|
;;;;;;;;;;;;;
|
|
;; sky
|
|
;;;;;;;;;;;;;
|
|
(with-profiler "sky"
|
|
(when (zero? (logand *vu1-enable-user* (vu1-renderer-mask sky)))
|
|
;; the sky is disabled. Just draw a solid gradient on the whole screen.
|
|
(with-dma-buffer-add-bucket ((dma-buf (-> (current-frame) global-buf)) (bucket-id sky-draw))
|
|
(dma-buffer-add-gs-set dma-buf
|
|
(zbuf-1 (new 'static 'gs-zbuf :zbp #x1c0 :psm (gs-psm ct24)))
|
|
(test-1 (new 'static 'gs-test :ate #x1 :atst (gs-atest always) :zte #x1 :ztst (gs-ztest always)))
|
|
(alpha-1 (new 'static 'gs-alpha :b #x1 :d #x1)))
|
|
(screen-gradient dma-buf
|
|
(-> *display* bg-clear-color 0)
|
|
(-> *display* bg-clear-color 1)
|
|
(-> *display* bg-clear-color 2)
|
|
(-> *display* bg-clear-color 3))))
|
|
(when (logtest? *vu1-enable-user* (vu1-renderer-mask sky))
|
|
;; check if we want the sky, and if we actually have textures ready.
|
|
;; we generate sky textures on the previous frame and they sit in vram (8160) until the next frame.
|
|
;; on the first frame after we request sky, we draw the textures, but they aren't ready until the next frame.
|
|
(cond
|
|
((and (-> *time-of-day-context* sky) *sky-drawn*) (render-sky-tng *time-of-day-context*))
|
|
(else
|
|
;; todo
|
|
(with-dma-buffer-add-bucket ((dma-buf (-> (current-frame) global-buf)) (bucket-id sky-draw))
|
|
(dma-buffer-add-gs-set dma-buf
|
|
(zbuf-1 (new 'static 'gs-zbuf :zbp #x1c0 :psm (gs-psm ct24)))
|
|
(test-1 (new 'static 'gs-test :ate #x1 :atst (gs-atest always) :zte #x1 :ztst (gs-ztest always)))
|
|
(alpha-1 (new 'static 'gs-alpha :b #x1 :d #x1)))
|
|
(screen-gradient dma-buf
|
|
(-> *time-of-day-context* erase-color)
|
|
(-> *time-of-day-context* erase-color)
|
|
(-> *time-of-day-context* erase-color)
|
|
(-> *time-of-day-context* erase-color)))))))
|
|
;; update mood lighting, draw sky textures.
|
|
(with-profiler "time-of-day"
|
|
(update-time-of-day *time-of-day-context*))
|
|
;; Foreground drawing fills these with the nearest requested object and its texture pages.
|
|
(#unless PC_PORT
|
|
(dotimes (level-index (-> *level* length))
|
|
(let ((active-level (-> *level* level level-index)))
|
|
(when (= (-> active-level status) 'active)
|
|
(dotimes (sink-index 9)
|
|
(set! (-> active-level closest-object sink-index) 4095996000.0)
|
|
(set! (-> active-level texture-mask sink-index) (the-as uint 0)))))))
|
|
(add-ee-profile-frame 'draw :r #x40 :b #x40 :a #x80)
|
|
;;;;;;; OCEAN
|
|
(with-profiler "ocean"
|
|
(update-ocean) ;; ocean map update
|
|
(draw-ocean) ;; far, mid, near, transition, and texture.
|
|
)
|
|
(add-ee-profile-frame 'draw :b #xff :a #x80)
|
|
;; reset MERC
|
|
(with-profiler "merc"
|
|
(set! (-> *merc-global-array* count) (the-as uint 0))
|
|
(set! *merc-globals* (the-as merc-globals (-> *merc-global-array* globals)))
|
|
(set! (-> *shadow-queue* cur-run) (the-as uint 0)))
|
|
;; draw the background!
|
|
(with-profiler "background"
|
|
(init-background)
|
|
(execute-connections *background-draw-engine* (current-frame))
|
|
;; finish bg (most of the work is here)
|
|
(reset! (-> *perf-stats* data 3))
|
|
(finish-background)
|
|
(read! (-> *perf-stats* data 3))
|
|
(update-wait-stats (-> *perf-stats* data 3) (-> *background-work* wait-to-vu0) (the-as uint 0) (the-as uint 0)))
|
|
;; perf stats are printed and restarted here, for some reason.
|
|
(with-profiler "stats"
|
|
(end-perf-stat-collection)
|
|
(when (not (paused?))
|
|
(when *stats-poly*
|
|
(dotimes (level-index (-> *level* length))
|
|
(let ((active-level (-> *level* level level-index)))
|
|
(if (= (-> active-level status) 'active) (collect-stats (-> active-level bsp)))))
|
|
(print-terrain-stats))
|
|
(if *display-perf-stats* (print-perf-stats)))
|
|
(start-perf-stat-collection))
|
|
;; draw the foreground engines.
|
|
(with-profiler "foreground-engines"
|
|
(foreground-engine-execute (-> *level* level-default foreground-draw-engine 0)
|
|
(current-frame)
|
|
2
|
|
0)
|
|
(foreground-engine-execute (-> *level* level-default foreground-draw-engine 1)
|
|
(current-frame)
|
|
2
|
|
1))
|
|
;; handle extra processing for foreground
|
|
(let ((foreground-buffer (-> *display* frames (-> *display* on-screen) frame global-buf)))
|
|
(with-profiler "bones"
|
|
(bones-mtx-calc-execute)) ;; skinning matrix calculation
|
|
(with-profiler "gmerc"
|
|
(generic-merc-execute-all foreground-buffer)) ;; mercneric conversion.
|
|
(with-profiler "shadow"
|
|
(shadow-execute-all foreground-buffer *shadow-queue*))
|
|
(with-profiler "eyes"
|
|
(update-eyes)))
|
|
;; sprite draw
|
|
(when (logtest? (vu1-renderer-mask sprite) *vu1-enable-user*)
|
|
(with-profiler "sprite"
|
|
(swap-fake-shadow-buffers)
|
|
(sprite-draw *display*)))
|
|
;; debug drawing
|
|
(with-profiler "debug-draw"
|
|
(when *debug-segment*
|
|
(debug-draw-actors *level* *display-actor-marks*)
|
|
(collide-shape-draw-debug-marks))
|
|
(render-boundaries))
|
|
;; for some reason we clear the touching list here...
|
|
(with-profiler "touching"
|
|
(send-events-for-touching-shapes *touching-list*)
|
|
(free-all-prim-nodes *touching-list*))
|
|
(add-ee-profile-frame 'draw :r #x40 :b #x40 :a #x80)
|
|
;; spawn actors, compact heaps, etc.
|
|
(with-profiler "actors-update"
|
|
(actors-update *level*))
|
|
(add-ee-profile-frame 'draw :r #x80 :a #x80)
|
|
(when (not (paused?))
|
|
(if *stats-collide* (print-collide-stats)))
|
|
(none))
|
|
|
|
(defun main-draw-hook ()
|
|
"Submit all renderer work for the current frame."
|
|
(real-main-draw-hook)
|
|
(none))
|
|
|
|
(define *draw-hook* main-draw-hook)
|
|
|
|
(defun debug-init-buffer ((debug-bucket bucket-id) (zbuf gs-zbuf) (test gs-test))
|
|
"Append a GIF packet that installs zbuf and test for debug draws in bucket."
|
|
;; The packet sends three qwords through VIF DIRECT: an A+D GIF tag followed by ZBUF_1 and
|
|
;; TEST_1 register writes. Its NEXT tail is inserted into the selected debug bucket so later
|
|
;; debug geometry inherits these depth settings.
|
|
(with-dma-buffer-add-bucket ((global-buf (-> *display* frames (-> *display* on-screen) frame global-buf)) debug-bucket) :bucket-group (-> *display* frames (-> *display* on-screen) frame bucket-group) (let ((packet-head (the-as object (-> global-buf base))))
|
|
(set! (-> (the-as dma-packet packet-head) dma) (new 'static 'dma-tag :qwc #x3 :id (dma-tag-id cnt)))
|
|
(set! (-> (the-as dma-packet packet-head) vif0) (new 'static 'vif-tag))
|
|
(set! (-> (the-as dma-packet packet-head) vif1) (new 'static 'vif-tag :imm #x3 :cmd (vif-cmd direct) :msk #x1))
|
|
(set! (-> global-buf base) (&+ (the-as pointer packet-head) 16))) (let ((gif-head (the-as object (-> global-buf base))))
|
|
(set! (-> (the-as gs-gif-tag gif-head) tag) (new 'static 'gif-tag64 :nloop #x1 :eop #x1 :nreg #x2))
|
|
(set! (-> (the-as gs-gif-tag gif-head) regs) GIF_REGS_ALL_AD)
|
|
(set! (-> global-buf base) (&+ (the-as pointer gif-head) 16))) (let ((register-data (-> global-buf base)))
|
|
(set! (-> (the-as (pointer gs-zbuf) register-data) 0) zbuf)
|
|
(set! (-> (the-as (pointer gs-reg64) register-data) 1) (gs-reg64 zbuf-1))
|
|
(set! (-> (the-as (pointer gs-test) register-data) 2) test)
|
|
(set! (-> (the-as (pointer gs-reg64) register-data) 3) (gs-reg64 test-1))
|
|
(set! (-> global-buf base) (&+ register-data 32))))
|
|
(none))
|
|
|
|
(define *screen-shot* #f)
|
|
|
|
(defun display-frame-start ((disp display) (new-frame-idx int) (odd-even int))
|
|
"Initialize display frame new-frame-idx for drawing field odd-even. Update timing and frame
|
|
counters, reset its DMA buffers and debug state, reserve ordered render buckets, initialize the
|
|
debug bucket, update the draw environment, and service the controllers."
|
|
;; Mask the VIF1 error selected by ERR.me0; the hardware requires this workaround before a frame.
|
|
(#unless PC_PORT
|
|
(set! (-> (the-as vif-bank #x10003c00) err me0) 1))
|
|
;; figure out how fast we're going compared to the desired.
|
|
;; larger = slower than we should.
|
|
;; due to vsync, we should never go too fast.
|
|
(let ((time-ratio (the float
|
|
(+ (/ (timer-count (the-as timer-bank #x10000800)) (the-as uint *ticks-per-frame*))
|
|
1 ;; so we round up.
|
|
))))
|
|
(let ((float-time-ratio (/ (the float (timer-count (the-as timer-bank #x10000800))) (the float *ticks-per-frame*))))
|
|
;; on the PS2, if you have > 1/60 seconds between frames, it means you missed a vsync.
|
|
;; this doesn't seem to be the case on my machine. It appears that glfwSwapBuffers sometimes returns ~1 ms early,
|
|
;; making the next frame ~1 ms too long.
|
|
;; to work around with, we internally run the game at 60 fps if it appears to be slightly too slow.
|
|
;; if we actually do miss a frame, the time ratio will be around 2.
|
|
(#when PC_PORT
|
|
(if (< float-time-ratio 1.3) (set! time-ratio 1.0))
|
|
#|
|
|
(if (> time-ratio 1.)
|
|
(format #t "LAG ~f frames~%" (- time-ratio 1.))
|
|
)
|
|
|#
|
|
))
|
|
;; inform display system of our speed. This will adjust the scaling used in all physics calculations
|
|
(set-time-ratios *display* time-ratio)
|
|
;; set our "old" counters. In the event of a game load/save, these will not jump
|
|
(set! (-> disp old-base-frame-counter) (-> disp base-frame-counter))
|
|
(set! (-> disp old-game-frame-counter) (-> disp game-frame-counter))
|
|
(set! (-> disp old-real-frame-counter) (-> disp real-frame-counter))
|
|
(set! (-> disp old-integral-frame-counter) (-> disp integral-frame-counter))
|
|
(set! (-> disp old-real-integral-frame-counter) (-> disp real-integral-frame-counter))
|
|
(set! (-> disp old-part-frame-counter) (-> disp part-frame-counter))
|
|
(set! (-> disp old-actual-frame-counter) (-> disp actual-frame-counter))
|
|
(set! (-> disp old-real-actual-frame-counter) (-> disp real-actual-frame-counter))
|
|
;; base, part, game, and real advance in 300-Hz time-frame ticks. integral counters advance by
|
|
;; the number of vertical-sync intervals that elapsed, while actual counters advance once per
|
|
;; rendered frame. The real counters continue while paused, and game also stops during movies.
|
|
(let ((scaled-ticks (* (the int time-ratio) (the int (-> disp time-factor)))))
|
|
;; tell the sparticle system
|
|
(set-particle-frame-time (min (seconds 0.04) scaled-ticks))
|
|
;; the "not real" frame counters only count when unpaused
|
|
(when (not (paused?))
|
|
;; these count by scaled time
|
|
(+! (-> disp base-frame-counter) scaled-ticks)
|
|
(+! (-> disp part-frame-counter) scaled-ticks)
|
|
;; this counts actual frames, not seconds. Will count 2 frames if we lag
|
|
(+! (-> disp integral-frame-counter) (the int time-ratio))
|
|
;; this counts actual frames, not doubling for lag. Will count 1 per frame drawn
|
|
(+! (-> disp actual-frame-counter) 1)
|
|
;; game counter will count seconds that we're not in a movie
|
|
(if (not (movie?)) (+! (-> disp game-frame-counter) scaled-ticks)))
|
|
;; real counts like base, but increments when paused
|
|
(+! (-> disp real-frame-counter) scaled-ticks))
|
|
;; actual frames, lag counts as 2x
|
|
(+! (-> disp real-integral-frame-counter) (the int time-ratio)))
|
|
;; actual real frames (for real)
|
|
(+! (-> disp real-actual-frame-counter) 1)
|
|
;; reset the timer.
|
|
(timer-reset (the-as timer-bank #x10000800))
|
|
;; take a screenshot, if desired
|
|
(when *screen-shot*
|
|
(if *debug-segment* (store-image odd-even))
|
|
(set! *screen-shot* #f))
|
|
;; set up the frame object.
|
|
(let ((new-frame (-> disp frames new-frame-idx frame)))
|
|
;; profile setup
|
|
(when *debug-segment*
|
|
(dotimes (bar-index 2)
|
|
(reset (-> new-frame profile-bar bar-index))))
|
|
;; right now, the old frame is being rendered.
|
|
;; if we set *sync-dma*, we will wait here until it finishes rendering.
|
|
(if *sync-dma* (sync-path 0 0))
|
|
;; reset the global dma buffer.
|
|
(let ((global-buf (-> new-frame global-buf)))
|
|
(set! (-> global-buf base) (-> global-buf data))
|
|
(set! (-> global-buf end) (&-> global-buf data-buffer (-> global-buf allocated-length))))
|
|
;; reset the debug dma buffer
|
|
(when *debug-segment*
|
|
(let ((debug-buf (-> new-frame debug-buf)))
|
|
(set! (-> debug-buf base) (-> debug-buf data))
|
|
(set! (-> debug-buf end) (&-> debug-buf data-buffer (-> debug-buf allocated-length)))))
|
|
;; reset the calc buffer. This holds the buckets themselves and what is sent
|
|
;; to actually draw the frame.
|
|
(let ((calc-buf (-> new-frame calc-buf)))
|
|
(set! (-> calc-buf base) (-> calc-buf data))
|
|
(set! (-> calc-buf end) (&-> calc-buf data-buffer (-> calc-buf allocated-length))))
|
|
;; the default buffer holds a DMA chain to fully reset the GS.
|
|
;; reinitialize it, just to be safe
|
|
(default-buffer-init *default-regs-buffer*)
|
|
;; and add it to the very beginning of the calc buf
|
|
(let* ((calc-buf (-> new-frame calc-buf))
|
|
(default-regs *default-regs-buffer*)
|
|
(reset-call (the-as object (-> calc-buf base))))
|
|
(set! (-> (the-as dma-packet reset-call) dma)
|
|
(new 'static 'dma-tag :id (dma-tag-id call) :addr (the-as int (-> default-regs data))))
|
|
(set! (-> (the-as dma-packet reset-call) vif0) (new 'static 'vif-tag))
|
|
(set! (-> (the-as dma-packet reset-call) vif1) (new 'static 'vif-tag))
|
|
(set! (-> calc-buf base) (&+ (the-as pointer reset-call) 16)))
|
|
;; could be used for debugging or something, but is set to nothing.
|
|
(*pre-draw-hook* (-> new-frame calc-buf))
|
|
;; reset debugging stuff
|
|
(when (not (paused?))
|
|
(clear *stdcon1*)
|
|
(debug-reset-buffers))
|
|
;; Reserve the ordered bucket heads at the front of calc-buf. Renderers may build their packets
|
|
;; in any CPU order; inserting each packet into its bucket determines the GS draw order.
|
|
(set! (-> new-frame bucket-group) (dma-buffer-add-buckets (-> new-frame calc-buf) BUCKET_COUNT)))
|
|
;; initialize the debug bucket
|
|
(debug-init-buffer (bucket-id debug-no-zbuf)
|
|
(new 'static 'gs-zbuf :zbp #x1c0 :psm (gs-psm ct24) :zmsk #x1)
|
|
(new 'static 'gs-test :zte #x1 :ztst (gs-ztest always)))
|
|
;; setup our drawing offset for even/odd offset
|
|
(set-draw-env-offset (-> disp frames new-frame-idx draw) 2048 2048 odd-even)
|
|
;; read controllers
|
|
(service-cpads)
|
|
;; now we are ready to run a frame!
|
|
(none))
|
|
|
|
(defun display-frame-finish ((disp display))
|
|
"Finish the current frame's DMA lists, link its ordered render buckets, append the final DMA tag,
|
|
flush the cache, and return disp. This does not start the transfer."
|
|
(let* ((this-frame (-> disp frames (-> disp on-screen) frame))
|
|
(this-calc-buf (-> this-frame calc-buf)))
|
|
;; post draw stuff
|
|
(tie-init-buffers this-calc-buf)
|
|
(merc-vu1-init-buffers)
|
|
(*post-draw-hook* (-> disp frames (-> disp on-screen) frame calc-buf))
|
|
;; Close each bucket with the default GS-state reset and a NEXT tag, so state cannot leak from
|
|
;; one rendering stage into the following stage.
|
|
;; iterate through all buckets and append a final GS state reset.
|
|
(dotimes (bucket-idx BUCKET_COUNT)
|
|
;; clear GS state after the bucket
|
|
(with-dma-buffer-add-bucket ((this-global-buf (-> this-frame global-buf)) (the-as bucket-id bucket-idx)) :bucket-group (-> *display* frames (-> *display* on-screen) frame bucket-group) (let* ((a0-3 this-global-buf)
|
|
(t0-0 *default-regs-buffer*)
|
|
(a1-0 (the-as object (-> a0-3 base))))
|
|
(set! (-> (the-as dma-packet a1-0) dma) (new 'static 'dma-tag :id (dma-tag-id call) :addr (the-as int (-> t0-0 data))))
|
|
(set! (-> (the-as dma-packet a1-0) vif0) (new 'static 'vif-tag :irq #x1))
|
|
(set! (-> (the-as dma-packet a1-0) vif1) (new 'static 'vif-tag))
|
|
(set! (-> a0-3 base) (&+ (the-as pointer a1-0) 16)))))
|
|
;; append a FLUSHE and IRQ to end the calc-buf
|
|
(let* ((v1-14 this-calc-buf)
|
|
(a0-10 (the-as object (-> v1-14 base))))
|
|
(set! (-> (the-as dma-packet a0-10) dma) (new 'static 'dma-tag :id (dma-tag-id cnt)))
|
|
(set! (-> (the-as dma-packet a0-10) vif0) (new 'static 'vif-tag :cmd (vif-cmd flushe) :msk #x1))
|
|
(set! (-> (the-as dma-packet a0-10) vif1) (new 'static 'vif-tag :irq #x1))
|
|
(set! (-> v1-14 base) (&+ (the-as pointer a0-10) 16)))
|
|
;; Each reserved head is a zero-length NEXT tag. An empty head jumps directly to the following
|
|
;; bucket; a populated head enters its packet chain, whose tail returns to the following head.
|
|
;; Patching the heads therefore makes the complete ordered frame one GIF DMA chain.
|
|
;; patch the buckets. Now sending the calc buf will send everything!
|
|
(dma-buffer-patch-buckets (-> this-frame bucket-group) BUCKET_COUNT)
|
|
;; append the final END.
|
|
(let* ((v1-15 this-calc-buf)
|
|
(a0-13 (the-as object (-> v1-15 base))))
|
|
(set! (-> (the-as dma-packet a0-13) dma) (new 'static 'dma-tag :id (dma-tag-id end)))
|
|
(set! (-> (the-as (pointer uint64) a0-13) 1) (the-as uint 0))
|
|
(set! (-> v1-15 base) (&+ (the-as pointer a0-13) 16)))
|
|
;; final cache flush after finishing DMA chains
|
|
(flush-cache 0)
|
|
;; print debug stats.
|
|
(when (not (paused?))
|
|
(when *stats-buffer*
|
|
(let* ((global-buf (-> this-frame global-buf))
|
|
(calc-current (-> this-calc-buf base))
|
|
(calc-start (-> this-calc-buf data))
|
|
(global-current (-> global-buf base))
|
|
(global-start (-> global-buf data))
|
|
(global-end (-> global-buf end)))
|
|
(format *stdcon* "~0kvu1 buf = ~d~%" (&- calc-current (the-as uint calc-start)))
|
|
(format *stdcon* "~0kglobal buf = ~d~%" (&- global-current (the-as uint global-start)))
|
|
(format *stdcon* "~0kbase = #x~x~%" global-current)
|
|
(format *stdcon* "~0kend = #x~x~%" global-end)))))
|
|
disp)
|
|
|
|
(defun determine-pause-mode ()
|
|
"Handle debug frame advance, pause input, controller-loss pause, and progress-screen
|
|
deactivation."
|
|
;; debug frame advance
|
|
(when (and *debug-pause* (= *master-mode* 'pause))
|
|
(logclear! (-> *cpad-list* cpads 0 button0-abs 0) (pad-buttons start r2))
|
|
(logclear! (-> *cpad-list* cpads 0 button0-rel 0) (pad-buttons start r2))
|
|
(while (and (= *master-mode* 'pause) (not (cpad-pressed? 0 start r2)))
|
|
(sync-path 0 0)
|
|
(service-cpads))
|
|
(toggle-pause))
|
|
(when (or (not *progress-process*) (can-go-back? (-> *progress-process* 0)))
|
|
(if (or (cpad-pressed? 0 select r3 start) ;; push pause
|
|
(and (logtest? (-> *cpad-list* cpads 0 valid) 128) ;; controller lost
|
|
(= *master-mode* 'game)
|
|
(>= (-> *display* base-frame-counter) (-> *game-info* blackout-time))
|
|
;; this is a hack. this is initialized to (seconds 1000). It prevents controller-loss pause from
|
|
;; triggering in the first few seconds of gameplay.
|
|
(< (seconds 1003) (-> *display* real-frame-counter)))
|
|
(and (cpad-pressed? 0 r2) (paused?)) ;; debug press
|
|
*pause-lock*)
|
|
(toggle-pause)))
|
|
;; if we toggled out of pause, kill it.
|
|
(if (!= *master-mode* 'progress) (deactivate-progress))
|
|
0)
|
|
|
|
(define *surrogate-dma-buffer* (the dma-buffer #f))
|
|
|
|
(#when PC_PORT
|
|
(define *disasm-count* 0)
|
|
(defmacro disasm-next-dma (&key (count 1))
|
|
`(set! *disasm-count* ,count)))
|
|
|
|
(defun display-sync ((disp display))
|
|
"Wait for the previous render and vertical sync, apply pending video-mode changes, start the
|
|
current frame's DMA chain, update pause state, and initialize the next display frame."
|
|
;; wait for rendering to finish.
|
|
(sync-path 0 0)
|
|
;; remember when.
|
|
;; og:preserve-this setting this to 0 to get rid of lag compensation in PC port, since it's not helpful
|
|
(set! (-> disp frames (-> disp on-screen) frame run-time)
|
|
(#if PC_PORT 0 (the-as int (timer-count (the-as timer-bank #x10000800)))))
|
|
;; now, do a vsync. If we finished rendering in time, this will just wait until the next.
|
|
(let ((frame-idx (-> disp on-screen))
|
|
(syncv-result (syncv 0)))
|
|
;; starting here, we are in a new frame
|
|
;; syncv returns odd/even (if you miss multiple syncv's due to the sync-path above taking many
|
|
;; frames, this will get us back on the correct field)
|
|
(set! *oddeven* syncv-result)
|
|
;; if we need to change video modes:
|
|
(when (-> *video-parms* set-video-mode)
|
|
;; to GS
|
|
(set-display2 *display* 0 512 (-> *video-parms* screen-sy) 2 49)
|
|
(set! (-> *video-parms* set-video-mode) #f)
|
|
;; reset video mode is for changing ntsc/pal
|
|
(when (-> *video-parms* reset-video-mode)
|
|
(set! (-> *video-parms* reset-video-mode) #f)
|
|
;; need to call reset-graph with some magic number
|
|
;; also stash this parameter so that if things go really wrong and our DMA transfer
|
|
;; times out, we can reset-graph to the appropriate video mode
|
|
(if (or (= (-> *setting-control* current video-mode) 'ntsc) (= (-> *setting-control* current video-mode) 'custom))
|
|
(set! *video-reset-parm* 2)
|
|
(set! *video-reset-parm* 3))
|
|
(reset-graph 0 1 *video-reset-parm* 1)))
|
|
;; setup the env (Sony functions)
|
|
(put-display-env (-> disp frames frame-idx display))
|
|
(put-draw-env (the-as (pointer gif-tag) (-> disp frames frame-idx gif)))
|
|
;; begin rendering the next frame
|
|
(let ((dma-buf-to-send (-> disp frames frame-idx frame calc-buf)))
|
|
(when (nonzero? (dma-buffer-length dma-buf-to-send))
|
|
(#when PC_PORT
|
|
(when (> *disasm-count* 0)
|
|
(disasm-dma-list (the-as dma-packet (-> dma-buf-to-send data-buffer)) 'details #t #t -1)
|
|
(-! *disasm-count* 1)))
|
|
(#if PC_PORT
|
|
(__send-gfx-dma-chain (the-as dma-bank-source #x10009000)
|
|
(cond
|
|
;; some buffer for debugging, not used
|
|
(*surrogate-dma-buffer* *surrogate-dma-buffer*)
|
|
(else (-> dma-buf-to-send data-buffer))))
|
|
(dma-buffer-send-chain (the-as dma-bank-source #x10009000)
|
|
(cond
|
|
(*surrogate-dma-buffer* *surrogate-dma-buffer*)
|
|
(else dma-buf-to-send))))))
|
|
(determine-pause-mode)
|
|
;; update display frame
|
|
(let ((next-frame (+ frame-idx 1)))
|
|
(if (< 1 next-frame) (set! next-frame 0))
|
|
(set! (-> disp last-screen) (-> disp on-screen))
|
|
(set! (-> disp on-screen) next-frame)
|
|
;; initialize next frame
|
|
(display-frame-start disp next-frame syncv-result)))
|
|
(none))
|
|
|
|
(defun swap-display ((disp display))
|
|
"Swap frames! Synchronizes with rendering and vsync, kicks off the next render, and initializes the
|
|
to-draw frame"
|
|
(display-frame-finish disp)
|
|
(display-sync disp) ;; also starts next
|
|
)
|
|
|
|
(defun-debug marks-cam-restore ()
|
|
"Restore Mark's saved Village3 camera pose and FOV, install its CPU, VU, and tfragment profiling
|
|
baselines, clear the saved statistic strings, and enable old-stat display."
|
|
(let ((camera-position (new-stack-vector0))
|
|
(camera-rotation (new-stack-matrix0)))
|
|
(set! (-> camera-position x) 1672489.2)
|
|
(set! (-> camera-position y) 60862.703)
|
|
(set! (-> camera-position z) -13051605.0)
|
|
(set! (-> camera-position w) 1.0)
|
|
(set! (-> camera-rotation vector 0 x) -0.1783)
|
|
(set! (-> camera-rotation vector 0 y) 0.0)
|
|
(set! (-> camera-rotation vector 0 z) 0.9839)
|
|
(set! (-> camera-rotation vector 0 w) 0.0)
|
|
(set! (-> camera-rotation vector 1 x) -0.0629)
|
|
(set! (-> camera-rotation vector 1 y) 0.9979)
|
|
(set! (-> camera-rotation vector 1 z) -0.0114)
|
|
(set! (-> camera-rotation vector 1 w) 0.0)
|
|
(set! (-> camera-rotation vector 2 x) -0.9819)
|
|
(set! (-> camera-rotation vector 2 y) -0.064)
|
|
(set! (-> camera-rotation vector 2 z) -0.178)
|
|
(set! (-> camera-rotation vector 2 w) 0.0)
|
|
(set! (-> camera-rotation vector 3 x) 0.0)
|
|
(set! (-> camera-rotation vector 3 y) 0.0)
|
|
(set! (-> camera-rotation vector 3 z) 0.0)
|
|
(set! (-> camera-rotation vector 3 w) 1.0)
|
|
(debug-set-camera-pos-rot! camera-position camera-rotation))
|
|
(send-event *camera* 'set-fov 17294.205)
|
|
(clear *camera-old-level*)
|
|
(format *camera-old-level* "village3")
|
|
(set! *camera-old-cpu* 1219)
|
|
(set! *camera-old-vu* 9602)
|
|
(set! *camera-old-tfrag-bytes* 0)
|
|
(clear *camera-old-stat-string-tfrag*)
|
|
(clear *camera-old-stat-string-tfrag-near*)
|
|
(clear *camera-old-stat-string-total*)
|
|
(set! *display-camera-old-stats* #t)
|
|
(none))
|
|
|
|
(defun-debug eddie-cam-restore ()
|
|
"Restore Eddie's saved debug camera pose."
|
|
(let ((camera-position (new-stack-vector0))
|
|
(camera-rotation (new-stack-matrix0)))
|
|
(set! (-> camera-position x) -427963.66)
|
|
(set! (-> camera-position y) 24967.182)
|
|
(set! (-> camera-position z) 339465.53)
|
|
(set! (-> camera-position w) 1.0)
|
|
(set! (-> camera-rotation vector 0 x) -0.6026)
|
|
(set! (-> camera-rotation vector 0 y) 0.0)
|
|
(set! (-> camera-rotation vector 0 z) 0.7979)
|
|
(set! (-> camera-rotation vector 0 w) 0.0)
|
|
(set! (-> camera-rotation vector 1 x) -0.1522)
|
|
(set! (-> camera-rotation vector 1 y) 0.9816)
|
|
(set! (-> camera-rotation vector 1 z) -0.1149)
|
|
(set! (-> camera-rotation vector 1 w) 0.0)
|
|
(set! (-> camera-rotation vector 2 x) -0.7833)
|
|
(set! (-> camera-rotation vector 2 y) -0.1908)
|
|
(set! (-> camera-rotation vector 2 z) -0.5915)
|
|
(set! (-> camera-rotation vector 2 w) 0.0)
|
|
(set! (-> camera-rotation vector 3 x) 0.0)
|
|
(set! (-> camera-rotation vector 3 y) 0.0)
|
|
(set! (-> camera-rotation vector 3 z) 0.0)
|
|
(set! (-> camera-rotation vector 3 w) 1.0)
|
|
(debug-set-camera-pos-rot! camera-position camera-rotation))
|
|
(none))
|
|
|
|
(defun-debug gregs-jungle-cam-restore ()
|
|
"Restore Greg's saved Jungle camera pose and FOV, install its CPU, VU, and tfragment profiling
|
|
baselines, and clear the saved statistic strings."
|
|
(let ((camera-position (new-stack-vector0))
|
|
(camera-rotation (new-stack-matrix0)))
|
|
(set! (-> camera-position x) 1399233.0)
|
|
(set! (-> camera-position y) 39027.11)
|
|
(set! (-> camera-position z) -1485580.1)
|
|
(set! (-> camera-position w) 1.0)
|
|
(set! (-> camera-rotation vector 0 x) 0.9965)
|
|
(set! (-> camera-rotation vector 0 y) 0.0)
|
|
(set! (-> camera-rotation vector 0 z) 0.0829)
|
|
(set! (-> camera-rotation vector 0 w) 0.0)
|
|
(set! (-> camera-rotation vector 1 x) -0.0021)
|
|
(set! (-> camera-rotation vector 1 y) 0.9996)
|
|
(set! (-> camera-rotation vector 1 z) 0.0253)
|
|
(set! (-> camera-rotation vector 1 w) 0.0)
|
|
(set! (-> camera-rotation vector 2 x) -0.0829)
|
|
(set! (-> camera-rotation vector 2 y) -0.0254)
|
|
(set! (-> camera-rotation vector 2 z) 0.9962)
|
|
(set! (-> camera-rotation vector 2 w) 0.0)
|
|
(set! (-> camera-rotation vector 3 x) 0.0)
|
|
(set! (-> camera-rotation vector 3 y) 0.0)
|
|
(set! (-> camera-rotation vector 3 z) 0.0)
|
|
(set! (-> camera-rotation vector 3 w) 1.0)
|
|
(debug-set-camera-pos-rot! camera-position camera-rotation))
|
|
(send-event *camera* 'set-fov 11650.845)
|
|
(clear *camera-old-level*)
|
|
(format *camera-old-level* "jungle")
|
|
(set! *camera-old-cpu* 5801)
|
|
(set! *camera-old-vu* 9605)
|
|
(set! *camera-old-tfrag-bytes* #x1ffee0)
|
|
(clear *camera-old-stat-string-tfrag*)
|
|
(clear *camera-old-stat-string-tfrag-near*)
|
|
(clear *camera-old-stat-string-total*)
|
|
(none))
|
|
|
|
(defun-debug gregs-village1-cam-restore ()
|
|
"Restore Greg's saved Village1 camera pose and FOV, install its CPU, VU, and tfragment profiling
|
|
baselines, and clear the saved statistic strings."
|
|
(let ((camera-position (new-stack-vector0))
|
|
(camera-rotation (new-stack-matrix0)))
|
|
(set! (-> camera-position x) -511224.06)
|
|
(set! (-> camera-position y) 157579.95)
|
|
(set! (-> camera-position z) 764585.25)
|
|
(set! (-> camera-position w) 1.0)
|
|
(set! (-> camera-rotation vector 0 x) -0.9009)
|
|
(set! (-> camera-rotation vector 0 y) 0.0)
|
|
(set! (-> camera-rotation vector 0 z) -0.4338)
|
|
(set! (-> camera-rotation vector 0 w) 0.0)
|
|
(set! (-> camera-rotation vector 1 x) 0.0984)
|
|
(set! (-> camera-rotation vector 1 y) 0.9739)
|
|
(set! (-> camera-rotation vector 1 z) -0.2043)
|
|
(set! (-> camera-rotation vector 1 w) 0.0)
|
|
(set! (-> camera-rotation vector 2 x) 0.4225)
|
|
(set! (-> camera-rotation vector 2 y) -0.2268)
|
|
(set! (-> camera-rotation vector 2 z) -0.8774)
|
|
(set! (-> camera-rotation vector 2 w) 0.0)
|
|
(set! (-> camera-rotation vector 3 x) 0.0)
|
|
(set! (-> camera-rotation vector 3 y) 0.0)
|
|
(set! (-> camera-rotation vector 3 z) 0.0)
|
|
(set! (-> camera-rotation vector 3 w) 1.0)
|
|
(debug-set-camera-pos-rot! camera-position camera-rotation))
|
|
(send-event *camera* 'set-fov 11650.845)
|
|
(clear *camera-old-level*)
|
|
(format *camera-old-level* "village1")
|
|
(set! *camera-old-cpu* 4899)
|
|
(set! *camera-old-vu* 9605)
|
|
(set! *camera-old-tfrag-bytes* #x24e680)
|
|
(clear *camera-old-stat-string-tfrag*)
|
|
(clear *camera-old-stat-string-tfrag-near*)
|
|
(clear *camera-old-stat-string-total*)
|
|
(none))
|
|
|
|
(defun-debug gregs-texture-cam-restore ()
|
|
"Restore Greg's saved Village1 texture-test camera pose and FOV, install its CPU, VU, and
|
|
tfragment profiling baselines, and clear the saved statistic strings."
|
|
(let ((camera-position (new-stack-vector0))
|
|
(camera-rotation (new-stack-matrix0)))
|
|
(set! (-> camera-position x) 1103816.0)
|
|
(set! (-> camera-position y) 96275.71)
|
|
(set! (-> camera-position z) -632064.5)
|
|
(set! (-> camera-position w) 1.0)
|
|
(set! (-> camera-rotation vector 0 x) 0.4063)
|
|
(set! (-> camera-rotation vector 0 y) 0.0)
|
|
(set! (-> camera-rotation vector 0 z) -0.9137)
|
|
(set! (-> camera-rotation vector 0 w) 1.0)
|
|
(set! (-> camera-rotation vector 1 x) 0.2824)
|
|
(set! (-> camera-rotation vector 1 y) 0.951)
|
|
(set! (-> camera-rotation vector 1 z) 0.1256)
|
|
(set! (-> camera-rotation vector 1 w) 1.0)
|
|
(set! (-> camera-rotation vector 2 x) 0.8689)
|
|
(set! (-> camera-rotation vector 2 y) -0.3091)
|
|
(set! (-> camera-rotation vector 2 z) 0.3864)
|
|
(set! (-> camera-rotation vector 2 w) 1.0)
|
|
(set! (-> camera-rotation vector 3 x) 0.0)
|
|
(set! (-> camera-rotation vector 3 y) 0.0)
|
|
(set! (-> camera-rotation vector 3 z) 0.0)
|
|
(set! (-> camera-rotation vector 3 w) 1.0)
|
|
(debug-set-camera-pos-rot! camera-position camera-rotation))
|
|
(send-event *camera* 'set-fov 11650.845)
|
|
(clear *camera-old-level*)
|
|
(format *camera-old-level* "village1")
|
|
(set! *camera-old-cpu* 4772)
|
|
(set! *camera-old-vu* 9603)
|
|
(set! *camera-old-tfrag-bytes* #x22e680)
|
|
(clear *camera-old-stat-string-tfrag*)
|
|
(clear *camera-old-stat-string-tfrag-near*)
|
|
(clear *camera-old-stat-string-total*)
|
|
(none))
|
|
|
|
(defun-debug gregs-texture2-cam-restore ()
|
|
"Restore Greg's saved second Village1 texture-test camera pose and FOV, install its CPU, VU, and
|
|
tfragment profiling baselines, and clear the saved statistic strings."
|
|
(let ((camera-position (new-stack-vector0))
|
|
(camera-rotation (new-stack-matrix0)))
|
|
(set! (-> camera-position x) 1954572.9)
|
|
(set! (-> camera-position y) 135123.98)
|
|
(set! (-> camera-position z) -1028725.44)
|
|
(set! (-> camera-position w) 1.0)
|
|
(set! (-> camera-rotation vector 0 x) 0.2535)
|
|
(set! (-> camera-rotation vector 0 y) 0.0)
|
|
(set! (-> camera-rotation vector 0 z) 0.9673)
|
|
(set! (-> camera-rotation vector 0 w) 1.0)
|
|
(set! (-> camera-rotation vector 1 x) -0.1051)
|
|
(set! (-> camera-rotation vector 1 y) 0.994)
|
|
(set! (-> camera-rotation vector 1 z) 0.0275)
|
|
(set! (-> camera-rotation vector 1 w) 1.0)
|
|
(set! (-> camera-rotation vector 2 x) -0.9615)
|
|
(set! (-> camera-rotation vector 2 y) -0.1087)
|
|
(set! (-> camera-rotation vector 2 z) 0.252)
|
|
(set! (-> camera-rotation vector 2 w) 1.0)
|
|
(set! (-> camera-rotation vector 3 x) 0.0)
|
|
(set! (-> camera-rotation vector 3 y) 0.0)
|
|
(set! (-> camera-rotation vector 3 z) 0.0)
|
|
(set! (-> camera-rotation vector 3 w) 1.0)
|
|
(debug-set-camera-pos-rot! camera-position camera-rotation))
|
|
(send-event *camera* 'set-fov 11650.845)
|
|
(clear *camera-old-level*)
|
|
(format *camera-old-level* "village1")
|
|
(set! *camera-old-cpu* 4936)
|
|
(set! *camera-old-vu* #x4b0c)
|
|
(set! *camera-old-tfrag-bytes* #x22e680)
|
|
(clear *camera-old-stat-string-tfrag*)
|
|
(clear *camera-old-stat-string-tfrag-near*)
|
|
(clear *camera-old-stat-string-total*)
|
|
(none))
|
|
|
|
(defun-debug cave-cam-restore ()
|
|
"Restore the saved cave debug camera pose."
|
|
(let ((camera-position (new-stack-vector0))
|
|
(camera-rotation (new-stack-matrix0)))
|
|
(set! (-> camera-position x) -1449013.1)
|
|
(set! (-> camera-position y) 15114.015)
|
|
(set! (-> camera-position z) -1621305.5)
|
|
(set! (-> camera-position w) 1.0)
|
|
(set! (-> camera-rotation vector 0 x) -0.8223)
|
|
(set! (-> camera-rotation vector 0 y) 0.0)
|
|
(set! (-> camera-rotation vector 0 z) -0.5689)
|
|
(set! (-> camera-rotation vector 0 w) 0.0)
|
|
(set! (-> camera-rotation vector 1 x) 0.0076)
|
|
(set! (-> camera-rotation vector 1 y) 0.9999)
|
|
(set! (-> camera-rotation vector 1 z) -0.0111)
|
|
(set! (-> camera-rotation vector 1 w) 0.0)
|
|
(set! (-> camera-rotation vector 2 x) 0.5689)
|
|
(set! (-> camera-rotation vector 2 y) -0.0135)
|
|
(set! (-> camera-rotation vector 2 z) -0.8222)
|
|
(set! (-> camera-rotation vector 2 w) 0.0)
|
|
(set! (-> camera-rotation vector 3 x) 0.0)
|
|
(set! (-> camera-rotation vector 3 y) 0.0)
|
|
(set! (-> camera-rotation vector 3 z) 0.0)
|
|
(set! (-> camera-rotation vector 3 w) 1.0)
|
|
(debug-set-camera-pos-rot! camera-position camera-rotation))
|
|
(none))
|
|
|
|
(defun-debug paals-cam-restore ()
|
|
"Restore Paal's saved debug camera pose."
|
|
(let ((camera-position (new-stack-vector0))
|
|
(camera-rotation (new-stack-matrix0)))
|
|
(set! (-> camera-position x) -791260.7)
|
|
(set! (-> camera-position y) 50858.62)
|
|
(set! (-> camera-position z) -163715.47)
|
|
(set! (-> camera-position w) 1.0)
|
|
(set! (-> camera-rotation vector 0 x) -0.7816)
|
|
(set! (-> camera-rotation vector 0 y) 0.0)
|
|
(set! (-> camera-rotation vector 0 z) -0.6236)
|
|
(set! (-> camera-rotation vector 0 w) 0.0)
|
|
(set! (-> camera-rotation vector 1 x) 0.0672)
|
|
(set! (-> camera-rotation vector 1 y) 0.9941)
|
|
(set! (-> camera-rotation vector 1 z) -0.0843)
|
|
(set! (-> camera-rotation vector 1 w) 0.0)
|
|
(set! (-> camera-rotation vector 2 x) 0.62)
|
|
(set! (-> camera-rotation vector 2 y) -0.1079)
|
|
(set! (-> camera-rotation vector 2 z) -0.7771)
|
|
(set! (-> camera-rotation vector 2 w) 0.0)
|
|
(set! (-> camera-rotation vector 3 x) 0.0)
|
|
(set! (-> camera-rotation vector 3 y) 0.0)
|
|
(set! (-> camera-rotation vector 3 z) 0.0)
|
|
(set! (-> camera-rotation vector 3 w) 1.0)
|
|
(debug-set-camera-pos-rot! camera-position camera-rotation))
|
|
(none))
|