Archive/jak-project
1
0
Fork 0
mirror of https://github.com/open-goal/jak-project.git synced 2024-10-20 21:27:52 -04:00
Code Issues Actions 3 Packages Projects Releases Wiki Activity
jak-project/goal_src/jak3/engine/collide/collide-touch.gc

519 lines
16 KiB
Common Lisp
Raw Normal View History

jak3: add `goal_src` skeleton (#3069)
2023-10-10 09:41:05 -04:00
;;-*-Lisp-*-
(in-package goal)
;; name: collide-touch.gc
;; name in dgo: collide-touch
;; dgos: GAME
;; DECOMP BEGINS
decomp3: spawn `target`, add merc and particle buckets and some temporary hacks (#3445) This includes all the collision stuff needed to spawn `target`, decompiles the sparticle code and adds some of the PC hacks needed for merc to run (it doesn't work quite right and looks bad, likely due to a combination of code copied from Jak 2 and the time of day hacks). There are a bunch of temporary hacks (see commits) in place to prevent the game from crashing quite as much, but it is still extremely prone to doing so due to lots of missing functions/potentially bad decomp. --------- Co-authored-by: water <awaterford111445@gmail.com>
2024-04-05 00:07:39 -04:00
(defmethod get-free-node-count ((this touching-prims-entry-pool))
(let ((v0-0 0))
(let ((v1-0 (-> this head)))
(while v1-0
(+! v0-0 1)
(set! v1-0 (-> v1-0 next))
(nop!)
(nop!)
(nop!)
)
)
v0-0
)
)
(defmethod alloc-node ((this touching-prims-entry-pool))
(let ((gp-0 (-> this head)))
(cond
(gp-0
(let ((v1-0 (-> gp-0 next)))
(set! (-> this head) v1-0)
(if v1-0
(set! (-> v1-0 prev) #f)
)
)
(set! (-> gp-0 allocated?) #t)
(set! (-> gp-0 next) #f)
(set! (-> gp-0 prev) #f)
)
(else
(format 0 "ERROR: touching-prims-entry-pool::alloc-node() failed!~%")
)
)
gp-0
)
)
(defmethod free-node ((this touching-prims-entry-pool) (arg0 touching-prims-entry))
(when (-> arg0 allocated?)
(set! (-> arg0 allocated?) #f)
(let ((v1-1 (-> this head)))
(set! (-> arg0 next) v1-1)
(set! (-> arg0 prev) #f)
(set! (-> this head) arg0)
(when v1-1
(set! (-> v1-1 prev) arg0)
arg0
)
)
)
)
(defmethod free-touching-prims-list ((this touching-shapes-entry))
(when (-> this cshape1)
(set! (-> this cshape1) #f)
(let ((gp-0 (-> this head)))
(when gp-0
(set! (-> this head) #f)
(let ((s5-0 *touching-prims-entry-pool*))
(while gp-0
(let ((a1-0 gp-0))
(set! gp-0 (-> a1-0 next))
(free-node s5-0 a1-0)
)
)
)
)
)
)
0
(none)
)
(defmethod free-nodes ((this touching-list))
(let ((s5-0 (the-as object (-> this touching-shapes))))
(countdown (s4-0 (-> this num-touching-shapes))
(free-touching-prims-list (the-as touching-shapes-entry s5-0))
(set! s5-0 (&+ (the-as touching-shapes-entry s5-0) 32))
)
)
(set! (-> this num-touching-shapes) 0)
(set! (-> this resolve-u) 0)
0
(none)
)
;; WARN: Return type mismatch object vs touching-shapes-entry.
(defmethod get-shapes-entry ((this touching-list) (arg0 collide-shape) (arg1 collide-shape))
(let ((v0-0 (the-as object (-> this touching-shapes))))
(let ((v1-0 (the-as touching-shapes-entry #f)))
(countdown (a3-0 (-> this num-touching-shapes))
(let ((t0-0 (-> (the-as touching-shapes-entry v0-0) cshape1)))
(set! v1-0 (cond
(t0-0
(if (or (and (= t0-0 arg0) (= (-> (the-as touching-shapes-entry v0-0) cshape2) arg1))
(and (= t0-0 arg1) (= (-> (the-as touching-shapes-entry v0-0) cshape2) arg0))
)
(return (the-as touching-shapes-entry v0-0))
)
v1-0
)
(else
(the-as touching-shapes-entry v0-0)
)
)
)
)
(set! v0-0 (&+ (the-as touching-shapes-entry v0-0) 32))
)
(cond
(v1-0
(set! v0-0 v1-0)
)
(else
(when (>= (-> this num-touching-shapes) 32)
(format 0 "ERROR: touching-list::get-shapes-entry() failed!~%")
(return (the-as touching-shapes-entry #f))
)
(+! (-> this num-touching-shapes) 1)
)
)
)
(set! (-> (the-as touching-shapes-entry v0-0) cshape1) arg0)
(set! (-> (the-as touching-shapes-entry v0-0) cshape2) arg1)
(set! (-> (the-as touching-shapes-entry v0-0) head) #f)
(set! (-> (the-as touching-shapes-entry v0-0) resolve-u) 1)
(set! (-> this resolve-u) 1)
(set! (-> (the-as touching-shapes-entry v0-0) handle1) (process->handle (-> arg0 process)))
(set! (-> (the-as touching-shapes-entry v0-0) handle2) (process->handle (-> arg1 process)))
(the-as touching-shapes-entry v0-0)
)
)
(deftype add-prims-touching-work (structure)
((tri1 collide-tri-result)
(tri2 collide-tri-result)
)
)
;; WARN: Function (method 9 touching-list) has a return type of none, but the expression builder found a return statement.
(defmethod add-touching-prims ((this touching-list)
(arg0 collide-shape-prim)
(arg1 collide-shape-prim)
(arg2 float)
(arg3 collide-tri-result)
(arg4 collide-tri-result)
)
(let ((gp-0 (new 'stack-no-clear 'add-prims-touching-work)))
(set! (-> gp-0 tri1) arg3)
(set! (-> gp-0 tri2) arg4)
(let ((s2-0 (get-shapes-entry this (-> arg0 cshape) (-> arg1 cshape))))
(when s2-0
(when (= (-> s2-0 cshape1) (-> arg1 cshape))
(let ((v1-4 arg0))
(set! arg0 arg1)
(set! arg1 v1-4)
)
)
(let ((s0-0 (-> s2-0 head)))
(while s0-0
(when (and (= (-> s0-0 prim1 cprim) arg0) (= (-> s0-0 prim2 cprim) arg1))
(when (< arg2 (-> s0-0 u))
(-> s0-0 u)
(let ((v1-12 (-> s0-0 prim1))
(a1-2 (-> gp-0 tri1))
)
(cond
(a1-2
(set! (-> v1-12 has-tri?) #t)
(mem-copy! (the-as pointer (-> v1-12 tri)) (the-as pointer a1-2) 88)
)
(else
(set! (-> v1-12 has-tri?) #f)
)
)
)
(let ((v1-15 (-> s0-0 prim2))
(a1-3 (-> gp-0 tri2))
)
(cond
(a1-3
(set! (-> v1-15 has-tri?) #t)
(mem-copy! (the-as pointer (-> v1-15 tri)) (the-as pointer a1-3) 88)
)
(else
(set! (-> v1-15 has-tri?) #f)
)
)
)
)
(return 0)
)
(set! s0-0 (-> s0-0 next))
)
)
(let ((s0-1 (alloc-node *touching-prims-entry-pool*)))
(when s0-1
(let ((v1-22 (-> s2-0 head)))
(set! (-> s0-1 next) v1-22)
(set! (-> s0-1 prev) #f)
(set! (-> s2-0 head) s0-1)
(if v1-22
(set! (-> v1-22 prev) s0-1)
)
)
(set! (-> s0-1 u) arg2)
(when (>= arg2 0.0)
(set! (-> s2-0 resolve-u) 1)
(set! (-> this resolve-u) 1)
)
(let ((v1-26 (-> s0-1 prim1))
(a1-4 (-> gp-0 tri1))
)
(set! (-> v1-26 cprim) arg0)
(cond
(a1-4
(set! (-> v1-26 has-tri?) #t)
(mem-copy! (the-as pointer (-> v1-26 tri)) (the-as pointer a1-4) 88)
)
(else
(set! (-> v1-26 has-tri?) #f)
)
)
)
(let ((v1-29 (-> s0-1 prim2))
(a1-5 (-> gp-0 tri2))
)
(set! (-> v1-29 cprim) arg1)
(cond
(a1-5
(set! (-> v1-29 has-tri?) #t)
(mem-copy! (the-as pointer (-> v1-29 tri)) (the-as pointer a1-5) 88)
)
(else
(set! (-> v1-29 has-tri?) #f)
)
)
)
)
)
)
)
)
0
(none)
)
(defmethod update-from-step-size ((this touching-list) (arg0 float))
(when (nonzero? (-> this resolve-u))
(set! (-> this resolve-u) 0)
(let ((s5-0 (the-as object (-> this touching-shapes))))
(countdown (s4-0 (-> this num-touching-shapes))
(when (nonzero? (-> (the-as touching-shapes-entry s5-0) resolve-u))
(set! (-> (the-as touching-shapes-entry s5-0) resolve-u) 0)
(when (-> (the-as touching-shapes-entry s5-0) cshape1)
(let ((s3-0 (-> (the-as touching-shapes-entry s5-0) head)))
(while s3-0
(let ((f0-0 (-> s3-0 u)))
(set! s3-0 (cond
((>= f0-0 0.0)
(cond
((>= arg0 f0-0)
(set! (-> s3-0 u) -1.0)
(set! s3-0 (-> s3-0 next))
)
(else
(let ((a1-1 s3-0))
(let ((v1-8 (-> s3-0 next)))
(let ((a0-1 (-> s3-0 prev)))
(if a0-1
(set! (-> a0-1 next) v1-8)
(set! (-> (the-as touching-shapes-entry s5-0) head) v1-8)
)
(if v1-8
(set! (-> v1-8 prev) a0-1)
)
)
(set! s3-0 v1-8)
)
(free-node *touching-prims-entry-pool* a1-1)
)
)
)
s3-0
)
(else
(-> s3-0 next)
)
)
)
)
)
)
(if (not (-> (the-as touching-shapes-entry s5-0) head))
(set! (-> (the-as touching-shapes-entry s5-0) cshape1) #f)
)
)
)
(set! s5-0 (&+ (the-as touching-shapes-entry s5-0) 32))
)
)
)
0
(none)
)
(defmethod send-events-for-touching-shapes ((this touching-list))
(let ((gp-0 (the-as object (-> this touching-shapes))))
(countdown (s5-0 (-> this num-touching-shapes))
(let ((s3-0 (-> (the-as touching-shapes-entry gp-0) cshape1)))
(when s3-0
(let ((s4-0 (handle->process (-> (the-as touching-shapes-entry gp-0) handle1)))
(s2-0 (handle->process (-> (the-as touching-shapes-entry gp-0) handle2)))
)
(when (and s4-0 s2-0)
(let ((s1-0 (-> (the-as touching-shapes-entry gp-0) cshape2)))
(when (< (-> s3-0 event-priority) (-> s1-0 event-priority))
(let ((v1-9 s3-0))
(set! s3-0 s1-0)
(set! s1-0 v1-9)
)
(let ((v1-11 s4-0))
(set! s4-0 s2-0)
(set! s2-0 v1-11)
)
)
(let ((v1-13 (-> s3-0 event-self)))
(if v1-13
(send-event s4-0 v1-13 :from s2-0 gp-0)
)
)
(let ((v1-14 (-> s3-0 event-other)))
(if v1-14
(send-event s2-0 v1-14 :from s4-0 gp-0)
)
)
(let ((v1-15 (-> s1-0 event-self)))
(if v1-15
(send-event s2-0 v1-15 :from s4-0 gp-0)
)
)
(let ((v1-16 (-> s1-0 event-other)))
(if v1-16
(send-event s4-0 v1-16 :from s2-0 gp-0)
)
)
)
)
)
)
)
(set! gp-0 (&+ (the-as touching-shapes-entry gp-0) 32))
)
)
0
(none)
)
(defmethod prims-touching? ((this touching-shapes-entry) (arg0 collide-shape) (arg1 uint))
(cond
((= (-> this cshape1) arg0)
(let ((v1-1 (-> this head)))
(while v1-1
(if (logtest? (-> v1-1 prim1 cprim prim-id) arg1)
(return v1-1)
)
(set! v1-1 (-> v1-1 next))
)
)
)
((= (-> this cshape2) arg0)
(let ((v1-4 (-> this head)))
(while v1-4
(if (logtest? (-> v1-4 prim2 cprim prim-id) arg1)
(return v1-4)
)
(set! v1-4 (-> v1-4 next))
)
)
)
(else
(format 0 "ERROR: touching-shapes-entry::prims-touching? : Bogus cshape value!~%")
)
)
(the-as touching-prims-entry #f)
)
;; WARN: Return type mismatch touching-prims-entry vs basic.
(defmethod prims-touching-action? ((this touching-shapes-entry) (arg0 collide-shape) (arg1 collide-action) (arg2 collide-action))
(cond
((= (-> this cshape1) arg0)
(let ((v1-1 (-> this head)))
(while v1-1
(let ((a0-1 (-> v1-1 prim1 cprim)))
(if (and (logtest? arg1 (-> a0-1 prim-core action)) (not (logtest? arg2 (-> a0-1 prim-core action))))
(return (the-as basic v1-1))
)
)
(set! v1-1 (-> v1-1 next))
)
)
)
((= (-> this cshape2) arg0)
(let ((v1-4 (-> this head)))
(while v1-4
(let ((a0-5 (-> v1-4 prim2 cprim)))
(if (and (logtest? arg1 (-> a0-5 prim-core action)) (not (logtest? arg2 (-> a0-5 prim-core action))))
(return (the-as basic v1-4))
)
)
(set! v1-4 (-> v1-4 next))
)
)
)
(else
(format 0 "ERROR: touching-shapes-entry::prims-touching-action? : Bogus cshape value!~%")
)
)
(the-as basic #f)
)
(defmethod get-touched-shape ((this touching-shapes-entry) (arg0 collide-shape))
(cond
((= (-> this cshape1) arg0)
(return (-> this cshape2))
)
((= (-> this cshape2) arg0)
(return (-> this cshape1))
)
)
(the-as collide-shape #f)
)
(defmethod get-touched-prim ((this touching-prims-entry) (arg0 collide-shape) (arg1 touching-shapes-entry))
(cond
((= (-> arg1 cshape1) arg0)
(return (-> this prim1 cprim))
)
((= (-> arg1 cshape2) arg0)
(return (-> this prim2 cprim))
)
)
(the-as collide-shape-prim #f)
)
(defmethod get-touched-tri ((this touching-prims-entry) (arg0 collide-shape) (arg1 touching-shapes-entry))
(let ((v0-0 (the-as collide-tri-result #f)))
(cond
((not this)
)
((= (-> arg1 cshape1) arg0)
(let ((v1-4 (-> this prim1)))
(if (-> v1-4 has-tri?)
(set! v0-0 (-> v1-4 tri))
)
)
)
((= (-> arg1 cshape2) arg0)
(let ((v1-7 (-> this prim2)))
(if (-> v1-7 has-tri?)
(set! v0-0 (-> v1-7 tri))
)
)
)
)
v0-0
)
)
(defmethod touching-prims-entry-method-9 ((this touching-prims-entry) (arg0 vector))
(let* ((s4-0 (-> this prim1 cprim))
(v1-0 (-> this prim2 cprim))
(gp-1 (vector-!
(new 'stack-no-clear 'vector)
(the-as vector (-> v1-0 prim-core))
(the-as vector (-> s4-0 prim-core))
)
)
)
(let ((f1-2 (- (- (vector-length gp-1) (-> v1-0 prim-core world-sphere w)) (-> s4-0 prim-core world-sphere w))))
(vector-normalize! gp-1 (+ (-> s4-0 prim-core world-sphere w) (* 0.5 f1-2)))
)
(vector+! arg0 gp-1 (the-as vector (-> s4-0 prim-core)))
)
arg0
)
(defmethod get-middle-of-bsphere-overlap ((this touching-prims-entry) (arg0 vector))
(let ((v1-0 (-> this prim1 cprim))
(a2-0 (-> this prim2 cprim))
)
(vector+! arg0 (the-as vector (-> a2-0 prim-core)) (the-as vector (-> v1-0 prim-core)))
)
(vector-float*! arg0 arg0 0.5)
arg0
)
(defun get-intersect-point ((arg0 vector) (arg1 touching-prims-entry) (arg2 collide-shape) (arg3 touching-shapes-entry))
(when arg1
(let ((a0-2 (get-touched-tri arg1 arg2 arg3)))
(if a0-2
(set! (-> arg0 quad) (-> a0-2 intersect quad))
(touching-prims-entry-method-9 arg1 arg0)
)
)
)
arg0
)
Reference in a new issue Copy permalink