mirror/jak-project
1
0
Fork 0
mirror of https://github.com/open-goal/jak-project synced 2026-06-01 01:40:07 -04:00
Code Issues Packages Projects Releases Wiki Activity
Files
ci/flag-asm-diff
jak-project/goal_src/jak2/engine/draw/drawable.gc
T

2225 lines
87 KiB
Common Lisp
Raw Permalink Blame History

;;-*-Lisp-*-
(in-package goal)
;; name: drawable.gc
;; name in dgo: drawable
;; dgos: ENGINE, GAME
(define-extern draw-vortex (function none))
;; DECOMP BEGINS
(defmacro spr-work ()
`(the work-area *fake-scratchpad-data*))
;;;;;;;;;;;;;;;;;;;;
;; culling
;;;;;;;;;;;;;;;;;;;;
;; these functions check to see if objects are within view.
;; these use the math-camera values, which is calculated based on the in-game camera position/settings.
(defun sphere-cull ((arg0 vector))
"Is the given sphere in the view frustum?
Uses the planes in vf16-vf19."
(local-vars (v1-0 uint128) (v1-1 uint128) (v1-2 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)
)
;; og:preserve-this modified for PC: these register would be loaded by the draw method of bsp.
(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))
)
(init-vf0-vector)
(.lvf vf10 (&-> arg0 quad))
(.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 vf9 vf19 vf0 acc)
;; og:preserve-this
;; checking to see if we are inside all 4 planes.
;; using the inside part of the sphere
(.add.w.vf vf9 vf9 vf10)
(.mov v1-0 vf9)
(.pcgtw v1-1 0 v1-0)
(.ppach v1-2 (the-as uint128 0) v1-1)
(zero? (the-as int v1-2))
)
)
;; og:preserve-this
(defun sphere-cull-for-ocean ((arg0 vector))
"Is the given sphere in the view frustum?
PC-port ocean version"
(local-vars (v1-0 uint128) (v1-1 uint128) (v1-2 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)
)
;; og:preserve-this modified for PC: these register would be loaded by the draw method of bsp.
(cond
((-> *time-of-day-context* use-camera-other)
(let ((at-0 *math-camera*))
(.lvf vf16 (&-> at-0 plane-other 0 quad))
(.lvf vf17 (&-> at-0 plane-other 1 quad))
(.lvf vf18 (&-> at-0 plane-other 2 quad))
(.lvf vf19 (&-> at-0 plane-other 3 quad))
)
)
(else
(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))
)
)
)
(init-vf0-vector)
(.lvf vf10 (&-> arg0 quad))
(.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 vf9 vf19 vf0 acc)
;; checking to see if we are inside all 4 planes.
;; using the inside part of the sphere
(.add.w.vf vf9 vf9 vf10)
(.mov v1-0 vf9)
(.pcgtw v1-1 0 v1-0)
(.ppach v1-2 (the-as uint128 0) v1-1)
(zero? (the-as int v1-2))
)
)
(defun guard-band-cull ((arg0 vector))
"Is the given sphere within the guard band, and possibly 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 modified for PC: these registers would be loaded in dma-add-process-drawable
(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 (&-> arg0 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)
;; checking to see if we are outside any 1 of the 4 planes
;; using the outside part of the sphere.
(.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))
)
)
(defun sphere-in-view-frustum? ((arg0 sphere))
"Is the given sphere in the view frustum?
Safe to use anywhere, uses planes from math-camera.
Unlike sphere-cull, which assumes that the register are setup.
"
(local-vars (v1-1 uint128) (v1-2 uint128) (v1-3 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 ((v1-0 *math-camera*))
(.lvf vf6 (&-> arg0 quad))
(.lvf vf1 (&-> v1-0 plane 0 quad))
(.lvf vf2 (&-> v1-0 plane 1 quad))
(.lvf vf3 (&-> v1-0 plane 2 quad))
(.lvf vf4 (&-> v1-0 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 v1-1 vf5)
(.pcgtw v1-2 0 v1-1)
(.ppach v1-3 (the-as uint128 0) v1-2)
(zero? (the-as int v1-3))
)
)
(defun line-in-view-frustum? ((arg0 vector) (arg1 vector))
"Is the line segment at least partially in the view frustum?
Safe to use anywhere, uses planes in math-camera."
(local-vars (v1-1 uint128) (v1-2 uint128) (v1-3 uint128) (a0-1 uint128) (a0-2 uint128) (a0-3 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 ((v1-0 *math-camera*))
(.lvf vf9 (&-> arg0 quad))
(.lvf vf10 (&-> arg1 quad))
(.lvf vf16 (&-> v1-0 plane 0 quad))
(.lvf vf17 (&-> v1-0 plane 1 quad))
(.lvf vf18 (&-> v1-0 plane 2 quad))
(.lvf vf19 (&-> v1-0 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 v1-1 vf9)
(.pcgtw v1-2 0 v1-1)
(.ppach v1-3 (the-as uint128 0) v1-2)
(.mov a0-1 vf10)
(.pcgtw a0-2 0 a0-1)
(.ppach a0-3 (the-as uint128 0) a0-2)
(not (logtest? (the-as int v1-3) (the-as int a0-3)))
)
)
;;;;;;;;;;;;;;;;;;;;;;;;;;
;; precomputed visibility
;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun vis-cull ((id int))
"Is this thing visible in the precomputed visiblity data? By draw-node id.
Assumes the scratchpad has the vis-list loaded."
(let* ((vis-byte (-> (spr-work) background vis-list (/ id 8))) ;; vis byte
(shift-amount (+ 56 (logand id 7)))
(shifted (shl vis-byte shift-amount))
)
(< (the-as int shifted) 0)
)
)
(defun-debug vis-cull-debug ((a0-0 work-area) (id int))
"Like vis-cull, but you can specify a different work-area.
Unused."
(let* ((vis-byte (-> a0-0 background vis-list (/ id 8))) ;; vis byte
(shift-amount (+ 56 (logand id 7)))
(shifted (shl vis-byte shift-amount))
)
(< (the-as int shifted) 0)
)
)
(defun error-sphere ((arg0 drawable-error) (arg1 string))
"Draw a sphere with an error message around this drawable-error."
(when *artist-error-spheres*
(when (vis-cull (-> arg0 id))
(when (sphere-cull (-> arg0 bsphere))
(add-debug-sphere
#t
(bucket-id debug2)
(-> arg0 bsphere)
(-> arg0 bsphere w)
(new 'static 'rgba :r #x80 :a #x80)
)
(add-debug-text-3d
#t
(bucket-id debug-no-zbuf1)
arg1
(-> arg0 bsphere)
(font-color white)
(the-as vector2h #f)
)
)
)
)
0
(none)
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; drawable methods
;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; the drawable class is the base class for tons of things
;; basically anything in the a tree-like structure in the level uses this
;; so these methods are super vague and not well defined.
;; Generally, you shouldn't call any of these unless you know the type and
;; what they will do.
(defmethod login ((this drawable))
"Initialize a drawable after load."
this
)
(defmethod draw ((this drawable) (arg0 drawable) (arg1 display-frame))
"Draw something. The meaning of this depends on the exact drawable class,
but in general the heavy work isn't here - this just adds stuff to lists."
0
(none)
)
(defmethod fill-collide-list-from-box ((this drawable) (arg0 int) (arg1 collide-list) (arg2 collide-query))
"Collect a list of collision meshes contained in the box."
0
)
(defmethod fill-collide-list-from-line-sphere ((this drawable) (arg0 int) (arg1 collide-list) (arg2 collide-query))
"Collect a list of collision meshes contained in 'line-sphere'."
0
)
(defmethod collect-regions ((this drawable) (arg0 sphere) (arg1 int) (arg2 region-prim-list))
"Determines the number of [[drawable]]s in the `obj` that overlap the given `area-of-interest` this number is stored in the `region-list`'s item count
@param area-of-interest The area defined by a sphere that we care about overlaps
@param _count The amount of [[drawable]]s in the object to enumerate through
@param! region-list Stores the overlapping regions and a count for how many were found
@returns none"
0
(none)
)
(defmethod collect-stats ((this drawable))
"Collect statistics for debugging"
0
(none)
)
(defmethod debug-draw ((this drawable) (arg0 drawable) (arg1 display-frame))
"Draw debug visualizations"
0
(none)
)
(defmethod draw ((this drawable-error) (arg0 drawable-error) (arg1 display-frame))
"Draw a debug sphere."
(error-sphere arg0 (-> arg0 name))
0
(none)
)
(defmethod unpack-vis ((this drawable) (arg0 (pointer int8)) (arg1 (pointer int8)))
"Unpack vis data from arg1 to arg0, unpacking it. Return pointer to next thing."
arg1
)
;;;;;;;;;;;;;;;;;;;;;;;;
;; instance system
;;;;;;;;;;;;;;;;;;;;;;;;
;; instance debug
(define *edit-instance* (the-as string #f))
(when *debug-segment*
(define *instance-mem-usage* (new 'debug 'memory-usage-block))
)
(defun find-instance-by-name-level ((arg0 string) (arg1 level))
"Look in the given level for prototypes with the given name.
Will find both tie and shrub.
Despite the name, returns the _prototype_, not the instance (the instances aren't named)."
(let ((s5-0 (-> arg1 bsp drawable-trees)))
(dotimes (s4-0 (-> s5-0 length))
(let ((v1-3 (-> s5-0 trees s4-0)))
(case (-> v1-3 type)
((drawable-tree-instance-shrub)
(let ((s3-0 (-> (the-as drawable-tree-instance-shrub v1-3) info prototype-inline-array-shrub)))
(dotimes (s2-0 (-> s3-0 length))
(if (string= arg0 (-> s3-0 data s2-0 name))
(return (-> s3-0 data s2-0))
)
)
)
)
((drawable-tree-instance-tie)
(let ((s3-1 (-> (the-as drawable-tree-instance-tie v1-3) prototypes prototype-array-tie)))
(dotimes (s2-1 (-> s3-1 length))
(if (string= arg0 (-> s3-1 array-data s2-1 name))
(return (-> s3-1 array-data s2-1))
)
)
)
)
)
)
)
)
(the-as prototype-bucket #f)
)
(defun find-instance-by-name ((arg0 string))
"Look in all levels for prototypes with the given name.
Will find both tie and shrub.
Despite the name, returns the _prototype_, not the instance (the instances aren't named)."
(dotimes (s5-0 (-> *level* length))
(let ((a1-0 (-> *level* level s5-0)))
(when (= (-> a1-0 status) 'active)
(let ((a0-4 (find-instance-by-name-level arg0 a1-0)))
(if a0-4
(return a0-4)
)
)
)
)
)
(the-as prototype-bucket #f)
)
(defun prototypes-game-visible-set! ((arg0 pair) (arg1 symbol))
"Set the visibility of the given prototypes, to hide stuff in levels that shouldn't appear.
Also disables collision."
(let ((a0-1 (car arg0)))
(while (not (null? arg0))
(let ((v1-0 (find-instance-by-name (the-as string a0-1))))
(when v1-0
(if arg1
(logclear! (-> v1-0 flags) (prototype-flags visible no-collide))
(logior! (-> v1-0 flags) (prototype-flags visible no-collide))
)
)
)
(set! arg0 (cdr arg0))
(set! a0-1 (car arg0))
)
)
0
)
(defun-debug find-instance-by-index ((arg0 type) (arg1 int) (arg2 bsp-header))
"Find an instance by its index in the bsp's drawable-tree-instance array.
The type should be either drawable-tree-instance-shrub or drawable-tree-instance-tie.
If bsp-header isn't set, picks the first active level. Otherwise looks in the level with this bsp."
(dotimes (v1-0 (-> *level* length))
(let ((a3-3 (-> *level* level v1-0)))
(when (= (-> a3-3 status) 'active)
(let ((a3-4 (-> a3-3 bsp)))
(when (or (not arg2) (= a3-4 arg2))
(let ((a3-5 (-> a3-4 drawable-trees)))
(dotimes (t0-5 (-> a3-5 length))
(let ((t1-3 (-> a3-5 trees t0-5)))
(case (-> t1-3 type)
((drawable-tree-instance-shrub)
(when (= arg0 (-> t1-3 type))
(let ((v1-2 (-> (the-as drawable-tree-instance-shrub t1-3) info prototype-inline-array-shrub)))
(return (-> v1-2 data arg1))
)
)
)
((drawable-tree-instance-tie)
(when (= arg0 (-> t1-3 type))
(let ((v1-5 (-> (the-as drawable-tree-instance-tie t1-3) prototypes prototype-array-tie)))
(return (-> v1-5 array-data arg1))
)
)
)
)
)
)
)
)
)
)
)
)
(the-as prototype-bucket #f)
)
(defun-debug prototype-bucket-type ((arg0 prototype-bucket))
"Get the instance type for this bucket. Will always be instance-shrubbery/instance-tie, doesn't
consider generic/billboard stuff."
;; using 1 here to avoid generic stuff.
(case (-> arg0 geometry 1 type)
((prototype-shrubbery shrubbery)
instance-shrubbery
)
((prototype-tie prototype-tie tie-fragment)
instance-tie
)
)
)
(defun-debug prototype-bucket-recalc-fields ((arg0 prototype-bucket))
"Recalculate the dists for a prototype (either tie or shrub) after it has been adjusted."
(case (prototype-bucket-type arg0)
((instance-shrubbery)
(set! (-> arg0 rdists x) (/ 1.0 (- (-> arg0 dists w) (-> arg0 dists x))))
)
(else
(set! (-> arg0 dists z) (+ (-> arg0 dists x) (* 0.33333334 (- (-> arg0 dists w) (-> arg0 dists x)))))
(set! (-> arg0 rdists x) (/ 1.0 (- (-> arg0 dists z) (-> arg0 dists x))))
)
)
(set! (-> arg0 rdists z) (/ 1.0 (- (-> arg0 dists w) (-> arg0 dists z))))
(set! (-> arg0 dists y) (* 0.5 (-> arg0 dists x)))
(set! (-> arg0 rdists y) (/ 1.0 (-> arg0 dists y)))
arg0
)
(defun-debug print-prototype-list ()
"Print all prototypes in all loaded levels."
(local-vars (sv-16 (function prototype-bucket-shrub memory-usage-block int prototype-bucket-shrub)))
(dotimes (gp-0 (-> *level* length))
(let ((s5-0 (-> *level* level gp-0)))
(when (= (-> s5-0 status) 'active)
(format #t "-------- level ~S~%" (-> s5-0 name))
(let ((s5-1 (-> s5-0 bsp drawable-trees)))
(dotimes (s4-0 (-> s5-1 length))
(let ((v1-8 (-> s5-1 trees s4-0)))
(case (-> v1-8 type)
((drawable-tree-instance-shrub)
(let ((s3-0 (-> (the-as drawable-tree-instance-shrub v1-8) info prototype-inline-array-shrub)))
(dotimes (s2-0 (-> s3-0 length))
0
(let ((s1-0 (-> s3-0 data s2-0)))
(dotimes (s0-0 4)
(reset! *instance-mem-usage*)
(if (nonzero? (-> s1-0 geometry s0-0))
(mem-usage (-> s1-0 geometry s0-0) *instance-mem-usage* 0)
)
)
(let ((s0-1 s1-0))
(set! sv-16 (method-of-object s0-1 mem-usage))
(let ((a1-4 (reset! *instance-mem-usage*))
(a2-2 0)
)
(sv-16 s0-1 a1-4 a2-2)
)
)
(let ((v1-29 (calculate-total *instance-mem-usage*)))
(format
#t
" ~-48S~4D shrub ~5,,2fK ~4,,2fK~%"
(-> s1-0 name)
(-> s1-0 in-level)
(* 0.0009765625 (the float v1-29))
(* 0.0009765625 (the float (* (the-as uint 80) (-> s1-0 in-level))))
)
)
)
)
)
)
((drawable-tree-instance-tie)
(let ((s3-1 (-> (the-as drawable-tree-instance-tie v1-8) prototypes prototype-array-tie)))
(dotimes (s2-1 (-> s3-1 length))
0
(let ((s1-1 (-> s3-1 array-data s2-1)))
(reset! *instance-mem-usage*)
(dotimes (s0-2 4)
(when (nonzero? (-> s1-1 tie-geom s0-2))
(let* ((a0-13 (-> s1-1 tie-geom s0-2))
(t9-8 (method-of-object a0-13 mem-usage))
(a1-7 *instance-mem-usage*)
(v1-47 s0-2)
)
(t9-8 a0-13 a1-7 (logior (cond
((= v1-47 1)
4
)
((= v1-47 2)
8
)
((= v1-47 3)
16
)
(else
0
)
)
2
)
)
)
)
)
(mem-usage s1-1 *instance-mem-usage* 0)
(let ((v1-54 (calculate-total *instance-mem-usage*)))
(format
#t
" ~-48S~4D tie ~5,,2fK ~4,,2fK~%"
(-> s1-1 name)
(-> s1-1 in-level)
(* 0.0009765625 (the float v1-54))
(* 0.0009765625 (the float (* (-> s1-1 in-level) 64)))
)
)
)
)
)
)
)
)
)
)
)
)
)
0
(none)
)
(defun-debug draw-instance-info ((arg0 string))
"Print info about a prototype."
(local-vars
(sv-16 uint)
;; og:preserve-this uint -> uint32
(sv-32 uint32)
(sv-48 uint32)
(sv-64 int)
(sv-80 int)
(sv-96 int)
(sv-112 int)
(sv-128 int)
(sv-144 int)
)
(when (and *display-instance-info* *edit-instance*)
(let ((s5-0 (find-instance-by-name *edit-instance*)))
(when s5-0
(dotimes (s4-0 (-> *level* length))
(let ((v1-5 (-> *level* level s4-0)))
(when (= (-> v1-5 status) 'active)
(let ((s3-0 (-> v1-5 bsp drawable-trees)))
(dotimes (s2-0 (-> s3-0 length))
(let ((v1-9 (-> s3-0 trees s2-0)))
(case (-> v1-9 type)
((drawable-tree-instance-shrub)
)
((drawable-tree-instance-tie)
(let ((s1-0 (-> v1-9 data (+ (-> v1-9 length) -1))))
(dotimes (s0-0 (-> (the-as drawable-inline-array-instance-tie s1-0) length))
(if (string= (-> (the-as drawable-inline-array-instance-tie s1-0) data s0-0 bucket-ptr name) *edit-instance*)
(add-debug-sphere
#t
(bucket-id debug-no-zbuf1)
(the-as
vector
(+ (the-as uint (-> (the-as drawable-inline-array-instance-tie s1-0) data 0 bsphere)) (* s0-0 64))
)
(-> (the-as drawable-inline-array-instance-tie s1-0) data s0-0 bsphere w)
(new 'static 'rgba :g #xff :a #x80)
)
)
)
)
)
)
)
)
)
)
)
)
(let ((s2-1 (prototype-bucket-type s5-0)))
(let ((s4-1 0))
0
(cond
((= s2-1 instance-shrubbery)
(set! s4-1 80)
)
((= s2-1 instance-tie)
(reset! *instance-mem-usage*)
(dotimes (s4-2 4)
(when (nonzero? (-> s5-0 geometry s4-2))
(let* ((a0-17 (-> s5-0 geometry s4-2))
(t9-5 (method-of-object a0-17 mem-usage))
(a1-6 *instance-mem-usage*)
(v1-40 s4-2)
)
(t9-5 a0-17 a1-6 (logior (cond
((= v1-40 1)
4
)
((= v1-40 2)
8
)
((= v1-40 3)
16
)
(else
0
)
)
2
)
)
)
)
)
(set! s4-1 (+ (calculate-total *instance-mem-usage*) 64))
)
)
(mem-usage s5-0 (reset! *instance-mem-usage*) 0)
(let ((v1-50 (calculate-total *instance-mem-usage*)))
(format
arg0
"~%~A ~A b @ #x~X ~,,2fK/~,,2fK~%"
s2-1
(-> s5-0 name)
s5-0
(* 0.0009765625 (the float v1-50))
(* 0.0009765625 (the float s4-1))
)
)
)
(format arg0 "near: ~m mid: ~m far: ~m~%" (-> s5-0 dists x) (-> s5-0 dists z) (-> s5-0 dists w))
(let ((s3-2 0)
(s4-3 0)
)
(cond
((= s2-1 instance-shrubbery)
(let ((f30-0 0.0))
(format
arg0
"usage: vis: ~D shrub: ~D trans-shrub ~D bill: ~D in level: ~D~%"
(-> (the-as prototype-bucket-shrub s5-0) count 0)
(-> (the-as prototype-bucket-shrub s5-0) count 1)
(-> (the-as prototype-bucket-shrub s5-0) count 2)
(-> (the-as prototype-bucket-shrub s5-0) count 3)
(-> (the-as prototype-bucket-shrub s5-0) in-level)
)
(format arg0 "~%frag# tris dverts strlen tex~%")
(let ((s1-2 (the-as prototype-shrubbery (-> (the-as prototype-bucket-shrub s5-0) geometry 1)))
(s2-2 (+ (-> (the-as prototype-bucket-shrub s5-0) count 1) (-> (the-as prototype-bucket-shrub s5-0) count 2)))
)
(dotimes (s0-1 (-> s1-2 length))
(set! sv-16 (shrub-num-tris (-> s1-2 data s0-1)))
(set! sv-32 (-> s1-2 data s0-1 header data 2))
(set! sv-48 (-> s1-2 data s0-1 header data 0))
(format
arg0
"~5D ~4D ~5D ~6f ~D~%"
s0-1
sv-16
sv-32
(/ (* 2.0 (the float sv-16)) (the float (- sv-32 (the-as uint sv-16))))
sv-48
)
(+! s3-2 sv-16)
(+! s4-3 (the-as int sv-32))
(set! f30-0
(+ 29.0
(* 5.5 (the float (- sv-32 (the-as uint sv-16))))
(* 22.0 (the float sv-48))
(* 8.0 (the float sv-32))
(* 53.0 (the float (/ (+ s2-2 9) (the-as uint 10))))
(* (the float s2-2) (+ 15.0 (* 5.0 (the float sv-48)) (* 13.5 (the float sv-32))))
f30-0
)
)
)
(format
arg0
"total ~4D ~5D ~6f ~D speed: ~f~%"
s3-2
s4-3
(/ (* 2.0 (the float s3-2)) (the float (- s4-3 s3-2)))
(-> s5-0 utextures)
(/ f30-0 (* (the float s2-2) (the float s3-2)))
)
)
)
)
((= s2-1 instance-tie)
(set! sv-144 0)
(let ((s1-3 0)
(s0-2 0)
(s2-3 0)
)
(format arg0 "~%level visible frags tris dverts strlen tex ttris~%")
(set! sv-64 1)
(set! sv-80 3)
(while (>= sv-80 sv-64)
(let ((v1-100 (-> (the-as prototype-bucket-tie s5-0) tie-geom sv-64)))
(set! sv-96 0)
(set! sv-112 0)
(set! sv-128 0)
(dotimes (a0-36 (-> v1-100 length))
(set! sv-96 (+ sv-96 (-> v1-100 data a0-36 debug num-tris)))
(set! sv-112 (+ sv-112 (-> v1-100 data a0-36 debug num-dverts)))
(set! sv-128 (+ sv-128 (-> v1-100 data a0-36 tex-count)))
)
(set! sv-144 (+ sv-144 (the-as int (-> (the-as prototype-bucket-tie s5-0) count sv-64))))
(format
arg0
"~5D ~7D ~5D ~5D"
sv-64
(-> (the-as prototype-bucket-tie s5-0) count sv-64)
(-> v1-100 length)
sv-96
)
)
(format
arg0
" ~5D ~6f ~3D ~5D~%"
sv-112
(/ (* 2.0 (the float sv-96)) (the float (- sv-112 sv-96)))
sv-128
(* (the-as uint sv-96) (the-as uint (-> (the-as prototype-bucket-tie s5-0) count sv-64)))
)
(+! s1-3 (* (the-as uint sv-96) (the-as uint (-> (the-as prototype-bucket-tie s5-0) count sv-64))))
(+! s0-2 (* (the-as uint sv-112) (the-as uint (-> (the-as prototype-bucket-tie s5-0) count sv-64))))
(+! s3-2 sv-96)
(+! s4-3 sv-112)
(+! s2-3 sv-128)
(set! sv-64 (+ sv-64 1))
)
(let ((t9-20 format)
(a0-52 arg0)
(a1-28 "total ~7D/~3D ~5D")
(a3-12 (-> s5-0 in-level))
)
(t9-20 a0-52 a1-28 sv-144 a3-12 s3-2)
)
(format
arg0
" ~5D ~6f ~3D ~5D~%"
s4-3
(/ (* 2.0 (the float s1-3)) (the float (- s0-2 s1-3)))
s2-3
s1-3
)
)
)
)
)
)
)
)
)
(none)
)
(defun-debug set-shadow-by-name ((arg0 string) (arg1 int) (arg2 int))
"Update the shadow masks and values for an active process-drawable."
(let ((v1-0 (process-by-name arg0 *active-pool*)))
(when v1-0
(let ((v1-1 (-> (the-as process-drawable v1-0) draw)))
(cond
((< arg2 16)
(logior! (-> v1-1 shadow-mask) (ash 1 arg1))
(logclear! (-> v1-1 shadow-values) (ash 15 (* arg1 4)))
(logior! (-> v1-1 shadow-values) (ash arg2 (* arg1 4)))
)
(else
(logclear! (-> v1-1 shadow-mask) (ash 1 arg1))
(logclear! (-> v1-1 shadow-values) (ash 15 (* arg1 4)))
)
)
)
)
)
(none)
)
(defun-debug get-shadow-by-name ((arg0 string))
"Get the current mask/values for an active process-drawable"
(let ((v1-0 (process-by-name arg0 *active-pool*)))
(when v1-0
(let ((s5-0 (-> (the-as process-drawable v1-0) draw)))
(format 0 "actor ~s {~%" arg0)
(format 0 " SHADOW_MASK(0x~02x)~%" (-> s5-0 shadow-mask))
(format 0 " SHADOW_VALUES(0x~08x)~%" (-> s5-0 shadow-values))
)
(format 0 "}~%")
)
)
(none)
)
(defun-debug teleport-camera-by-name ((arg0 string))
"Send the camera to an entity, switch to string mode."
(let* ((gp-0 (entity-by-name arg0))
(v1-0 (if (type? gp-0 entity-actor)
gp-0
)
)
)
(if (and v1-0 *camera*)
(send-event *camera* 'teleport-to-vector-start-string (-> v1-0 trans))
)
)
(none)
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; foreground drawing system
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; processes will call ja-post, which adds them to the matrix engine
;; the matrix engine runs (there's a few ways), it computes joints, then kicks out the process from the matrix engine
;; all drawable processes belong to the foreground-draw-engine.
;; - foreground-initialize-engines runs, preparing for the foreground engine run
;; - foreground-engine-execute runs,
;; - foreground-init runs
;; - execute-connections runs on the foreground engine
;; it calls add-process-drawable which calls dma-add-func which is usually dma-add-process-drawable
;; - dma-add-process-drawable does culling, picking lights/shadow
;; - calls foreground-draw
;; picks merc/emerc/shadow/generic/effects, more light processing
;; adds the bone calculation, calls the foreground-<renderer> to generate dma
;; - foreground-wrapup runs, patching up merc/emerc stuff
;; - foreground-execute-cpu-vu0-engines runs
;; - does bone calcs for merc
;; - does VU0/CPU stuff for generic/shadow/lightning
(defun dma-add-process-drawable ((pd process-drawable) (dc draw-control) (flag symbol) (dma-buf dma-buffer))
"Draw a normal process-drawable. Set up lighting/shadow settings, then pass on to foreground renderer."
(local-vars
(a0-82 int)
(a0-84 int)
(a3-11 uint128)
(sv-16 process-drawable)
(tod time-of-day-context)
(shadow-mask uint)
(lev-idx-for-mood uint)
(my-origin vector)
(lev-mood mood-context)
(light-result-bucket light-hash-bucket)
(index-ptr pointer)
(index-index int)
)
(with-pp
(rlet ((acc :class vf)
(Q :class vf)
(vf0 :class vf)
(vf1 :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)
(vf6 :class vf)
)
(init-vf0-vector)
(set! sv-16 pd)
;; og:preserve-this
(reset! (-> *perf-stats* data (perf-stat-bucket foreground)))
;; skip drawing when in menu mode.
(when (-> *blit-displays-work* menu-mode)
(if (not (logtest? (-> dc status) (draw-control-status hud)))
(return #f)
)
)
;; clear previous on-screen flag, we don't know if we're on-screen yet.
(logclear! (-> dc status) (draw-control-status on-screen))
;; only if we should draw...
(when (not (logtest? (-> dc status) (draw-control-status no-draw no-draw-temp uninited)))
;; og:preserve-this scratchpad
(let ((fg-bounds (-> (scratchpad-object foreground-work) bounds))
(fg-lights (-> (scratchpad-object foreground-work) lights))
)
(set! tod *time-of-day-context*)
(.lvf vf16 (&-> dc origin quad))
(.svf (&-> fg-bounds quad) vf16)
;; sphere cull.
(when (sphere-in-view-frustum? fg-bounds)
(cond
((logtest? (-> dc global-effect) (draw-control-global-effect title-light))
;; magic special case for title light.
(when (not (-> tod title-updated))
(set! (-> tod title-updated) #t)
(let ((s1-0 (-> *math-camera* inv-camera-rot))
(a1-3 (new 'stack-no-clear 'vector))
(s2-0 (new 'stack-no-clear 'vector))
)
(set-vector! a1-3 0.612 0.5 -0.612 0.0)
(set-vector! s2-0 -0.696 0.174 0.696 0.0)
(vector-matrix*! (the-as vector (-> tod title-light-group)) a1-3 s1-0)
(vector-matrix*! (the-as vector (-> tod title-light-group dir1)) s2-0 s1-0)
)
)
(vu-lights<-light-group! fg-lights (-> tod title-light-group))
)
(else
;; terrible lighting and shadow stuff
(set! shadow-mask (-> dc shadow-mask))
(let ((shadow-mask-not (lognot shadow-mask)))
(set! lev-idx-for-mood (-> dc level-index))
(let ((light-idx (-> dc light-index))
(lg (new 'stack-no-clear 'light-group))
)
(if (and (>= lev-idx-for-mood (the-as uint 6)) (< light-idx (the-as uint 20)))
(+! light-idx 20)
)
(let ((v1-40 (the-as
mood-context
(+ (the-as uint (-> *level* level0 mood-context)) (* (the-as uint 5232) lev-idx-for-mood))
)
)
)
(cond
((< light-idx (the-as uint 8))
(quad-copy! (the-as pointer lg) (the-as pointer (-> v1-40 light-group light-idx)) 12)
)
((< light-idx (the-as uint 18))
(quad-copy! (the-as pointer lg) (the-as pointer (-> v1-40 light-group (+ light-idx -10))) 12)
)
((< light-idx (the-as uint 28))
(quad-copy! (the-as pointer lg) (the-as pointer (-> tod light-group (+ light-idx -20))) 12)
)
((< light-idx (the-as uint 38))
(quad-copy! (the-as pointer lg) (the-as pointer (-> tod light-group (+ light-idx -30))) 12)
)
)
)
(when (not (or (>= lev-idx-for-mood (the-as uint 6)) (zero? shadow-mask)))
(let ((packed-shadow-vals (-> dc shadow-values)))
(dotimes (light-idx2 4)
(when (nonzero? (-> lg lights light-idx2 mask))
(when (not (logtest? (-> lg lights light-idx2 mask) shadow-mask-not))
(let ((light-pal-idx (-> lg lights light-idx2 palette-index)))
(set! (-> lg lights light-idx2 extra x)
(* 0.0625
(the float (logand (ash packed-shadow-vals (* -4 light-pal-idx)) 15))
(-> lg lights light-idx2 extra x)
)
)
)
)
)
)
)
)
(when (or (and (>= light-idx (the-as uint 10)) (< light-idx (the-as uint 18)))
(and (>= light-idx (the-as uint 30)) (< light-idx (the-as uint 38)))
)
(dotimes (fg-light-lev-idx (-> *level* length))
(let ((lev (-> *level* level fg-light-lev-idx)))
(when (= (-> lev status) 'active)
(let ((light-hash (-> lev light-hash)))
(set! my-origin (-> dc origin))
(set! lev-mood (-> lev mood-context))
(when (nonzero? light-hash)
(let ((light-lookup-result (light-hash-get-bucket-index light-hash (-> dc origin))))
(when (!= light-lookup-result -1)
(set! light-result-bucket (-> light-hash bucket-array light-lookup-result))
(set! index-ptr (the pointer (+ (+ (-> light-result-bucket index) 0) (the-as uint (-> light-hash index-array)))))
(set! index-index 0)
(while (< index-index (the-as int (-> light-result-bucket count)))
(let* ((light-sphere (-> light-hash light-sphere-array (-> (the-as (pointer uint8) (&+ index-ptr index-index)))))
(palette-idx (-> light-sphere palette-index))
(interp (if (= palette-idx -1)
1.0
(-> lev-mood times palette-idx w)
)
)
)
(if (!= (* (-> light-sphere brightness) interp) 0.0)
(add-light-sphere-to-light-group lg light-sphere my-origin lev-mood)
)
)
(set! index-index (+ index-index 1))
)
)
)
)
)
)
)
)
)
;; convert to vu format
(vu-lights<-light-group! fg-lights lg)
;; adjust shadow angle
(when (and (nonzero? (-> dc shadow-ctrl))
(-> dc shadow-ctrl)
(not (logtest? (-> dc shadow-ctrl settings flags) (shadow-flags disable-draw)))
(not (logtest? (-> dc shadow-ctrl settings flags) (shadow-flags shdf07)))
)
(let ((target-shadow-dir (new 'stack-no-clear 'vector))
(current-shadow-dir (-> dc shadow-ctrl settings shadow-dir))
(shadow-dir-w (-> dc shadow-ctrl settings shadow-dir w))
)
(.lvf vf1 (&-> lg dir0 direction quad))
(.lvf vf2 (&-> lg dir1 direction quad))
(.lvf vf3 (&-> lg dir2 direction quad))
(.lvf vf4 (&-> lg dir0 extra quad))
(.lvf vf5 (&-> lg dir1 extra quad))
(.lvf vf6 (&-> lg dir2 extra quad))
(.mul.x.vf acc vf1 vf4)
(.add.mul.x.vf acc vf2 vf5 acc)
(.add.mul.x.vf vf1 vf3 vf6 acc)
(.svf (&-> target-shadow-dir quad) vf1)
(vector-normalize! target-shadow-dir -1.0)
(when (< (- (-> target-shadow-dir y)) 0.9063)
(let* ((f0-16 0.4226)
(f1-6 (-> target-shadow-dir x))
(f1-8 (* f1-6 f1-6))
(f2-0 (-> target-shadow-dir z))
(f0-17 (/ f0-16 (sqrtf (+ f1-8 (* f2-0 f2-0)))))
)
(set! (-> target-shadow-dir x) (* (-> target-shadow-dir x) f0-17))
(set! (-> target-shadow-dir y) -0.9063)
(set! (-> target-shadow-dir z) (* (-> target-shadow-dir z) f0-17))
)
)
(when (not (paused?))
(vector-seek! current-shadow-dir target-shadow-dir (* 0.2 (seconds-per-frame)))
(vector-normalize! current-shadow-dir 1.0)
)
(set! (-> dc shadow-ctrl settings shadow-dir w) shadow-dir-w)
)
)
;; og:preserve-this
(#when PC_PORT (add-debug-lights *display-lights* (bucket-id debug2) (-> lg lights) (-> dc origin)))
)
)
)
)
;; apply mult and emissive lighting.
(.lvf vf28 (&-> dc color-mult quad))
(.lvf vf29 (&-> dc color-emissive quad))
(.lvf vf2 (&-> fg-lights color 0 quad))
(.lvf vf3 (&-> fg-lights color 1 quad))
(.lvf vf4 (&-> fg-lights color 2 quad))
(.lvf vf5 (&-> fg-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 (&-> fg-lights color 0 quad) vf2)
(.svf (&-> fg-lights color 1 quad) vf3)
(.svf (&-> fg-lights color 2 quad) vf4)
(.svf (&-> fg-lights ambient quad) vf5)
;; load math camera registers for distance calcs
(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 quad 0))
(.lvf vf25 (&-> at-0 camera-rot quad 1))
(.lvf vf26 (&-> at-0 camera-rot quad 2))
(.lvf vf27 (&-> at-0 camera-rot trans quad))
)
;; og:preserve-this scratchpad
;; do distance math
(let ((fg-dist (-> (scratchpad-object foreground-work) distance)))
(.lvf vf15 (&-> fg-bounds 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 vf15 vf26 vf15 acc :mask #b111)
(.mul.vf vf28 vf15 vf15)
(.max.w.vf vf29 vf0 vf0)
(.add.y.vf acc vf28 vf28)
(.add.mul.z.vf vf28 vf29 vf28 acc :mask #b1)
(.sqrt.vf Q vf28 :ftf #b0)
(.sub.w.vf vf28 vf0 vf15 :mask #b1000)
(.wait.vf)
(.add.vf vf15 vf28 Q :mask #b1000)
(.svf (&-> fg-dist quad) vf15)
;; pick lods
(when (< 0.0 (+ (-> fg-dist z) (-> dc bounds w)))
(let ((lod-idx 0))
(let ((dist-w (-> fg-dist w)))
(set! (-> dc distance) dist-w)
(when (nonzero? (-> dc lod-set max-lod))
(cond
((>= (-> dc force-lod) 0)
(set! lod-idx (-> dc force-lod))
;; og:preserve-this force high lods
(if (#if (not PC_PORT)
(< (-> dc lod-set lod (-> dc lod-set max-lod) dist) dist-w)
(and (-> *pc-settings* ps2-lod-dist?) (< (-> dc lod-set lod (-> dc lod-set max-lod) dist) dist-w)))
(return #f)
)
)
(else
(while (and (< lod-idx (the-as int (-> dc lod-set max-lod))) (< (-> dc lod-set lod lod-idx dist) dist-w))
(+! lod-idx 1)
)
)
)
)
;; og:preserve-this lod hacks!
(with-pc
(when (not (-> *pc-settings* ps2-lod-dist?))
(set! lod-idx (minmax (-> *pc-settings* lod-force-actor) 0 (-> dc lod-set max-lod)))
(when (> (-> dc force-lod) -1)
(set! lod-idx (-> dc force-lod))
)
)
)
(if (#if (not PC_PORT)
(and (< (-> dc lod-set lod lod-idx dist) dist-w) (< (-> dc force-lod) 0))
(and (-> *pc-settings* ps2-lod-dist?) (< (-> dc lod-set lod lod-idx dist) dist-w) (< (-> dc force-lod) 0))
)
(return #f)
)
;; predict texture use and set masks.
(let ((src-lev (-> *level* level (-> dc level-index)))
(corrected-dist (* dist-w (-> *math-camera* fov-correction-factor)))
(tex-use (-> dc mgeo header texture-usage-group))
)
(dotimes (use-fg-idx 7)
(let ((use-idx (+ use-fg-idx 11)))
(if (not (logtest? (-> dc status) (draw-control-status no-closest-distance)))
(set! (-> src-lev closest-object-array use-idx) (fmin (-> src-lev closest-object-array use-idx) dist-w))
)
)
(let ((tex-lod (cond
((>= corrected-dist (-> tex-use data use-fg-idx data 0 dist))
0
)
((>= corrected-dist (-> tex-use data use-fg-idx data 1 dist))
1
)
(else
2
)
)
)
(a2-23 (+ use-fg-idx 11))
)
(let ((a3-10 (-> src-lev texture-mask a2-23 mask quad))
(t0-3 (-> (the-as (pointer uint128) (+ (the-as uint tex-use) (* 48 use-fg-idx) (* tex-lod 16))) 0))
)
(.por a3-11 a3-10 t0-3)
)
(set! (-> src-lev texture-mask a2-23 mask quad) a3-11)
)
)
)
;; see if we need special scissor mode.
(if (or (guard-band-cull fg-bounds) (< dist-w (* 1.2 (-> *math-camera* d))))
(logior! (-> dc status) (draw-control-status close-to-screen))
(logclear! (-> dc status) (draw-control-status close-to-screen))
)
;; if we got this far, we're on-screen.
(logior! (-> dc status) (draw-control-status on-screen))
(if (logtest? (-> dc status) (draw-control-status no-draw-bounds no-draw-bounds2))
(return #f)
)
(set! (-> pp clock) (-> sv-16 clock))
;; draw!
;; og:preserve-this PC port note: we ALWAYS disable the envmap hack when a process-drawable has warp effect enabled
(when (or (= lod-idx (-> dc cur-lod)) (logtest? (-> dc status) (draw-control-status lod-set)))
(protect ((-> *pc-settings* force-envmap?))
(when (not (movie?))
(dotimes (eff-i (-> dc mgeo header effect-count))
(if (and (zero? (logand (ash 1 eff-i) (-> dc effect-mask)))
(logtest? (effect-bits cross-fade) (-> dc mgeo effect eff-i effect-bits)))
(false! (-> *pc-settings* force-envmap?)))))
(foreground-draw dc dma-buf dist-w)
)
)
)
;; og:preserve-this trick to do joint math twice if we're changing lods.
(when (and (< lod-idx (-> dc cur-lod)) (logtest? (-> dc status) (draw-control-status math-skel)))
;; og:preserve-this added this check for PC port to prevent memory corruption
(if (< (-> *matrix-engine* length) (-> *matrix-engine* allocated-length))
(let ((v1-159 *matrix-engine*))
(set! (-> v1-159 (-> v1-159 length)) (process->handle sv-16))
(+! (-> v1-159 length) 1)
)
)
)
(lod-set! dc lod-idx)
)
(logior! (-> dc status) (draw-control-status lod-set))
)
)
)
)
)
;; og:preserve-this
(read! (-> *perf-stats* data (perf-stat-bucket foreground)))
(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 ((arg0 process-drawable) (arg1 draw-control) (arg2 float) (arg3 dma-buffer))
"Generate DMA for a foreground-hud process-drawable."
(local-vars (a3-4 uint128))
;; clear old value of on-screen
(logclear! (-> arg1 status) (draw-control-status on-screen))
;; only draw if we're enabled
(when (not (logtest? (-> arg1 status) (draw-control-status no-draw no-draw-temp uninited)))
;; og:preserve-this scratchpad
;; copy *hud-lights* to the scratchpad lights.
(let ((v1-6 (-> (scratchpad-object foreground-work) lights))
(a0-3 *hud-lights*)
)
(set! (-> v1-6 direction 0 quad) (-> a0-3 direction 0 quad))
(set! (-> v1-6 direction 1 quad) (-> a0-3 direction 1 quad))
(set! (-> v1-6 direction 2 quad) (-> a0-3 direction 2 quad))
(set! (-> v1-6 color 0 quad) (-> a0-3 color 0 quad))
(set! (-> v1-6 color 1 quad) (-> a0-3 color 1 quad))
(set! (-> v1-6 color 2 quad) (-> a0-3 color 2 quad))
(set! (-> v1-6 ambient quad) (-> a0-3 ambient quad))
)
;; force lod0 and on-screen
(lod-set! arg1 0)
(logior! (-> arg1 status) (draw-control-status on-screen))
;; send to foreground.
(foreground-draw-hud arg1 arg3 arg2)
;; update textures.
(let ((v1-12 (-> *level* default-level))
(a0-8 (-> arg1 mgeo header texture-usage-group))
)
(dotimes (a1-9 7)
(let ((a2-1 (+ a1-9 11)))
(let ((a3-3 (-> v1-12 texture-mask a2-1 mask quad))
(t0-3 (-> a0-8 data a1-9 data 2 mask quad))
)
(.por a3-4 a3-3 t0-3)
)
(set! (-> v1-12 texture-mask a2-1 mask quad) a3-4)
)
)
)
)
0
(none)
)
(defun add-process-drawable ((arg0 process-drawable) (arg1 draw-control) (arg2 symbol) (arg3 dma-buffer))
"Call the dma-add-func callback on a draw-control to draw it."
((-> arg1 dma-add-func) arg0 arg1 arg2 arg3)
(none)
)
(defun foreground-engine-execute ((arg0 engine) (arg1 display-frame))
"Run the foreground drawing engine."
(when (> (length arg0) 0)
(let ((gp-0 (-> *display* frames (-> *display* on-screen) global-buf base)))
(with-profiler 'foreground *profile-foreground-color*
(let ((s4-1 (-> arg1 global-buf)))
;; og:preserve-this
; (let ((v1-29 (-> s4-1 base)))
; (.sync.l)
; (.cache dxwbin v1-29 0)
; (.sync.l)
; (.cache dxwbin v1-29 1)
; )
; (.sync.l)
; 0
;; prepare for foreground functions
(foreground-init)
;; add dma for each foreground object
(execute-connections arg0 s4-1)
;; stitch together buckets/finalize renderers.
(foreground-wrapup)
)
)
(let ((v1-49 *dma-mem-usage*))
(when (nonzero? v1-49)
(set! (-> v1-49 length) (max 36 (-> v1-49 length)))
(set! (-> v1-49 data 35 name) "pris-fragment")
(+! (-> v1-49 data 35 count) 1)
(+! (-> v1-49 data 35 used)
(&- (-> *display* frames (-> *display* on-screen) global-buf base) (the-as uint gp-0))
)
(set! (-> v1-49 data 35 total) (-> v1-49 data 35 used))
)
)
)
)
0
(none)
)
(defun-debug main-debug-hook ()
"Execute the debug engine, collision renderer, and draw-instance-info."
(when (not (or (= *master-mode* 'menu) (= *master-mode* 'progress)))
(let ((a0-3 *col-rend*))
(if (-> a0-3 draw?)
(col-rend-method-9 a0-3)
)
)
(execute-connections *debug-engine* #f)
(draw-instance-info *stdcon*)
)
(none)
)
(define *debug-hook* (cons main-debug-hook '()))
(define *add-sphere* #f)
(define *generic-effect-mode* 0)
(defun foreground-initialize-engines ()
"Called before dispatching foreground engine to set up."
;; initialize shadow lists.
(let ((v1-0 *shadow-globals*))
(dotimes (a0-0 2)
(let ((a1-2 (-> v1-0 bucket a0-0)))
(set! (-> a1-2 first) (the-as pointer 0))
(set! (-> a1-2 next) (the-as pointer 0))
(set! (-> a1-2 shadow-color) (if (zero? a0-0)
(new 'static 'rgba :r #xf0 :g #xf0 :b #xf0 :a #x80)
(the-as rgba (-> *setting-control* user-current spotlight-color))
)
)
(set! (-> a1-2 constants) (the-as shadow-vu1-constants 0))
)
)
)
(none)
)
(defun foreground-execute-cpu-vu0-engines ()
"Run the CPU/VU0 part of foreground. Happens after the foreground-engine-execute is done (first pass dma done).
Generates bone matrices for VU1 renderers and does leftover stuff that depends on bones."
(let ((gp-0 (-> *display* frames (-> *display* on-screen) global-buf)))
;; do the bones
(bones-init gp-0)
(bones-mtx-calc-execute)
;; generic-merc/shadow have VU0/CPU parts that need bones, run them here.
(generic-merc-execute-all gp-0)
(shadow-execute-all gp-0)
)
(lightning-draw-all)
(none)
)
(defun real-main-draw-hook ()
"Main function to run the drawable system, called from the display-loop in main.gc"
(local-vars (a0-96 int) (a0-98 int))
(with-pp
(when *slow-frame-rate*
;; og:preserve-this
(dotimes (v1-2 128000000) ;; was 12800000
(nop!)
(nop!)
(nop!)
(nop!)
(nop!)
(nop!)
)
)
"Function to be executed to set up for engine dma"
;; update render/texture upload masks
(set! (-> *display* vu1-enable-user) (-> *display* vu1-enable-user-menu))
(set! (-> *texture-pool* texture-enable-user) (-> *texture-pool* texture-enable-user-menu))
;; display memory stats
(when *debug-segment*
(when (and *stats-memory* (!= *master-mode* 'menu))
(cond
(*stats-memory-short*
(dotimes (gp-0 (-> *level* length))
(let ((s5-0 (-> *level* level gp-0)))
(if (= (-> s5-0 status) 'active)
(print-mem-usage (compute-memory-usage! s5-0 #f) s5-0 *stdcon*)
)
)
)
)
(else
(let ((gp-1 (-> *level* level *stats-memory-level-index*)))
(if (and gp-1 (= (-> gp-1 status) 'active))
(print-mem-usage (compute-memory-usage! gp-1 #f) gp-1 *stdcon*)
)
)
)
)
)
(reset! *dma-mem-usage*)
)
;; set up foreground buckets
(foreground-initialize-engines)
;; update time of day and wind effects.
(let ((gp-2 (-> pp clock)))
(if (= (-> *time-of-day-context* mode) (time-of-day-palette-id unk3))
(set! (-> pp clock) (-> *display* bg-clock))
(set! (-> pp clock) (-> *display* real-clock))
)
;; og:preserve-this
; (if (not (paused?))
; (update-wind *wind-work* *wind-scales*)
; )
(update-time-of-day *time-of-day-context*)
(set! (-> pp clock) gp-2)
)
;; draw the sky
(with-profiler 'sky *profile-sky-color*
(if (-> *sky-work* draw-vortex)
(draw-vortex)
(draw *sky-work*)
)
(flush-cache 0)
)
;; draw the ocean
(let ((gp-5 (-> pp clock)))
(if (= (-> *time-of-day-context* mode) (time-of-day-palette-id unk3))
(set! (-> pp clock) (-> *display* bg-clock))
(set! (-> pp clock) (-> *display* real-clock))
)
(with-profiler 'ocean *profile-ocean-color*
(draw! *ocean*)
(when *ocean-map*
(update-map *ocean*)
)
)
(set! (-> pp clock) gp-5)
)
;; run the foreground system
(foreground-engine-execute *foreground-draw-engine* (-> *display* frames (-> *display* on-screen)))
(let ((gp-6 (-> pp clock)))
(if (= (-> *time-of-day-context* mode) (time-of-day-palette-id unk3))
(set! (-> pp clock) (-> *display* bg-clock))
(set! (-> pp clock) (-> *display* real-clock))
)
(foreground-execute-cpu-vu0-engines)
(set! (-> pp clock) gp-6)
)
;; og:preserve-this
;; ??
; (when *add-sphere*
; )
;; run the sprite/particle system.
(if (not (paused?))
(execute-part-engine)
)
(if (logtest? (vu1-renderer-mask sprite) (-> *display* vu1-enable-user))
(sprite-draw *display*)
)
;; debug draw collision stuff before processing it.
(when *debug-segment*
(debug-draw-actors *level* *display-actor-marks*)
(collide-shape-draw-debug-marks)
)
;; after debug drawing, send events to actors
(send-events-for-touching-shapes *touching-list*)
(free-nodes *touching-list*)
(prepare *collide-rider-pool*)
(send-all! *event-queue*)
;; spawn/update actors
(with-profiler 'update-actors *profile-update-actors-color*
(actors-update *level*)
)
(with-profiler 'nav *profile-nav-color*
(update-nav-meshes-method *level*)
)
(with-profiler 'background *profile-background-color*
;; Run the background renderers!
;; first, reset the background-work
(init-background)
;; next, collect all levels that are registered with the engine
;; this will call the drawable system's draw method on the levels which adds all
;; trees known to the background system to *background-work*.
(execute-connections *background-draw-engine* (-> *display* frames (-> *display* on-screen)))
;; execute all background drawing
(reset! (-> *perf-stats* data (perf-stat-bucket background)))
(finish-background)
(read! (-> *perf-stats* data (perf-stat-bucket background)))
;; update VU stats for background draw.
(update-wait-stats (-> *perf-stats* data (perf-stat-bucket background))
(-> *background-work* wait-to-vu0)
(the-as uint 0)
(the-as uint 0)
)
)
(end-perf-stat-collection)
;; background stats
(when (and (!= *master-mode* 'menu) *stats-poly*)
(dotimes (gp-13 (-> *level* length))
(let ((v1-307 (-> *level* level gp-13)))
(if (= (-> v1-307 status) 'active)
(collect-stats (-> v1-307 bsp))
)
)
)
(print-terrain-stats)
)
;; perf and collide stats
(when (not (paused?))
(if (and (!= *master-mode* 'menu) *stats-perf*)
(print-perf-stats)
)
(if (and (!= *master-mode* 'menu) *stats-collide*)
(print-collide-stats)
)
(when (and (!= *master-mode* 'menu) *stats-joint*)
(format *stdcon* "joint calls: ~D~%" (-> *new-joint-decompressor-stats* num-calls))
(format *stdcon* "joint anims: ~D~%" (-> *new-joint-decompressor-stats* num-anims))
(format *stdcon* "joint joints: ~D~%" (-> *new-joint-decompressor-stats* num-joints))
(format *stdcon* "joint time us: ~D~%" (-> *new-joint-decompressor-stats* total-time))
(reset! *new-joint-decompressor-stats*)
)
)
(start-perf-stat-collection)
0
(none)
)
)
(defun main-draw-hook ()
(real-main-draw-hook)
(none)
)
(define *draw-hook* main-draw-hook)
(defun default-init-buffer ((arg0 bucket-id) (arg1 gs-zbuf) (arg2 gs-test))
(let ((v1-6 (-> *display* frames (-> *display* on-screen) bucket-group arg0)))
(when (!= v1-6 (-> v1-6 last))
(let* ((a0-8 (-> *display* frames (-> *display* on-screen) global-buf))
(a3-3 (-> a0-8 base))
)
(dma-buffer-add-gs-set-flusha a0-8
(zbuf-1 arg1)
(test-1 arg2)
(alpha-1 (new 'static 'gs-alpha :b #x1 :d #x1))
(pabe 0)
(clamp-1 (new 'static 'gs-clamp :wms (gs-tex-wrap-mode clamp) :wmt (gs-tex-wrap-mode clamp)))
(tex1-1 (new 'static 'gs-tex1 :mmag #x1 :mmin #x1))
(texa (new 'static 'gs-texa :ta1 #x80))
(texclut (new 'static 'gs-texclut :cbw #x4))
(fogcol *fog-color*)
)
(let ((a1-18 (the-as object (-> a0-8 base))))
(set! (-> (the-as dma-packet a1-18) dma) (new 'static 'dma-tag :id (dma-tag-id next) :addr (-> v1-6 next)))
(set! (-> (the-as dma-packet a1-18) vif0) (new 'static 'vif-tag))
(set! (-> (the-as dma-packet a1-18) vif1) (new 'static 'vif-tag))
(set! (-> a0-8 base) (&+ (the-as pointer a1-18) 16))
)
(set! (-> v1-6 next) (the-as uint a3-3))
)
)
)
(none)
)
(defun default-end-buffer ((arg0 bucket-id) (arg1 gs-zbuf) (arg2 gs-test))
(let ((v1-6 (-> *display* frames (-> *display* on-screen) bucket-group arg0)))
(when (!= v1-6 (-> v1-6 last))
(let* ((a3-2 (-> *display* frames (-> *display* on-screen) global-buf))
(a0-8 (-> a3-2 base))
)
(dma-buffer-add-gs-set-flusha a3-2
(zbuf-1 arg1)
(test-1 arg2)
(alpha-1 (new 'static 'gs-alpha :b #x1 :d #x1))
(pabe 0)
(clamp-1 (new 'static 'gs-clamp :wms (gs-tex-wrap-mode clamp) :wmt (gs-tex-wrap-mode clamp)))
(tex1-1 (new 'static 'gs-tex1 :mmag #x1 :mmin #x1))
(texa (new 'static 'gs-texa :ta1 #x80))
(texclut (new 'static 'gs-texclut :cbw #x4))
(fogcol *fog-color*)
)
(let ((t0-4 (-> a3-2 base)))
(let ((a1-18 (the-as object (-> a3-2 base))))
(set! (-> (the-as dma-packet a1-18) dma) (new 'static 'dma-tag :id (dma-tag-id next)))
(set! (-> (the-as dma-packet a1-18) vif0) (new 'static 'vif-tag))
(set! (-> (the-as dma-packet a1-18) vif1) (new 'static 'vif-tag))
(set! (-> a3-2 base) (&+ (the-as pointer a1-18) 16))
)
(set! (-> (the-as dma-bucket (-> v1-6 last)) next) (the-as uint a0-8))
(set! (-> v1-6 last) (the-as (pointer dma-tag) t0-4))
)
)
)
)
(none)
)
(defun-debug screen-shot-scale ((arg0 int) (arg1 string))
(set! (-> *screen-shot-work* size) arg0)
(set! (-> *screen-shot-work* name) arg1)
(set! *display-profile* #f)
0
(none)
)
(defun-debug screen-shot ()
(screen-shot-scale 1 "image")
0
(none)
)
(defun display-frame-start ((arg0 display) (arg1 int) (arg2 float))
"Advance clocks, poll pads/mouse, set up buckets."
;; og:preserve-this workaround for PS2 HW bug
; (set! (-> (the-as vif-bank #x10003c00) err me0) 1)
;; tick frame clocks
(set-time-ratios *display* 1.0)
(tick! (-> arg0 frame-clock))
(tick! (-> arg0 real-frame-clock))
;; tick other clocks
(set-time-ratios *display* arg2)
(tick! (-> arg0 session-clock))
(tick! (-> arg0 game-clock))
(tick! (-> arg0 total-game-clock))
(tick! (-> arg0 base-clock))
(tick! (-> arg0 real-clock))
(tick! (-> arg0 target-clock))
(tick! (-> arg0 camera-clock))
(tick! (-> arg0 entity-clock))
(tick! (-> arg0 user0-clock))
(tick! (-> arg0 bg-clock))
(set! (-> arg0 bg-clock frame-counter) (the-as time-frame (mod (-> arg0 bg-clock frame-counter) #x69780)))
(tick! (-> arg0 part-clock))
(when (and (nonzero? *screen-shot-work*) (!= (-> *screen-shot-work* count) -1))
(let ((v1-43 (-> *screen-shot-work* size)))
(if (!= (-> *screen-shot-work* count) (* v1-43 v1-43))
(store-image *screen-shot-work*)
)
)
(+! (-> *screen-shot-work* count) -1)
(if (= (-> *screen-shot-work* count) -1)
(set! (-> *screen-shot-work* size) -1)
)
)
(let ((s5-1 (-> arg0 frames arg1)))
(if *sync-dma*
(sync-path 0 0)
)
(let ((v1-57 (-> s5-1 global-buf)))
(set! (-> v1-57 base) (-> v1-57 data))
(set! (-> v1-57 end) (&-> v1-57 data-buffer (-> v1-57 allocated-length)))
)
(let ((v1-58 (-> s5-1 global-buf)))
(&+! (-> v1-58 end) -65536)
)
(when *debug-segment*
(let ((v1-61 (-> s5-1 debug-buf)))
(set! (-> v1-61 base) (-> v1-61 data))
(set! (-> v1-61 end) (&-> v1-61 data-buffer (-> v1-61 allocated-length)))
)
)
(let ((v1-62 (-> s5-1 calc-buf)))
(set! (-> v1-62 base) (-> v1-62 data))
(set! (-> v1-62 end) (&-> v1-62 data-buffer (-> v1-62 allocated-length)))
)
(*pre-draw-hook* (-> s5-1 calc-buf))
(when (not (paused?))
(clear *stdcon1*)
(debug-reset-buffers)
(clear! *simple-sprite-system*)
)
;; og:preserve-this
(set! (-> s5-1 bucket-group) (dma-buffer-add-buckets (-> s5-1 calc-buf) (enum-length bucket-id)))
)
(service-cpads)
(service-mouse)
(execute-connections *pad-engine* #f)
(none)
)
;; og:preserve-this pc port function
(defun pc-maybe-vsync ()
"PC Port implementation of the block of code in display-sync that computes frame-time-ratio and maybe vsyncs."
;; for now, it's very simple.
;; I think the right logic in the future is to always vsync here, but return a more accurate dog ratio.
(syncv 0) ;; sync always!
;(set! *ticks-per-frame* 9765) ;; hack!
1.0 ;; and report that we run at full speed.
)
(defun display-sync ((arg0 display))
"Determine frame timing, possibly vsync, and kick off next DMA.
This also calls sync-path, but this appears redundant because the display loop did this already."
;; The "rendered" frame is the one that has had its DMA processed and is completed and in VRAM.
;; The "drawn" frame is the one that has DMA ready, but not sent.
;; The "vblank period" is how long in between actual frames on the TV. This is 16.67 ms for NTSC.
;; This function will kick off the drawn frame's DMA, possibly vsync, and update timing stuff.
;; Currently, I believe the _start_ of the drawn frame's DMA will do the "blit" to move
;; the "rendered" frame's image from the drawing buffer to the frame buffer, but it's possible I have this backward.
;; apparently useless sync
;; everything in here happens after DMA is done.
(sync-path 0 0)
(let* ((just-rendered-frame (-> arg0 last-screen))
(current-time (shl (timer1-time) 48))
(just-rendered-frame-start-time (shl (-> arg0 frames just-rendered-frame start-time) 48))
(prev-vblank-time-1 (shl (-> arg0 vblank-start-time 0) 48))
(prev-vblank-time-2 (shl (-> arg0 vblank-start-time 1) 48))
)
;; measure the actual *ticks-per-frame* by comparing the timings of the last two vblanks.
;; I think this should be constant for PAL/NTSC, the vblank interrupt happens no matter what and is based
;; on the TV timing stuff.
;(set! *ticks-per-frame* (sar (- prev-vblank-time-2 prev-vblank-time-1) 48))
(set! *ticks-per-frame* 9765) ;; HACK
(let* ((ticks-per-frame-f (the float *ticks-per-frame*))
;; how long we spent on this frame (measured from the dma-send until now)
(frame-duration (the float (sar (- current-time (the-as uint just-rendered-frame-start-time)) 48)))
;; how long we spent on this frame, as a fraction of the time between vblanks (the actual TV framerate)
(frame-time-ratio (/ frame-duration ticks-per-frame-f))
)
(/ (the float (sar (- current-time (the-as uint prev-vblank-time-2)) 48)) ticks-per-frame-f)
;; how close we are to the next vblank (should be between 0 and 1)
(let ((vysnc-progress (/ (the float (sar (- current-time (the-as uint prev-vblank-time-2)) 48)) ticks-per-frame-f))
;; the "lag ratio" of the frame that was just drawn.
(last-dog (fmax 1.0 (fmin 4.0 (-> *display* dog-ratio))))
)
;; store the amount of ticks that the frame took.
;; og:preserve-this
;; PC PORT NOTE : the originaly game reads this field in places to check if frames are taking too long and avoid doing potentially laggy things.
;; those numbers are hardcoded for 60fps, they would be a pain to adjust, and the effects in the pc port are negligible.
;; so, we just pretend frames rendered in planck time.
(set! (-> arg0 frames just-rendered-frame run-time) (#if PC_PORT 0 (the int frame-duration)))
;; next, we'll compute this "lag" ratio (will become dog-ratio of the next frame).
;; higher numbers = game running slower = bigger timesteps
#|
(set! frame-time-ratio
(cond
((-> arg0 run-half-speed)
;; running at half speed flag is likely used for debugging? It forces 1 vsync here always.
(syncv 0)
;; do a vysnc if we are both:
;; - took less than 2 vblank periods to do the last frame (we finished early)
;; - we have more than 10% of the frame left.
;; see the comments in the next section for a better explanation of why they do this.
(if (and (< (/ (the float (sar (- (shl (timer1-time) 48) (the-as uint just-rendered-frame-start-time)) 48))
ticks-per-frame-f
)
2.0
)
(< vysnc-progress 0.9)
)
(syncv 0)
)
;; report a dog-ratio of exactly 2 always, for this debug mode
2.0
)
(else
;; not using the half-speed debug option.
(cond
;; case where we're lagging and don't want to vsync usually.
((< 1.0 frame-time-ratio)
;; we're lagging! In this case, we usually don't bother with vsync, and there would be tearing.
;; not sure about this check, but I guess we never vysnc here if we're on the first 2 frames of the game?
(when (not (or (zero? prev-vblank-time-1) (zero? prev-vblank-time-2)))
;; if the force sync counter is set, do a vsync and decrease the counter.
(when (> (-> arg0 force-sync) 0)
(syncv 0)
(+! (-> arg0 force-sync) -1)
;; update the frame-time-ratio because we just made this frame longer by vsyncing.
(let ((v1-23 (shl (timer1-time) 48)))
(the float (sar (- v1-23 (the-as uint just-rendered-frame-start-time)) 48))
(set! frame-time-ratio
(/ (the float (sar (- v1-23 (the-as uint just-rendered-frame-start-time)) 48)) ticks-per-frame-f)
)
)
)
)
;; this "dog-count" thing can be set to 1.0 if the game thinks that its running fast enough for full framerate
;; but the frame start time is misaligned with the actual TV's vblank.
;; we are lagging here, so we don't want this, and dog-count should be set to 0
(set! (-> arg0 dog-count) 0.0)
)
;; case where we're vsyncing.
;; this should happen if the last-dog is 1.0 (was fast enough), or if the dog-count is set
;; the dog-count will be set if the frames are fast enough, but not currently aligned.
((or (= last-dog 1.0) (!= (-> arg0 dog-count) 0.0))
;; still, only do the sync if we have a lot of time. I guess that vsyncing in other cases is not
;; needed, and just wastes time. Might as well start on the next frame early!
(if (< vysnc-progress 0.9)
(syncv 0)
)
;; force no lag
(set! frame-time-ratio 1.0)
;; clear dog-count, go back to normal lag/no-lag decisions.
(set! (-> arg0 dog-count) 0.0)
)
(else
;; weird case: last frame was lag (last-dog != 1.0), but this frame wasn't (frame-time-ratio < 1).
;; so we're transition from lag to no lag. In this case, we want to get back aligned with vsyncs.
;; interestingly, we don't vsync immediately, but instead set a flag to vsync on the next frame, if
;; that frame's time is also non-lag. As a result, we only syncrhonize with vsync if we have 2 non-lag frames
;; in a row (both of them misaligned.), and we spread the syncrhonization delays between 2 frames
(when (not (or (zero? prev-vblank-time-1) (zero? prev-vblank-time-2))) ;; only if we've done at least 2 syncs..
;; here we wait, recomputing frame-time-ratio/vsync-progress until either:
;; - we're in the first or last third of the frame
;; - we've waited longer than the previous frame lagged.
(while (or (< frame-time-ratio last-dog) (and (< 0.333 vysnc-progress) (< vysnc-progress 0.667)))
(let ((v1-34 (shl (timer1-time) 48)))
(set! frame-time-ratio
(/ (the float (sar (- v1-34 (the-as uint just-rendered-frame-start-time)) 48)) ticks-per-frame-f)
)
(if (< frame-time-ratio 0.0) ;; ?? timer wraparound issues?
(set! frame-time-ratio last-dog)
)
(set! vysnc-progress
(/ (the float (sar (- v1-34 (the-as uint (shl (-> arg0 vblank-start-time 1) 48))) 48)) ticks-per-frame-f)
)
)
)
)
;; force next frame to vsync if it didn't lag, then we will be back on framerate!
(set! (-> arg0 dog-count) 1.0)
)
)
frame-time-ratio
)
)
)
|#
;; og:preserve-this added: just skip this for now.
(set! frame-time-ratio (pc-maybe-vsync))
(if (< frame-time-ratio 0.0)
(set! frame-time-ratio last-dog)
)
)
;; never allow faster than full-speed frames (the logic above will prevent running faster than TV framerate)
(let ((next-dog (fmax 1.0 frame-time-ratio))
(frame-to-render (-> arg0 on-screen))
)
;; measure time again, after waiting/vsyncing.
(let ((time-after-vsync (timer1-time)))
(+! (-> arg0 total-run-time)
(sar (- (shl time-after-vsync 48) (the-as uint just-rendered-frame-start-time)) 48)
)
;; and use this as the start time for the frame we're about to render.
(set! (-> arg0 frames frame-to-render start-time) (the-as int time-after-vsync))
)
;; while nothing is drawing, update GS/video/magic stuff.
;; (set-graphics-mode)
;; start DMA
(let ((next-dma-buf (-> arg0 frames frame-to-render calc-buf)))
(when (nonzero? (dma-buffer-length next-dma-buf))
(+! frame-to-render 1)
(if (< 1 frame-to-render)
(set! frame-to-render 0)
)
;; swap DMA buffers
(set! (-> arg0 last-screen) (-> arg0 on-screen))
(set! (-> arg0 on-screen) frame-to-render)
;; reset VU profiler for upcoming chain
(when *debug-segment*
(set! *profile-interrupt-segment* (-> *display* frames (-> *display* last-screen) profile-array data 1))
(set! (-> *profile-interrupt-segment* depth) 0)
(set! (-> *profile-interrupt-segment* max-depth) 1)
)
;; send the chain!
(__send-gfx-dma-chain (the-as dma-bank-source #x10009000) (-> next-dma-buf data-buffer))
)
)
;; screenshot/pause stuff.
(determine-pause-mode)
(when (and (nonzero? *screen-shot-work*) (= (-> *screen-shot-work* count) -1) (!= (-> *screen-shot-work* size) -1))
(let ((v1-77 (-> *screen-shot-work* size)))
(set! (-> *screen-shot-work* count) (* v1-77 v1-77))
)
(set-master-mode 'pause)
)
;; prepare engine for the next frame
(display-frame-start arg0 frame-to-render next-dog)
)
)
)
(none)
)
(defun display-frame-finish ((arg0 display))
"Do final DMA setup after drawing.
Note that this runs _after_ rendering, while VU1/GS are not doing anything.
so it's best to keep this code as simple as possible."
(with-pp
(let* ((s4-0 (-> arg0 frames (-> arg0 on-screen)))
(s5-0 (-> s4-0 calc-buf))
)
;(-> s4-0 global-buf)
;; post-draw buffer setup
(tfrag-vu1-init-buffers)
(tie-vu1-init-buffers)
(merc-vu1-init-buffers)
;; og:preserve-this
; (emerc-vu1-init-buffers)
(generic-vu1-init-buffers)
;; sprite texture remaps
(when (-> *texture-pool* update-sprites-flag)
(update-sprites *texture-pool*)
(particle-adgif-cache-flush)
(remap-all-particles)
)
;; texture uploads while GS is not doing anything.
(with-profiler 'texture *profile-texture-color*
(let ((s3-1 (-> pp clock)))
(if (= (-> *time-of-day-context* mode) (time-of-day-palette-id unk3))
(set! (-> pp clock) (-> *display* bg-clock))
(set! (-> pp clock) (-> *display* real-clock))
)
(upload-textures *texture-pool*)
(set! (-> pp clock) s3-1)
)
)
;; more texture mapping.
(if (-> *texture-pool* update-flag)
(update-warp-and-hud *texture-pool*)
)
;; unclear why eyes are here... maybe they rely on textures that were just remapped.
; (-> *display* frames (-> *display* on-screen) global-buf)
(update-eyes)
;; end each normal bucket with the standard GS state reset
(let ((s3-3 6)
(s2-2 (bucket-id debug2))
)
(while (>= s2-2 s3-3)
(default-end-buffer
(the-as bucket-id s3-3)
(new 'static 'gs-zbuf :zbp #x130 :psm (gs-psm ct24))
(new 'static 'gs-test :zte #x1 :ztst (gs-ztest greater-equal))
)
(+! s3-3 1)
)
)
;; initialize buckets with weird custom settings (disable z buffer)
(default-init-buffer
(bucket-id debug-no-zbuf1)
(new 'static 'gs-zbuf :zbp #x130 :psm (gs-psm ct24) :zmsk #x1)
(new 'static 'gs-test :zte #x1 :ztst (gs-ztest always))
)
(default-init-buffer
(bucket-id debug-no-zbuf2)
(new 'static 'gs-zbuf :zbp #x130 :psm (gs-psm ct24) :zmsk #x1)
(new 'static 'gs-test :zte #x1 :ztst (gs-ztest always))
)
(default-init-buffer
(bucket-id screen-filter)
(new 'static 'gs-zbuf :zbp #x130 :psm (gs-psm ct24) :zmsk #x1)
(new 'static 'gs-test :zte #x1 :ztst (gs-ztest always))
)
(*post-draw-hook* (-> arg0 frames (-> arg0 on-screen) calc-buf))
;; final flushe
(let* ((v1-70 s5-0)
(a0-25 (the-as object (-> v1-70 base)))
)
(set! (-> (the-as dma-packet a0-25) dma) (new 'static 'dma-tag :id (dma-tag-id cnt)))
(set! (-> (the-as dma-packet a0-25) vif0) (new 'static 'vif-tag :imm #x148 :cmd (vif-cmd mark)))
(set! (-> (the-as dma-packet a0-25) vif1) (new 'static 'vif-tag :cmd (vif-cmd flushe) :irq #x1 :msk #x1))
(set! (-> v1-70 base) (the-as pointer (&+ (the-as dma-packet a0-25) 16)))
)
;; link all buckets to build the final massive dma list.
(dma-buffer-patch-buckets (-> s4-0 bucket-group) (enum-length bucket-id))
;; append the final END
(let* ((v1-71 s5-0)
(a0-28 (the-as object (-> v1-71 base)))
)
(set! (-> (the-as dma-packet a0-28) dma) (new 'static 'dma-tag :id (dma-tag-id end)))
(set! (-> (the-as (pointer int64) a0-28) 1) 0)
(set! (-> v1-71 base) (&+ (the-as pointer a0-28) 16))
)
;; make sure nothing is in cache
(flush-cache 0)
;; list final dma sizes
(when (not (paused?))
(when *stats-buffer*
(let* ((a0-31 (-> s4-0 global-buf))
(v1-75 (-> s5-0 base))
(a2-4 (-> s5-0 data))
(s4-1 (-> a0-31 base))
(s5-1 (-> a0-31 data))
(s3-4 (-> a0-31 end))
)
(format *stdcon* "~0kvu1 buf = ~d~%" (&- v1-75 (the-as uint a2-4)))
(format *stdcon* "~0kglobal buf = ~d~%" (&- s4-1 (the-as uint s5-1)))
(format *stdcon* "~0kbase = #x~x~%" s4-1)
(format *stdcon* "~0kend = #x~x~%" s3-4)
)
)
)
;; now the DMA is ready to send!
)
arg0
)
)
;; definition for function determine-pause-mode
(defun determine-pause-mode ()
(when (and (or (not *progress-process*) (can-go-back? (-> *progress-process* 0)))
(or (!= *master-mode* 'freeze) (and *debug-segment* (cpad-pressed? 0 select start) (cpad-hold? 0 l3)))
)
(if (or (cpad-pressed? 0 select start)
(cond
((= *master-mode* 'menu)
(cpad-pressed? 0 r3 r2 triangle circle)
)
(*cam-layout*
#f
)
(else
#f
)
)
(or (and (logtest? (-> *cpad-list* cpads 0 valid) 128)
(= *master-mode* 'game)
(>= (-> *display* base-clock frame-counter) (-> *game-info* blackout-time))
(= (-> *setting-control* user-current bg-a) 0.0)
(and (= (-> *setting-control* user-current bg-a-force) 0.0)
(< (seconds 1003) (-> *display* real-clock frame-counter))
)
)
(and (cpad-pressed? 0 r2) (or (= *master-mode* 'pause) (= *master-mode* 'menu)))
*pause-lock*
)
)
(toggle-pause)
)
)
(if (and *progress-process* (!= *master-mode* 'progress))
(deactivate-progress)
)
0
)
(defun swap-display ((arg0 display))
(display-frame-finish arg0)
(display-sync arg0)
(none)
)
Reference in New Issue View Git Blame Copy Permalink