mirror of
https://github.com/open-goal/jak-project.git
synced 2024-10-20 11:26:18 -04:00
cd68cb671e
Major change to how `deftype` shows up in our code: - the decompiler will no longer emit the `offset-assert`, `method-count-assert`, `size-assert` and `flag-assert` parameters. There are extremely few cases where having this in the decompiled code is helpful, as the types there come from `all-types` which already has those parameters. This also doesn't break type consistency because: - the asserts aren't compared. - the first step of the test uses `all-types`, which has the asserts, which will throw an error if they're bad. - the decompiler won't emit the `heap-base` parameter unless necessary now. - the decompiler will try its hardest to turn a fixed-offset field into an `overlay-at` field. It falls back to the old offset if all else fails. - `overlay-at` now supports field "dereferencing" to specify the offset that's within a field that's a structure, e.g.: ```lisp (deftype foobar (structure) ((vec vector :inline) (flags int32 :overlay-at (-> vec w)) ) ) ``` in this structure, the offset of `flags` will be 12 because that is the final offset of `vec`'s `w` field within this structure. - **removed ID from all method declarations.** IDs are only ever automatically assigned now. Fixes #3068. - added an `:overlay` parameter to method declarations, in order to declare a new method that goes on top of a previously-defined method. Syntax is `:overlay <method-name>`. Please do not ever use this. - added `state-methods` list parameter. This lets you quickly specify a list of states to be put in the method table. Same syntax as the `states` list parameter. The decompiler will try to put as many states in this as it can without messing with the method ID order. Also changes `defmethod` to make the first type definition (before the arguments) optional. The type can now be inferred from the first argument. Fixes #3093. --------- Co-authored-by: Hat Kid <6624576+Hat-Kid@users.noreply.github.com>
552 lines
18 KiB
Common Lisp
552 lines
18 KiB
Common Lisp
;;-*-Lisp-*-
|
|
(in-package goal)
|
|
|
|
;; name: history.gc
|
|
;; name in dgo: history
|
|
;; dgos: ENGINE, GAME
|
|
|
|
(defenum collide-status
|
|
:bitfield #t
|
|
:type uint64
|
|
(on-surface 0)
|
|
(on-ground 1)
|
|
(touch-surface 2)
|
|
(touch-wall 3)
|
|
(touch-ceiling 4)
|
|
(touch-actor 5)
|
|
(on-special-surface 6)
|
|
(touch-edge 7)
|
|
(no-touch 8)
|
|
(blocked 9)
|
|
(on-water 10)
|
|
(impact-surface 11)
|
|
(touch-background 12)
|
|
(stuck 13)
|
|
(touch-ceiling-sticky 14)
|
|
(glance 15)
|
|
(probe-hit 16)
|
|
)
|
|
|
|
(defenum history-channel
|
|
:type uint8
|
|
(trans 0)
|
|
(transv 1)
|
|
(transv-in 2)
|
|
(transv-out 3)
|
|
(intersect 4)
|
|
(local-normal 5)
|
|
(surface-normal 6)
|
|
(collide-status 7)
|
|
(pat 8)
|
|
(time 9)
|
|
(friction 10))
|
|
|
|
;; DECOMP BEGINS
|
|
|
|
;; this file is debug only
|
|
(declare-file (debug))
|
|
|
|
(defun history-channel->string ((arg0 history-channel))
|
|
(case arg0
|
|
(((history-channel friction))
|
|
"friction"
|
|
)
|
|
(((history-channel transv-out))
|
|
"transv-out"
|
|
)
|
|
(((history-channel pat))
|
|
"pat"
|
|
)
|
|
(((history-channel transv-in))
|
|
"transv-in"
|
|
)
|
|
(((history-channel trans))
|
|
"trans"
|
|
)
|
|
(((history-channel local-normal))
|
|
"local-normal"
|
|
)
|
|
(((history-channel collide-status))
|
|
"collide-status"
|
|
)
|
|
(((history-channel time))
|
|
"time"
|
|
)
|
|
(((history-channel intersect))
|
|
"intersect"
|
|
)
|
|
(((history-channel surface-normal))
|
|
"surface-normal"
|
|
)
|
|
(((history-channel transv))
|
|
"transv"
|
|
)
|
|
(else
|
|
"*unknown*"
|
|
)
|
|
)
|
|
)
|
|
|
|
(deftype history-elt (structure)
|
|
((record-tag-bytes uint8 4)
|
|
(record-tag uint32 :overlay-at (-> record-tag-bytes 0))
|
|
(record-id uint16 :overlay-at (-> record-tag-bytes 0))
|
|
(owner uint8 :overlay-at (-> record-tag-bytes 2))
|
|
(channel history-channel)
|
|
(timestamp time-frame)
|
|
(origin vector :inline)
|
|
(bytes uint8 16)
|
|
(vector vector :inline :overlay-at (-> bytes 0))
|
|
(float float :overlay-at (-> bytes 0))
|
|
(collide-status collide-status :overlay-at (-> bytes 0))
|
|
(collide-reaction-flag uint32 :overlay-at (-> bytes 8))
|
|
(pat pat-surface :overlay-at (-> bytes 0))
|
|
)
|
|
)
|
|
|
|
|
|
(deftype history-iterator (basic)
|
|
((max-age uint32)
|
|
(owner uint8)
|
|
(proc process)
|
|
(out object)
|
|
(channel-mask uint64)
|
|
(index int32)
|
|
(done? symbol)
|
|
)
|
|
(:methods
|
|
(new (symbol type uint) _type_)
|
|
(frame-counter-delta (_type_ history-elt) time-frame)
|
|
(update-entries! (_type_) history-elt)
|
|
(get-age (_type_ history-elt) float)
|
|
)
|
|
)
|
|
|
|
|
|
(deftype history (basic)
|
|
((alloc-index int32)
|
|
(allocated-length int32)
|
|
(elts history-elt :inline :dynamic :offset 16)
|
|
)
|
|
(:methods
|
|
(new (symbol type int) _type_)
|
|
(clear-record-tags! (_type_ history-channel uint uint) history-elt)
|
|
(clear-history-entries! (_type_) none)
|
|
)
|
|
)
|
|
|
|
|
|
(defmethod length ((this history))
|
|
(-> this allocated-length)
|
|
)
|
|
|
|
;; WARN: Return type mismatch uint vs int.
|
|
(defmethod asize-of ((this history))
|
|
(the-as int (+ (-> this type size) (* 48 (-> this allocated-length))))
|
|
)
|
|
|
|
(defmethod new history ((allocation symbol) (type-to-make type) (arg0 int))
|
|
(let ((v0-0 (object-new allocation type-to-make (the-as int (+ (-> type-to-make size) (* 48 arg0))))))
|
|
(set! (-> v0-0 allocated-length) arg0)
|
|
v0-0
|
|
)
|
|
)
|
|
|
|
(defmethod clear-history-entries! ((this history))
|
|
"Iterates through each [[history-elt]] in the `elt` dynamic array
|
|
For each entry:
|
|
- clear `timestamp`
|
|
- clear `record-tag`"
|
|
(set! (-> this alloc-index) 0)
|
|
(countdown (v1-0 (-> this allocated-length))
|
|
(let ((a1-3 (-> this elts v1-0)))
|
|
(set! (-> a1-3 record-tag) (the-as uint 0))
|
|
(set! (-> a1-3 timestamp) 0)
|
|
)
|
|
0
|
|
)
|
|
0
|
|
(none)
|
|
)
|
|
|
|
(define-perm *history* history (new 'debug 'history 4096))
|
|
|
|
(clear-history-entries! *history*)
|
|
|
|
;; WARN: new jak 2 until loop case, check carefully
|
|
(defmethod clear-record-tags! ((this history) (arg0 history-channel) (arg1 uint) (arg2 uint))
|
|
"First grab the latest [[history-elt]] at `alloc-index`
|
|
1. update it's `channel`, `record-id` and `owner` from the provided args
|
|
2. - if it's `record-tag` is zero -- return it
|
|
- otherwise, iterate through all `elts` until one is found that does not match it's `timestamp`
|
|
- if not `0` out the `record-tag` for that elt and continue iteration"
|
|
(let* ((t1-0 (-> this alloc-index))
|
|
(v1-0 (-> this elts))
|
|
(v0-0 (-> v1-0 t1-0))
|
|
)
|
|
(let ((t2-0 (-> v0-0 record-tag))
|
|
(t0-2 (-> v0-0 timestamp))
|
|
)
|
|
(set! (-> v0-0 channel) arg0)
|
|
(set! (-> v0-0 record-id) arg1)
|
|
(set! (-> v0-0 owner) arg2)
|
|
(set! (-> v0-0 timestamp) (-> *display* base-clock frame-counter))
|
|
(let* ((a1-4 (-> this allocated-length))
|
|
(a2-2 (mod (+ t1-0 1) a1-4))
|
|
)
|
|
(set! (-> this alloc-index) a2-2)
|
|
(when (nonzero? t2-0)
|
|
(until #f
|
|
(let ((a0-4 (-> v1-0 a2-2)))
|
|
(if (!= t0-2 (-> a0-4 timestamp))
|
|
(return v0-0)
|
|
)
|
|
(set! (-> a0-4 record-tag) (the-as uint 0))
|
|
)
|
|
(set! a2-2 (mod (+ a2-2 1) a1-4))
|
|
)
|
|
#f
|
|
)
|
|
)
|
|
)
|
|
v0-0
|
|
)
|
|
)
|
|
|
|
(defmethod new history-iterator ((allocation symbol) (type-to-make type) (arg0 uint))
|
|
(let ((v0-0 (object-new allocation type-to-make (the-as int (-> type-to-make size)))))
|
|
(set! (-> v0-0 max-age) arg0)
|
|
(set! (-> v0-0 owner) (the-as uint 1))
|
|
(set! (-> v0-0 proc) #f)
|
|
(set! (-> v0-0 out) *stdcon*)
|
|
(set! (-> v0-0 channel-mask) (the-as uint -1))
|
|
(set! (-> v0-0 index) (-> *history* alloc-index))
|
|
(set! (-> v0-0 done?) #f)
|
|
v0-0
|
|
)
|
|
)
|
|
|
|
(defmethod update-entries! ((this history-iterator))
|
|
"Iterate through each [[history-elt]] in [[*history*]]
|
|
- If we hit the end set `done?` to true
|
|
- If the `timestamp` on the elt, minus the current framecounter exceeds `max-age`, we are also done, return #f
|
|
- However if we find an elt who's `owner` matches the iterator's, break out early returning that `elt`"
|
|
(let ((v1-0 *history*)
|
|
(a1-2 (-> *display* base-clock frame-counter))
|
|
)
|
|
(while (not (-> this done?))
|
|
(let ((a2-1 (+ (-> this index) -1)))
|
|
(if (< a2-1 0)
|
|
(set! a2-1 (+ (-> v1-0 allocated-length) -1))
|
|
)
|
|
(set! (-> this index) a2-1)
|
|
(if (= a2-1 (-> v1-0 alloc-index))
|
|
(set! (-> this done?) #t)
|
|
)
|
|
(let ((a2-5 (-> v1-0 elts a2-1)))
|
|
(when (nonzero? (-> a2-5 record-tag))
|
|
(when (< (the-as time-frame (-> this max-age)) (- a1-2 (-> a2-5 timestamp)))
|
|
(set! (-> this done?) #t)
|
|
(return (the-as history-elt #f))
|
|
)
|
|
(if (= (-> a2-5 owner) (-> this owner))
|
|
(return a2-5)
|
|
)
|
|
)
|
|
)
|
|
)
|
|
)
|
|
)
|
|
(the-as history-elt #f)
|
|
)
|
|
|
|
(defmethod get-age ((this history-iterator) (arg0 history-elt))
|
|
"Get the age of a history element"
|
|
(- 1.0 (fmin 1.0 (/ (the float (+ (- 1 (-> arg0 timestamp)) (-> *display* base-clock frame-counter)))
|
|
(the float (+ (-> this max-age) 1))
|
|
)
|
|
)
|
|
)
|
|
)
|
|
|
|
(defmethod frame-counter-delta ((this history-iterator) (arg0 history-elt))
|
|
"Returns the difference between [[*display*]]'s `base-clock.frame-counter` and the elt's `timestamp`"
|
|
(- (-> *display* base-clock frame-counter) (-> arg0 timestamp))
|
|
)
|
|
|
|
;; WARN: new jak 2 until loop case, check carefully
|
|
(defun history-print ((arg0 history-iterator))
|
|
(local-vars
|
|
(sv-16 object)
|
|
(sv-24 int)
|
|
(sv-32 int)
|
|
(sv-40 history-elt)
|
|
(sv-48 time-frame)
|
|
(sv-56 uint)
|
|
(sv-64 collide-status)
|
|
(sv-72 float)
|
|
(sv-80 string)
|
|
(sv-96 string)
|
|
)
|
|
(set! sv-16 (-> arg0 out))
|
|
(set! sv-24 -1)
|
|
(set! sv-32 0)
|
|
(until #f
|
|
(set! sv-40 (update-entries! arg0))
|
|
(if (not sv-40)
|
|
(goto cfg-71)
|
|
)
|
|
(when (logtest? (-> arg0 channel-mask) (ash 1 (-> sv-40 channel)))
|
|
(set! sv-48 (frame-counter-delta arg0 sv-40))
|
|
(set! sv-56 (-> sv-40 record-id))
|
|
(cond
|
|
((!= sv-24 sv-48)
|
|
(set! sv-24 (the-as int sv-48))
|
|
(set! sv-32 (the-as int sv-56))
|
|
(format sv-16 "~3D ~4X " sv-48 (-> sv-40 record-id))
|
|
)
|
|
((!= sv-32 sv-56)
|
|
(set! sv-32 (the-as int sv-56))
|
|
(format sv-16 " ~4X " (-> sv-40 record-id))
|
|
)
|
|
(else
|
|
(format sv-16 " ")
|
|
)
|
|
)
|
|
(let ((v1-22 (-> sv-40 channel)))
|
|
(cond
|
|
((or (= v1-22 (history-channel trans))
|
|
(or (= v1-22 (history-channel transv))
|
|
(= v1-22 (history-channel transv-in))
|
|
(= v1-22 (history-channel transv-out))
|
|
(= v1-22 (history-channel intersect))
|
|
)
|
|
)
|
|
(format
|
|
sv-16
|
|
"~-15S: ~14Mm ~14Mm ~14Mm~%"
|
|
(history-channel->string (-> sv-40 channel))
|
|
(-> sv-40 vector x)
|
|
(-> sv-40 vector y)
|
|
(-> sv-40 vector z)
|
|
)
|
|
)
|
|
((or (= v1-22 (history-channel local-normal)) (= v1-22 (history-channel surface-normal)))
|
|
(format
|
|
sv-16
|
|
"~-15S: ~14f ~14f ~14f~%"
|
|
(history-channel->string (-> sv-40 channel))
|
|
(-> sv-40 vector x)
|
|
(-> sv-40 vector y)
|
|
(-> sv-40 vector z)
|
|
)
|
|
)
|
|
((= v1-22 (history-channel pat))
|
|
(let* ((s2-0 (-> sv-40 vector x))
|
|
(s5-2 format)
|
|
(s4-2 sv-16)
|
|
(s3-2 "~-15S: #x~6X mode:~-8S material:~-10S event:~S~%")
|
|
(s1-0 (history-channel->string (-> sv-40 channel)))
|
|
(s0-0 s2-0)
|
|
)
|
|
(set! sv-80 (pat-mode->string (the-as pat-surface s2-0)))
|
|
(set! sv-96 (pat-material->string (the-as pat-surface s2-0)))
|
|
(let ((t2-0 (pat-event->string (the-as pat-surface s2-0))))
|
|
(s5-2 s4-2 s3-2 s1-0 s0-0 sv-80 sv-96 t2-0)
|
|
)
|
|
)
|
|
)
|
|
((= v1-22 (history-channel collide-status))
|
|
(set! sv-64 (-> sv-40 collide-status))
|
|
(set! sv-72 (-> sv-40 vector z))
|
|
(format sv-16 "~-15S: #x~6X " (history-channel->string (-> sv-40 channel)) sv-64)
|
|
(let ((s5-4 sv-64))
|
|
(if (= (logand s5-4 (collide-status touch-background)) (collide-status touch-background))
|
|
(format sv-16 "touch-background ")
|
|
)
|
|
(if (= (logand s5-4 (collide-status on-special-surface)) (collide-status on-special-surface))
|
|
(format sv-16 "on-special-surface ")
|
|
)
|
|
(if (= (logand s5-4 (collide-status touch-wall)) (collide-status touch-wall))
|
|
(format sv-16 "touch-wall ")
|
|
)
|
|
(if (= (logand s5-4 (collide-status on-surface)) (collide-status on-surface))
|
|
(format sv-16 "on-surface ")
|
|
)
|
|
(if (= (logand s5-4 (collide-status impact-surface)) (collide-status impact-surface))
|
|
(format sv-16 "impact-surface ")
|
|
)
|
|
(if (= (logand s5-4 (collide-status touch-ceiling)) (collide-status touch-ceiling))
|
|
(format sv-16 "touch-ceiling ")
|
|
)
|
|
(if (= (logand s5-4 (collide-status on-ground)) (collide-status on-ground))
|
|
(format sv-16 "on-ground ")
|
|
)
|
|
(if (= (logand s5-4 (collide-status glance)) (collide-status glance))
|
|
(format sv-16 "glance ")
|
|
)
|
|
(if (= (logand s5-4 (collide-status blocked)) (collide-status blocked))
|
|
(format sv-16 "blocked ")
|
|
)
|
|
(if (= (logand s5-4 (collide-status touch-edge)) (collide-status touch-edge))
|
|
(format sv-16 "touch-edge ")
|
|
)
|
|
(if (= (logand s5-4 (collide-status touch-ceiling-sticky)) (collide-status touch-ceiling-sticky))
|
|
(format sv-16 "touch-ceiling-sticky ")
|
|
)
|
|
(if (= (logand s5-4 (collide-status on-water)) (collide-status on-water))
|
|
(format sv-16 "on-water ")
|
|
)
|
|
(if (= (logand s5-4 (collide-status touch-actor)) (collide-status touch-actor))
|
|
(format sv-16 "touch-actor ")
|
|
)
|
|
(if (= (logand (collide-status probe-hit) s5-4) (collide-status probe-hit))
|
|
(format sv-16 "probe-hit ")
|
|
)
|
|
(if (= (logand s5-4 (collide-status stuck)) (collide-status stuck))
|
|
(format sv-16 "stuck ")
|
|
)
|
|
(if (= (logand s5-4 (collide-status no-touch)) (collide-status no-touch))
|
|
(format sv-16 "no-touch ")
|
|
)
|
|
(if (= (logand s5-4 (collide-status touch-surface)) (collide-status touch-surface))
|
|
(format sv-16 "touch-surface ")
|
|
)
|
|
)
|
|
(format sv-16 " #x~6X~%" sv-72)
|
|
)
|
|
((= v1-22 (history-channel friction))
|
|
(let ((f30-0 (-> sv-40 vector x)))
|
|
(format sv-16 "~-15S: ~f~%" (history-channel->string (-> sv-40 channel)) f30-0)
|
|
)
|
|
)
|
|
)
|
|
)
|
|
)
|
|
)
|
|
#f
|
|
(label cfg-71)
|
|
0
|
|
(none)
|
|
)
|
|
|
|
;; WARN: new jak 2 until loop case, check carefully
|
|
(defun history-draw ((arg0 history-iterator))
|
|
(local-vars (sv-16 vector) (sv-20 vector) (sv-24 pat-surface))
|
|
(set! sv-16 (the-as vector #f))
|
|
(set! sv-20 (the-as vector #f))
|
|
(set! sv-24 (new 'static 'pat-surface))
|
|
(until #f
|
|
(let ((s5-0 (update-entries! arg0)))
|
|
(if (not s5-0)
|
|
(goto cfg-34)
|
|
)
|
|
(when (logtest? (-> arg0 channel-mask) (ash 1 (-> s5-0 channel)))
|
|
(let* ((f0-0 (get-age arg0 s5-0))
|
|
(v1-8 (the int (lerp 4.0 128.0 f0-0)))
|
|
)
|
|
(case (-> s5-0 channel)
|
|
(((history-channel trans))
|
|
(if sv-16
|
|
(add-debug-line
|
|
#t
|
|
(bucket-id debug-no-zbuf1)
|
|
sv-16
|
|
(-> s5-0 vector)
|
|
(the-as rgba (logior #xffff00 (shl v1-8 24)))
|
|
#f
|
|
(the-as rgba -1)
|
|
)
|
|
(add-debug-x #t (bucket-id debug-no-zbuf1) (-> s5-0 vector) (the-as rgba (logior #xffff00 (shl v1-8 24))))
|
|
)
|
|
(set! sv-16 (-> s5-0 vector))
|
|
)
|
|
(((history-channel intersect))
|
|
(if sv-20
|
|
(add-debug-line
|
|
#t
|
|
(bucket-id debug-no-zbuf1)
|
|
sv-20
|
|
(-> s5-0 vector)
|
|
(the-as rgba (logior #xffffff (shl v1-8 24)))
|
|
#f
|
|
(the-as rgba -1)
|
|
)
|
|
(add-debug-x #t (bucket-id debug-no-zbuf1) (-> s5-0 vector) (the-as rgba (logior #xffffff (shl v1-8 24))))
|
|
)
|
|
(set! sv-20 (-> s5-0 vector))
|
|
)
|
|
(((history-channel transv))
|
|
(add-debug-vector
|
|
#t
|
|
(bucket-id debug-no-zbuf1)
|
|
(-> s5-0 origin)
|
|
(-> s5-0 vector)
|
|
(meters 0.000024414063)
|
|
(the-as rgba (logior (shl v1-8 24) #xff00))
|
|
)
|
|
)
|
|
(((history-channel transv-in))
|
|
(add-debug-vector
|
|
#t
|
|
(bucket-id debug-no-zbuf1)
|
|
(-> s5-0 origin)
|
|
(-> s5-0 vector)
|
|
(meters 0.000024414063)
|
|
(the-as rgba (logior #x408040 (shl v1-8 24)))
|
|
)
|
|
)
|
|
(((history-channel transv-out))
|
|
(add-debug-vector
|
|
#t
|
|
(bucket-id debug-no-zbuf1)
|
|
(-> s5-0 origin)
|
|
(-> s5-0 vector)
|
|
(meters 0.000024414063)
|
|
(the-as rgba (logior #x404080 (shl v1-8 24)))
|
|
)
|
|
)
|
|
(((history-channel local-normal) (history-channel surface-normal))
|
|
(let ((t1-7
|
|
(logand (the-as uint (-> *pat-mode-info* (-> sv-24 mode) hilite-color)) (the-as uint #xffffffff00ffffff))
|
|
)
|
|
)
|
|
(add-debug-vector
|
|
#t
|
|
(bucket-id debug-no-zbuf1)
|
|
(-> s5-0 origin)
|
|
(-> s5-0 vector)
|
|
(meters 1)
|
|
(the-as rgba (logior t1-7 (shl v1-8 24)))
|
|
)
|
|
)
|
|
)
|
|
(((history-channel pat))
|
|
(set! sv-24 (the-as pat-surface (-> s5-0 vector x)))
|
|
)
|
|
(((history-channel friction))
|
|
(let ((f0-3 (-> s5-0 vector x))
|
|
(a3-10 (new 'stack-no-clear 'vector))
|
|
)
|
|
(set-vector! a3-10 0.0 (* -8192.0 f0-3) 0.0 1.0)
|
|
(add-debug-vector
|
|
#t
|
|
(bucket-id debug-no-zbuf1)
|
|
(-> s5-0 origin)
|
|
a3-10
|
|
(meters 0.00024414062)
|
|
(the-as rgba (logior #xffffff (shl v1-8 24)))
|
|
)
|
|
)
|
|
)
|
|
)
|
|
)
|
|
)
|
|
)
|
|
)
|
|
#f
|
|
(label cfg-34)
|
|
0
|
|
(none)
|
|
)
|