format/j1: made it through about 10% of files

This commit is contained in:
Tyler Wilding
2024-05-18 21:50:46 -04:00
parent 0f40f33dfd
commit 32ec1c0100
27 changed files with 7839 additions and 12766 deletions
File diff suppressed because it is too large Load Diff
@@ -1,7 +1,6 @@
;;-*-Lisp-*-
(in-package goal)
(bundles "ENGINE.CGO" "GAME.CGO")
(require "engine/math/vector-h.gc")
(require "engine/geometry/bounding-box-h.gc")
@@ -20,143 +19,138 @@
;; DECOMP BEGINS
(deftype edge-grab-info (structure)
((world-vertex vector 6 :inline)
(local-vertex vector 6 :inline)
(actor-cshape-prim-offset int32)
(actor-handle handle)
(hanging-matrix matrix :inline)
(edge-vertex vector 2 :inline :overlay-at (-> world-vertex 0))
(center-hold vector :inline :overlay-at (-> world-vertex 2))
(tri-vertex vector 3 :inline :overlay-at (-> world-vertex 3))
(left-hand-hold vector :inline)
(right-hand-hold vector :inline)
(center-hold-old vector :inline)
(edge-tri-pat uint32)
)
((world-vertex vector 6 :inline)
(local-vertex vector 6 :inline)
(actor-cshape-prim-offset int32)
(actor-handle handle)
(hanging-matrix matrix :inline)
(edge-vertex vector 2 :inline :overlay-at (-> world-vertex 0))
(center-hold vector :inline :overlay-at (-> world-vertex 2))
(tri-vertex vector 3 :inline :overlay-at (-> world-vertex 3))
(left-hand-hold vector :inline)
(right-hand-hold vector :inline)
(center-hold-old vector :inline)
(edge-tri-pat uint32))
(:methods
(edge-grab-info-method-9 (_type_) symbol)
(debug-draw (_type_) symbol)
)
)
(edge-grab-info-method-9 (_type_) symbol)
(debug-draw (_type_) symbol)))
;; og:preserve-this
(declare-type collide-cache-tri structure)
(deftype collide-edge-tri (structure)
((ctri collide-cache-tri)
(normal vector :inline)
)
)
(deftype collide-edge-tri (structure)
((ctri collide-cache-tri)
(normal vector :inline)))
(deftype collide-edge-edge (structure)
((ignore basic)
(etri collide-edge-tri)
(vertex-ptr (inline-array vector) 2)
(outward vector :inline)
(edge-vec-norm vector :inline)
)
)
((ignore basic)
(etri collide-edge-tri)
(vertex-ptr (inline-array vector) 2)
(outward vector :inline)
(edge-vec-norm vector :inline)))
(deftype collide-edge-hold-item (structure)
((next collide-edge-hold-item)
(rating float)
(split int8)
(edge collide-edge-edge)
(center-pt vector :inline)
(outward-pt vector :inline)
)
)
((next collide-edge-hold-item)
(rating float)
(split int8)
(edge collide-edge-edge)
(center-pt vector :inline)
(outward-pt vector :inline)))
(deftype collide-edge-hold-list (structure)
((num-allocs uint32)
(num-attempts uint32)
(head collide-edge-hold-item)
(items collide-edge-hold-item 32 :inline)
(attempts qword 32 :inline)
)
((num-allocs uint32)
(num-attempts uint32)
(head collide-edge-hold-item)
(items collide-edge-hold-item 32 :inline)
(attempts qword 32 :inline))
(:methods
(debug-draw (_type_) object)
(add-to-list! (_type_ collide-edge-hold-item) none)
)
)
(debug-draw (_type_) object)
(add-to-list! (_type_ collide-edge-hold-item) none)))
;; og:preserve-this
(declare-type collide-cache basic)
(declare-type collide-shape basic)
(deftype collide-edge-work (structure)
((ccache collide-cache)
(cshape collide-shape)
(num-verts uint32)
(num-edges uint32)
(num-tris uint32)
(cache-fill-box bounding-box :inline)
(within-reach-box bounding-box :inline)
(within-reach-box4w bounding-box4w :inline)
(search-pt vector :inline)
(search-dir-vec vector :inline)
(max-dist-sqrd-to-outward-pt float)
(max-dir-cosa-delta float)
(split-dists float 2)
(outward-offset vector :inline)
(local-cache-fill-box bounding-box :inline)
(local-within-reach-box bounding-box :inline)
(local-player-spheres sphere 12 :inline)
(world-player-spheres sphere 12 :inline)
(local-player-hanging-spheres sphere 6 :inline :overlay-at (-> local-player-spheres 0))
(world-player-hanging-spheres sphere 6 :inline :overlay-at (-> world-player-spheres 0))
(local-player-leap-up-spheres sphere 6 :inline :overlay-at (-> local-player-spheres 6))
(world-player-leap-up-spheres sphere 6 :inline :overlay-at (-> world-player-spheres 6))
(verts vector 64 :inline)
(edges collide-edge-edge 96 :inline)
(tris collide-edge-tri 48 :inline)
(hold-list collide-edge-hold-list :inline)
)
((ccache collide-cache)
(cshape collide-shape)
(num-verts uint32)
(num-edges uint32)
(num-tris uint32)
(cache-fill-box bounding-box :inline)
(within-reach-box bounding-box :inline)
(within-reach-box4w bounding-box4w :inline)
(search-pt vector :inline)
(search-dir-vec vector :inline)
(max-dist-sqrd-to-outward-pt float)
(max-dir-cosa-delta float)
(split-dists float 2)
(outward-offset vector :inline)
(local-cache-fill-box bounding-box :inline)
(local-within-reach-box bounding-box :inline)
(local-player-spheres sphere 12 :inline)
(world-player-spheres sphere 12 :inline)
(local-player-hanging-spheres sphere 6 :inline :overlay-at (-> local-player-spheres 0))
(world-player-hanging-spheres sphere 6 :inline :overlay-at (-> world-player-spheres 0))
(local-player-leap-up-spheres sphere 6 :inline :overlay-at (-> local-player-spheres 6))
(world-player-leap-up-spheres sphere 6 :inline :overlay-at (-> world-player-spheres 6))
(verts vector 64 :inline)
(edges collide-edge-edge 96 :inline)
(tris collide-edge-tri 48 :inline)
(hold-list collide-edge-hold-list :inline))
(:methods
(search-for-edges (_type_ collide-edge-hold-list) symbol)
(debug-draw-edges (_type_) object)
(debug-draw-tris (_type_) none)
(debug-draw-sphere (_type_) symbol)
(compute-center-point! (_type_ collide-edge-edge vector) float)
(collide-edge-work-method-14 (_type_ vector vector int) float)
(find-grabbable-edges! (_type_) none)
(find-grabbable-tris! (_type_) none)
(should-add-to-list? (_type_ collide-edge-hold-item collide-edge-edge) symbol)
(find-best-grab! (_type_ collide-edge-hold-list edge-grab-info) symbol)
(check-grab-for-collisions (_type_ collide-edge-hold-item edge-grab-info) symbol)
)
)
(search-for-edges (_type_ collide-edge-hold-list) symbol)
(debug-draw-edges (_type_) object)
(debug-draw-tris (_type_) none)
(debug-draw-sphere (_type_) symbol)
(compute-center-point! (_type_ collide-edge-edge vector) float)
(collide-edge-work-method-14 (_type_ vector vector int) float)
(find-grabbable-edges! (_type_) none)
(find-grabbable-tris! (_type_) none)
(should-add-to-list? (_type_ collide-edge-hold-item collide-edge-edge) symbol)
(find-best-grab! (_type_ collide-edge-hold-list edge-grab-info) symbol)
(check-grab-for-collisions (_type_ collide-edge-hold-item edge-grab-info) symbol)))
(define *collide-edge-work* (new 'static 'collide-edge-work
:max-dist-sqrd-to-outward-pt 37748736.0
:max-dir-cosa-delta 0.6
:split-dists (new 'static 'array float 2 1024.0 1433.6)
:outward-offset (new 'static 'vector :x 708.608 :y 13312.0 :w 1.0)
:local-cache-fill-box (new 'static 'bounding-box
:min (new 'static 'vector :x -8192.0 :y -11059.2 :z -8192.0 :w 1.0)
:max (new 'static 'vector :x 8192.0 :y 24576.0 :z 8192.0 :w 1.0)
)
:local-within-reach-box (new 'static 'bounding-box
:min (new 'static 'vector :x -6144.0 :y 5324.8 :z -6144.0 :w 1.0)
:max (new 'static 'vector :x 6144.0 :y 11059.2 :z 6144.0 :w 1.0)
)
:local-player-spheres (new 'static 'inline-array sphere 12
(new 'static 'sphere :x 1720.32 :y -819.2 :w 1433.6)
(new 'static 'sphere :x 2293.76 :y -3276.8 :w 1884.16)
(new 'static 'sphere :x 1966.08 :y -6144.0 :w 1556.48)
(new 'static 'sphere :x 1966.08 :y -8601.6 :w 1556.48)
(new 'static 'sphere :x 1761.28 :y -11059.2 :w 1351.68)
(new 'static 'sphere :x 1679.36 :y -13312.0 :w 1269.76)
(new 'static 'sphere :x -737.28 :y 4096.0 :w 3072.0)
(new 'static 'sphere :x -737.28 :y 6553.6 :w 3072.0)
(new 'static 'sphere :x -737.28 :y 9420.8 :w 3072.0)
(new 'static 'sphere :x 1720.32 :y 3686.4 :w 2949.12)
(new 'static 'sphere :x 1720.32 :y 5734.4 :w 2949.12)
(new 'static 'sphere :x 1720.32 :y 8601.6 :w 2949.12)
)
)
)
(define *collide-edge-work*
(new 'static
'collide-edge-work
:max-dist-sqrd-to-outward-pt 37748736.0
:max-dir-cosa-delta 0.6
:split-dists
(new 'static 'array float 2 1024.0 1433.6)
:outward-offset
(new 'static 'vector :x 708.608 :y 13312.0 :w 1.0)
:local-cache-fill-box
(new 'static
'bounding-box
:min
(new 'static 'vector :x -8192.0 :y -11059.2 :z -8192.0 :w 1.0)
:max
(new 'static 'vector :x 8192.0 :y 24576.0 :z 8192.0 :w 1.0))
:local-within-reach-box
(new 'static
'bounding-box
:min
(new 'static 'vector :x -6144.0 :y 5324.8 :z -6144.0 :w 1.0)
:max
(new 'static 'vector :x 6144.0 :y 11059.2 :z 6144.0 :w 1.0))
:local-player-spheres
(new 'static
'inline-array
sphere
12
(new 'static 'sphere :x 1720.32 :y -819.2 :w 1433.6)
(new 'static 'sphere :x 2293.76 :y -3276.8 :w 1884.16)
(new 'static 'sphere :x 1966.08 :y -6144.0 :w 1556.48)
(new 'static 'sphere :x 1966.08 :y -8601.6 :w 1556.48)
(new 'static 'sphere :x 1761.28 :y -11059.2 :w 1351.68)
(new 'static 'sphere :x 1679.36 :y -13312.0 :w 1269.76)
(new 'static 'sphere :x -737.28 :y 4096.0 :w 3072.0)
(new 'static 'sphere :x -737.28 :y 6553.6 :w 3072.0)
(new 'static 'sphere :x -737.28 :y 9420.8 :w 3072.0)
(new 'static 'sphere :x 1720.32 :y 3686.4 :w 2949.12)
(new 'static 'sphere :x 1720.32 :y 5734.4 :w 2949.12)
(new 'static 'sphere :x 1720.32 :y 8601.6 :w 2949.12))))
(define-perm *edge-grab-info* edge-grab-info (new 'global 'edge-grab-info))
+195 -422
View File
@@ -1,7 +1,6 @@
;;-*-Lisp-*-
(in-package goal)
(bundles "ENGINE.CGO" "GAME.CGO")
(require "engine/collide/surface-h.gc")
(require "engine/collide/collide-edge-grab-h.gc")
(require "kernel/gstate.gc")
@@ -25,21 +24,18 @@
(vf4 :class vf)
(vf5 :class vf)
(vf6 :class vf)
(vf7 :class vf)
)
(vf7 :class vf))
(let ((gp-0 *collide-edge-work*))
;; reset the edge work...
(set! (-> gp-0 num-verts) (the-as uint 0))
(set! (-> gp-0 num-edges) (the-as uint 0))
(set! (-> gp-0 num-tris) (the-as uint 0))
(let ((v1-0 (-> this control)))
(set! (-> gp-0 ccache) arg0)
(.lvf vf1 (&-> gp-0 local-cache-fill-box min quad))
(.lvf vf2 (&-> gp-0 local-cache-fill-box max quad))
(set! (-> gp-0 cshape) v1-0)
(.lvf vf3 (&-> v1-0 trans quad))
)
(.lvf vf3 (&-> v1-0 trans quad)))
;; translate the cache filling box
(.add.vf vf1 vf1 vf3 :mask #b111)
(.add.vf vf2 vf2 vf3 :mask #b111)
@@ -57,16 +53,12 @@
(.svf (&-> gp-0 within-reach-box max quad) vf5)
(.svf (&-> gp-0 within-reach-box4w min quad) vf6)
(.svf (&-> gp-0 within-reach-box4w max quad) vf7)
;; Fill the collide cache!
(fill-using-bounding-box
arg0
(-> gp-0 cache-fill-box)
(-> this control root-prim collide-with)
this
(new 'static 'pat-surface :noentity #x1)
)
(fill-using-bounding-box arg0
(-> gp-0 cache-fill-box)
(-> this control root-prim collide-with)
this
(new 'static 'pat-surface :noentity #x1))
;; Filter out tris that can't be grabbed
(find-grabbable-tris! gp-0)
(when (nonzero? (-> gp-0 num-tris))
@@ -82,22 +74,13 @@
(search-for-edges gp-0 (-> gp-0 hold-list))
(when (find-best-grab! gp-0 (-> gp-0 hold-list) *edge-grab-info*)
(send-event *target* 'edge-grab)
(return (the-as object #f))
)
)
(return (the-as object #f))))
;; use target's heading
(vector-z-quaternion! (-> gp-0 search-dir-vec) (-> *target* control unknown-quaternion00))
(search-for-edges gp-0 (-> gp-0 hold-list))
(if (find-best-grab! gp-0 (-> gp-0 hold-list) *edge-grab-info*)
(send-event *target* 'edge-grab)
)
0
)
)
)
0
)
)
(if (find-best-grab! gp-0 (-> gp-0 hold-list) *edge-grab-info*) (send-event *target* 'edge-grab))
0)))
0))
(defmethod search-for-edges ((this collide-edge-work) (arg0 collide-edge-hold-list))
"Iterate through edges, adding them to the collide-edge-hold-list, if they are good"
@@ -106,8 +89,7 @@
(set! (-> arg0 num-attempts) (the-as uint 0))
(set! (-> arg0 head) #f)
(let ((s4-0 (the-as collide-edge-hold-item (-> arg0 items)))
(s3-0 (the-as collide-edge-edge (-> this edges)))
)
(s3-0 (the-as collide-edge-edge (-> this edges))))
;; loop over edges
(countdown (s2-0 (-> this num-edges))
(when (not (-> s3-0 ignore))
@@ -119,28 +101,19 @@
(+! (-> arg0 num-allocs) 1)
(when (= (-> arg0 num-allocs) 32)
(format 0 "ERROR: Reached limit of edge grab hold items!~%")
(return #f)
)
(&+! s4-0 48)
)
)
(&+! s3-0 48)
)
)
#f
)
(return #f))
(&+! s4-0 48)))
(&+! s3-0 48)))
#f)
;; add to list.
(defmethod-mips2c "(method 10 collide-edge-hold-list)" 10 collide-edge-hold-list)
(deftype pbhp-stack-vars (structure)
((edge collide-edge-edge)
(allocated basic)
(neg-hold-pt vector :inline)
(split-vec vector :inline)
)
)
((edge collide-edge-edge)
(allocated basic)
(neg-hold-pt vector :inline)
(split-vec vector :inline)))
(defmethod-mips2c "(method 18 collide-edge-work)" 18 collide-edge-work)
@@ -148,29 +121,19 @@
(local-vars (sv-144 (function vector vector vector float vector)) (sv-160 vector) (sv-176 vector))
(let* ((s3-0 (-> arg0 edge))
(s1-0 (-> s3-0 etri ctri))
(s4-0 (-> s1-0 prim-index))
)
(s4-0 (-> s1-0 prim-index)))
(let ((s0-0 (new 'stack-no-clear 'vector)))
(vector+*! s0-0 (-> arg0 center-pt) (-> s3-0 edge-vec-norm) 1105.92)
(let ((f0-0 (collide-edge-work-method-14 this (-> arg1 right-hand-hold) s0-0 (the-as int s4-0))))
(if (< 491.52 f0-0)
(return #f)
)
)
(if (< 491.52 f0-0) (return #f)))
(set! sv-144 vector+*!)
(set! sv-160 s0-0)
(set! sv-176 (-> arg0 center-pt))
(let ((a2-3 (vector-negate! (new 'stack-no-clear 'vector) (-> s3-0 edge-vec-norm)))
(a3-2 1105.92)
)
(sv-144 sv-160 sv-176 a2-3 a3-2)
)
(a3-2 1105.92))
(sv-144 sv-160 sv-176 a2-3 a3-2))
(let ((f0-1 (collide-edge-work-method-14 this (-> arg1 left-hand-hold) s0-0 (the-as int s4-0))))
(if (< 491.52 f0-1)
(return #f)
)
)
)
(if (< 491.52 f0-1) (return #f))))
(set! (-> arg1 tri-vertex 0 quad) (-> s1-0 vertex 0 quad))
(set! (-> arg1 world-vertex 4 quad) (-> s1-0 vertex 1 quad))
(set! (-> arg1 world-vertex 5 quad) (-> s1-0 vertex 2 quad))
@@ -179,23 +142,15 @@
(set! (-> arg1 world-vertex 0 quad) (-> s3-0 vertex-ptr 0 0 quad))
(set! (-> arg1 world-vertex 1 quad) (-> s3-0 vertex-ptr 1 0 quad))
(set! (-> arg1 hanging-matrix vector 1 quad) (-> *target* control dynam gravity-normal quad))
(vector-normalize!
(vector-! (-> arg1 hanging-matrix vector 2) (-> arg1 world-vertex 1) (the-as vector (-> arg1 world-vertex)))
1.0
)
(vector-normalize!
(vector-cross!
(the-as vector (-> arg1 hanging-matrix))
(-> arg1 hanging-matrix vector 2)
(-> arg1 hanging-matrix vector 1)
)
1.0
)
(vector-cross!
(-> arg1 hanging-matrix vector 2)
(the-as vector (-> arg1 hanging-matrix))
(-> arg1 hanging-matrix vector 1)
)
(vector-normalize! (vector-! (-> arg1 hanging-matrix vector 2) (-> arg1 world-vertex 1) (the-as vector (-> arg1 world-vertex)))
1.0)
(vector-normalize! (vector-cross! (the-as vector (-> arg1 hanging-matrix))
(-> arg1 hanging-matrix vector 2)
(-> arg1 hanging-matrix vector 1))
1.0)
(vector-cross! (-> arg1 hanging-matrix vector 2)
(the-as vector (-> arg1 hanging-matrix))
(-> arg1 hanging-matrix vector 1))
(set! (-> arg1 hanging-matrix vector 3 quad) (-> arg1 center-hold quad))
(transform-vectors! (-> arg1 hanging-matrix) (-> this world-player-spheres) (-> this local-player-spheres) 12)
(let ((a1-13 (new 'stack-no-clear 'collide-using-spheres-params)))
@@ -205,37 +160,20 @@
(set! (-> a1-13 proc) #f)
(set! (-> a1-13 ignore-pat) (new 'static 'pat-surface :noentity #x1))
(set! (-> a1-13 solid-only) #t)
(if (probe-using-spheres (-> this ccache) a1-13)
(return #f)
)
)
(if (probe-using-spheres (-> this ccache) a1-13) (return #f)))
(let* ((v1-36 (the-as object (-> this ccache prims s4-0 prim)))
(a0-35 (-> (the-as collide-shape-prim v1-36) cshape))
)
(a0-35 (-> (the-as collide-shape-prim v1-36) cshape)))
(cond
(a0-35
(set! (-> arg1 actor-cshape-prim-offset) (- (the-as int v1-36) (the-as int (-> a0-35 process))))
(set! (-> arg1 actor-handle) (process->handle (-> a0-35 process)))
(let ((a1-19
(-> a0-35 process node-list data (-> (the-as collide-shape-prim v1-36) transform-index) bone transform)
)
(s5-1 (new 'stack-no-clear 'matrix))
)
(matrix-4x4-inverse! s5-1 a1-19)
(dotimes (s4-1 6)
(vector-matrix*! (-> arg1 local-vertex s4-1) (-> arg1 world-vertex s4-1) s5-1)
)
)
)
(else
(set! (-> arg1 actor-cshape-prim-offset) 0)
(set! (-> arg1 actor-handle) (the-as handle #f))
)
)
)
)
#t
)
(set! (-> arg1 actor-cshape-prim-offset) (- (the-as int v1-36) (the-as int (-> a0-35 process))))
(set! (-> arg1 actor-handle) (process->handle (-> a0-35 process)))
(let ((a1-19 (-> a0-35 process node-list data (-> (the-as collide-shape-prim v1-36) transform-index) bone transform))
(s5-1 (new 'stack-no-clear 'matrix)))
(matrix-4x4-inverse! s5-1 a1-19)
(dotimes (s4-1 6)
(vector-matrix*! (-> arg1 local-vertex s4-1) (-> arg1 world-vertex s4-1) s5-1))))
(else (set! (-> arg1 actor-cshape-prim-offset) 0) (set! (-> arg1 actor-handle) (the-as handle #f))))))
#t)
(defmethod edge-grab-info-method-9 ((this edge-grab-info))
(local-vars (v0-0 symbol) (v1-14 int))
@@ -248,36 +186,19 @@
(vf4 :class vf)
(vf5 :class vf)
(vf6 :class vf)
(vf7 :class vf)
)
(vf7 :class vf))
(init-vf0-vector)
(let ((s5-0 (the-as object #f)))
(set! (-> this center-hold-old quad) (-> this center-hold quad))
(let ((v1-1 (-> this actor-cshape-prim-offset)))
(when (nonzero? v1-1)
(let ((a0-5 (handle->process (-> this actor-handle))))
(if (not (the-as process a0-5))
(return #f)
)
(if (not (the-as process a0-5)) (return #f))
(set! s5-0 (+ (the-as int a0-5) v1-1))
(if (zero? (-> (the-as collide-shape-prim s5-0) prim-core collide-as))
(return #f)
)
(let ((s4-0
(-> (the-as process-drawable a0-5)
node-list
data
(-> (the-as collide-shape-prim s5-0) transform-index)
bone
transform
)
)
)
(if (zero? (-> (the-as collide-shape-prim s5-0) prim-core collide-as)) (return #f))
(let ((s4-0 (-> (the-as process-drawable a0-5) node-list data (-> (the-as collide-shape-prim s5-0) transform-index) bone transform)))
(dotimes (s3-0 6)
(vector-matrix*! (-> this world-vertex s3-0) (-> this local-vertex s3-0) s4-0)
)
)
)
(vector-matrix*! (-> this world-vertex s3-0) (-> this local-vertex s3-0) s4-0))))
(.lvf vf1 (&-> this world-vertex 3 quad))
(.lvf vf2 (&-> this world-vertex 4 quad))
(.lvf vf3 (&-> this world-vertex 5 quad))
@@ -295,46 +216,26 @@
(nop!)
(.mul.vf vf6 vf6 Q :mask #b111)
(.mov v1-14 vf6)
(b! (>= (the-as float (sar (the-as int v1-14) 32)) f1-0) cfg-17)
)
(b! (>= (the-as float (sar (the-as int v1-14) 32)) f1-0) cfg-17))
(set! v0-0 #f)
(b! #t cfg-27 :delay (nop!))
(label cfg-17)
(set! (-> this hanging-matrix vector 1 quad) (-> *target* control dynam gravity-normal quad))
(vector-normalize!
(vector-! (-> this hanging-matrix vector 2) (-> this world-vertex 1) (the-as vector (-> this world-vertex)))
1.0
)
(vector-normalize!
(vector-cross!
(the-as vector (-> this hanging-matrix))
(-> this hanging-matrix vector 2)
(-> this hanging-matrix vector 1)
)
1.0
)
(vector-cross!
(-> this hanging-matrix vector 2)
(the-as vector (-> this hanging-matrix))
(-> this hanging-matrix vector 1)
)
(vector-normalize! (vector-! (-> this hanging-matrix vector 2) (-> this world-vertex 1) (the-as vector (-> this world-vertex)))
1.0)
(vector-normalize! (vector-cross! (the-as vector (-> this hanging-matrix))
(-> this hanging-matrix vector 2)
(-> this hanging-matrix vector 1))
1.0)
(vector-cross! (-> this hanging-matrix vector 2)
(the-as vector (-> this hanging-matrix))
(-> this hanging-matrix vector 1))
(set! (-> this hanging-matrix vector 3 quad) (-> this center-hold quad))
(let ((v1-21 *collide-edge-work*))
(transform-vectors!
(-> this hanging-matrix)
(-> v1-21 world-player-spheres)
(-> v1-21 local-player-spheres)
12
)
)
)
)
(transform-vectors! (-> this hanging-matrix) (-> v1-21 world-player-spheres) (-> v1-21 local-player-spheres) 12))))
(let ((v1-22 *collide-edge-work*)
(a1-14 (new 'stack-no-clear 'collide-using-spheres-params))
)
(let ((a0-24 'target-edge-grab-jump))
(b! (!= (-> *target* next-state name) a0-24) cfg-20 :delay (nop!))
)
(a1-14 (new 'stack-no-clear 'collide-using-spheres-params)))
(let ((a0-24 'target-edge-grab-jump)) (b! (!= (-> *target* next-state name) a0-24) cfg-20 :delay (nop!)))
(set! (-> a1-14 spheres) (-> v1-22 world-player-leap-up-spheres))
(set! (-> a1-14 num-spheres) (the-as uint 6))
(set! (-> a1-14 collide-with) (-> v1-22 cshape root-prim collide-with))
@@ -350,26 +251,20 @@
(set! (-> a1-14 ignore-pat) (new 'static 'pat-surface :noentity #x1))
(set! (-> a1-14 solid-only) #t)
(label cfg-21)
(b! (not (fill-and-probe-using-spheres *collide-cache* a1-14)) cfg-24)
)
(b! (not (fill-and-probe-using-spheres *collide-cache* a1-14)) cfg-24))
(set! v0-0 #f)
(b! #t cfg-27 :delay (nop!))
(the-as none 0)
(label cfg-24)
(b! (not (the-as int s5-0)) cfg-26)
(let ((v1-40 (-> (the-as collide-shape-prim s5-0) cshape)))
(send-event (-> v1-40 process) 'edge-grabbed this)
)
)
(let ((v1-40 (-> (the-as collide-shape-prim s5-0) cshape))) (send-event (-> v1-40 process) 'edge-grabbed this)))
(label cfg-26)
(set! v0-0 #t)
(label cfg-27)
v0-0
)
)
v0-0))
(defmethod-mips2c "(method 16 collide-edge-work)" 16 collide-edge-work)
(defmethod-mips2c "(method 15 collide-edge-work)" 15 collide-edge-work)
(defmethod collide-edge-work-method-14 ((this collide-edge-work) (arg0 vector) (arg1 vector) (arg2 int))
@@ -382,17 +277,8 @@
(let ((f0-0 (vector-segment-distance-point! arg1 (-> v1-3 vertex-ptr 0 0) (-> v1-3 vertex-ptr 1 0) s2-0)))
(when (or (< f30-0 0.0) (< f0-0 f30-0))
(set! f30-0 f0-0)
(set! (-> arg0 quad) (-> s2-0 quad))
)
)
)
)
)
)
)
f30-0
)
)
(set! (-> arg0 quad) (-> s2-0 quad)))))))))
f30-0))
;; 17 cew
(defmethod should-add-to-list? ((this collide-edge-work) (arg0 collide-edge-hold-item) (arg1 collide-edge-edge))
@@ -405,8 +291,7 @@
(v1-6 float)
(a3-1 uint128)
(t0-0 uint128)
(t1-1 uint128)
)
(t1-1 uint128))
(rlet ((Q :class vf)
(vf0 :class vf)
(vf1 :class vf)
@@ -419,8 +304,7 @@
(vf6 :class vf)
(vf7 :class vf)
(vf8 :class vf)
(vf9 :class vf)
)
(vf9 :class vf))
(init-vf0-vector)
(nop!)
(nop!)
@@ -436,10 +320,7 @@
(.pcgtw t1-1 t0-0 t1-0)
(.lvf vf4 (&-> this outward-offset quad))
(.pcgtw a3-1 a3-0 t0-0)
(.lvf vf5 (&-> v1-0 trans quad))
)
)
)
(.lvf vf5 (&-> v1-0 trans quad)))))
(.por v1-1 t1-1 a3-1)
(let ((f0-0 (-> this max-dist-sqrd-to-outward-pt)))
(.ppach v1-2 r0-0 v1-1)
@@ -464,9 +345,7 @@
(.mul.vf vf9 vf8 vf6)
(.add.z.vf vf9 vf9 vf9 :mask #b1)
(.mov v1-5 vf9)
(b! (< v1-5 f1-0) cfg-4)
)
)
(b! (< v1-5 f1-0) cfg-4)))
(.sub.vf vf7 vf11 vf1)
(.svf (&-> arg0 center-pt quad) vf1)
(.mul.vf vf7 vf7 vf7)
@@ -483,10 +362,7 @@
(b! #t cfg-6 :delay (nop!))
(set! v0-0 (the-as symbol 0))
(label cfg-6)
v0-0
)
)
)
v0-0)))
(defmethod compute-center-point! ((this collide-edge-work) (arg0 collide-edge-edge) (arg1 vector))
(local-vars (v0-0 float) (v1-1 float) (v1-2 float) (v1-3 float))
@@ -502,18 +378,15 @@
(vf6 :class vf)
(vf7 :class vf)
(vf8 :class vf)
(vf9 :class vf)
)
(vf9 :class vf))
(init-vf0-vector)
(.mov.vf vf7 vf0)
(.lvf vf1 (&-> this search-pt quad))
(let ((f0-0 0.0))
(let ((v1-0 (-> arg0 vertex-ptr 0))
(a0-1 (-> arg0 vertex-ptr 1))
)
(a0-1 (-> arg0 vertex-ptr 1)))
(.lvf vf2 (&-> v1-0 0 quad))
(.lvf vf3 (&-> a0-1 0 quad))
)
(.lvf vf3 (&-> a0-1 0 quad)))
(.sub.vf vf4 vf1 vf2)
(.sub.vf vf5 vf3 vf2)
(.mul.vf vf6 vf5 vf5)
@@ -540,74 +413,41 @@
(b! (< f3-0 f0-0) cfg-4 :likely-delay (set! f3-0 f0-0))
(b! (< f1-0 f3-0) cfg-4 :likely-delay (set! f3-0 f1-0))
(label cfg-4)
(let ((v1-4 (* f3-0 f2-0)))
(.mov vf11 v1-4)
)
)
)
)
)
(let ((v1-4 (* f3-0 f2-0))) (.mov vf11 v1-4))))))
(.mul.x.vf vf7 vf5 vf11 :mask #b111)
(.add.vf vf7 vf7 vf2 :mask #b111)
(.svf (&-> arg1 quad) vf7)
(.mov v0-0 vf7)
v0-0
)
)
v0-0))
(defmethod debug-draw ((this edge-grab-info))
(add-debug-line
#t
(bucket-id debug-no-zbuf)
(the-as vector (-> this world-vertex))
(-> this world-vertex 1)
(new 'static 'rgba :r #xff :a #x60)
#f
(the-as rgba -1)
)
(add-debug-sphere
#t
(bucket-id debug-no-zbuf)
(-> this center-hold)
204.8
(new 'static 'rgba :r #xff :g #xff :a #x80)
)
(add-debug-sphere
#t
(bucket-id debug-no-zbuf)
(-> this left-hand-hold)
204.8
(new 'static 'rgba :r #xff :g #xff :a #x60)
)
(add-debug-sphere
#t
(bucket-id debug-no-zbuf)
(-> this right-hand-hold)
204.8
(new 'static 'rgba :r #xff :g #xff :a #x60)
)
(add-debug-outline-triangle
#t
(bucket-id debug-no-zbuf)
(the-as vector (-> this tri-vertex))
(-> this world-vertex 4)
(-> this world-vertex 5)
(new 'static 'rgba :r #xff :a #x30)
)
(the-as symbol (cond
((nonzero? (-> this actor-cshape-prim-offset))
(if (handle->process (-> this actor-handle))
(format *stdcon* "grab: ~A~%" (-> this actor-handle process 0 name))
(format *stdcon* "grab: invalid handle~%")
)
)
(else
(format *stdcon* "grab: ground~%")
)
)
)
)
(add-debug-line #t
(bucket-id debug-no-zbuf)
(the-as vector (-> this world-vertex))
(-> this world-vertex 1)
(new 'static 'rgba :r #xff :a #x60)
#f
(the-as rgba -1))
(add-debug-sphere #t (bucket-id debug-no-zbuf) (-> this center-hold) 204.8 (new 'static 'rgba :r #xff :g #xff :a #x80))
(add-debug-sphere #t (bucket-id debug-no-zbuf) (-> this left-hand-hold) 204.8 (new 'static 'rgba :r #xff :g #xff :a #x60))
(add-debug-sphere #t
(bucket-id debug-no-zbuf)
(-> this right-hand-hold)
204.8
(new 'static 'rgba :r #xff :g #xff :a #x60))
(add-debug-outline-triangle #t
(bucket-id debug-no-zbuf)
(the-as vector (-> this tri-vertex))
(-> this world-vertex 4)
(-> this world-vertex 5)
(new 'static 'rgba :r #xff :a #x30))
(the-as symbol
(cond
((nonzero? (-> this actor-cshape-prim-offset))
(if (handle->process (-> this actor-handle))
(format *stdcon* "grab: ~A~%" (-> this actor-handle process 0 name))
(format *stdcon* "grab: invalid handle~%")))
(else (format *stdcon* "grab: ground~%")))))
(defmethod debug-draw-edges ((this collide-edge-work))
(let ((gp-0 0))
@@ -615,65 +455,41 @@
(let* ((s3-0 (-> this edges s4-0))
(a2-0 (-> s3-0 vertex-ptr 0 0))
(a3-0 (-> s3-0 vertex-ptr 1 0))
(s2-0 (new 'stack-no-clear 'vector))
)
(s2-0 (new 'stack-no-clear 'vector)))
(vector+! s2-0 a2-0 a3-0)
(vector-float*! s2-0 s2-0 0.5)
(cond
((-> s3-0 ignore)
(add-debug-line
#t
(bucket-id debug-no-zbuf)
a2-0
a3-0
(new 'static 'rgba :r #x7f :g #x7f :b #x7f :a #x50)
#f
(the-as rgba -1)
)
(+! gp-0 1)
)
(add-debug-line #t
(bucket-id debug-no-zbuf)
a2-0
a3-0
(new 'static 'rgba :r #x7f :g #x7f :b #x7f :a #x50)
#f
(the-as rgba -1))
(+! gp-0 1))
(else
(add-debug-line
#t
(bucket-id debug-no-zbuf)
a2-0
a3-0
(new 'static 'rgba :r #xff :g #xff :b #xff :a #x60)
#f
(the-as rgba -1)
)
(add-debug-vector
#t
(bucket-id debug-no-zbuf)
s2-0
(-> s3-0 outward)
(meters 0.3)
(new 'static 'rgba :r #xff :a #x80)
)
)
)
)
)
(format *stdcon* "found ~D edges (and ~D ignored)~%" (- (-> this num-edges) (the-as uint gp-0)) gp-0)
)
)
(add-debug-line #t
(bucket-id debug-no-zbuf)
a2-0
a3-0
(new 'static 'rgba :r #xff :g #xff :b #xff :a #x60)
#f
(the-as rgba -1))
(add-debug-vector #t (bucket-id debug-no-zbuf) s2-0 (-> s3-0 outward) (meters 0.3) (new 'static 'rgba :r #xff :a #x80))))))
(format *stdcon* "found ~D edges (and ~D ignored)~%" (- (-> this num-edges) (the-as uint gp-0)) gp-0)))
(defmethod debug-draw-sphere ((this collide-edge-work))
(dotimes (s5-0 (the-as int (-> this num-verts)))
(let ((a2-0 (-> this verts s5-0)))
(add-debug-sphere #t (bucket-id debug-no-zbuf) a2-0 819.2 (new 'static 'rgba :r #xff :g #xff :a #x80))
)
)
#f
)
(add-debug-sphere #t (bucket-id debug-no-zbuf) a2-0 819.2 (new 'static 'rgba :r #xff :g #xff :a #x80))))
#f)
(defmethod debug-draw ((this collide-edge-hold-list))
(let ((s4-0 (-> this head))
(s5-0 0)
)
(s5-0 0))
(let ((s3-0 (new 'stack-no-clear 'vector))
(s2-0 #t)
)
(s2-0 #t))
(set! (-> s3-0 quad) (-> *target* control unknown-vector90 quad))
(while s4-0
(+! s5-0 1)
@@ -681,129 +497,86 @@
(add-debug-sphere #t (bucket-id debug-no-zbuf) s3-0 409.6 (new 'static 'rgba :a #x80))
(cond
(s2-0
(set! s2-0 #f)
(add-debug-sphere
#t
(bucket-id debug-no-zbuf)
(-> s4-0 center-pt)
614.4
(new 'static 'rgba :r #xff :g #xff :a #x80)
)
(add-debug-sphere #t (bucket-id debug-no-zbuf) (-> s4-0 outward-pt) 409.6 (new 'static 'rgba :r #xff :a #x80))
)
(set! s2-0 #f)
(add-debug-sphere #t (bucket-id debug-no-zbuf) (-> s4-0 center-pt) 614.4 (new 'static 'rgba :r #xff :g #xff :a #x80))
(add-debug-sphere #t (bucket-id debug-no-zbuf) (-> s4-0 outward-pt) 409.6 (new 'static 'rgba :r #xff :a #x80)))
(else
(add-debug-sphere
#t
(bucket-id debug-no-zbuf)
(-> s4-0 center-pt)
614.4
(new 'static 'rgba :r #x7f :g #x7f :a #x40)
)
(add-debug-sphere #t (bucket-id debug-no-zbuf) (-> s4-0 outward-pt) 409.6 (new 'static 'rgba :r #x7f :a #x40))
)
)
(set! s4-0 (-> s4-0 next))
)
)
(format *stdcon* "hold list has ~D item(s)~%" s5-0)
)
(add-debug-sphere #t (bucket-id debug-no-zbuf) (-> s4-0 center-pt) 614.4 (new 'static 'rgba :r #x7f :g #x7f :a #x40))
(add-debug-sphere #t (bucket-id debug-no-zbuf) (-> s4-0 outward-pt) 409.6 (new 'static 'rgba :r #x7f :a #x40))))
(set! s4-0 (-> s4-0 next))))
(format *stdcon* "hold list has ~D item(s)~%" s5-0))
(dotimes (s5-1 (the-as int (-> this num-attempts)))
(add-debug-sphere
#t
(bucket-id debug-no-zbuf)
(the-as vector (-> this attempts s5-1))
409.6
(new 'static 'rgba :a #x40)
)
)
(format *stdcon* "hold list has ~D attempt(s)~%" (-> this num-attempts))
)
(add-debug-sphere #t (bucket-id debug-no-zbuf) (the-as vector (-> this attempts s5-1)) 409.6 (new 'static 'rgba :a #x40)))
(format *stdcon* "hold list has ~D attempt(s)~%" (-> this num-attempts)))
(defmethod debug-draw-tris ((this collide-edge-work))
(dotimes (s5-0 (the-as int (-> this num-tris)))
(let* ((v1-3 (-> this tris s5-0 ctri))
(t1-0 (copy-and-set-field (-> *pat-mode-info* (-> v1-3 pat mode) color) a 64))
)
(add-debug-outline-triangle
#t
(bucket-id debug-no-zbuf)
(the-as vector (-> v1-3 vertex))
(-> v1-3 vertex 1)
(-> v1-3 vertex 2)
t1-0
)
)
)
(none)
)
(t1-0 (copy-and-set-field (-> *pat-mode-info* (-> v1-3 pat mode) color) a 64)))
(add-debug-outline-triangle #t
(bucket-id debug-no-zbuf)
(the-as vector (-> v1-3 vertex))
(-> v1-3 vertex 1)
(-> v1-3 vertex 2)
t1-0)))
(none))
(let ((v1-1
(new 'static 'surface
:name '*rotate-surface*
:turnv 1.0
:turnvv 1.0
:tiltv 1.0
:tiltvv 1.0
:transv-max 1.0
:target-speed 1.0
:seek0 153600.0
:seek90 153600.0
:seek180 256000.0
:fric 153600.0
:nonlin-fric-dist 5120.0
:slip-factor 1.0
:slope-down-factor 10240.0
:slope-slip-angle 8192.0
:impact-fric 1.0
:bend-factor 0.8
:bend-speed 4.0
:alignv 1.0
:slope-up-traction 1.0
:align-speed 1.0
:flags (surface-flags moving-ground)
)
)
)
(let ((v1-1 (new 'static
'surface
:name '*rotate-surface*
:turnv 1.0
:turnvv 1.0
:tiltv 1.0
:tiltvv 1.0
:transv-max 1.0
:target-speed 1.0
:seek0 153600.0
:seek90 153600.0
:seek180 256000.0
:fric 153600.0
:nonlin-fric-dist 5120.0
:slip-factor 1.0
:slope-down-factor 10240.0
:slope-slip-angle 8192.0
:impact-fric 1.0
:bend-factor 0.8
:bend-speed 4.0
:alignv 1.0
:slope-up-traction 1.0
:align-speed 1.0
:flags
(surface-flags moving-ground))))
(define *rotate-surface* v1-1)
(set! *rotate-surface* v1-1)
(set! (-> v1-1 mult-hook)
(the-as
(function surface surface surface int none)
(lambda ((arg0 surface) (arg1 object) (arg2 object) (arg3 int)) (if (= arg3 1)
(set! (-> arg0 fric) 151756.8)
)
)
)
)
(the-as (function surface surface surface int none)
(lambda ((arg0 surface) (arg1 object) (arg2 object) (arg3 int)) (if (= arg3 1) (set! (-> arg0 fric) 151756.8)))))
(set! (-> v1-1 touch-hook) nothing)
(set! (-> v1-1 active-hook) nothing)
)
(set! (-> v1-1 active-hook) nothing))
(let ((v1-2 (new 'static 'surface
:name '*no-walk-surface*
:turnv 0.5
:turnvv 1.0
:tiltv 1.0
:tiltvv 1.0
:transv-max 0.7
:target-speed 0.7
:seek0 24576.0
:seek90 24576.0
:seek180 24576.0
:fric 23756.8
:nonlin-fric-dist 4091904.0
:slope-slip-angle 16384.0
:bend-speed 4.0
:alignv 0.5
:slope-up-traction 0.9
:align-speed 1.0
:flags (surface-flags no-turn-around always-rotate-toward-transv)
)
)
)
(let ((v1-2 (new 'static
'surface
:name '*no-walk-surface*
:turnv 0.5
:turnvv 1.0
:tiltv 1.0
:tiltvv 1.0
:transv-max 0.7
:target-speed 0.7
:seek0 24576.0
:seek90 24576.0
:seek180 24576.0
:fric 23756.8
:nonlin-fric-dist 4091904.0
:slope-slip-angle 16384.0
:bend-speed 4.0
:alignv 0.5
:slope-up-traction 0.9
:align-speed 1.0
:flags
(surface-flags no-turn-around always-rotate-toward-transv))))
(define *no-walk-surface* v1-2)
(set! *no-walk-surface* v1-2)
(set! (-> v1-2 mult-hook) (the-as (function surface surface surface int none) nothing))
(set! (-> v1-2 touch-hook) nothing)
(set! (-> v1-2 active-hook) nothing)
)
(set! (-> v1-2 active-hook) nothing))
+14 -29
View File
@@ -1,7 +1,6 @@
;;-*-Lisp-*-
(in-package goal)
(bundles "ENGINE.CGO" "GAME.CGO")
(require "engine/math/vector-h.gc")
(require "engine/draw/drawable-tree-h.gc")
(require "engine/draw/drawable-inline-array-h.gc")
@@ -25,39 +24,25 @@
; TODO - defined in drawable, but needed in collide-frag
(define-extern sphere-cull (function vector symbol))
(deftype collide-frag-vertex (vector)
()
)
(deftype collide-frag-vertex (vector) ())
(deftype collide-frag-mesh (basic)
((packed-data uint32)
(pat-array uint32)
(strip-data-len uint16)
(poly-count uint16)
(base-trans vector :inline)
(vertex-count uint8 :overlay-at (-> base-trans w))
(vertex-data-qwc uint8 :offset 29)
(total-qwc uint8 :offset 30)
(unused uint8 :offset 31)
)
)
((packed-data uint32)
(pat-array uint32)
(strip-data-len uint16)
(poly-count uint16)
(base-trans vector :inline)
(vertex-count uint8 :overlay-at (-> base-trans w))
(vertex-data-qwc uint8 :offset 29)
(total-qwc uint8 :offset 30)
(unused uint8 :offset 31)))
(deftype collide-fragment (drawable)
((mesh collide-frag-mesh :offset 8)
)
)
((mesh collide-frag-mesh :offset 8)))
(deftype drawable-inline-array-collide-fragment (drawable-inline-array)
((data collide-fragment 1 :inline)
(pad uint32)
)
)
((data collide-fragment 1 :inline)
(pad uint32)))
(deftype drawable-tree-collide-fragment (drawable-tree)
((data-override drawable-inline-array :overlay-at (-> data 0))
)
)
((data-override drawable-inline-array :overlay-at (-> data 0))))
+23 -62
View File
@@ -1,7 +1,6 @@
;;-*-Lisp-*-
(in-package goal)
(bundles "ENGINE.CGO" "GAME.CGO")
(require "engine/level/bsp.gc")
(require "engine/collide/collide-frag-h.gc")
@@ -14,78 +13,58 @@
;; DECOMP BEGINS
(defmethod login ((this drawable-tree-collide-fragment))
this
)
this)
(defmethod draw ((this drawable-tree-collide-fragment) (arg0 drawable-tree-collide-fragment) (arg1 display-frame))
"Note: this doesn't do anything (sadly)"
(when *display-render-collision*
(dotimes (s4-0 (-> this length))
(draw (-> this data s4-0) (-> this data s4-0) arg1)
)
)
(draw (-> this data s4-0) (-> this data s4-0) arg1)))
0
(none)
)
(none))
(defmethod unpack-vis ((this drawable-tree-collide-fragment) (arg0 (pointer int8)) (arg1 (pointer int8)))
arg1
)
arg1)
(defmethod collide-with-box ((this drawable-tree-collide-fragment) (arg0 int) (arg1 collide-list))
"Collide everything in the tree with a box. Length arg doesn't matter here."
(collide-with-box (-> this data-override) (-> this length) arg1)
0
(none)
)
(none))
(defmethod collide-y-probe ((this drawable-tree-collide-fragment) (arg0 int) (arg1 collide-list))
(collide-y-probe (-> this data-override) (-> this length) arg1)
0
(none)
)
(none))
(defmethod collide-ray ((this drawable-tree-collide-fragment) (arg0 int) (arg1 collide-list))
(collide-ray (-> this data-override) (-> this length) arg1)
0
(none)
)
(none))
(defmethod mem-usage ((this collide-fragment) (arg0 memory-usage-block) (arg1 int))
(let ((s5-0 (if (logtest? arg1 1)
53
50
)
)
(s4-0 (-> this mesh))
)
(let ((s5-0 (if (logtest? arg1 1) 53 50))
(s4-0 (-> this mesh)))
(set! (-> arg0 data s5-0 name) (symbol->string 'collide-fragment))
(+! (-> arg0 data s5-0 count) 1)
(let ((v1-11 (+ (asize-of this) (asize-of s4-0))))
(+! (-> arg0 data s5-0 used) v1-11)
(+! (-> arg0 data s5-0 total) (logand -16 (+ v1-11 15)))
)
(+! (-> arg0 data s5-0 total) (logand -16 (+ v1-11 15))))
(set! (-> arg0 data (+ s5-0 1) name) "collision-poly")
(+! (-> arg0 data (+ s5-0 1) count) (-> s4-0 poly-count))
(let ((v1-22 (+ (-> s4-0 strip-data-len) (-> s4-0 poly-count))))
(+! (-> arg0 data (+ s5-0 1) used) v1-22)
(+! (-> arg0 data (+ s5-0 1) total) v1-22)
)
(+! (-> arg0 data (+ s5-0 1) total) v1-22))
(set! (-> arg0 data (+ s5-0 2) name) "collision-vertex")
(+! (-> arg0 data (+ s5-0 2) count) (-> s4-0 vertex-count))
(let ((v1-31 (* (-> s4-0 vertex-data-qwc) 16)))
(+! (-> arg0 data (+ s5-0 2) used) v1-31)
(let ((v0-2 (+ (-> arg0 data (+ s5-0 2) total) v1-31)))
(set! (-> arg0 data (+ s5-0 2) total) v0-2)
(the-as collide-fragment v0-2)
)
)
)
)
(the-as collide-fragment v0-2)))))
(defmethod login ((this drawable-inline-array-collide-fragment))
this
)
this)
(defmethod draw ((this collide-fragment) (arg0 collide-fragment) (arg1 display-frame))
;; if we wanted to draw collide-fragment's we'd do it here.
@@ -103,52 +82,34 @@
; )
;; (add-debug-point #t (bucket-id debug) (-> this bsphere))
0
(none)
)
(none))
(defmethod draw ((this drawable-inline-array-collide-fragment)
(arg0 drawable-inline-array-collide-fragment)
(arg1 display-frame)
)
(defmethod draw ((this drawable-inline-array-collide-fragment) (arg0 drawable-inline-array-collide-fragment) (arg1 display-frame))
(dotimes (s4-0 (-> this length))
(let ((s3-0 (-> this data s4-0)))
(if (sphere-cull (-> s3-0 bsphere))
(draw s3-0 s3-0 arg1)
)
)
)
(let ((s3-0 (-> this data s4-0))) (if (sphere-cull (-> s3-0 bsphere)) (draw s3-0 s3-0 arg1))))
0
(none)
)
(none))
(defmethod collide-with-box ((this drawable-inline-array-collide-fragment) (arg0 int) (arg1 collide-list))
(collide-with-box (the-as collide-fragment (-> this data)) (-> this length) arg1)
0
(none)
)
(none))
(defmethod collide-y-probe ((this drawable-inline-array-collide-fragment) (arg0 int) (arg1 collide-list))
(collide-y-probe (the-as collide-fragment (-> this data)) (-> this length) arg1)
0
(none)
)
(none))
(defmethod collide-ray ((this drawable-inline-array-collide-fragment) (arg0 int) (arg1 collide-list))
(collide-ray (the-as collide-fragment (-> this data)) (-> this length) arg1)
0
(none)
)
(none))
(defmethod mem-usage ((this drawable-inline-array-collide-fragment) (arg0 memory-usage-block) (arg1 int))
(set! (-> arg0 length) (max 1 (-> arg0 length)))
(set! (-> arg0 data 0 name) (symbol->string 'drawable-group))
(+! (-> arg0 data 0 count) 1)
(let ((v1-7 32))
(+! (-> arg0 data 0 used) v1-7)
(+! (-> arg0 data 0 total) (logand -16 (+ v1-7 15)))
)
(let ((v1-7 32)) (+! (-> arg0 data 0 used) v1-7) (+! (-> arg0 data 0 total) (logand -16 (+ v1-7 15))))
(dotimes (s3-0 (-> this length))
(mem-usage (-> this data s3-0) arg0 arg1)
)
this
)
(mem-usage (-> this data s3-0) arg0 arg1))
this)
@@ -1,8 +1,9 @@
;;-*-Lisp-*-
(in-package goal)
(bundles "ENGINE.CGO" "GAME.CGO")
;; name: collide-func-h.gc
;; name in dgo: collide-func-h
;; dgos: GAME, ENGINE
;; empty!
;; empty!
+46 -122
View File
@@ -1,7 +1,6 @@
;;-*-Lisp-*-
(in-package goal)
(bundles "ENGINE.CGO" "GAME.CGO")
(require "engine/math/vector.gc")
(require "kernel/gkernel-h.gc")
@@ -9,7 +8,6 @@
;; name in dgo: collide-func
;; dgos: GAME, ENGINE
;; This file contains the primitive intersection functions used for collision.
;; Most take a description of primitive and a "probe"
;; The probe has an origin and a direction. The length of the direction vector is the length
@@ -28,20 +26,10 @@
(defconstant COLLISION_MISS -100000000.0)
(defun raw-ray-sphere-intersect ((arg0 float))
"DANGER: this function takes two arguments by vf registers.
As a result, it doesn't work properly in OpenGOAL. See the functions below."
(local-vars
(v1-1 float)
(v1-2 float)
(v1-4 number)
(a0-1 float)
(a0-2 float)
(a0-3 int)
(a1-0 float)
)
(local-vars (v1-1 float) (v1-2 float) (v1-4 number) (a0-1 float) (a0-2 float) (a0-3 int) (a1-0 float))
(crash!)
(rlet ((Q :class vf)
(vf0 :class vf)
@@ -53,8 +41,7 @@
(vf6 :class vf)
(vf7 :class vf)
(vf8 :class vf)
(vf9 :class vf)
)
(vf9 :class vf))
(init-vf0-vector)
(.mov vf3 arg0) ;; vf3 = radius
;; sphere is at the origin, vf1 is source of the ray (o)
@@ -80,8 +67,7 @@
(b! (< (the-as int a1-0) 0) cfg-7 :delay (set! a0-2 a0-1))
(.mul.vf vf4 vf0 Q :mask #b1000)
(.sub.vf vf9 vf8 vf7)
(b! (= a0-2 v1-0) cfg-6 :delay (.mov v1-1 vf5))
)
(b! (= a0-2 v1-0) cfg-6 :delay (.mov v1-1 vf5)))
(.sqrt.vf Q vf9 :ftf #b1)
(b! (>= (the-as int v1-1) 0) cfg-6 :delay (.mov v1-2 vf9))
(b! (< (the-as int v1-2) 0) cfg-6 :delay 1.0)
@@ -93,33 +79,21 @@
(.add.w.vf vf9 vf5 vf9 :mask #b10)
(.mov a0-3 vf6)
(.mul.w.vf vf9 vf9 vf4 :mask #b10)
(b!
(< (logand (the-as uint v1-4) (the-as uint a0-3)) 0)
cfg-6
:delay
(.sub.y.vf vf4 vf0 vf9)
)
(b! (< (logand (the-as uint v1-4) (the-as uint a0-3)) 0) cfg-6 :delay (.sub.y.vf vf4 vf0 vf9))
(b! #t cfg-7 :delay (.mov result vf4))
(label cfg-6)
(set! result -100000000.0)
(label cfg-7)
(the-as float result)
)
)
)
(the-as float result))))
(defmacro pc-port-do-raw-ray-sphere-intersect (rad vf1-val vf2-val)
"Calls to raw-ray-sphere-intersect should be replaced with this macro,
and this should be given vf1, vf2, which contain the origin and direction of the probe."
`(let ((vf1-storage (new 'stack-no-clear 'vector))
(vf2-storage (new 'stack-no-clear 'vector))
)
(.svf (&-> vf1-storage quad) ,vf1-val)
(.svf (&-> vf2-storage quad) ,vf2-val)
(pc-port-raw-ray-sphere-implementation ,rad vf1-storage vf2-storage)
)
)
(vf2-storage (new 'stack-no-clear 'vector)))
(.svf (&-> vf1-storage quad) ,vf1-val)
(.svf (&-> vf2-storage quad) ,vf2-val)
(pc-port-raw-ray-sphere-implementation ,rad vf1-storage vf2-storage)))
(defun pc-port-raw-ray-sphere-implementation ((rad float) (vf1-val vector) (vf2-val vector))
"This is one of the main primitives for collision.
@@ -130,15 +104,7 @@
- too far away (return MISS)
- inside (return 0)
"
(local-vars
(v1-1 int)
(v1-2 int)
(v1-4 int)
(a0-1 float)
(a0-2 float)
(a0-3 int)
(a1-0 int)
)
(local-vars (v1-1 int) (v1-2 int) (v1-4 int) (a0-1 float) (a0-2 float) (a0-3 int) (a1-0 int))
(rlet ((Q :class vf)
(vf0 :class vf)
(vf1 :class vf)
@@ -149,8 +115,7 @@
(vf6 :class vf)
(vf7 :class vf)
(vf8 :class vf)
(vf9 :class vf)
)
(vf9 :class vf))
(init-vf0-vector)
(.lvf vf1 (&-> vf1-val quad))
(.lvf vf2 (&-> vf2-val quad))
@@ -189,71 +154,53 @@
(.add.w.vf vf9 vf5 vf9 :mask #b10)
(.mov a0-3 vf6)
(.mul.w.vf vf9 vf9 vf4 :mask #b10)
;; too far.
(b! (< (logand (the-as int v1-4) (the-as int a0-3)) 0)
cfg-6
:delay (.sub.y.vf vf4 vf0 vf9)
)
(b! (< (logand (the-as int v1-4) (the-as int a0-3)) 0) cfg-6 :delay (.sub.y.vf vf4 vf0 vf9))
(b! #t cfg-7 :delay (.mov result vf4))
(label cfg-6)
(set! result -100000000.0)
(label cfg-7)
(the-as float result)
)
)
)
(the-as float result))))
(defun ray-sphere-intersect ((ray-origin vector) (ray-dir vector) (sph-origin vector) (radius float))
"Intersect a ray and sphere. Will return 0 if you are in the sphere, -huge number if you don't hit it.
Returns the length of the ray to the first intersection."
;; offset stuff as if the sphere is at the origin.
(rlet ((vf1 :class vf)
(vf2 :class vf)
)
(vf2 :class vf))
(.lvf vf1 (&-> ray-origin quad))
(.lvf vf2 (&-> sph-origin quad))
(.sub.vf vf1 vf1 vf2) ;; the sphere is at the origin in the actual intersection.
(.lvf vf2 (&-> ray-dir quad))
;;(raw-ray-sphere-intersect radius)
(pc-port-do-raw-ray-sphere-intersect radius vf1 vf2)
)
)
(pc-port-do-raw-ray-sphere-intersect radius vf1 vf2)))
(defun ray-circle-intersect ((ray-origin vector) (ray-dir vector) (circle-origin vector) (radius float))
"Intersect ray with circle. Circle is on the y plane and this throws out the y components
of ray-origin, circle-origin, and ray-dir"
(rlet ((vf0 :class vf)
(vf1 :class vf)
(vf2 :class vf)
)
(init-vf0-vector)
(.lvf vf1 (&-> ray-origin quad))
(.mov.vf vf1 vf0 :mask #b10)
(.lvf vf2 (&-> circle-origin quad))
(.mov.vf vf2 vf0 :mask #b10)
(.sub.vf vf1 vf1 vf2)
(.lvf vf2 (&-> ray-dir quad))
(.mov.vf vf2 vf0 :mask #b10)
;;(raw-ray-sphere-intersect radius)
(pc-port-do-raw-ray-sphere-intersect radius vf1 vf2)
)
)
(vf2 :class vf))
(init-vf0-vector)
(.lvf vf1 (&-> ray-origin quad))
(.mov.vf vf1 vf0 :mask #b10)
(.lvf vf2 (&-> circle-origin quad))
(.mov.vf vf2 vf0 :mask #b10)
(.sub.vf vf1 vf1 vf2)
(.lvf vf2 (&-> ray-dir quad))
(.mov.vf vf2 vf0 :mask #b10)
;;(raw-ray-sphere-intersect radius)
(pc-port-do-raw-ray-sphere-intersect radius vf1 vf2)))
(defun ray-cylinder-intersect ((ray-origin vector) (ray-dir vector) (cyl-origin vector) (cyl-axis vector) (cyl-rad float) (cyl-len float) (pt-out vector))
(defun ray-cylinder-intersect ((ray-origin vector) (ray-dir vector)
(cyl-origin vector)
(cyl-axis vector)
(cyl-rad float)
(cyl-len float)
(pt-out vector))
"Intersect with a cylinder.
Currently this is untested."
(local-vars
(v0-1 float)
(v1-0 int)
(v1-2 int)
(a0-1 int)
(a0-2 int)
(a0-4 int)
(a0-5 int)
)
(local-vars (v0-1 float) (v1-0 int) (v1-2 int) (a0-1 int) (a0-2 int) (a0-4 int) (a0-5 int))
(rlet ((vf1 :class vf)
(vf10 :class vf)
(vf11 :class vf)
@@ -267,8 +214,7 @@
(vf19 :class vf)
(vf2 :class vf)
(vf20 :class vf)
(vf21 :class vf)
)
(vf21 :class vf))
(.lvf vf10 (&-> ray-origin quad))
(.lvf vf12 (&-> cyl-origin quad))
(.sub.vf vf15 vf10 vf12)
@@ -290,8 +236,7 @@
(.mov a0-1 vf18)
(let ((v1-1 (logand v1-0 (the-as uint a0-1))))
(.sub.vf vf1 vf15 vf1)
(b! (< v1-1 0) cfg-6 :delay (.sub.vf vf2 vf11 vf2))
)
(b! (< v1-1 0) cfg-6 :delay (.sub.vf vf2 vf11 vf2)))
(.mov v1-2 vf19)
(.mov a0-2 vf20)
(b! (>= (the-as int (logior v1-2 (the-as uint a0-2))) 0) cfg-6 :delay (nop!))
@@ -303,22 +248,14 @@
(.mul.y.vf vf13 vf13 vf16)
(.sub.x.vf vf19 vf16 vf14)
(.mov a0-4 vf16)
(b!
(< (the-as int a0-4) 0)
cfg-6
:delay
(.add.vf vf12 vf12 vf13 :mask #b111)
)
(b! (< (the-as int a0-4) 0) cfg-6 :delay (.add.vf vf12 vf12 vf13 :mask #b111))
(.mov a0-5 vf19)
(b! (>= (the-as int a0-5) 0) cfg-6 :delay (.svf (&-> pt-out quad) vf12))
(b! #t cfg-7 :delay (set! v0-1 v1-4))
)
(b! #t cfg-7 :delay (set! v0-1 v1-4)))
(label cfg-6)
(set! v0-1 -100000000.0)
(label cfg-7)
v0-1
)
)
v0-1))
(defun ray-plane-intersect ((arg0 vector) (arg1 vector) (arg2 vector) (arg3 vector) (arg4 vector) (arg5 vector) (arg6 vector))
"Unused."
@@ -334,8 +271,7 @@
(vf6 :class vf)
(vf7 :class vf)
(vf8 :class vf)
(vf9 :class vf)
)
(vf9 :class vf))
(init-vf0-vector)
(.lvf vf3 (&-> arg5 quad))
(.lvf vf1 (&-> arg4 quad))
@@ -360,8 +296,7 @@
(.mov a2-1 vf8)
(.isqrt.vf Q vf0 vf5 :fsf #b11 :ftf #b0)
(let ((f1-0 a2-1)
(f2-0 v1-0)
)
(f2-0 v1-0))
(cond
((!= f2-0 0.0)
(let ((f1-1 (/ f1-0 f2-0)))
@@ -375,34 +310,23 @@
(.add.mul.w.vf vf7 vf6 vf0 acc :mask #b111)
(.svf (&-> arg0 quad) vf7)
(.mov v1-1 vf7)
v0-0
)
)
)
(else
-100000000.0
)
)
)
)
)
v0-0)))
(else -100000000.0)))))
;; ray-triangle-intersect (unused)
;; collide-do-primitives (used in moving-sphere-triangle-intersect)
(def-mips2c collide-do-primitives (function float))
;; moving-sphere-triangle-intersect (used in cam)
(def-mips2c moving-sphere-triangle-intersect (function vector vector float collide-cache-tri vector vector float))
;; moving-sphere-sphere-intersect (used in collide)
(defun moving-sphere-sphere-intersect ((arg0 vector) (arg1 vector) (arg2 vector) (arg3 vector))
(let ((f30-0 (ray-sphere-intersect arg0 arg1 arg2 (+ (-> arg0 w) (-> arg2 w)))))
(when (>= f30-0 0.0)
(let ((s3-1 (vector-normalize! (vector-! (new-stack-vector0) arg2 arg0) (-> arg0 w))))
(vector+*! arg3 arg0 arg1 f30-0)
(vector+! arg3 arg3 s3-1)
)
)
f30-0
)
)
(vector+! arg3 arg3 s3-1)))
f30-0))
;; moving-sphere-moving-sphere-intersect (unused)
+2 -1
View File
@@ -1,8 +1,9 @@
;;-*-Lisp-*-
(in-package goal)
(bundles "ENGINE.CGO" "GAME.CGO")
;; name: collide-h.gc
;; name in dgo: collide-h
;; dgos: GAME, ENGINE
(define *collide-test-flag* #f)
(define *collide-test-flag* #f)
+36 -53
View File
@@ -1,7 +1,6 @@
;;-*-Lisp-*-
(in-package goal)
(bundles "ENGINE.CGO" "GAME.CGO")
(require "kernel-defs.gc")
;; name: collide-mesh-h.gc
@@ -20,12 +19,10 @@
;; The triangle involved in collision
;; Note: this is reused for the background collision system.
(deftype collide-tri-result (structure)
((vertex vector 3 :inline)
(intersect vector :inline)
(normal vector :inline)
(pat pat-surface)
)
)
((vertex vector 3 :inline)
(intersect vector :inline)
(normal vector :inline)
(pat pat-surface)))
;;;;;;;;;;;;;;;;;;;;
;; static mesh data
@@ -35,34 +32,29 @@
;; The vertex indices index into the collide-mesh vertex-data array.
;; Due to using uint8's you only get 256 vertices.
(deftype collide-mesh-tri (structure)
((vertex-index uint8 3)
(unused uint8)
(pat pat-surface)
)
:pack-me
)
((vertex-index uint8 3)
(unused uint8)
(pat pat-surface))
:pack-me)
;; og:preserve-this
(declare-type collide-mesh-cache-tri structure)
;; A collision mesh. Note that's it's bound to a specific joint.
(deftype collide-mesh (basic)
((joint-id int32)
(num-tris uint32)
(num-verts uint32)
(vertex-data (inline-array vector))
(tris collide-mesh-tri 1 :inline :offset 32)
)
((joint-id int32)
(num-tris uint32)
(num-verts uint32)
(vertex-data (inline-array vector))
(tris collide-mesh-tri 1 :inline :offset 32))
(:methods
(debug-draw-tris (_type_ process-drawable int) none)
(overlap-test (_type_ collide-mesh-cache-tri vector) symbol)
(should-push-away-test (_type_ collide-mesh-cache-tri collide-tri-result vector float) float)
(sphere-on-platform-test (_type_ collide-mesh-cache-tri collide-tri-result vector float) float)
(populate-cache! (_type_ collide-mesh-cache-tri matrix) none)
(collide-mesh-math-1 (_type_ object object) none)
(collide-mesh-math-2 (_type_ object object object) none)
)
)
(debug-draw-tris (_type_ process-drawable int) none)
(overlap-test (_type_ collide-mesh-cache-tri vector) symbol)
(should-push-away-test (_type_ collide-mesh-cache-tri collide-tri-result vector float) float)
(sphere-on-platform-test (_type_ collide-mesh-cache-tri collide-tri-result vector float) float)
(populate-cache! (_type_ collide-mesh-cache-tri matrix) none)
(collide-mesh-math-1 (_type_ object object) none)
(collide-mesh-math-2 (_type_ object object object) none)))
;;;;;;;;;;;;;;;;;;;;
;; cache
@@ -78,17 +70,14 @@
(defconstant COLLIDE_MESH_CACHE_SIZE #xa000)
(deftype collide-mesh-cache (basic)
((used-size uint32)
(max-size uint32)
(id uint64)
(data uint8 40960 :offset 32)
)
((used-size uint32)
(max-size uint32)
(id uint64)
(data uint8 40960 :offset 32))
(:methods
(allocate! (_type_ int) int)
(is-id? (_type_ int) symbol)
(next-id! (_type_) uint)
)
)
(allocate! (_type_ int) int)
(is-id? (_type_ int) symbol)
(next-id! (_type_) uint)))
(defmethod next-id! ((obj collide-mesh-cache))
"Reset all used entries in the cache and increment the id.
@@ -101,30 +90,22 @@
(let ((v0 (+ v1 1)))
;; beql v0, r0, L3
;; addiu v0, r0, 1 (only taken if v0 = 0)
(if (= v0 0)
(set! v0 (the uint 1))
)
(if (= v0 0) (set! v0 (the uint 1)))
;; L3:
;; sd v0, 12(a0)
(set! (-> obj id) v0)
v0
)
)
)
v0)))
(defmethod is-id? ((this collide-mesh-cache) (arg0 int))
"Is this our id?"
(= (-> this id) arg0)
)
(= (-> this id) arg0))
;; possibly this is stored in the data of the collide-mesh-cache
(deftype collide-mesh-cache-tri (structure)
((vertex vector 3 :inline)
(normal vector :inline)
(bbox4w bounding-box4w :inline)
(pat pat-surface :overlay-at (-> normal w))
)
)
((vertex vector 3 :inline)
(normal vector :inline)
(bbox4w bounding-box4w :inline)
(pat pat-surface :overlay-at (-> normal w))))
;; only allocate if we don't have an existing one.
(define-perm *collide-mesh-cache* collide-mesh-cache (new 'global 'collide-mesh-cache))
@@ -132,5 +113,7 @@
;; og:preserve-this
;; in all cases, re-init.
(set! (-> *collide-mesh-cache* id) 1)
(set! (-> *collide-mesh-cache* used-size) 0)
(set! (-> *collide-mesh-cache* max-size) COLLIDE_MESH_CACHE_SIZE)
+39 -115
View File
@@ -1,7 +1,6 @@
;;-*-Lisp-*-
(in-package goal)
(bundles "ENGINE.CGO" "GAME.CGO")
(require "engine/collide/pat-h.gc")
(require "engine/debug/debug.gc")
(require "engine/collide/collide-mesh-h.gc")
@@ -14,27 +13,21 @@
(defmethod asize-of ((this collide-mesh))
"Compute the size in memory of a collide-mesh. Somehow this only counts num-tris and not verts."
(the-as int (+ (-> collide-mesh size) (* (+ (-> this num-tris) -1) 8)))
)
(the-as int (+ (-> collide-mesh size) (* (+ (-> this num-tris) -1) 8))))
(defmethod mem-usage ((this collide-mesh) (arg0 memory-usage-block) (arg1 int))
"Compute the memory usage of a collide-mesh."
(set! (-> arg0 length) (max 79 (-> arg0 length)))
(set! (-> arg0 data 78 name) "collide-mesh")
(+! (-> arg0 data 78 count) 1)
(let ((v1-6 (asize-of this)))
(+! (-> arg0 data 78 used) v1-6)
(+! (-> arg0 data 78 total) (logand -16 (+ v1-6 15)))
)
(let ((v1-6 (asize-of this))) (+! (-> arg0 data 78 used) v1-6) (+! (-> arg0 data 78 total) (logand -16 (+ v1-6 15))))
(set! (-> arg0 length) (max 79 (-> arg0 length)))
(set! (-> arg0 data 78 name) "collide-mesh")
(+! (-> arg0 data 78 count) 1)
(let ((v1-16 (* (-> this num-verts) 16)))
(+! (-> arg0 data 78 used) v1-16)
(+! (-> arg0 data 78 total) (logand -16 (+ v1-16 15)))
)
(the-as collide-mesh 0)
)
(+! (-> arg0 data 78 total) (logand -16 (+ v1-16 15))))
(the-as collide-mesh 0))
(defmethod debug-draw-tris ((this collide-mesh) (arg0 process-drawable) (arg1 int))
"Draw a collide-mesh."
@@ -46,17 +39,14 @@
(vf4 :class vf)
(vf5 :class vf)
(vf6 :class vf)
(vf7 :class vf)
)
(vf7 :class vf))
(init-vf0-vector)
(let ((s5-0 (the-as object (-> this tris)))
(s4-0 (-> arg0 node-list data arg1 bone transform))
)
(s4-0 (-> arg0 node-list data arg1 bone transform)))
(countdown (s3-0 (-> this num-tris))
(let ((a2-1 (new 'stack-no-clear 'vector))
(a3-0 (new 'stack-no-clear 'vector))
(t0-0 (new 'stack-no-clear 'vector))
)
(t0-0 (new 'stack-no-clear 'vector)))
(.lvf vf4 (&-> s4-0 vector 0 quad))
(.lvf vf5 (&-> s4-0 vector 1 quad))
(.lvf vf6 (&-> s4-0 vector 2 quad))
@@ -80,32 +70,20 @@
(.svf (&-> a2-1 quad) vf1)
(.svf (&-> a3-0 quad) vf2)
(.svf (&-> t0-0 quad) vf3)
(add-debug-flat-triangle #t (bucket-id debug-no-zbuf) a2-1 a3-0 t0-0 t1-0)
)
)
(set! s5-0 (-> (the-as (inline-array collide-mesh-tri) s5-0) 1))
)
)
(add-debug-flat-triangle #t (bucket-id debug-no-zbuf) a2-1 a3-0 t0-0 t1-0)))
(set! s5-0 (-> (the-as (inline-array collide-mesh-tri) s5-0) 1))))
0
(none)
)
)
(none)))
(deftype sopt-work (structure)
((intersect vector :inline)
(sphere-bbox4w bounding-box4w :inline)
)
)
((intersect vector :inline)
(sphere-bbox4w bounding-box4w :inline)))
(defmethod-mips2c "(method 12 collide-mesh)" 12 collide-mesh)
(deftype spat-work (structure)
((intersect vector :inline)
(sphere-bbox4w bounding-box4w :inline)
)
)
((intersect vector :inline)
(sphere-bbox4w bounding-box4w :inline)))
(defmethod-mips2c "(method 11 collide-mesh)" 11 collide-mesh)
@@ -121,14 +99,11 @@
(a3-0 (-> this data))
(a2-0 (-> this max-size))
(v1-2 (* v1-1 16))
(a3-1 (&+ a3-0 a1-1))
)
(a3-1 (&+ a3-0 a1-1)))
(let ((t1-0 (- a2-0 (the-as uint v1-2)))
(t0-0 (-> this id))
)
(t0-0 (-> this id)))
(b! (< (the-as int t1-0) 0) cfg-6 :delay (set! a1-2 (the-as int (+ a1-1 v1-2))))
(b! (>= (the-as int (- a2-0 (the-as uint a1-2))) 0) cfg-5 :delay (set! a2-2 (the-as int (+ t0-0 1))))
)
(b! (>= (the-as int (- a2-0 (the-as uint a1-2))) 0) cfg-5 :delay (set! a2-2 (the-as int (+ t0-0 1)))))
(b! (zero? (the-as uint a2-2)) cfg-4 :likely-delay (set! a2-2 1))
(label cfg-4)
(set! a1-2 v1-2)
@@ -142,10 +117,7 @@
(format 0 "ERROR: Attempted to allocate something bigger than the entire mesh cache!~%")
(set! v0-0 (the-as (pointer uint8) #f))
(label cfg-7)
(the-as int v0-0)
)
)
)
(the-as int v0-0))))
(defmethod populate-cache! ((this collide-mesh) (arg0 collide-mesh-cache-tri) (arg1 matrix))
(local-vars (t0-2 uint))
@@ -163,13 +135,11 @@
(vf6 :class vf)
(vf7 :class vf)
(vf8 :class vf)
(vf9 :class vf)
)
(vf9 :class vf))
(init-vf0-vector)
(nop!)
(let ((t0-0 (scratchpad-object int))
(v1-0 (-> this num-verts))
)
(v1-0 (-> this num-verts)))
(nop!)
(let ((a3-0 (-> this vertex-data)))
(b! (zero? v1-0) cfg-3 :delay (.lvf vf1 (&-> arg1 vector 0 quad)))
@@ -228,29 +198,23 @@
(.svf (+ t0-1 16) vf10)
(nop!)
(.svf (+ t0-1 32) vf11)
(b! (> (the-as int v1-0) 0) cfg-2 :delay (.svf (+ t0-1 48) vf12))
)
)
)
(b! (> (the-as int v1-0) 0) cfg-2 :delay (.svf (+ t0-1 48) vf12)))))
(label cfg-3)
(let ((v1-1 (the-as collide-mesh-tri (-> this tris))))
(nop!)
(let ((a2-1 (scratchpad-object int))
(a0-1 (-> this num-tris))
)
(a0-1 (-> this num-tris)))
(b! (zero? a0-1) cfg-6 :delay (set! t0-2 (-> v1-1 vertex-index 0)))
(let* ((a1-1 (&+ arg0 -96))
(let* ((a1-1 (&+ arg0 -96))
(a3-1 (-> v1-1 vertex-index 1))
(t0-3 (* t0-2 16))
(t2-0 (-> v1-1 vertex-index 2))
(t1-0 (* a3-1 16))
(a3-2 (-> v1-1 pat))
)
(a3-2 (-> v1-1 pat)))
(let* ((t2-1 (* t2-0 16))
(t0-4 (+ t0-3 a2-1))
(t1-1 (+ t1-0 a2-1))
(t2-2 (+ t2-1 a2-1))
)
(t2-2 (+ t2-1 a2-1)))
(label cfg-5)
(+! a0-1 -1)
(.lvf vf1 t0-4)
@@ -283,14 +247,7 @@
(.add.mul.z.vf vf7 vf0 vf7 acc :mask #b1000)
(set! t1-1 (+ t2-4 a2-1))
(.isqrt.vf Q vf0 vf7 :fsf #b11 :ftf #b11)
(set! t2-2 (+ t3-0 a2-1))
)
)
)
)
)
)
)
(set! t2-2 (+ t3-0 a2-1)))))))))
(.ftoi.vf vf8 vf8)
(nop!)
(.ftoi.vf vf9 vf9)
@@ -305,22 +262,14 @@
(.svf (&-> a1-1 normal quad) vf6)
(nop!)
(set! (-> a1-1 normal w) (the-as float a3-2))
(b! (nonzero? a0-1) cfg-5 :delay (set! a3-2 (-> v1-1 pat)))
)
)
)
(b! (nonzero? a0-1) cfg-5 :delay (set! a3-2 (-> v1-1 pat))))))
(label cfg-6)
0
(none)
)
)
(none)))
(deftype oot-work (structure)
((intersect vector :inline)
(sphere-bbox4w bounding-box4w :inline)
)
)
((intersect vector :inline)
(sphere-bbox4w bounding-box4w :inline)))
(defmethod overlap-test ((this collide-mesh) (arg0 collide-mesh-cache-tri) (arg1 vector))
(local-vars
@@ -332,8 +281,7 @@
(a1-4 uint128)
(a1-7 uint)
(a2-1 uint128)
(a2-2 uint128)
)
(a2-2 uint128))
(rlet ((acc :class vf)
(vf0 :class vf)
(vf1 :class vf)
@@ -341,13 +289,11 @@
(vf3 :class vf)
(vf4 :class vf)
(vf5 :class vf)
(vf6 :class vf)
)
(vf6 :class vf))
(init-vf0-vector)
(set! zero (the-as uint128 0))
(let ((s5-0 (new 'stack-no-clear 'matrix))
(s4-0 arg0)
)
(s4-0 arg0))
(.lvf vf2 (&-> arg1 quad))
(let ((s3-0 (-> this num-tris)))
(.sub.w.vf vf5 vf2 vf2)
@@ -360,25 +306,13 @@
(.svf (&-> s5-0 vector 2 quad) vf6)
(label cfg-1)
(b! (zero? s3-0) cfg-7 :delay (set! a2-1 (-> s4-0 bbox4w min quad)))
(+! s3-0 -1)
)
(let ((a1-1 (-> s4-0 bbox4w max quad)))
(.pcgtw a2-2 a2-1 a0-1)
(.pcgtw a1-2 v1-0 a1-1)
)
(+! s3-0 -1))
(let ((a1-1 (-> s4-0 bbox4w max quad))) (.pcgtw a2-2 a2-1 a0-1) (.pcgtw a1-2 v1-0 a1-1))
(.por a1-3 a2-2 a1-2)
(nop!)
(.ppach a1-4 zero a1-3)
(let ((a1-5 (shl (the-as int a1-4) 16)))
(nop!)
(b! (nonzero? a1-5) cfg-1 :likely-delay (set! s4-0 (&+ s4-0 96)))
)
(closest-pt-in-triangle
(the-as vector (-> s5-0 vector))
arg1
(the-as matrix (-> s4-0 vertex))
(-> s4-0 normal)
)
(let ((a1-5 (shl (the-as int a1-4) 16))) (nop!) (b! (nonzero? a1-5) cfg-1 :likely-delay (set! s4-0 (&+ s4-0 96))))
(closest-pt-in-triangle (the-as vector (-> s5-0 vector)) arg1 (the-as matrix (-> s4-0 vertex)) (-> s4-0 normal))
(.lvf vf1 (&-> s5-0 vector 0 quad))
(.lvf vf2 (&-> arg1 quad))
(set! v1-0 (-> s5-0 vector 1 quad))
@@ -392,15 +326,5 @@
(.sub.w.vf vf3 vf3 vf4 :mask #b1000)
(.add.w.vf vf3 vf0 vf3 :mask #b10)
(.mov a1-7 vf3)
(b! (>= (the-as int a1-7) 0) cfg-1 :delay (set! s4-0 (&+ s4-0 96)))
)
(let ((v0-1 #t))
(b! #t cfg-8 :delay (nop!))
(the-as none 0)
(label cfg-7)
(set! v0-1 #f)
(label cfg-8)
v0-1
)
)
)
(b! (>= (the-as int a1-7) 0) cfg-1 :delay (set! s4-0 (&+ s4-0 96))))
(let ((v0-1 #t)) (b! #t cfg-8 :delay (nop!)) (the-as none 0) (label cfg-7) (set! v0-1 #f) (label cfg-8) v0-1)))
+87 -212
View File
@@ -1,7 +1,6 @@
;;-*-Lisp-*-
(in-package goal)
(bundles "ENGINE.CGO" "GAME.CGO")
(require "engine/level/level-h.gc")
(require "kernel/gkernel.gc")
(require "engine/collide/collide-cache-h.gc")
@@ -28,16 +27,11 @@
(defun creates-new-method? ((arg0 type) (arg1 int))
"Is the method with the given ID in the given type a new method for this type?"
;; does our parent have it?
(let ((v1-1 (-> arg0 parent allocated-length)))
(-> arg0 allocated-length)
(>= arg1 (the-as int v1-1))
)
)
(let ((v1-1 (-> arg0 parent allocated-length))) (-> arg0 allocated-length) (>= arg1 (the-as int v1-1))))
(defun overrides-parent-method? ((arg0 type) (arg1 int))
"Does the method with the given ID in the given type override a method of its parent?"
(!= (-> arg0 method-table arg1) (-> arg0 parent method-table arg1))
)
(!= (-> arg0 method-table arg1) (-> arg0 parent method-table arg1)))
(defun describe-methods ((arg0 type))
"Print information about the methods of a type."
@@ -47,25 +41,12 @@
(format #t "~3d:~%" s4-0)
(while (!= s3-0 basic)
(cond
((creates-new-method? s3-0 s4-0)
(format #t " created by ~s.~%" (symbol->string (-> s3-0 symbol)))
(set! s3-0 basic)
)
((creates-new-method? s3-0 s4-0) (format #t " created by ~s.~%" (symbol->string (-> s3-0 symbol))) (set! s3-0 basic))
((overrides-parent-method? s3-0 s4-0)
(format #t " overridden by ~s.~%" (symbol->string (-> s3-0 symbol)))
(set! s3-0 (-> s3-0 parent))
)
(else
(set! s3-0 (-> s3-0 parent))
)
)
)
)
)
)
#f
)
(set! s3-0 (-> s3-0 parent)))
(else (set! s3-0 (-> s3-0 parent))))))))
#f)
;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Collide Fragment Debug
@@ -75,36 +56,31 @@
(defun indent-to ((arg0 int))
"Print out arg0 spaces"
(dotimes (s5-0 arg0)
(format #t " ")
)
(none)
)
(format #t " "))
(none))
(defun-recursive probe-traverse-draw-node none ((arg0 draw-node) (arg1 int))
"Print out info for a draw node, and recursively its children. They forgot to finish this one."
(indent-to arg1)
(format #t "[~08x] child-count: ~d, flags: ~d, dist: ~f, child: ~a~%"
arg0
(-> arg0 child-count)
(-> arg0 flags)
(-> arg0 distance)
(-> arg0 child)
)
(cond
((nonzero? (-> arg0 flags))
(let ((s4-0 (-> arg0 child)))
(dotimes (s3-0 (the-as int (-> arg0 child-count)))
(probe-traverse-draw-node (the-as draw-node (+ (the-as uint s4-0) (* s3-0 32))) (+ arg1 1))
)
)
)
(else
;; we hit the leaves.
)
)
0
(none)
)
(defun-recursive probe-traverse-draw-node
none
((arg0 draw-node) (arg1 int))
"Print out info for a draw node, and recursively its children. They forgot to finish this one."
(indent-to arg1)
(format #t
"[~08x] child-count: ~d, flags: ~d, dist: ~f, child: ~a~%"
arg0
(-> arg0 child-count)
(-> arg0 flags)
(-> arg0 distance)
(-> arg0 child))
(cond
((nonzero? (-> arg0 flags))
(let ((s4-0 (-> arg0 child)))
(dotimes (s3-0 (the-as int (-> arg0 child-count)))
(probe-traverse-draw-node (the-as draw-node (+ (the-as uint s4-0) (* s3-0 32))) (+ arg1 1)))))
(else
;; we hit the leaves.
))
0
(none))
(defun probe-traverse-inline-array-node ((arg0 drawable-inline-array-node) (arg1 int))
"Print out a drawable-inline-array-node, and recursively all children"
@@ -114,13 +90,8 @@
(dotimes (s3-0 s4-0)
(indent-to arg1)
(format #t "(~3d) ~a~%" s3-0 (-> arg0 data s3-0))
(if (= (-> arg0 data s3-0 type) draw-node)
(probe-traverse-draw-node (-> arg0 data s3-0) (+ arg1 1))
)
)
)
(none)
)
(if (= (-> arg0 data s3-0 type) draw-node) (probe-traverse-draw-node (-> arg0 data s3-0) (+ arg1 1)))))
(none))
(defun probe-traverse-collide-fragment ((arg0 drawable-tree-collide-fragment) (arg1 int))
"Print out all levels of a drawabl-tree-collide-fragment."
@@ -130,30 +101,20 @@
(dotimes (s3-0 (+ s4-0 -1))
(indent-to arg1)
(if (= (-> arg0 data s3-0 type) drawable-inline-array-node)
(probe-traverse-inline-array-node (the-as drawable-inline-array-node (-> arg0 data s3-0)) (+ arg1 1))
(format #t "unknown: ~a~%" (-> arg0 data s3-0))
)
)
)
(none)
)
(probe-traverse-inline-array-node (the-as drawable-inline-array-node (-> arg0 data s3-0)) (+ arg1 1))
(format #t "unknown: ~a~%" (-> arg0 data s3-0)))))
(none))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Collide Probe Implementation
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(deftype collide-probe-stack-elem (structure)
((child uint32)
(count uint32)
)
)
((child uint32)
(count uint32)))
(deftype collide-probe-stack (structure)
((data collide-probe-stack-elem 1024 :inline)
)
)
((data collide-probe-stack-elem 1024 :inline)))
;;(define *collide-probe-stack* (the-as pointer (+ 4192 #x70000000)))
(define *collide-probe-stack* (scratchpad-object collide-probe-stack :offset 4192))
@@ -163,19 +124,15 @@
(def-mips2c collide-probe-node (function (inline-array draw-node) int collide-list int))
(defun print-out ((arg0 int))
(format *stdcon* "~d~%" arg0)
)
(format *stdcon* "~d~%" arg0))
(defun collide-probe-instance-tie-collide-frags ()
0
(none)
)
(none))
;; collide-probe-instance-tie
(def-mips2c collide-probe-instance-tie (function object int collide-list int int))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Collide Probe Setup/Wrappers
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
@@ -186,16 +143,12 @@
(cond
((< 1 (-> arg0 length))
(let ((v1-1 (-> arg0 data-override)))
(collide-probe-node (-> (the-as drawable-inline-array-node v1-1) data) (-> v1-1 length) arg1)
)
)
(collide-probe-node (-> (the-as drawable-inline-array-node v1-1) data) (-> v1-1 length) arg1)))
(else
;; only 1 level in the tree. this is unsupported.
)
)
;; only 1 level in the tree. this is unsupported.
))
0
(none)
)
(none))
(defun collide-probe-instance-tie-tree-make-list ((arg0 drawable-tree-instance-tie) (arg1 collide-list))
"Given a TIE instance tree, make a list.
@@ -203,28 +156,18 @@
(cond
((< 1 (-> arg0 length))
(let ((v1-2 (-> arg0 data 0)))
(collide-probe-instance-tie
(-> (the-as drawable-inline-array-node v1-2) data)
(-> (the-as drawable-inline-array-node v1-2) length)
arg1
1
)
)
)
(collide-probe-instance-tie (-> (the-as drawable-inline-array-node v1-2) data)
(-> (the-as drawable-inline-array-node v1-2) length)
arg1
1)))
((= (-> arg0 length) 1)
;; between 1 and 8. Set flag 0 to indicate that we are using instance ties.
(let ((v1-7 (-> arg0 data 0)))
(collide-probe-instance-tie
(-> (the-as drawable-inline-array-instance-tie v1-7) data)
(-> (the-as drawable-inline-array-instance-tie v1-7) length)
arg1
0
)
)
)
)
0
)
(collide-probe-instance-tie (-> (the-as drawable-inline-array-instance-tie v1-7) data)
(-> (the-as drawable-inline-array-instance-tie v1-7) length)
arg1
0))))
0)
(defun collide-upload-vu0 ()
"Upload the probe program to VU0."
@@ -233,28 +176,20 @@
;; reset the buffer
(let ((v1-0 gp-0))
(set! (-> v1-0 base) (-> v1-0 data))
(set! (-> v1-0 end) (&-> v1-0 data-buffer (-> v1-0 allocated-length)))
)
(set! (-> v1-0 end) (&-> v1-0 data-buffer (-> v1-0 allocated-length))))
;; upload the function dma
(dma-buffer-add-vu-function gp-0 collide-vu0-block 0)
;; end dma chain
(let* ((v1-1 gp-0)
(a0-5 (the-as object (-> v1-1 base)))
)
(a0-5 (the-as object (-> v1-1 base))))
(set! (-> (the-as dma-packet a0-5) dma) (new 'static 'dma-tag :id (dma-tag-id end)))
(set! (-> (the-as (pointer uint64) a0-5) 1) (the-as uint 0))
(set! (-> v1-1 base) (&+ (the-as pointer a0-5) 16))
)
(set! (-> v1-1 base) (&+ (the-as pointer a0-5) 16)))
;; go!
(.sync.l)
(dma-buffer-send-chain (the-as dma-bank-source #x10008000) gp-0)
)
)
(dma-buffer-send-chain (the-as dma-bank-source #x10008000) gp-0)))
0
(none)
)
(none))
;; main collide probe function:
@@ -264,7 +199,6 @@
0
;; load vu0 program
(collide-upload-vu0)
;; iterate over trees
(let ((s5-1 (-> s5-0 drawable-trees)))
(dotimes (s4-0 (-> s5-1 length))
@@ -276,56 +210,30 @@
(cond
((< 1 (-> v1-3 length))
(let ((v1-4 (-> v1-3 data 0)))
(collide-probe-instance-tie
(-> (the-as drawable-inline-array-node v1-4) data)
(-> (the-as drawable-inline-array-node v1-4) length)
a2-0
1
)
)
)
(collide-probe-instance-tie (-> (the-as drawable-inline-array-node v1-4) data)
(-> (the-as drawable-inline-array-node v1-4) length)
a2-0
1)))
((= (-> v1-3 length) 1)
(let ((v1-6 (-> v1-3 data 0)))
(collide-probe-instance-tie
(-> (the-as drawable-inline-array-instance-tie v1-6) data)
(-> (the-as drawable-inline-array-instance-tie v1-6) length)
a2-0
0
)
)
)
)
)
0
)
(collide-probe-instance-tie (-> (the-as drawable-inline-array-instance-tie v1-6) data)
(-> (the-as drawable-inline-array-instance-tie v1-6) length)
a2-0
0)))))
0)
((= (-> v1-3 type) drawable-tree-collide-fragment)
;; collide with tfrags
(let ((a2-1 arg1))
(cond
((< 1 (-> v1-3 length))
(let ((v1-9 (-> v1-3 data 0)))
(collide-probe-node
(-> (the-as drawable-inline-array-node v1-9) data)
(-> (the-as drawable-inline-array-node v1-9) length)
a2-1
)
)
)
(else
)
)
)
0
)
(else
)
)
)
)
)
)
(none)
)
(collide-probe-node (-> (the-as drawable-inline-array-node v1-9) data)
(-> (the-as drawable-inline-array-node v1-9) length)
a2-1)))
(else)))
0)
(else))))))
(none))
;;;;;;;;;;;;;;;;;;;
;; Hacks
@@ -336,65 +244,32 @@
(defun distc ((arg0 vector) (arg1 vector))
(let* ((f0-1 (- (-> arg0 x) (-> arg1 x)))
(f0-3 (* f0-1 f0-1))
(f1-2 (- (-> arg0 z) (-> arg1 z)))
)
(sqrtf (+ f0-3 (* f1-2 f1-2)))
)
)
(f1-2 (- (-> arg0 z) (-> arg1 z))))
(sqrtf (+ f0-3 (* f1-2 f1-2)))))
(defun interpolate ((arg0 float) (arg1 float) (arg2 float) (arg3 float) (arg4 float))
(let ((f0-1 (- arg3 arg1))
(f1-2 (- arg4 arg2))
(f3-1 (- arg0 arg1))
)
(+ arg2 (/ (* f3-1 f1-2) f0-1))
)
)
(f3-1 (- arg0 arg1)))
(+ arg2 (/ (* f3-1 f1-2) f0-1))))
(defun misty-ambush-height ((arg0 vector))
(let* ((a1-0 (new 'static 'vector :x -808960.0 :y 111656.96 :z 3924992.0))
(f0-0 (distc arg0 a1-0))
)
(f0-0 (distc arg0 a1-0)))
(cond
((< f0-0 52019.2)
111656.96
)
((>= 58982.4 f0-0)
(interpolate f0-0 52019.2 111656.96 58982.4 116776.96)
)
((>= 124436.48 f0-0)
(interpolate f0-0 58982.4 116776.96 124436.48 114688.0)
)
((>= 219217.92 f0-0)
(interpolate f0-0 124436.48 114688.0 219217.92 113254.4)
)
(else
113254.4
)
)
)
)
((< f0-0 52019.2) 111656.96)
((>= 58982.4 f0-0) (interpolate f0-0 52019.2 111656.96 58982.4 116776.96))
((>= 124436.48 f0-0) (interpolate f0-0 58982.4 116776.96 124436.48 114688.0))
((>= 219217.92 f0-0) (interpolate f0-0 124436.48 114688.0 219217.92 113254.4))
(else 113254.4))))
(defun misty-ambush-height-probe ((arg0 vector) (arg1 float))
"Hack to manually compute the ground height in misty ambush."
(let ((f0-0 (misty-ambush-height arg0)))
(cond
((< f0-0 (-> arg0 y))
(/ (- (-> arg0 y) f0-0) arg1)
)
(else
(format 0 "WARNING: ~%height = ~f, pos.y = ~f" (* 0.00024414062 f0-0) (* 0.00024414062 (-> arg0 y)))
-1.0
)
)
)
)
((< f0-0 (-> arg0 y)) (/ (- (-> arg0 y) f0-0) arg1))
(else (format 0 "WARNING: ~%height = ~f, pos.y = ~f" (* 0.00024414062 f0-0) (* 0.00024414062 (-> arg0 y))) -1.0))))
(defun pke-collide-test ()
0
(none)
)
(none))
+266 -333
View File
@@ -1,7 +1,6 @@
;;-*-Lisp-*-
(in-package goal)
(bundles "ENGINE.CGO" "GAME.CGO")
(require "engine/collide/pat-h.gc")
(require "engine/math/quaternion.gc")
(require "kernel/gkernel-h.gc")
@@ -42,7 +41,6 @@
;; - uses "collide-mesh-cache".
;; - can't collide with water or the background.
;; The "new" system:
;; - is the only way to collide with the background/water
;; - uses "collide-cache"
@@ -53,7 +51,6 @@
;; foreground meshes. The new system can just import foreground collision meshes
;; into its collide cache.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Collision queries:
@@ -74,7 +71,6 @@
;; This will call the reaction function. The default "default-collision-reaction" function is in collide-shape.gc
;; will fill the touching list.
;; Nav Enemy Collision (made up name)
;; collide-shape-moving-method-58 and integrate-for-enemy-with-move-to-ground are nav-enemy specific.
;; the details aren't super well understood yet. But they basically try to go forward if they aren't blocked.
@@ -87,8 +83,8 @@
;; for platforms, detect if somebody is on the platform. (on-platform-test)
;; uses old system. Sends event adds to rider list.
(declare-type touching-list structure)
(declare-type collide-shape-prim basic)
;; DECOMP BEGINS
@@ -101,57 +97,43 @@
;; Sticky: when you hit the platform, your velocity immediately changes to match the thing.
;; like when Jak lands on a platform.
(deftype collide-sticky-rider (structure)
((rider-handle handle)
(sticky-prim collide-shape-prim)
(prim-ry float)
(rider-local-pos vector :inline)
)
((rider-handle handle)
(sticky-prim collide-shape-prim)
(prim-ry float)
(rider-local-pos vector :inline))
(:methods
(set-rider! (_type_ handle) symbol)
)
)
(set-rider! (_type_ handle) symbol)))
(defmethod set-rider! ((this collide-sticky-rider) (arg0 handle))
"Set the rider and clear the primitive."
(set! (-> this rider-handle) arg0)
(set! (-> this sticky-prim) #f)
#f
)
#f)
;; A collection of collide-sticky-riders
;; dynamic type. There's one collide-sticky-rider per rider.
(deftype collide-sticky-rider-group (basic)
((num-riders int32)
(allocated-riders int32)
(rider collide-sticky-rider 1 :inline)
)
((num-riders int32)
(allocated-riders int32)
(rider collide-sticky-rider 1 :inline))
(:methods
(new (symbol type int) _type_)
(add-rider! (_type_ process-drawable) collide-sticky-rider)
(reset! (_type_) int)
)
)
(new (symbol type int) _type_)
(add-rider! (_type_ process-drawable) collide-sticky-rider)
(reset! (_type_) int)))
(defmethod reset! ((this collide-sticky-rider-group))
"Reset all active riders"
(set! (-> this num-riders) 0)
0
)
0)
;; The rider will be pulled along by the object.
;; This includes possibly rotating the rider (if the platform spins, it spins Jak too).
(deftype pull-rider-info (structure)
((rider collide-sticky-rider)
(rider-cshape collide-shape-moving)
(rider-delta-ry float)
(rider-dest vector :inline)
)
)
((rider collide-sticky-rider)
(rider-cshape collide-shape-moving)
(rider-delta-ry float)
(rider-dest vector :inline)))
;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Collision Result
@@ -161,37 +143,29 @@
;; this computes a "move-vec" and "u". If you move along "move-vec" by "u", you will move out of collsion.
;; It also tells you which primitives are colliding.
(deftype collide-shape-intersect (basic)
((move-vec vector :inline)
(best-u float)
(best-tri collide-tri-result :inline)
(best-from-prim collide-shape-prim)
(best-to-prim collide-shape-prim)
)
((move-vec vector :inline)
(best-u float)
(best-tri collide-tri-result :inline)
(best-from-prim collide-shape-prim)
(best-to-prim collide-shape-prim))
(:methods
(init! (_type_ vector) symbol)
)
)
(init! (_type_ vector) symbol)))
;; Collision with just overlap distance, no vector.
(deftype collide-overlap-result (structure)
((best-dist float)
(best-from-prim collide-shape-prim)
(best-to-prim collide-shape-prim)
(best-from-tri collide-tri-result :inline)
)
((best-dist float)
(best-from-prim collide-shape-prim)
(best-to-prim collide-shape-prim)
(best-from-tri collide-tri-result :inline))
(:methods
(reset! (_type_) none)
)
)
(reset! (_type_) none)))
(defmethod reset! ((this collide-overlap-result))
"Reset the result."
(set! (-> this best-dist) 0.0)
(set! (-> this best-from-prim) #f)
(set! (-> this best-to-prim) #f)
(none)
)
(none))
;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Touching System
@@ -201,24 +175,24 @@
;; but this isn't well understood yet
(deftype overlaps-others-params (structure)
((options uint32)
(tlist touching-list)
)
)
((options uint32)
(tlist touching-list)))
;; The engine system is used to link collision checks with processes.
;; This allows you to have lists of processes where the process will remove itself when it dies.
(define *collide-hit-by-player-list* (new 'global 'engine 'collide-hit-by-player-list 768))
(define *collide-usually-hit-by-player-list* (new 'global 'engine 'collide-usually-hit-by-player-list 256))
(define *collide-hit-by-others-list* (new 'global 'engine 'collide-hit-by-others-list 96))
(define *collide-player-list* (new 'global 'engine 'collide-player-list 32))
(defenum collide-list-enum
(hit-by-player)
(usually-hit-by-player)
(hit-by-others)
(player)
)
(player))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Collision Primitive Base
@@ -226,7 +200,6 @@
;; These are the settings that can be set per primitive.
(defenum collide-kind
:type uint64
:bitfield #t
@@ -293,29 +266,28 @@
(unknown-60 60)
(unknown-61 61)
(unknown-62 62)
(unknown-63 63)
)
(unknown-63 63))
(defenum collide-action
:type uint32
:bitfield #t
(solid 0) ;; used for solid things
(rider-plat-sticky 1) ;; used for platforms in rider/platform interactions
(rider-target 2) ;; used for target in rider/platform interactions
(edgegrab-active 3) ;; set/cleared when entering/exiting edgegrab states
(rider-plat 4) ;; used for platforms in rider/platform interactions
(unused 5) ;; totally unused?
(edgegrab-possible 6) ;; used when edge grab checks should be done
(edgegrab-cam 7) ;; set/cleared when entering/exiting edgegrab states
(swingpole-active 8) ;; set/cleared when entering/exiting swingpole states
(racer 9) ;; set/cleared when entering/exiting racer states
(attackable 10) ;; used for something to do with attacking/damaging
(solid 0) ;; used for solid things
(rider-plat-sticky 1) ;; used for platforms in rider/platform interactions
(rider-target 2) ;; used for target in rider/platform interactions
(edgegrab-active 3) ;; set/cleared when entering/exiting edgegrab states
(rider-plat 4) ;; used for platforms in rider/platform interactions
(unused 5) ;; totally unused?
(edgegrab-possible 6) ;; used when edge grab checks should be done
(edgegrab-cam 7) ;; set/cleared when entering/exiting edgegrab states
(swingpole-active 8) ;; set/cleared when entering/exiting swingpole states
(racer 9) ;; set/cleared when entering/exiting racer states
(attackable 10) ;; used for something to do with attacking/damaging
(attackable-unused 11) ;; seems to relate to attacking - set in several places but never tested for?
(snowball 12) ;; set/cleared when entering/exiting snowball states
(tube 13) ;; set/cleared when entering/exiting tube states
(flut 14) ;; set/cleared when entering/exiting flutflut states
(racer-grounded 15) ;; set/cleared when entering/exiting certain racer states w/ extra conditions
(racer-unused 16) ;; seems to relate to racer - never set, only cleared in one place?
(snowball 12) ;; set/cleared when entering/exiting snowball states
(tube 13) ;; set/cleared when entering/exiting tube states
(flut 14) ;; set/cleared when entering/exiting flutflut states
(racer-grounded 15) ;; set/cleared when entering/exiting certain racer states w/ extra conditions
(racer-unused 16) ;; seems to relate to racer - never set, only cleared in one place?
)
;; this field is a bit confusing. you have to have a higher offense to win against an object.
@@ -325,70 +297,67 @@
(defenum collide-offense
:type int8
(no-offense 0)
(touch 1) ;; just have to touch
(normal-attack 2) ;; any attack (like a normal crate)
(strong-attack 3) ;; hit with zoomer, slide, ground pound/flop, flut attack
(indestructible 4) ;; can't attack it.
(touch 1) ;; just have to touch
(normal-attack 2) ;; any attack (like a normal crate)
(strong-attack 3) ;; hit with zoomer, slide, ground pound/flop, flut attack
(indestructible 4) ;; can't attack it.
)
;; Every primitive has a prim-core.
;; this is a 32-byte chunk of data that can be pulled out an put in collide caches
;; it stores the transformed world sphere and the collision settings
(deftype collide-prim-core (structure)
((world-sphere vector :inline)
(collide-as collide-kind)
(action collide-action)
(offense collide-offense)
(prim-type int8)
(extra uint8 2)
(quad uint128 2 :overlay-at (-> world-sphere quad))
)
)
((world-sphere vector :inline)
(collide-as collide-kind)
(action collide-action)
(offense collide-offense)
(prim-type int8)
(extra uint8 2)
(quad uint128 2 :overlay-at (-> world-sphere quad))))
(declare-type collide-shape basic)
(declare-type collide-cache-prim structure)
(declare-type collide-shape-prim-group basic)
(declare-type collide-cache basic)
;; the base class for collision shapes.
(deftype collide-shape-prim (basic)
((cshape collide-shape)
(prim-id uint32)
(transform-index int8)
(prim-core collide-prim-core :inline)
(local-sphere vector :inline)
(collide-with collide-kind)
(world-sphere vector :inline :overlay-at (-> prim-core world-sphere))
(collide-as collide-kind :overlay-at (-> prim-core collide-as))
(action collide-action :overlay-at (-> prim-core action))
(offense collide-offense :overlay-at (-> prim-core offense))
(prim-type int8 :overlay-at (-> prim-core prim-type))
(radius meters :overlay-at (-> local-sphere w))
)
((cshape collide-shape)
(prim-id uint32)
(transform-index int8)
(prim-core collide-prim-core :inline)
(local-sphere vector :inline)
(collide-with collide-kind)
(world-sphere vector :inline :overlay-at (-> prim-core world-sphere))
(collide-as collide-kind :overlay-at (-> prim-core collide-as))
(action collide-action :overlay-at (-> prim-core action))
(offense collide-offense :overlay-at (-> prim-core offense))
(prim-type int8 :overlay-at (-> prim-core prim-type))
(radius meters :overlay-at (-> local-sphere w)))
(:methods
(new (symbol type collide-shape uint int) _type_)
(move-by-vector! (_type_ vector) none)
(find-prim-by-id (_type_ uint) collide-shape-prim)
(debug-draw-world-sphere (_type_) symbol)
(add-fg-prim-using-box (_type_ collide-cache) none)
(add-fg-prim-using-line-sphere (_type_ collide-cache) none)
(add-fg-prim-using-y-probe (_type_ collide-cache) none)
(overlaps-others-test (_type_ overlaps-others-params collide-shape-prim) symbol)
(overlaps-others-group (_type_ overlaps-others-params collide-shape-prim-group) symbol)
(unused-17 () none)
(collide-with-collide-cache-prim-mesh (_type_ collide-shape-intersect collide-cache-prim) none)
(collide-with-collide-cache-prim-sphere (_type_ collide-shape-intersect collide-cache-prim) none)
(add-to-bounding-box (_type_ collide-kind) symbol)
(num-mesh (_type_ collide-shape-prim) int)
(on-platform-test (_type_ collide-shape-prim collide-overlap-result float) none)
(should-push-away-test (_type_ collide-shape-prim collide-overlap-result) none)
(should-push-away-reverse-test (_type_ collide-shape-prim-group collide-overlap-result) none)
(update-transforms! (_type_ process-drawable) symbol)
(set-collide-as! (_type_ collide-kind) none)
(set-collide-with! (_type_ collide-kind) none)
)
)
(new (symbol type collide-shape uint int) _type_)
(move-by-vector! (_type_ vector) none)
(find-prim-by-id (_type_ uint) collide-shape-prim)
(debug-draw-world-sphere (_type_) symbol)
(add-fg-prim-using-box (_type_ collide-cache) none)
(add-fg-prim-using-line-sphere (_type_ collide-cache) none)
(add-fg-prim-using-y-probe (_type_ collide-cache) none)
(overlaps-others-test (_type_ overlaps-others-params collide-shape-prim) symbol)
(overlaps-others-group (_type_ overlaps-others-params collide-shape-prim-group) symbol)
(unused-17 () none)
(collide-with-collide-cache-prim-mesh (_type_ collide-shape-intersect collide-cache-prim) none)
(collide-with-collide-cache-prim-sphere (_type_ collide-shape-intersect collide-cache-prim) none)
(add-to-bounding-box (_type_ collide-kind) symbol)
(num-mesh (_type_ collide-shape-prim) int)
(on-platform-test (_type_ collide-shape-prim collide-overlap-result float) none)
(should-push-away-test (_type_ collide-shape-prim collide-overlap-result) none)
(should-push-away-reverse-test (_type_ collide-shape-prim-group collide-overlap-result) none)
(update-transforms! (_type_ process-drawable) symbol)
(set-collide-as! (_type_ collide-kind) none)
(set-collide-with! (_type_ collide-kind) none)))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Specific Collision Implementation
@@ -402,43 +371,34 @@
;; the pat is stored directly here.
;; I believe the "local sphere" is used as the sphere.
(deftype collide-shape-prim-sphere (collide-shape-prim)
((pat pat-surface)
)
((pat pat-surface))
(:methods
(new (symbol type collide-shape uint) _type_)
)
)
(new (symbol type collide-shape uint) _type_)))
;; mesh collision
;; the pats are stored per tri in the mesh.
;; These meshes interact with a cache automatically (a specific collide-shape-prim-mesh cache, not the
;; more general collide-cache)
(deftype collide-shape-prim-mesh (collide-shape-prim)
((mesh collide-mesh)
(mesh-id int32)
(mesh-cache-id uint64)
(mesh-cache-tris (inline-array collide-mesh-cache-tri))
)
((mesh collide-mesh)
(mesh-id int32)
(mesh-cache-id uint64)
(mesh-cache-tris (inline-array collide-mesh-cache-tri)))
(:methods
(new (symbol type collide-shape uint uint) _type_)
(change-mesh (_type_ int) none)
)
)
(new (symbol type collide-shape uint uint) _type_)
(change-mesh (_type_ int) none)))
;; A group of collide-shape-prim's
(deftype collide-shape-prim-group (collide-shape-prim)
((num-prims int32)
(num-prims-u uint32 :overlay-at num-prims)
(allocated-prims int32)
(prim collide-shape-prim 1)
(prims collide-shape-prim :dynamic :overlay-at (-> prim 0))
)
((num-prims int32)
(num-prims-u uint32 :overlay-at num-prims)
(allocated-prims int32)
(prim collide-shape-prim 1)
(prims collide-shape-prim :dynamic :overlay-at (-> prim 0)))
(:methods
(new (symbol type collide-shape uint int) _type_)
(append-prim (_type_ collide-shape-prim) none)
(add-to-non-empty-bounding-box (_type_ collide-kind) none)
)
)
(new (symbol type collide-shape uint int) _type_)
(append-prim (_type_ collide-shape-prim) none)
(add-to-non-empty-bounding-box (_type_ collide-kind) none)))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Collide Shape
@@ -452,6 +412,7 @@
;; - riders
(declare-type collide-work structure)
(declare-type touching-shapes-entry structure)
(defenum nav-flags
@@ -464,55 +425,51 @@
(navf4 4)
(navf5 5)
(navf6 6)
(navf7 7)
)
(navf7 7))
;; we're a child of trsqv, so we store a full transform + derivative.
(deftype collide-shape (trsqv)
((process process-drawable)
(max-iteration-count uint8)
(nav-flags nav-flags)
(pad-byte uint8 2)
(pat-ignore-mask pat-surface)
(event-self symbol)
(event-other symbol)
(root-prim collide-shape-prim)
(riders collide-sticky-rider-group)
(backup-collide-as collide-kind)
(backup-collide-with collide-kind)
)
((process process-drawable)
(max-iteration-count uint8)
(nav-flags nav-flags)
(pad-byte uint8 2)
(pat-ignore-mask pat-surface)
(event-self symbol)
(event-other symbol)
(root-prim collide-shape-prim)
(riders collide-sticky-rider-group)
(backup-collide-as collide-kind)
(backup-collide-with collide-kind))
(:methods
(new (symbol type process-drawable collide-list-enum) _type_)
(move-by-vector! (_type_ vector) none)
(alloc-riders (_type_ int) none)
(move-to-point! (_type_ vector) none)
(debug-draw (_type_) none)
(fill-cache-for-shape! (_type_ float collide-kind) none)
(fill-cache-integrate-and-collide! (_type_ vector collide-kind) none)
(find-prim-by-id (_type_ uint) collide-shape-prim)
(detect-riders! (_type_) symbol)
(build-bounding-box-for-shape (_type_ bounding-box float collide-kind) symbol)
(integrate-and-collide! (_type_ vector) none)
(find-collision-meshes (_type_) symbol)
(on-platform (_type_ collide-shape collide-overlap-result) symbol)
(find-overlapping-shapes (_type_ overlaps-others-params) symbol)
(calc-shove-up (_type_ attack-info float) vector)
(should-push-away (_type_ collide-shape collide-overlap-result) symbol)
(pull-rider! (_type_ pull-rider-info) none)
(pull-riders! (_type_) symbol)
(do-push-aways! (_type_) symbol)
(set-root-prim! (_type_ collide-shape-prim) collide-shape-prim)
(update-transforms! (_type_) symbol)
(clear-collide-with-as (_type_) none)
(restore-collide-with-as (_type_) none)
(backup-collide-with-as (_type_) none)
(set-root-prim-collide-with! (_type_ collide-kind) none)
(set-root-prim-collide-as! (_type_ collide-kind) none)
(set-collide-kinds (_type_ int collide-kind collide-kind) none)
(set-collide-offense (_type_ int collide-offense) none)
(send-shove-back (_type_ process touching-shapes-entry float float float) none)
)
)
(new (symbol type process-drawable collide-list-enum) _type_)
(move-by-vector! (_type_ vector) none)
(alloc-riders (_type_ int) none)
(move-to-point! (_type_ vector) none)
(debug-draw (_type_) none)
(fill-cache-for-shape! (_type_ float collide-kind) none)
(fill-cache-integrate-and-collide! (_type_ vector collide-kind) none)
(find-prim-by-id (_type_ uint) collide-shape-prim)
(detect-riders! (_type_) symbol)
(build-bounding-box-for-shape (_type_ bounding-box float collide-kind) symbol)
(integrate-and-collide! (_type_ vector) none)
(find-collision-meshes (_type_) symbol)
(on-platform (_type_ collide-shape collide-overlap-result) symbol)
(find-overlapping-shapes (_type_ overlaps-others-params) symbol)
(calc-shove-up (_type_ attack-info float) vector)
(should-push-away (_type_ collide-shape collide-overlap-result) symbol)
(pull-rider! (_type_ pull-rider-info) none)
(pull-riders! (_type_) symbol)
(do-push-aways! (_type_) symbol)
(set-root-prim! (_type_ collide-shape-prim) collide-shape-prim)
(update-transforms! (_type_) symbol)
(clear-collide-with-as (_type_) none)
(restore-collide-with-as (_type_) none)
(backup-collide-with-as (_type_) none)
(set-root-prim-collide-with! (_type_ collide-kind) none)
(set-root-prim-collide-as! (_type_ collide-kind) none)
(set-collide-kinds (_type_ int collide-kind collide-kind) none)
(set-collide-offense (_type_ int collide-offense) none)
(send-shove-back (_type_ process touching-shapes-entry float float float) none)))
(defenum cshape-moving-flags
:bitfield #t
@@ -546,8 +503,7 @@
(csmf26)
(csmf27)
(csmf28)
(csmf29)
)
(csmf29))
(defenum cshape-reaction-flags
:bitfield #t
@@ -583,49 +539,45 @@
(csrf28)
(csrf29)
(csrf30)
(csrf31)
)
(csrf31))
;; A collide-shape for independently moving objects
(deftype collide-shape-moving (collide-shape)
((rider-time time-frame)
(rider-last-move vector :inline)
(trans-old vector 3 :inline)
(poly-pat pat-surface)
(cur-pat pat-surface)
(ground-pat pat-surface)
(status cshape-moving-flags)
(old-status cshape-moving-flags)
(prev-status cshape-moving-flags)
(reaction-flag cshape-reaction-flags)
(reaction (function collide-shape-moving collide-shape-intersect vector vector cshape-moving-flags))
(no-reaction (function collide-shape-moving collide-shape-intersect vector vector none))
(local-normal vector :inline)
(surface-normal vector :inline)
(poly-normal vector :inline)
(ground-poly-normal vector :inline)
(ground-touch-point vector :inline)
(shadow-pos vector :inline)
(ground-impact-vel meters)
(surface-angle float)
(poly-angle float)
(touch-angle float)
(coverage float)
(dynam dynamics)
(surf surface)
)
((rider-time time-frame)
(rider-last-move vector :inline)
(trans-old vector 3 :inline)
(poly-pat pat-surface)
(cur-pat pat-surface)
(ground-pat pat-surface)
(status cshape-moving-flags)
(old-status cshape-moving-flags)
(prev-status cshape-moving-flags)
(reaction-flag cshape-reaction-flags)
(reaction (function collide-shape-moving collide-shape-intersect vector vector cshape-moving-flags))
(no-reaction (function collide-shape-moving collide-shape-intersect vector vector none))
(local-normal vector :inline)
(surface-normal vector :inline)
(poly-normal vector :inline)
(ground-poly-normal vector :inline)
(ground-touch-point vector :inline)
(shadow-pos vector :inline)
(ground-impact-vel meters)
(surface-angle float)
(poly-angle float)
(touch-angle float)
(coverage float)
(dynam dynamics)
(surf surface))
(:methods
(set-and-handle-pat! (_type_ pat-surface) none)
(integrate-no-collide! (_type_ vector) none)
(collide-shape-moving-method-58 (_type_ vector) symbol)
(integrate-for-enemy-with-move-to-ground! (_type_ vector collide-kind float symbol symbol symbol) none)
(move-to-ground (_type_ float float symbol collide-kind) symbol)
(move-to-ground-point! (_type_ vector vector vector) none)
(compute-acc-due-to-gravity (_type_ vector float) vector)
(step-collison! (_type_ vector vector float) float)
(move-to-tri! (_type_ collide-tri-result vector) none)
)
)
(set-and-handle-pat! (_type_ pat-surface) none)
(integrate-no-collide! (_type_ vector) none)
(collide-shape-moving-method-58 (_type_ vector) symbol)
(integrate-for-enemy-with-move-to-ground! (_type_ vector collide-kind float symbol symbol symbol) none)
(move-to-ground (_type_ float float symbol collide-kind) symbol)
(move-to-ground-point! (_type_ vector vector vector) none)
(compute-acc-due-to-gravity (_type_ vector float) vector)
(step-collison! (_type_ vector vector float) float)
(move-to-tri! (_type_ collide-tri-result vector) none)))
;;;;;;;;;;;;;;;;;;;;
;; Basic Methods
@@ -641,61 +593,53 @@
(set! (-> v0-0 transform-index) -2)
(set! (-> v0-0 prim-core offense) (collide-offense no-offense))
(set! (-> v0-0 prim-core prim-type) -2)
v0-0
)
)
v0-0))
(defmethod new collide-shape-prim-sphere ((allocation symbol) (type-to-make type) (cshape collide-shape) (prim-id uint))
"Allocate a new sphere primitive"
(let ((this (the collide-shape-prim-sphere ((method-of-type collide-shape-prim new) allocation type-to-make cshape prim-id (size-of collide-shape-prim-sphere)))))
(set! (-> this pat) (new 'static 'pat-surface :mode (pat-mode obstacle)))
(set! (-> this prim-core prim-type) -1)
this
)
)
(let ((this (the collide-shape-prim-sphere
((method-of-type collide-shape-prim new) allocation type-to-make cshape prim-id (size-of collide-shape-prim-sphere)))))
(set! (-> this pat) (new 'static 'pat-surface :mode (pat-mode obstacle)))
(set! (-> this prim-core prim-type) -1)
this))
(defmethod new collide-shape-prim-mesh ((allocation symbol) (type-to-make type) (cshape collide-shape) (mesh-id uint) (prim-id uint))
"Allocate a new mesh primitive"
(let ((this (the collide-shape-prim-mesh ((method-of-type collide-shape-prim new) allocation type-to-make cshape prim-id (size-of collide-shape-prim-mesh)))))
(let ((this (the collide-shape-prim-mesh
((method-of-type collide-shape-prim new) allocation type-to-make cshape prim-id (size-of collide-shape-prim-mesh)))))
(set! (-> this mesh) #f)
(set! (-> this mesh-id) (the-as int mesh-id))
(set! (-> this mesh-cache-id) (the-as uint 0))
(set! (-> this prim-core prim-type) 1)
(the-as collide-shape-prim-mesh this)
)
)
(the-as collide-shape-prim-mesh this)))
(defmethod new collide-shape-prim-group ((allocation symbol) (type-to-make type) (cshape collide-shape) (elt-count uint) (prim-id int))
"Allocate a group of primitives."
(let ((this (the collide-shape-prim-group ((method-of-type collide-shape-prim new) allocation type-to-make cshape (the uint prim-id) (the int (+ (-> type-to-make size) (* (+ elt-count -1) 4)))))))
(let ((this (the collide-shape-prim-group
((method-of-type collide-shape-prim new) allocation
type-to-make
cshape
(the uint prim-id)
(the int (+ (-> type-to-make size) (* (+ elt-count -1) 4)))))))
(set! (-> this allocated-prims) (the int elt-count))
(set! (-> this num-prims) 0)
(set! (-> this prim-core prim-type) 0)
(while (nonzero? elt-count)
(+! elt-count -1)
(set! (-> this prim elt-count) (the collide-shape-prim #f))
(nop!)
)
this
)
)
(nop!))
this))
(defmethod length ((this collide-shape-prim-group))
"How many primitives are used?"
(-> this num-prims)
)
(-> this num-prims))
(defmethod asize-of ((this collide-shape-prim-group))
"How big is this in memory?"
(the-as int (+ (-> this type size) (* (+ (-> this allocated-prims) -1) 4)))
)
(the-as int (+ (-> this type size) (* (+ (-> this allocated-prims) -1) 4))))
(defmethod new collide-shape ((allocation symbol) (type-to-make type) (proc process-drawable) (collide-list-kind collide-list-enum))
"Allocate a new collide-shape and add to a collide-list"
(let ((this (object-new allocation type-to-make (the int (-> type-to-make size)))))
(set! (-> this process) proc)
(set! (-> this max-iteration-count) 1)
@@ -704,84 +648,73 @@
(set! (-> this event-other) #f)
(set! (-> this riders) #f)
(set! (-> this root-prim) #f)
(case (-> proc type symbol)
(('camera)
(set! (-> this pat-ignore-mask) (new 'static 'pat-surface :nocamera #x1))
)
(else
(set! (-> this pat-ignore-mask) (new 'static 'pat-surface :noentity #x1))
)
)
(('camera) (set! (-> this pat-ignore-mask) (new 'static 'pat-surface :nocamera #x1)))
(else (set! (-> this pat-ignore-mask) (new 'static 'pat-surface :noentity #x1))))
;; reset transformation to the origin.
(set! (-> this trans w) 1.0)
(quaternion-identity! (-> this quat))
(vector-identity! (-> this scale))
;; add us to right list.
(case collide-list-kind
(((collide-list-enum hit-by-player))
(add-connection *collide-hit-by-player-list* proc #f this #f #f))
(((collide-list-enum usually-hit-by-player))
(add-connection *collide-usually-hit-by-player-list* proc #f this #f #f))
(((collide-list-enum hit-by-others))
(add-connection *collide-hit-by-others-list* proc #f this #f #f))
(((collide-list-enum player))
(add-connection *collide-player-list* proc #f this #f #f))
(else
(format 0 "Unsupported collide-list-enum in collide-shape constructor!~%")
)
)
this
)
)
(((collide-list-enum hit-by-player)) (add-connection *collide-hit-by-player-list* proc #f this #f #f))
(((collide-list-enum usually-hit-by-player)) (add-connection *collide-usually-hit-by-player-list* proc #f this #f #f))
(((collide-list-enum hit-by-others)) (add-connection *collide-hit-by-others-list* proc #f this #f #f))
(((collide-list-enum player)) (add-connection *collide-player-list* proc #f this #f #f))
(else (format 0 "Unsupported collide-list-enum in collide-shape constructor!~%")))
this))
(defmethod new collide-sticky-rider-group ((allocation symbol) (type-to-make type) (riders-amount int))
"Allocate a new collide-sticky-rider-group with space for riders-amount sticky riders."
(let ((this (object-new allocation type-to-make (the int (+ (-> type-to-make size) (the uint (* (1- riders-amount) (size-of collide-sticky-rider))))))))
(set! (-> this allocated-riders) riders-amount)
(set! (-> this num-riders) 0)
this
)
)
(let ((this (object-new allocation
type-to-make
(the int (+ (-> type-to-make size) (the uint (* (1 - riders-amount) (size-of collide-sticky-rider))))))))
(set! (-> this allocated-riders) riders-amount)
(set! (-> this num-riders) 0)
this))
(defmethod length ((this collide-sticky-rider-group))
(-> this num-riders)
)
(-> this num-riders))
(defmethod asize-of ((this collide-sticky-rider-group))
(the-as int (+ (-> this type size) (* (+ (-> this allocated-riders) -1) 32)))
)
(the-as int (+ (-> this type size) (* (+ (-> this allocated-riders) -1) 32))))
(define *collide-shape-prim-backgnd* (new 'static 'collide-shape-prim-mesh
:cshape #f
:prim-core (new 'static 'collide-prim-core
:world-sphere (new 'static 'vector :w 204800000.0)
:collide-as (collide-kind background)
:action (collide-action solid)
:offense (collide-offense indestructible)
:prim-type 2
)
:local-sphere (new 'static 'vector :w 204800000.0)
:mesh #f
)
)
(define *collide-shape-prim-backgnd*
(new 'static
'collide-shape-prim-mesh
:cshape #f
:prim-core
(new 'static
'collide-prim-core
:world-sphere
(new 'static 'vector :w 204800000.0)
:collide-as
(collide-kind background)
:action
(collide-action solid)
:offense
(collide-offense indestructible)
:prim-type 2)
:local-sphere
(new 'static 'vector :w 204800000.0)
:mesh #f))
(define *collide-shape-prim-water* (new 'static 'collide-shape-prim-mesh
:cshape #f
:prim-core (new 'static 'collide-prim-core
:world-sphere (new 'static 'vector :w 204800000.0)
:collide-as (collide-kind water)
:action (collide-action solid)
:offense (collide-offense indestructible)
:prim-type 2
)
:local-sphere (new 'static 'vector :w 204800000.0)
:mesh #f
)
)
(define *collide-shape-prim-water*
(new 'static
'collide-shape-prim-mesh
:cshape #f
:prim-core
(new 'static
'collide-prim-core
:world-sphere
(new 'static 'vector :w 204800000.0)
:collide-as
(collide-kind water)
:action
(collide-action solid)
:offense
(collide-offense indestructible)
:prim-type 2)
:local-sphere
(new 'static 'vector :w 204800000.0)
:mesh #f))
@@ -1,7 +1,6 @@
;;-*-Lisp-*-
(in-package goal)
(bundles "ENGINE.CGO" "GAME.CGO")
(require "engine/collide/collide-shape.gc")
;; name: collide-shape-rider.gc
@@ -12,40 +11,22 @@
(defmethod on-platform ((this collide-shape) (arg0 collide-shape) (arg1 collide-overlap-result))
"Are we on the platform? Returns #t/#f and also sets an overlap result."
(let ((v1-0 arg1))
(set! (-> v1-0 best-dist) 0.0)
(set! (-> v1-0 best-from-prim) #f)
(set! (-> v1-0 best-to-prim) #f)
)
(let ((v1-0 arg1)) (set! (-> v1-0 best-dist) 0.0) (set! (-> v1-0 best-from-prim) #f) (set! (-> v1-0 best-to-prim) #f))
(set! (-> arg1 best-dist) 122.88)
(let ((s5-0 (-> this root-prim))
(s4-0 (-> arg0 root-prim))
)
(s4-0 (-> arg0 root-prim)))
(when (and (logtest? (-> s5-0 collide-with) (-> s4-0 prim-core collide-as))
(logtest? (-> s5-0 prim-core action) (collide-action rider-plat-sticky))
(logtest? (-> s4-0 prim-core action) (collide-action rider-target))
)
(logtest? (-> s4-0 prim-core action) (collide-action rider-target)))
(let ((f0-4 (- (- (vector-vector-distance (the-as vector (-> s5-0 prim-core)) (the-as vector (-> s4-0 prim-core)))
(-> s5-0 prim-core world-sphere w)
)
(-> s4-0 prim-core world-sphere w)
)
)
)
(if (< f0-4 122.88)
(on-platform-test s5-0 s4-0 arg1 f0-4)
)
)
)
)
(< (-> arg1 best-dist) 122.88)
)
(-> s5-0 prim-core world-sphere w))
(-> s4-0 prim-core world-sphere w))))
(if (< f0-4 122.88) (on-platform-test s5-0 s4-0 arg1 f0-4)))))
(< (-> arg1 best-dist) 122.88))
(defmethod on-platform-test ((this collide-shape-prim) (arg0 collide-shape-prim) (arg1 collide-overlap-result) (arg2 float))
(format 0 "ERROR: collide-shape-prim::on-platform-test was called illegally!~%")
(none)
)
(none))
(defmethod on-platform-test ((this collide-shape-prim-group) (arg0 collide-shape-prim) (arg1 collide-overlap-result) (arg2 float))
"Check if we're on the platform for a prim group."
@@ -53,108 +34,60 @@
(dotimes (s2-0 (-> this num-prims))
(let ((s1-0 (-> this prims s2-0)))
;; check collide kind
(when (and (logtest? (-> s1-0 collide-with) s3-0)
(logtest? (-> s1-0 prim-core action) (collide-action rider-plat-sticky))
)
(when (and (logtest? (-> s1-0 collide-with) s3-0) (logtest? (-> s1-0 prim-core action) (collide-action rider-plat-sticky)))
;; check dist
(let ((f0-2 (- (- (vector-vector-distance (the-as vector (-> s1-0 prim-core)) (the-as vector (-> arg0 prim-core)))
(-> s1-0 prim-core world-sphere w)
)
(-> arg0 prim-core world-sphere w)
)
)
)
(-> s1-0 prim-core world-sphere w))
(-> arg0 prim-core world-sphere w))))
;; dist close enough, check!
(if (< f0-2 122.88)
(on-platform-test s1-0 arg0 arg1 f0-2)
)
)
)
)
)
)
(none)
)
(if (< f0-2 122.88) (on-platform-test s1-0 arg0 arg1 f0-2)))))))
(none))
(defmethod on-platform-test ((this collide-shape-prim-mesh) (arg0 collide-shape-prim) (arg1 collide-overlap-result) (arg2 float))
"check if we're on the platform for a mesh."
(case (-> arg0 type)
;; mesh to group
((collide-shape-prim-group)
(let ((s3-0 (-> this collide-with)))
(dotimes (s2-0 (-> (the-as collide-shape-prim-group arg0) num-prims))
(let ((s1-0 (-> (the-as collide-shape-prim-group arg0) prims s2-0)))
(when (and (logtest? s3-0 (-> s1-0 prim-core collide-as))
(logtest? (-> s1-0 prim-core action) (collide-action rider-target))
)
(let ((f0-2 (- (- (vector-vector-distance (the-as vector (-> this prim-core)) (the-as vector (-> s1-0 prim-core)))
(-> this prim-core world-sphere w)
)
(-> s1-0 prim-core world-sphere w)
)
)
)
(if (< f0-2 122.88)
(on-platform-test this s1-0 arg1 f0-2)
)
)
)
)
)
)
)
;; mesh to sphere. use the collide-mesh-cache.
((collide-shape-prim-sphere)
(let ((s3-1 (-> this mesh)))
(when s3-1
(let ((s2-1 *collide-mesh-cache*))
(when (!= (-> this mesh-cache-id) (-> s2-1 id))
(let ((v1-17 (allocate! s2-1 (* 96 (-> s3-1 num-tris)))))
(cond
(v1-17
(set! (-> this mesh-cache-tris) (the-as (inline-array collide-mesh-cache-tri) v1-17))
(set! (-> this mesh-cache-id) (-> s2-1 id))
(populate-cache!
s3-1
(the-as collide-mesh-cache-tri (-> this mesh-cache-tris))
(-> this cshape process node-list data (-> this transform-index) bone transform)
)
)
(else
(return #f)
)
)
)
)
)
(let* ((s2-2 (new 'stack-no-clear 'collide-tri-result))
(f0-4 (sphere-on-platform-test
s3-1
(the-as collide-mesh-cache-tri (-> this mesh-cache-tris))
s2-2
(the-as vector (-> arg0 prim-core))
(-> arg1 best-dist)
)
)
)
(when (< f0-4 (-> arg1 best-dist))
(set! (-> arg1 best-dist) f0-4)
(set! (-> arg1 best-from-prim) this)
(set! (-> arg1 best-to-prim) arg0)
(set! (-> arg1 best-from-tri vertex 0 quad) (-> s2-2 vertex 0 quad))
(set! (-> arg1 best-from-tri vertex 1 quad) (-> s2-2 vertex 1 quad))
(set! (-> arg1 best-from-tri vertex 2 quad) (-> s2-2 vertex 2 quad))
(set! (-> arg1 best-from-tri intersect quad) (-> s2-2 intersect quad))
(set! (-> arg1 best-from-tri normal quad) (-> s2-2 normal quad))
(set! (-> arg1 best-from-tri pat) (-> s2-2 pat))
)
)
)
)
)
)
(none)
)
;; mesh to group
((collide-shape-prim-group)
(let ((s3-0 (-> this collide-with)))
(dotimes (s2-0 (-> (the-as collide-shape-prim-group arg0) num-prims))
(let ((s1-0 (-> (the-as collide-shape-prim-group arg0) prims s2-0)))
(when (and (logtest? s3-0 (-> s1-0 prim-core collide-as)) (logtest? (-> s1-0 prim-core action) (collide-action rider-target)))
(let ((f0-2 (- (- (vector-vector-distance (the-as vector (-> this prim-core)) (the-as vector (-> s1-0 prim-core)))
(-> this prim-core world-sphere w))
(-> s1-0 prim-core world-sphere w))))
(if (< f0-2 122.88) (on-platform-test this s1-0 arg1 f0-2))))))))
;; mesh to sphere. use the collide-mesh-cache.
((collide-shape-prim-sphere)
(let ((s3-1 (-> this mesh)))
(when s3-1
(let ((s2-1 *collide-mesh-cache*))
(when (!= (-> this mesh-cache-id) (-> s2-1 id))
(let ((v1-17 (allocate! s2-1 (* 96 (-> s3-1 num-tris)))))
(cond
(v1-17
(set! (-> this mesh-cache-tris) (the-as (inline-array collide-mesh-cache-tri) v1-17))
(set! (-> this mesh-cache-id) (-> s2-1 id))
(populate-cache! s3-1
(the-as collide-mesh-cache-tri (-> this mesh-cache-tris))
(-> this cshape process node-list data (-> this transform-index) bone transform)))
(else (return #f))))))
(let* ((s2-2 (new 'stack-no-clear 'collide-tri-result))
(f0-4 (sphere-on-platform-test s3-1
(the-as collide-mesh-cache-tri (-> this mesh-cache-tris))
s2-2
(the-as vector (-> arg0 prim-core))
(-> arg1 best-dist))))
(when (< f0-4 (-> arg1 best-dist))
(set! (-> arg1 best-dist) f0-4)
(set! (-> arg1 best-from-prim) this)
(set! (-> arg1 best-to-prim) arg0)
(set! (-> arg1 best-from-tri vertex 0 quad) (-> s2-2 vertex 0 quad))
(set! (-> arg1 best-from-tri vertex 1 quad) (-> s2-2 vertex 1 quad))
(set! (-> arg1 best-from-tri vertex 2 quad) (-> s2-2 vertex 2 quad))
(set! (-> arg1 best-from-tri intersect quad) (-> s2-2 intersect quad))
(set! (-> arg1 best-from-tri normal quad) (-> s2-2 normal quad))
(set! (-> arg1 best-from-tri pat) (-> s2-2 pat))))))))
(none))
(defmethod add-rider! ((this collide-sticky-rider-group) (arg0 process-drawable))
"Add a rider to this platform."
@@ -163,33 +96,21 @@
((< (-> this num-riders) (-> this allocated-riders))
(set! gp-0 (-> this rider (-> this num-riders)))
(+! (-> this num-riders) 1)
(let ((v1-6 gp-0))
(set! (-> v1-6 rider-handle) (the-as handle arg0))
(set! (-> v1-6 sticky-prim) #f)
)
)
(else
(format 0 "ERROR: Exeeded max number of riders!~%")
)
)
gp-0
)
)
(let ((v1-6 gp-0)) (set! (-> v1-6 rider-handle) (the-as handle arg0)) (set! (-> v1-6 sticky-prim) #f)))
(else (format 0 "ERROR: Exeeded max number of riders!~%")))
gp-0))
(defmethod detect-riders! ((this collide-shape))
"See who is riding us."
(let ((s5-0 (-> this riders)))
(when s5-0
(let* ((v1-0 *collide-mesh-cache*)
(a0-1 (-> v1-0 id))
)
(a0-1 (-> v1-0 id)))
(set! (-> v1-0 used-size) (the-as uint 0))
(let ((a0-2 (the-as int (+ a0-1 1))))
(b! (zero? (the-as uint a0-2)) cfg-3 :likely-delay (set! a0-2 1))
(label cfg-3)
(set! (-> v1-0 id) (the-as uint a0-2))
)
)
(set! (-> v1-0 id) (the-as uint a0-2))))
(set! (-> s5-0 num-riders) 0)
0
(let ((s4-0 (-> this root-prim collide-with)))
@@ -199,46 +120,26 @@
(let ((s3-0 (-> v1-7 next0)))
(while (!= v1-7 (-> *collide-player-list* alive-list-end))
(let* ((s2-0 (-> (the-as connection v1-7) param1))
(v1-8 (-> (the-as collide-shape s2-0) root-prim))
)
(v1-8 (-> (the-as collide-shape s2-0) root-prim)))
(when (logtest? s4-0 (-> v1-8 prim-core collide-as))
(when (and (logtest? (-> v1-8 prim-core action) (collide-action rider-target))
(!= (-> this process) (-> (the-as collide-shape s2-0) process))
)
(!= (-> this process) (-> (the-as collide-shape s2-0) process)))
(let ((s1-0 (new 'stack-no-clear 'collide-overlap-result)))
(when (on-platform this (the-as collide-shape s2-0) s1-0)
(let ((s4-1 (add-rider! s5-0 (the-as process-drawable (process->handle (-> (the-as collide-shape s2-0) process)))))
)
(let ((s4-1 (add-rider! s5-0 (the-as process-drawable (process->handle (-> (the-as collide-shape s2-0) process))))))
(when s4-1
(let ((a0-11 (-> s1-0 best-from-prim)))
(set! (-> s4-1 sticky-prim) a0-11)
(let ((s1-1
(-> (the-as process-drawable (-> this process)) node-list data (-> a0-11 transform-index) bone transform)
)
)
(let ((s1-1 (-> (the-as process-drawable (-> this process)) node-list data (-> a0-11 transform-index) bone transform)))
(set! (-> s4-1 prim-ry) (matrix-y-angle s1-1))
(let ((s0-0 (new 'stack-no-clear 'matrix)))
(matrix-4x4-inverse! s0-0 s1-1)
(vector-matrix*! (-> s4-1 rider-local-pos) (-> (the-as collide-shape s2-0) trans) s0-0)
)
)
)
(send-event (-> this process) 'ridden s4-1)
)
)
(set! s4-0 (-> this root-prim collide-with))
)
)
)
)
)
(vector-matrix*! (-> s4-1 rider-local-pos) (-> (the-as collide-shape s2-0) trans) s0-0))))
(send-event (-> this process) 'ridden s4-1)))
(set! s4-0 (-> this root-prim collide-with)))))))
(set! v1-7 s3-0)
*collide-player-list*
(set! s3-0 (-> s3-0 next0))
)
)
)
)
(set! s3-0 (-> s3-0 next0))))))
(when (logtest? s4-0 (collide-kind cak-1 cak-2 cak-3))
(when (logtest? s4-0 (collide-kind cak-1))
(let ((v1-37 (-> *collide-hit-by-player-list* alive-list next0)))
@@ -246,16 +147,13 @@
(let ((s3-1 (-> v1-37 next0)))
(while (!= v1-37 (-> *collide-hit-by-player-list* alive-list-end))
(let* ((s2-1 (-> (the-as connection v1-37) param1))
(v1-38 (-> (the-as collide-shape s2-1) root-prim))
)
(v1-38 (-> (the-as collide-shape s2-1) root-prim)))
(when (logtest? s4-0 (-> v1-38 prim-core collide-as))
(when (and (logtest? (-> v1-38 prim-core action) (collide-action rider-target))
(!= (-> this process) (-> (the-as collide-shape s2-1) process))
)
(!= (-> this process) (-> (the-as collide-shape s2-1) process)))
(let ((s1-2 (new 'stack-no-clear 'collide-overlap-result)))
(when (on-platform this (the-as collide-shape s2-1) s1-2)
(let ((s4-2 (add-rider! s5-0 (the-as process-drawable (process->handle (-> (the-as collide-shape s2-1) process)))))
)
(let ((s4-2 (add-rider! s5-0 (the-as process-drawable (process->handle (-> (the-as collide-shape s2-1) process))))))
(when s4-2
(let ((a0-30 (-> s1-2 best-from-prim)))
(set! (-> s4-2 sticky-prim) a0-30)
@@ -263,42 +161,25 @@
(set! (-> s4-2 prim-ry) (matrix-y-angle s1-3))
(let ((s0-1 (new 'stack-no-clear 'matrix)))
(matrix-4x4-inverse! s0-1 s1-3)
(vector-matrix*! (-> s4-2 rider-local-pos) (-> (the-as collide-shape s2-1) trans) s0-1)
)
)
)
(send-event (-> this process) 'ridden s4-2)
)
)
(set! s4-0 (-> this root-prim collide-with))
)
)
)
)
)
(vector-matrix*! (-> s4-2 rider-local-pos) (-> (the-as collide-shape s2-1) trans) s0-1))))
(send-event (-> this process) 'ridden s4-2)))
(set! s4-0 (-> this root-prim collide-with)))))))
(set! v1-37 s3-1)
*collide-hit-by-player-list*
(set! s3-1 (-> s3-1 next0))
)
)
)
)
(set! s3-1 (-> s3-1 next0))))))
(when (logtest? s4-0 (collide-kind cak-2))
(let ((v1-66 (-> *collide-usually-hit-by-player-list* alive-list next0)))
*collide-usually-hit-by-player-list*
(let ((s3-2 (-> v1-66 next0)))
(while (!= v1-66 (-> *collide-usually-hit-by-player-list* alive-list-end))
(let* ((s2-2 (-> (the-as connection v1-66) param1))
(v1-67 (-> (the-as collide-shape s2-2) root-prim))
)
(v1-67 (-> (the-as collide-shape s2-2) root-prim)))
(when (logtest? s4-0 (-> v1-67 prim-core collide-as))
(when (and (logtest? (-> v1-67 prim-core action) (collide-action rider-target))
(!= (-> this process) (-> (the-as collide-shape s2-2) process))
)
(!= (-> this process) (-> (the-as collide-shape s2-2) process)))
(let ((s1-4 (new 'stack-no-clear 'collide-overlap-result)))
(when (on-platform this (the-as collide-shape s2-2) s1-4)
(let ((s4-3 (add-rider! s5-0 (the-as process-drawable (process->handle (-> (the-as collide-shape s2-2) process)))))
)
(let ((s4-3 (add-rider! s5-0 (the-as process-drawable (process->handle (-> (the-as collide-shape s2-2) process))))))
(when s4-3
(let ((a0-49 (-> s1-4 best-from-prim)))
(set! (-> s4-3 sticky-prim) a0-49)
@@ -306,42 +187,25 @@
(set! (-> s4-3 prim-ry) (matrix-y-angle s1-5))
(let ((s0-2 (new 'stack-no-clear 'matrix)))
(matrix-4x4-inverse! s0-2 s1-5)
(vector-matrix*! (-> s4-3 rider-local-pos) (-> (the-as collide-shape s2-2) trans) s0-2)
)
)
)
(send-event (-> this process) 'ridden s4-3)
)
)
(set! s4-0 (-> this root-prim collide-with))
)
)
)
)
)
(vector-matrix*! (-> s4-3 rider-local-pos) (-> (the-as collide-shape s2-2) trans) s0-2))))
(send-event (-> this process) 'ridden s4-3)))
(set! s4-0 (-> this root-prim collide-with)))))))
(set! v1-66 s3-2)
*collide-usually-hit-by-player-list*
(set! s3-2 (-> s3-2 next0))
)
)
)
)
(set! s3-2 (-> s3-2 next0))))))
(when (logtest? s4-0 (collide-kind cak-3))
(let ((v1-94 (-> *collide-hit-by-others-list* alive-list next0)))
*collide-hit-by-others-list*
(let ((s3-3 (-> v1-94 next0)))
(while (!= v1-94 (-> *collide-hit-by-others-list* alive-list-end))
(let* ((s2-3 (-> (the-as connection v1-94) param1))
(v1-95 (-> (the-as collide-shape s2-3) root-prim))
)
(v1-95 (-> (the-as collide-shape s2-3) root-prim)))
(when (logtest? s4-0 (-> v1-95 prim-core collide-as))
(when (and (logtest? (-> v1-95 prim-core action) (collide-action rider-target))
(!= (-> this process) (-> (the-as collide-shape s2-3) process))
)
(!= (-> this process) (-> (the-as collide-shape s2-3) process)))
(let ((s1-6 (new 'stack-no-clear 'collide-overlap-result)))
(when (on-platform this (the-as collide-shape s2-3) s1-6)
(let ((s4-4 (add-rider! s5-0 (the-as process-drawable (process->handle (-> (the-as collide-shape s2-3) process)))))
)
(let ((s4-4 (add-rider! s5-0 (the-as process-drawable (process->handle (-> (the-as collide-shape s2-3) process))))))
(when s4-4
(let ((a0-68 (-> s1-6 best-from-prim)))
(set! (-> s4-4 sticky-prim) a0-68)
@@ -349,32 +213,13 @@
(set! (-> s4-4 prim-ry) (matrix-y-angle s1-7))
(let ((s0-3 (new 'stack-no-clear 'matrix)))
(matrix-4x4-inverse! s0-3 s1-7)
(vector-matrix*! (-> s4-4 rider-local-pos) (-> (the-as collide-shape s2-3) trans) s0-3)
)
)
)
(send-event (-> this process) 'ridden s4-4)
)
)
(set! s4-0 (-> this root-prim collide-with))
)
)
)
)
)
(vector-matrix*! (-> s4-4 rider-local-pos) (-> (the-as collide-shape s2-3) trans) s0-3))))
(send-event (-> this process) 'ridden s4-4)))
(set! s4-0 (-> this root-prim collide-with)))))))
(set! v1-94 s3-3)
*collide-hit-by-others-list*
(set! s3-3 (-> s3-3 next0))
)
)
)
#f
)
)
)
)
)
)
(set! s3-3 (-> s3-3 next0)))))
#f))))))
(defmethod pull-riders! ((this collide-shape))
"Move our riders."
@@ -383,46 +228,30 @@
(let ((s4-0 (new 'stack-no-clear 'pull-rider-info)))
(countdown (s3-0 (-> s5-0 num-riders))
(let* ((v1-2 (-> s5-0 rider s3-0))
(a0-1 (-> v1-2 rider-handle))
)
(a0-1 (-> v1-2 rider-handle)))
(when (handle->process a0-1)
(set! (-> s4-0 rider) v1-2)
(set! (-> s4-0 rider-cshape)
(the-as collide-shape-moving (-> (the-as process-drawable (-> a0-1 process 0)) root))
)
(set! (-> s4-0 rider-cshape) (the-as collide-shape-moving (-> (the-as process-drawable (-> a0-1 process 0)) root)))
(let ((a0-5 (-> v1-2 sticky-prim)))
(when a0-5
(let ((s2-0 (-> this process node-list data (-> a0-5 transform-index) bone transform)))
(let ((s1-0 (-> s4-0 rider-dest)))
(vector-matrix*! s1-0 (-> v1-2 rider-local-pos) s2-0)
(vector-float*! s1-0 s1-0 (/ 1.0 (-> s1-0 w)))
)
(set! (-> s4-0 rider-delta-ry) (deg- (matrix-y-angle s2-0) (-> s4-0 rider prim-ry)))
)
(pull-rider! this s4-0)
)
)
)
)
)
)
#f
)
)
)
(vector-float*! s1-0 s1-0 (/ 1.0 (-> s1-0 w))))
(set! (-> s4-0 rider-delta-ry) (deg- (matrix-y-angle s2-0) (-> s4-0 rider prim-ry))))
(pull-rider! this s4-0)))))))
#f)))
(defmethod pull-rider! ((this collide-shape) (arg0 pull-rider-info))
"Move a rider."
(local-vars (at-0 int) (sv-160 (function collide-shape-moving float collide-kind none)))
(rlet ((vf0 :class vf)
(vf1 :class vf)
(vf2 :class vf)
)
(vf2 :class vf))
(init-vf0-vector)
(let ((gp-0 (-> arg0 rider-cshape)))
(let ((s3-0 (new 'stack-no-clear 'vector))
(s4-0 (new 'stack-no-clear 'vector))
)
(s4-0 (new 'stack-no-clear 'vector)))
(set! (-> s4-0 quad) (-> gp-0 trans quad))
(vector-! s3-0 (-> arg0 rider-dest) s4-0)
(cond
@@ -432,64 +261,33 @@
(let ((s0-0 gp-0))
(set! sv-160 (method-of-object s0-0 fill-cache-for-shape!))
(let ((a1-3 (+ 8192.0 (vector-length s3-0)))
(a2-0 (-> gp-0 root-prim collide-with))
)
(sv-160 s0-0 a1-3 a2-0)
)
)
(set! (-> this root-prim prim-core collide-as) s1-0)
)
(a2-0 (-> gp-0 root-prim collide-with)))
(sv-160 s0-0 a1-3 a2-0)))
(set! (-> this root-prim prim-core collide-as) s1-0))
(let ((s2-1 (new 'stack-no-clear 'vector)))
(set! (-> s2-1 quad) (-> s3-0 quad))
(let ((v1-12 s2-1))
(.lvf vf1 (&-> s2-1 quad))
(let ((f0-2 (-> *display* frames-per-second)))
(.mov at-0 f0-2)
)
(let ((f0-2 (-> *display* frames-per-second))) (.mov at-0 f0-2))
(.mov vf2 at-0)
(.mov.vf vf1 vf0 :mask #b1000)
(.mul.x.vf vf1 vf1 vf2 :mask #b111)
(.svf (&-> v1-12 quad) vf1)
)
(.svf (&-> v1-12 quad) vf1))
(cond
((type-type? (-> gp-0 type) collide-shape-moving)
(let ((s3-1 (-> gp-0 status)))
(integrate-and-collide! gp-0 s2-1)
(set! (-> gp-0 status) s3-1)
)
)
(else
(integrate-and-collide! gp-0 s2-1)
)
)
)
)
(else
(move-by-vector! gp-0 s3-0)
)
)
(let ((s3-1 (-> gp-0 status))) (integrate-and-collide! gp-0 s2-1) (set! (-> gp-0 status) s3-1)))
(else (integrate-and-collide! gp-0 s2-1)))))
(else (move-by-vector! gp-0 s3-0)))
(when (type-type? (-> gp-0 type) collide-shape-moving)
(let ((v1-18 (new 'stack-no-clear 'vector)))
(vector-! v1-18 (-> gp-0 trans) s4-0)
(vector-float*! (-> gp-0 rider-last-move) v1-18 (-> *display* frames-per-second))
)
(set-time! (-> gp-0 rider-time))
)
)
(let ((f0-4 (-> arg0 rider-delta-ry)))
(if (!= f0-4 0.0)
(send-event (-> gp-0 process) 'rotate-y-angle f0-4)
)
)
)
(none)
)
)
(vector-float*! (-> gp-0 rider-last-move) v1-18 (-> *display* frames-per-second)))
(set-time! (-> gp-0 rider-time))))
(let ((f0-4 (-> arg0 rider-delta-ry))) (if (!= f0-4 0.0) (send-event (-> gp-0 process) 'rotate-y-angle f0-4))))
(none)))
(defmethod alloc-riders ((this collide-shape) (arg0 int))
(if (-> this riders)
(format 0 "ERROR: colide-shape::alloc-riders is being called multiple times!~%")
(set! (-> this riders) (new 'process 'collide-sticky-rider-group arg0))
)
(none)
)
(format 0 "ERROR: colide-shape::alloc-riders is being called multiple times!~%")
(set! (-> this riders) (new 'process 'collide-sticky-rider-group arg0)))
(none))
File diff suppressed because it is too large Load Diff
+172 -179
View File
@@ -1,7 +1,6 @@
;;-*-Lisp-*-
(in-package goal)
(bundles "ENGINE.CGO" "GAME.CGO")
(require "engine/collide/collide-shape-h.gc")
;; name: collide-target-h.gc
@@ -13,187 +12,182 @@
;; We believe that target's control-info may contain an array of these.
;; Each collide-history is a record of a single collision event.
(deftype collide-history (structure)
((intersect vector :inline)
(trans vector :inline)
(transv vector :inline)
(transv-out vector :inline)
(local-normal vector :inline)
(surface-normal vector :inline)
(time time-frame)
(status cshape-moving-flags)
(pat pat-surface)
(reaction-flag cshape-reaction-flags)
)
((intersect vector :inline)
(trans vector :inline)
(transv vector :inline)
(transv-out vector :inline)
(local-normal vector :inline)
(surface-normal vector :inline)
(time time-frame)
(status cshape-moving-flags)
(pat pat-surface)
(reaction-flag cshape-reaction-flags))
(:methods
(update! (_type_ collide-shape-moving vector vector vector) _type_)
)
)
(update! (_type_ collide-shape-moving vector vector vector) _type_)))
;; This is the collide shape for target (Jak).
;; It is complicated.
(deftype control-info (collide-shape-moving)
((unknown-vector00 vector :inline :offset 448)
(unknown-vector01 vector :inline :offset 464)
(unknown-vector02 vector :inline :offset 480)
(unknown-quaternion00 quaternion :inline :offset 496)
(unknown-quaternion01 quaternion :inline :offset 512)
(unknown-float00 float :offset 528)
(unknown-float01 float :offset 532)
(unknown-float02 float :offset 536)
(unknown-vector10 vector :inline :offset 544)
(unknown-vector11 vector :inline :offset 560)
(unknown-vector12 vector :inline :offset 576)
(unknown-vector13 vector :inline :offset 592)
(unknown-vector14 vector :inline :offset 608)
(unknown-vector15 vector :inline :offset 624)
(unknown-vector16 vector :inline :offset 640)
(unknown-dynamics00 dynamics :offset 656)
(unknown-surface00 surface :offset 660)
(unknown-surface01 surface :offset 664)
(unknown-cpad-info00 cpad-info :offset 668)
(unknown-float10 float :offset 672)
(unknown-float11 float :offset 676)
(unknown-float12 float :offset 680)
(unknown-float13 float :offset 684)
(unknown-vector20 vector :inline :offset 688)
(unknown-vector21 vector :inline :offset 704)
(unknown-vector22 vector :inline :offset 720)
(unknown-vector23 vector :inline :offset 736)
(unknown-vector-array00 vector 7 :inline :offset 752)
(unknown-vector30 vector :inline :offset 880)
(unknown-vector31 vector :inline :offset 896)
(unknown-float20 float :offset 912)
(unknown-float21 float :offset 916)
(unknown-dword00 uint64 :offset 920)
(unknown-matrix00 matrix :inline :offset 928)
(unknown-matrix01 matrix :inline :offset 992)
(unknown-matrix02 matrix :inline :offset 1056)
(unknown-qword00 uint128 :offset 1136)
(unknown-float30 float :offset 1140)
(unknown-vector40 vector :inline :offset 1152)
(unknown-float40 float :offset 1172)
(unknown-float41 float :offset 1176)
(unknown-int00 int32 :offset 1180)
(unknown-float50 float :offset 1168)
(unknown-vector50 vector :inline :offset 1184)
(unknown-vector51 vector :inline :offset 1200)
(unknown-vector52 vector :inline :offset 1216)
(unknown-vector53 vector :inline :offset 1232)
(last-known-safe-ground vector :inline :offset 1248)
(unknown-vector55 vector :inline :offset 1264)
(unknown-dword10 time-frame :offset 1280)
(unknown-dword11 time-frame :offset 1288)
(unknown-float60 float :offset 1300)
(unknown-float61 float :offset 1304)
(unknown-float62 float :offset 1308)
(unknown-float63 float :offset 1312)
(unknown-float64 float :offset 1316)
(unknown-dword20 time-frame :offset 1320)
(unknown-dword21 time-frame :offset 1328)
(unknown-dword-coverage int64 :offset 1336)
(unknown-float-coverage-0 float :offset 1344)
(unknown-float-coverage-1 float :offset 1348)
(unknown-float-coverage-2 float :offset 1352)
(unknown-u32-coverage-0 uint32 :offset 1356)
(unknown-vector-coverage-0 vector :inline :offset 1376)
(unknown-vector-coverage-1 vector :inline :offset 1392)
(unknown-vector-coverage-2 vector :inline :offset 1440)
(unknown-vector-coverage-3 vector :inline :offset 1472)
(unknown-vector60 vector :inline :offset 1456)
(unknown-vector61 vector :inline :offset 1504)
(unknown-float70 float :offset 1520)
(unknown-float71 float :offset 1524)
(unknown-vector70 vector :inline :offset 1536)
(unknown-vector71 vector :inline :offset 1552)
(unknown-vector72 vector :inline :offset 1568)
(unknown-vector73 vector :inline :offset 1584)
(unknown-handle00 handle :offset 1600)
(unknown-sphere-array00 collide-shape-prim-sphere 3 :offset 1608)
(unknown-sphere00 collide-shape-prim-sphere :offset 1632)
(unknown-sphere01 collide-shape-prim-sphere :offset 1636)
(unknown-sphere02 collide-shape-prim-sphere :offset 1640)
(unknown-int50 int32 :offset 1656)
(unknown-dword30 time-frame :offset 1664)
(unknown-dword31 time-frame :offset 1672)
(unknown-dword32 time-frame :offset 1680)
(unknown-dword33 time-frame :offset 1688)
(unknown-dword34 time-frame :offset 1696)
(unknown-dword35 time-frame :offset 1704)
(unknown-dword36 time-frame :offset 1712)
(unknown-float80 float :offset 1724)
(unknown-float81 float :offset 1728)
(unknown-float82 float :offset 1732)
(unknown-vector80 vector :inline :offset 1744)
(unknown-cspace00 cspace :inline :offset 1760)
(unknown-vector90 vector :inline :offset 1776)
(unknown-vector91 vector :inline :offset 1792)
(unknown-vector92 vector :inline :offset 1824)
(unknown-cspace10 cspace :inline :offset 1808)
(unknown-symbol00 symbol :offset 1840)
(unknown-float90 float :offset 1844)
(unknown-float91 float :offset 1848)
(unknown-vector-array10 vector 16 :inline :offset 1856)
(unknown-float100 float :offset 2112)
(unknown-int10 int32 :offset 2116)
(unknown-float110 float :offset 2120)
(unknown-vector100 vector :inline :offset 2128)
(unknown-vector101 vector :inline :offset 2144)
(unknown-dword40 time-frame :offset 2160)
(unknown-dword41 time-frame :offset 2168)
(unknown-handle10 handle :offset 2176)
(unknown-uint20 uint32 :offset 2184)
(unknown-spoolanim00 spool-anim :overlay-at unknown-uint20)
(unknown-int20 int32 :overlay-at unknown-spoolanim00)
(unknown-symbol20 symbol :overlay-at unknown-int20)
(unknown-float120 float :overlay-at unknown-symbol20)
(unknown-int21 int32 :offset 2188)
(unknown-uint30 uint32 :overlay-at unknown-int21)
(unknown-float121 float :overlay-at unknown-uint30)
(unknown-uint31 uint32 :offset 2192)
(unknown-int37 int32 :overlay-at unknown-uint31)
(unknown-float122 float :offset 2196)
(unknown-float123 float :offset 2200)
(unknown-float124 float :offset 2204)
(unknown-vector102 vector :inline :offset 2224)
(unknown-vector103 vector :inline :offset 2240)
(unknown-quaternion02 quaternion :inline :offset 2256)
(unknown-quaternion03 quaternion :inline :offset 2272)
(unknown-smush00 smush-control :inline :offset 2288)
(unknown-vector110 vector :inline :offset 2320)
(unknown-vector111 vector :inline :offset 2336)
(unknown-symbol30 symbol :offset 2384)
(unknown-int31 uint32 :overlay-at unknown-symbol30)
(unknown-dword50 int64 :offset 2392)
(unknown-dword51 int64 :offset 2400)
(unknown-pointer00 pointer :offset 2416)
(unknown-symbol40 symbol :offset 2428)
(unknown-dword60 int64 :offset 2432)
(unknown-dword61 int64 :offset 2440)
(unknown-dword62 int64 :offset 2448)
(unknown-dword63 int64 :offset 2456)
(unknown-halfword00 int16 :offset 2488)
(history-length int16 :offset 2490)
(history-data collide-history 128 :inline)
(unknown-float140 float :offset 18944)
(unknown-dword70 time-frame :offset 18952)
(unknown-int40 int32 :offset 18880)
(unknown-dword80 time-frame :offset 18888)
(unknown-dword81 time-frame :offset 18896)
(unknown-float130 float :offset 18904)
(unknown-float131 float :offset 18908)
(unknown-dword82 time-frame :offset 18912)
(unknown-vector120 vector :inline :offset 18928)
(unknown-float150 float :overlay-at unknown-float140)
(unknown-vector121 vector :inline :offset 18960)
(wall-pat pat-surface :offset 18976)
(unknown-soundid00 sound-id :offset 18980)
(unknown-float141 float :offset 18984)
(unknown-soundid01 sound-id :offset 18988)
(unknown-int34 int32 :offset 18992)
(unknown-int35 int32 :offset 18996)
(unknown-int36 int32 :offset 19000)
)
)
((unknown-vector00 vector :inline :offset 448)
(unknown-vector01 vector :inline :offset 464)
(unknown-vector02 vector :inline :offset 480)
(unknown-quaternion00 quaternion :inline :offset 496)
(unknown-quaternion01 quaternion :inline :offset 512)
(unknown-float00 float :offset 528)
(unknown-float01 float :offset 532)
(unknown-float02 float :offset 536)
(unknown-vector10 vector :inline :offset 544)
(unknown-vector11 vector :inline :offset 560)
(unknown-vector12 vector :inline :offset 576)
(unknown-vector13 vector :inline :offset 592)
(unknown-vector14 vector :inline :offset 608)
(unknown-vector15 vector :inline :offset 624)
(unknown-vector16 vector :inline :offset 640)
(unknown-dynamics00 dynamics :offset 656)
(unknown-surface00 surface :offset 660)
(unknown-surface01 surface :offset 664)
(unknown-cpad-info00 cpad-info :offset 668)
(unknown-float10 float :offset 672)
(unknown-float11 float :offset 676)
(unknown-float12 float :offset 680)
(unknown-float13 float :offset 684)
(unknown-vector20 vector :inline :offset 688)
(unknown-vector21 vector :inline :offset 704)
(unknown-vector22 vector :inline :offset 720)
(unknown-vector23 vector :inline :offset 736)
(unknown-vector-array00 vector 7 :inline :offset 752)
(unknown-vector30 vector :inline :offset 880)
(unknown-vector31 vector :inline :offset 896)
(unknown-float20 float :offset 912)
(unknown-float21 float :offset 916)
(unknown-dword00 uint64 :offset 920)
(unknown-matrix00 matrix :inline :offset 928)
(unknown-matrix01 matrix :inline :offset 992)
(unknown-matrix02 matrix :inline :offset 1056)
(unknown-qword00 uint128 :offset 1136)
(unknown-float30 float :offset 1140)
(unknown-vector40 vector :inline :offset 1152)
(unknown-float40 float :offset 1172)
(unknown-float41 float :offset 1176)
(unknown-int00 int32 :offset 1180)
(unknown-float50 float :offset 1168)
(unknown-vector50 vector :inline :offset 1184)
(unknown-vector51 vector :inline :offset 1200)
(unknown-vector52 vector :inline :offset 1216)
(unknown-vector53 vector :inline :offset 1232)
(last-known-safe-ground vector :inline :offset 1248)
(unknown-vector55 vector :inline :offset 1264)
(unknown-dword10 time-frame :offset 1280)
(unknown-dword11 time-frame :offset 1288)
(unknown-float60 float :offset 1300)
(unknown-float61 float :offset 1304)
(unknown-float62 float :offset 1308)
(unknown-float63 float :offset 1312)
(unknown-float64 float :offset 1316)
(unknown-dword20 time-frame :offset 1320)
(unknown-dword21 time-frame :offset 1328)
(unknown-dword-coverage int64 :offset 1336)
(unknown-float-coverage-0 float :offset 1344)
(unknown-float-coverage-1 float :offset 1348)
(unknown-float-coverage-2 float :offset 1352)
(unknown-u32-coverage-0 uint32 :offset 1356)
(unknown-vector-coverage-0 vector :inline :offset 1376)
(unknown-vector-coverage-1 vector :inline :offset 1392)
(unknown-vector-coverage-2 vector :inline :offset 1440)
(unknown-vector-coverage-3 vector :inline :offset 1472)
(unknown-vector60 vector :inline :offset 1456)
(unknown-vector61 vector :inline :offset 1504)
(unknown-float70 float :offset 1520)
(unknown-float71 float :offset 1524)
(unknown-vector70 vector :inline :offset 1536)
(unknown-vector71 vector :inline :offset 1552)
(unknown-vector72 vector :inline :offset 1568)
(unknown-vector73 vector :inline :offset 1584)
(unknown-handle00 handle :offset 1600)
(unknown-sphere-array00 collide-shape-prim-sphere 3 :offset 1608)
(unknown-sphere00 collide-shape-prim-sphere :offset 1632)
(unknown-sphere01 collide-shape-prim-sphere :offset 1636)
(unknown-sphere02 collide-shape-prim-sphere :offset 1640)
(unknown-int50 int32 :offset 1656)
(unknown-dword30 time-frame :offset 1664)
(unknown-dword31 time-frame :offset 1672)
(unknown-dword32 time-frame :offset 1680)
(unknown-dword33 time-frame :offset 1688)
(unknown-dword34 time-frame :offset 1696)
(unknown-dword35 time-frame :offset 1704)
(unknown-dword36 time-frame :offset 1712)
(unknown-float80 float :offset 1724)
(unknown-float81 float :offset 1728)
(unknown-float82 float :offset 1732)
(unknown-vector80 vector :inline :offset 1744)
(unknown-cspace00 cspace :inline :offset 1760)
(unknown-vector90 vector :inline :offset 1776)
(unknown-vector91 vector :inline :offset 1792)
(unknown-vector92 vector :inline :offset 1824)
(unknown-cspace10 cspace :inline :offset 1808)
(unknown-symbol00 symbol :offset 1840)
(unknown-float90 float :offset 1844)
(unknown-float91 float :offset 1848)
(unknown-vector-array10 vector 16 :inline :offset 1856)
(unknown-float100 float :offset 2112)
(unknown-int10 int32 :offset 2116)
(unknown-float110 float :offset 2120)
(unknown-vector100 vector :inline :offset 2128)
(unknown-vector101 vector :inline :offset 2144)
(unknown-dword40 time-frame :offset 2160)
(unknown-dword41 time-frame :offset 2168)
(unknown-handle10 handle :offset 2176)
(unknown-uint20 uint32 :offset 2184)
(unknown-spoolanim00 spool-anim :overlay-at unknown-uint20)
(unknown-int20 int32 :overlay-at unknown-spoolanim00)
(unknown-symbol20 symbol :overlay-at unknown-int20)
(unknown-float120 float :overlay-at unknown-symbol20)
(unknown-int21 int32 :offset 2188)
(unknown-uint30 uint32 :overlay-at unknown-int21)
(unknown-float121 float :overlay-at unknown-uint30)
(unknown-uint31 uint32 :offset 2192)
(unknown-int37 int32 :overlay-at unknown-uint31)
(unknown-float122 float :offset 2196)
(unknown-float123 float :offset 2200)
(unknown-float124 float :offset 2204)
(unknown-vector102 vector :inline :offset 2224)
(unknown-vector103 vector :inline :offset 2240)
(unknown-quaternion02 quaternion :inline :offset 2256)
(unknown-quaternion03 quaternion :inline :offset 2272)
(unknown-smush00 smush-control :inline :offset 2288)
(unknown-vector110 vector :inline :offset 2320)
(unknown-vector111 vector :inline :offset 2336)
(unknown-symbol30 symbol :offset 2384)
(unknown-int31 uint32 :overlay-at unknown-symbol30)
(unknown-dword50 int64 :offset 2392)
(unknown-dword51 int64 :offset 2400)
(unknown-pointer00 pointer :offset 2416)
(unknown-symbol40 symbol :offset 2428)
(unknown-dword60 int64 :offset 2432)
(unknown-dword61 int64 :offset 2440)
(unknown-dword62 int64 :offset 2448)
(unknown-dword63 int64 :offset 2456)
(unknown-halfword00 int16 :offset 2488)
(history-length int16 :offset 2490)
(history-data collide-history 128 :inline)
(unknown-float140 float :offset 18944)
(unknown-dword70 time-frame :offset 18952)
(unknown-int40 int32 :offset 18880)
(unknown-dword80 time-frame :offset 18888)
(unknown-dword81 time-frame :offset 18896)
(unknown-float130 float :offset 18904)
(unknown-float131 float :offset 18908)
(unknown-dword82 time-frame :offset 18912)
(unknown-vector120 vector :inline :offset 18928)
(unknown-float150 float :overlay-at unknown-float140)
(unknown-vector121 vector :inline :offset 18960)
(wall-pat pat-surface :offset 18976)
(unknown-soundid00 sound-id :offset 18980)
(unknown-float141 float :offset 18984)
(unknown-soundid01 sound-id :offset 18988)
(unknown-int34 int32 :offset 18992)
(unknown-int35 int32 :offset 18996)
(unknown-int36 int32 :offset 19000)))
(defmethod update! ((this collide-history) (cshape collide-shape-moving) (xs vector) (transv vector) (transv-out vector))
"Update the collide-history element."
@@ -207,5 +201,4 @@
(set! (-> this status) (-> cshape status))
(set! (-> this reaction-flag) (-> cshape reaction-flag))
(set! (-> this pat) (-> cshape cur-pat))
this
)
this)
+60 -94
View File
@@ -1,7 +1,6 @@
;;-*-Lisp-*-
(in-package goal)
(bundles "ENGINE.CGO" "GAME.CGO")
(require "kernel-defs.gc")
;; name: collide-touch-h.gc
@@ -16,52 +15,40 @@
;; As the collision is resolved, shapes are added and removed from the touching list.
;; Once collision is done solving, you can send events or inspect what you touched!
(defconstant TOUCHING_LIST_LENGTH 32)
;; DECOMP BEGINS
;; A record of a primitive which is touching another, possibly including the triangle that is involved.
(deftype touching-prim (structure)
((cprim collide-shape-prim)
(has-tri? symbol)
(tri collide-tri-result :inline)
)
)
((cprim collide-shape-prim)
(has-tri? symbol)
(tri collide-tri-result :inline)))
;; A record of two primitives which are touching.
(deftype touching-prims-entry (structure)
((next touching-prims-entry)
(prev touching-prims-entry)
(allocated? symbol)
(u float)
(prim1 touching-prim :inline)
(prim2 touching-prim :inline)
)
((next touching-prims-entry)
(prev touching-prims-entry)
(allocated? symbol)
(u float)
(prim1 touching-prim :inline)
(prim2 touching-prim :inline))
(:methods
(get-touched-prim (_type_ trsqv touching-shapes-entry) collide-shape-prim)
(touching-prims-entry-method-10 () none)
(get-middle-of-bsphere-overlap (_type_ vector) vector)
(get-touched-tri (_type_ collide-shape touching-shapes-entry) collide-tri-result)
)
)
(get-touched-prim (_type_ trsqv touching-shapes-entry) collide-shape-prim)
(touching-prims-entry-method-10 () none)
(get-middle-of-bsphere-overlap (_type_ vector) vector)
(get-touched-tri (_type_ collide-shape touching-shapes-entry) collide-tri-result)))
;; A pool of up to 64 touching primitives. There is a linked list of freed entries.
(deftype touching-prims-entry-pool (structure)
((head touching-prims-entry)
(nodes touching-prims-entry 64 :inline)
)
((head touching-prims-entry)
(nodes touching-prims-entry 64 :inline))
(:methods
(new (symbol type) _type_)
(alloc-node (_type_) touching-prims-entry)
(get-free-node-count (_type_) int)
(init-list! (_type_) none)
(free-node (_type_ touching-prims-entry) touching-prims-entry)
)
)
(new (symbol type) _type_)
(alloc-node (_type_) touching-prims-entry)
(get-free-node-count (_type_) int)
(init-list! (_type_) none)
(free-node (_type_ touching-prims-entry) touching-prims-entry)))
(defmethod init-list! ((this touching-prims-entry-pool))
"Initialize all entries to be not allocated and in a linked list."
@@ -74,14 +61,9 @@
(set! (-> current next) (the-as touching-prims-entry next))
(set! (-> current allocated?) #f)
(set! prev current)
(set! current (the-as touching-prims-entry next))
)
)
)
(set! (-> prev next) #f)
)
(none)
)
(set! current (the-as touching-prims-entry next)))))
(set! (-> prev next) #f))
(none))
(defmethod new touching-prims-entry-pool ((allocation symbol) (type-to-make type))
"Allocate and initialize a new touching-prims-entry-pool"
@@ -89,80 +71,64 @@
;; Note - the original code passed (-> type-to-make size) as an argument.
;; however, the new method of structure doesn't have this argument.
;; it uses the same value for the size so it doesn't really matter.
(let ((this (the touching-prims-entry-pool ((method-of-type structure new)
allocation
type-to-make
;; (-> type-to-make size) see note
)
)))
(let ((this (the touching-prims-entry-pool
((method-of-type structure new) allocation
type-to-make
;; (-> type-to-make size) see note
))))
(init-list! this)
this
)
)
this))
;; two collide shapes which are touching.
;; This stores a list of primitive pairs which are touching.
(deftype touching-shapes-entry (structure)
((cshape1 collide-shape)
(cshape2 collide-shape)
(resolve-u int8)
(head touching-prims-entry)
)
((cshape1 collide-shape)
(cshape2 collide-shape)
(resolve-u int8)
(head touching-prims-entry))
:allow-misaligned
(:methods
(touching-shapes-entry-method-9 (_type_) none)
(get-touched-shape (_type_ collide-shape) collide-shape)
(touching-shapes-entry-method-11 () none)
(prims-touching? (_type_ collide-shape-moving uint) touching-prims-entry)
(prims-touching-action? (_type_ collide-shape collide-action collide-action) touching-prims-entry)
(touching-shapes-entry-method-14 () none)
(free-touching-prims-list (_type_) symbol)
(get-head (_type_) touching-prims-entry)
(get-next (_type_ touching-prims-entry) touching-prims-entry)
)
)
(touching-shapes-entry-method-9 (_type_) none)
(get-touched-shape (_type_ collide-shape) collide-shape)
(touching-shapes-entry-method-11 () none)
(prims-touching? (_type_ collide-shape-moving uint) touching-prims-entry)
(prims-touching-action? (_type_ collide-shape collide-action collide-action) touching-prims-entry)
(touching-shapes-entry-method-14 () none)
(free-touching-prims-list (_type_) symbol)
(get-head (_type_) touching-prims-entry)
(get-next (_type_ touching-prims-entry) touching-prims-entry)))
;; A list of (up to) TOUCHING_LIST_LENGTH pairs of colliding shapes
(deftype touching-list (structure)
((num-touching-shapes int32)
(resolve-u int8)
(touching-shapes touching-shapes-entry TOUCHING_LIST_LENGTH :inline)
)
((num-touching-shapes int32)
(resolve-u int8)
(touching-shapes touching-shapes-entry TOUCHING_LIST_LENGTH :inline))
(:methods
(new (symbol type) _type_)
(add-touching-prims (_type_ collide-shape-prim collide-shape-prim float collide-tri-result collide-tri-result) none)
(touching-list-method-10 () none)
(update-from-step-size (_type_ float) none)
(send-events-for-touching-shapes (_type_) none)
(get-shapes-entry (_type_ collide-shape collide-shape) touching-shapes-entry)
(free-all-prim-nodes (_type_) none)
)
)
(new (symbol type) _type_)
(add-touching-prims (_type_ collide-shape-prim collide-shape-prim float collide-tri-result collide-tri-result) none)
(touching-list-method-10 () none)
(update-from-step-size (_type_ float) none)
(send-events-for-touching-shapes (_type_) none)
(get-shapes-entry (_type_ collide-shape collide-shape) touching-shapes-entry)
(free-all-prim-nodes (_type_) none)))
(defmethod new touching-list ((allocation symbol) (type-to-make type))
"See note in touching-prims-entry-pool"
;; og:preserve-this
(let ((this (the touching-list ((method-of-type structure new)
allocation
type-to-make
;; (-> type-to-make size) see note
)
)))
(let ((this (the touching-list
((method-of-type structure new) allocation
type-to-make
;; (-> type-to-make size) see note
))))
(set! (-> this num-touching-shapes) 0)
(set! (-> this resolve-u) 0)
this
)
)
this))
(defmethod get-head ((this touching-shapes-entry))
(-> this head)
)
(-> this head))
(defmethod get-next ((this touching-shapes-entry) (arg0 touching-prims-entry))
(-> arg0 next)
)
(-> arg0 next))
;; Allocate the global touching lists.
;; We have a pool of prim pairs that can be used in any shape pair
+125 -386
View File
@@ -1,7 +1,6 @@
;;-*-Lisp-*-
(in-package goal)
(bundles "ENGINE.CGO" "GAME.CGO")
(require "engine/collide/collide-touch-h.gc")
(require "kernel/gstate.gc")
(require "engine/target/target-h.gc")
@@ -34,41 +33,20 @@
(defmethod get-free-node-count ((this touching-prims-entry-pool))
"Get the number of nodes that are not in use."
(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
)
)
(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))
"Allocate a node. Will return #f if there are none left."
(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
)
)
(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))
"Free a node allocated with alloc-node"
@@ -78,12 +56,7 @@
(set! (-> arg0 next) v1-1)
(set! (-> arg0 prev) #f)
(set! (-> this head) arg0)
(if v1-1
(set! (-> v1-1 prev) arg0)
)
)
)
)
(if v1-1 (set! (-> v1-1 prev) arg0)))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Shapes Entry
@@ -101,17 +74,8 @@
(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)
)
)
)
#f
)
)
)
)
(let ((a1-0 gp-0)) (set! gp-0 (-> a1-0 next)) (free-node s5-0 a1-0))))
#f))))
;;;;;;;;;;;;;;;;;;;;;;
;; Touching List
@@ -124,78 +88,53 @@
(let ((s5-0 (the-as touching-shapes-entry (-> this touching-shapes))))
(countdown (s4-0 (-> this num-touching-shapes))
(free-touching-prims-list s5-0)
(&+! s5-0 16)
)
)
(&+! s5-0 16)))
(set! (-> this num-touching-shapes) 0)
(set! (-> this resolve-u) 0)
0
(none)
)
(none))
(defmethod get-shapes-entry ((this touching-list) (arg0 collide-shape) (arg1 collide-shape))
"Get a touching-shapes-entry for the two shapes. If one exists, it will be returned. Otherwise a new one will be made."
(let ((v0-0 (the-as touching-shapes-entry (-> this touching-shapes)))) ;; the candidate
(let ((v1-0 (the-as touching-shapes-entry #f))) ;; a good one
(let ((v1-0 (the-as touching-shapes-entry #f))) ;; a good one
;; loop over all touching shapes
(countdown (a3-0 (-> this num-touching-shapes))
(let ((t0-0 (-> v0-0 cshape1)))
(set! v1-0
(cond
(t0-0
;; in use. If it's match, return it (allows a,b or b,a to match a,b)
(if (or (and (= t0-0 arg0) (= (-> v0-0 cshape2) arg1)) (and (= t0-0 arg1) (= (-> v0-0 cshape2) arg0)))
(return v0-0)
)
;; otherwise bad
v1-0
)
;; in use. If it's match, return it (allows a,b or b,a to match a,b)
(if (or (and (= t0-0 arg0) (= (-> v0-0 cshape2) arg1)) (and (= t0-0 arg1) (= (-> v0-0 cshape2) arg0))) (return v0-0))
;; otherwise bad
v1-0)
(else
;; not in use. remember it's free and keep looking.
v0-0
)
)
)
)
(&+! v0-0 16)
)
;; not in use. remember it's free and keep looking.
v0-0))))
(&+! v0-0 16))
;; done looping.
(cond
(v1-0 ;; did we find an unused slot? if so return it
(set! v0-0 v1-0)
)
(set! v0-0 v1-0))
(else
;; need to add a new one
(when (>= (-> this num-touching-shapes) TOUCHING_LIST_LENGTH)
;; but there's no room!
(format 0 "ERROR: touching-list::get-shapes-entry() failed!~%")
(return (the-as touching-shapes-entry #f))
)
;; enough room, increase the size
(+! (-> this num-touching-shapes) 1)
)
)
)
;; need to add a new one
(when (>= (-> this num-touching-shapes) TOUCHING_LIST_LENGTH)
;; but there's no room!
(format 0 "ERROR: touching-list::get-shapes-entry() failed!~%")
(return (the-as touching-shapes-entry #f)))
;; enough room, increase the size
(+! (-> this num-touching-shapes) 1))))
;; if we're doing a new one, set it up.
(set! (-> v0-0 cshape1) arg0)
(set! (-> v0-0 cshape2) arg1)
(set! (-> v0-0 head) #f)
(set! (-> v0-0 resolve-u) 1)
(set! (-> this resolve-u) 1)
(the-as touching-shapes-entry v0-0)
)
)
(the-as touching-shapes-entry v0-0)))
(deftype add-prims-touching-work (structure)
((tri1 collide-tri-result)
(tri2 collide-tri-result)
)
)
((tri1 collide-tri-result)
(tri2 collide-tri-result)))
;;;;;;;;;;;;;;;;;;;;;;;;;
;; Touching List Update
@@ -212,37 +151,22 @@
;; "What happens if I move forward 0.7 timesteps?"
;; .. repeat ..
(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)
)
(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))
"Tell the touching list that if we end taking a step of at least arg2, the prims arg0/arg1 will collide.
However, you don't have to know for sure if you're going to take this big of a step yet.
You can provide triangles if you want, but you don't have to.
The logic for calling this twice for the same prims in between calls to update-from-step-size is a little weird
so I suspect this never happens (and it's probably cheaper to avoid this duplication in the actual prim collision code)."
;; I don't know why they made this type, but I'm guessing it's to avoid the compiler spilling to the stack
(let ((gp-0 (new 'stack-no-clear 'add-prims-touching-work)))
(set! (-> gp-0 tri1) arg3)
(set! (-> gp-0 tri2) arg4)
;; first, grab the entry for the collide-shapes involved.
(let ((s2-0 (get-shapes-entry this (-> arg0 cshape) (-> arg1 cshape))))
(when s2-0
;; if we ask for a,b, that function might give us b,a. Detect that, and swap our collide shape prims.
(when (= (-> s2-0 cshape1) (-> arg1 cshape))
(let ((v1-4 arg0))
(set! arg0 arg1)
(set! arg1 v1-4)
)
)
(let ((v1-4 arg0)) (set! arg0 arg1) (set! arg1 v1-4)))
(let ((s0-0 (-> s2-0 head)))
;; loop over all the entries in the shapes
(while s0-0
@@ -253,42 +177,24 @@
;; this value is unused.
(-> s0-0 u)
(let ((v1-12 (-> s0-0 prim1))
(a1-2 (-> gp-0 tri1))
)
(a1-2 (-> gp-0 tri1)))
(cond
(a1-2
;; we have a tri, copy it
(set! (-> v1-12 has-tri?) #t)
(mem-copy! (the-as pointer (-> v1-12 tri)) (the-as pointer a1-2) 84)
)
;; we have a tri, copy it
(set! (-> v1-12 has-tri?) #t)
(mem-copy! (the-as pointer (-> v1-12 tri)) (the-as pointer a1-2) 84))
(else
;; no tri
(set! (-> v1-12 has-tri?) #f)
)
)
)
;; no tri
(set! (-> v1-12 has-tri?) #f))))
;; same for the other tri.
(let ((v1-15 (-> s0-0 prim2))
(a1-3 (-> gp-0 tri2))
)
(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) 84)
)
(else
(set! (-> v1-15 has-tri?) #f)
)
)
)
)
(a1-3 (set! (-> v1-15 has-tri?) #t) (mem-copy! (the-as pointer (-> v1-15 tri)) (the-as pointer a1-3) 84))
(else (set! (-> v1-15 has-tri?) #f)))))
;; after we found the matching node for these prims, we're done!
(return 0)
)
(set! s0-0 (-> s0-0 next))
)
)
(return 0))
(set! s0-0 (-> s0-0 next))))
;; nope, didn't find an entry, so make a new one.
(let ((s0-1 (alloc-node *touching-prims-entry-pool*)))
;; allocate a new node, link it.
@@ -297,58 +203,31 @@
(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)
)
)
(if v1-22 (set! (-> v1-22 prev) s0-1)))
;; and set it up.
(set! (-> s0-1 u) arg2)
(when (>= arg2 0.0)
;; if we're >0, we have to move (which we haven't done yet) to actually collide.
;; flag us as resolve-u (meaning our u is from the resolve function, which looks at what _would_
;; happen if we did it all at once.)
;; if we're <0, we started in collision (possible, if we didnt' converge on the last frame)
;; we should still add, but we don't need to bother with the "did we go far enough" checks.
(set! (-> s2-0 resolve-u) 1)
(set! (-> this resolve-u) 1)
)
(set! (-> this resolve-u) 1))
(let ((v1-26 (-> s0-1 prim1))
(a1-4 (-> gp-0 tri1))
)
(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) 84)
)
(else
(set! (-> v1-26 has-tri?) #f)
)
)
)
(a1-4 (set! (-> v1-26 has-tri?) #t) (mem-copy! (the-as pointer (-> v1-26 tri)) (the-as pointer a1-4) 84))
(else (set! (-> v1-26 has-tri?) #f))))
(let ((v1-29 (-> s0-1 prim2))
(a1-5 (-> gp-0 tri2))
)
(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) 84)
)
(else
(set! (-> v1-29 has-tri?) #f)
)
)
)
)
)
)
)
)
(a1-5 (set! (-> v1-29 has-tri?) #t) (mem-copy! (the-as pointer (-> v1-29 tri)) (the-as pointer a1-5) 84))
(else (set! (-> v1-29 has-tri?) #f)))))))))
0
(none)
)
(none))
(defmethod update-from-step-size ((this touching-list) (arg0 float))
"Given that we actually will take a step size of arg0, remove things we won't actually hit."
@@ -356,7 +235,6 @@
(when (nonzero? (-> this resolve-u))
;; remember we did it
(set! (-> this resolve-u) 0)
;; loop through touching-shape-entries
(let ((s5-0 (the-as touching-shapes-entry (-> this touching-shapes))))
(countdown (s4-0 (-> this num-touching-shapes))
@@ -381,52 +259,26 @@
;; we set the u to -1.0 to indicate that we're massively intersecting.
;; this will no longer be eligible for removal because we actually hit it.
(set! (-> s3-0 u) -1.0)
(set! s3-0 (-> s3-0 next))
)
(set! s3-0 (-> s3-0 next)))
(else
;; we would have needed to move more than arg0 to hit this one.
;; at least for now, remove by splicing out of the list and freeing.
(let ((a1-1 s3-0)) ;; this
(let ((v1-7 (-> s3-0 next))) ;; next
(let ((a0-1 (-> s3-0 prev))) ;; prev
(if a0-1
(set! (-> a0-1 next) v1-7)
(set! (-> s5-0 head) v1-7)
)
(if v1-7
(set! (-> v1-7 prev) a0-1)
)
)
(set! s3-0 v1-7)
)
(free-node *touching-prims-entry-pool* a1-1)
)
)
)
s3-0
)
;; we would have needed to move more than arg0 to hit this one.
;; at least for now, remove by splicing out of the list and freeing.
(let ((a1-1 s3-0)) ;; this
(let ((v1-7 (-> s3-0 next))) ;; next
(let ((a0-1 (-> s3-0 prev))) ;; prev
(if a0-1 (set! (-> a0-1 next) v1-7) (set! (-> s5-0 head) v1-7))
(if v1-7 (set! (-> v1-7 prev) a0-1)))
(set! s3-0 v1-7))
(free-node *touching-prims-entry-pool* a1-1))))
s3-0)
(else
;; not touching, advance to the next.
(-> s3-0 next)
)
)
)
)
)
)
;; not touching, advance to the next.
(-> s3-0 next)))))))
;; if we removed everything from this, mark it as dead (the allocation function will reuse it now)
(if (not (-> s5-0 head))
(set! (-> s5-0 cshape1) #f)
)
)
)
(&+! s5-0 16)
)
)
)
(if (not (-> s5-0 head)) (set! (-> s5-0 cshape1) #f))))
(&+! s5-0 16))))
0
(none)
)
(none))
(defmethod send-events-for-touching-shapes ((this touching-list))
"Send all events for touching shapes.
@@ -439,80 +291,39 @@
;; the touching list will run its logic on it regardless.
;; this is fixed here by creating a really large list of 2 handles per collide shape and storing all collided
;; process handles there. (process->handle) is then safe to use.
; (* 2 TOUCHING_LIST_LENGTH) -> 64
(let ((handles (new 'stack-no-clear 'array 'handle 64)))
(let ((entry (the-as touching-shapes-entry (-> this touching-shapes))))
(countdown (i (-> this num-touching-shapes))
(let ((c1 (-> entry cshape1)))
(when c1
(let ((c2 (-> entry cshape2)))
;; not quite sure why, but we make it look like cshape1 (s4) is target always.
;; I guess this makes it so the target/enemy events are always sent in the same order.
(when (= (-> c2 process type) target)
(swap! c1 c2)
)
(set! (-> handles (+ 0 (* 2 i))) (process->handle (-> c1 process)))
(set! (-> handles (+ 1 (* 2 i))) (process->handle (-> c2 process)))
)
)
)
(set! entry (-> (the-as (inline-array touching-shapes-entry) entry) 1))
)
)
(let ((entry (the-as touching-shapes-entry (-> this touching-shapes))))
(countdown (i (-> this num-touching-shapes))
(let ((c1 (-> entry cshape1)))
(when c1
(let ((c2 (-> entry cshape2)))
;; not quite sure why, but we make it look like cshape1 (s4) is target always.
;; I guess this makes it so the target/enemy events are always sent in the same order.
(when (= (-> c2 process type) target)
(swap! c1 c2)
)
;; send events!
(let (
(c1-proc (handle->process (-> handles (+ 0 (* 2 i)))))
(c2-proc (handle->process (-> handles (+ 1 (* 2 i)))))
)
(let ((v1-4 (-> c1 event-self)))
(if v1-4
(send-event c1-proc v1-4 :from c2-proc entry)
)
)
(let ((v1-5 (-> c1 event-other)))
(if v1-5
(send-event c2-proc v1-5 :from c1-proc entry)
)
)
(let ((v1-6 (-> c2 event-self)))
(if v1-6
(send-event c2-proc v1-6 :from c1-proc entry)
)
)
(let ((v1-7 (-> c2 event-other)))
(if v1-7
(send-event c1-proc v1-7 :from c2-proc entry)
)
)
)
)
)
)
(set! entry (-> (the-as (inline-array touching-shapes-entry) entry) 1))
)
)
)
(let ((entry (the-as touching-shapes-entry (-> this touching-shapes))))
(countdown (i (-> this num-touching-shapes))
(let ((c1 (-> entry cshape1)))
(when c1
(let ((c2 (-> entry cshape2)))
;; not quite sure why, but we make it look like cshape1 (s4) is target always.
;; I guess this makes it so the target/enemy events are always sent in the same order.
(when (= (-> c2 process type) target)
(swap! c1 c2))
(set! (-> handles (+ 0 (* 2 i))) (process->handle (-> c1 process)))
(set! (-> handles (+ 1 (* 2 i))) (process->handle (-> c2 process))))))
(set! entry (-> (the-as (inline-array touching-shapes-entry) entry) 1))))
(let ((entry (the-as touching-shapes-entry (-> this touching-shapes))))
(countdown (i (-> this num-touching-shapes))
(let ((c1 (-> entry cshape1)))
(when c1
(let ((c2 (-> entry cshape2)))
;; not quite sure why, but we make it look like cshape1 (s4) is target always.
;; I guess this makes it so the target/enemy events are always sent in the same order.
(when (= (-> c2 process type) target)
(swap! c1 c2))
;; send events!
(let ((c1-proc (handle->process (-> handles (+ 0 (* 2 i)))))
(c2-proc (handle->process (-> handles (+ 1 (* 2 i))))))
(let ((v1-4 (-> c1 event-self))) (if v1-4 (send-event c1-proc v1-4 :from c2-proc entry)))
(let ((v1-5 (-> c1 event-other))) (if v1-5 (send-event c2-proc v1-5 :from c1-proc entry)))
(let ((v1-6 (-> c2 event-self))) (if v1-6 (send-event c2-proc v1-6 :from c1-proc entry)))
(let ((v1-7 (-> c2 event-other))) (if v1-7 (send-event c1-proc v1-7 :from c2-proc entry)))))))
(set! entry (-> (the-as (inline-array touching-shapes-entry) entry) 1)))))
0
(none)
)
(none))
(defmethod prims-touching? ((this touching-shapes-entry) (arg0 collide-shape-moving) (arg1 uint))
"In a pair of collide shapes, is a prim from the given collide shape with the given prim-id mask touching the other shape?"
@@ -520,29 +331,15 @@
((= (-> 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))
)
)
)
(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)
)
(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))
(defmethod prims-touching-action? ((this touching-shapes-entry) (arg0 collide-shape) (arg1 collide-action) (arg2 collide-action))
"In a pair of collide shapes, find a pair of colliding prims where the prim from the given collide shape has at least one of the actions in arg1
@@ -552,81 +349,38 @@
(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 v1-1)
)
)
(set! v1-1 (-> v1-1 next))
)
)
)
(if (and (logtest? arg1 (-> a0-1 prim-core action)) (not (logtest? arg2 (-> a0-1 prim-core action)))) (return 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 v1-4)
)
)
(set! v1-4 (-> v1-4 next))
)
)
)
(else
(format 0 "ERROR: touching-shapes-entry::prims-touching-action? : Bogus cshape value!~%")
)
)
(the-as touching-prims-entry #f)
)
(if (and (logtest? arg1 (-> a0-5 prim-core action)) (not (logtest? arg2 (-> a0-5 prim-core action)))) (return v1-4)))
(set! v1-4 (-> v1-4 next)))))
(else (format 0 "ERROR: touching-shapes-entry::prims-touching-action? : Bogus cshape value!~%")))
(the-as touching-prims-entry #f))
(defmethod get-touched-shape ((this touching-shapes-entry) (arg0 collide-shape))
"Get the other shape in a pair of shapes."
(cond
((= (-> this cshape1) arg0)
(return (-> this cshape2))
)
((= (-> this cshape2) arg0)
(return (-> this cshape1))
)
)
(the-as collide-shape #f)
)
((= (-> 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 trsqv) (arg1 touching-shapes-entry))
"Get the primitive belonging to the collide shape that is touching."
(cond
((= (-> arg1 cshape1) arg0)
(return (-> this prim1 cprim))
)
((= (-> arg1 cshape2) arg0)
(return (-> this prim2 cprim))
)
)
(the-as collide-shape-prim #f)
)
((= (-> 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))
"Get the triangle belonging to the the collide shape that is touching (if it has one, otherwise #f)"
(let ((v0-0 (the-as collide-tri-result #f)))
(cond
((= (-> arg1 cshape1) arg0)
(let ((v1-2 (-> this prim1)))
(if (-> v1-2 has-tri?)
(set! v0-0 (-> v1-2 tri))
)
)
)
((= (-> arg1 cshape2) arg0)
(let ((v1-5 (-> this prim2)))
(if (-> v1-5 has-tri?)
(set! v0-0 (-> v1-5 tri))
)
)
)
)
v0-0
)
)
((= (-> arg1 cshape1) arg0) (let ((v1-2 (-> this prim1))) (if (-> v1-2 has-tri?) (set! v0-0 (-> v1-2 tri)))))
((= (-> arg1 cshape2) arg0) (let ((v1-5 (-> this prim2))) (if (-> v1-5 has-tri?) (set! v0-0 (-> v1-5 tri))))))
v0-0))
(defmethod get-middle-of-bsphere-overlap ((this touching-prims-entry) (arg0 vector))
"This is a bit weird...
@@ -634,27 +388,12 @@
that is inside of both spheres, and get the midpoint of that."
(let* ((s4-0 (-> this prim1 cprim))
(s3-0 (-> this prim2 cprim))
;; compute the offset between the prim cores.
(gp-1 (vector-!
(new 'stack-no-clear 'vector)
(the-as vector (-> s3-0 prim-core))
(the-as vector (-> s4-0 prim-core))
)
)
)
(gp-1 (vector-! (new 'stack-no-clear 'vector) (the-as vector (-> s3-0 prim-core)) (the-as vector (-> s4-0 prim-core)))))
;; subtract off the two radius. this is now the offset between the "closest" points (and is negative)
(let ((f1-2 (- (- (vector-length gp-1) (-> s3-0 prim-core world-sphere w)) (-> s4-0 prim-core world-sphere w))))
;; this offset is the radius, minus half the overlap distance
(vector-normalize! gp-1 (+ (-> s4-0 prim-core world-sphere w) (* 0.5 f1-2)))
)
(vector-normalize! gp-1 (+ (-> s4-0 prim-core world-sphere w) (* 0.5 f1-2))))
;; so add it to s4's origin to get to the halfway point
(vector+! arg0 gp-1 (the-as vector (-> s4-0 prim-core)))
)
arg0
)
(vector+! arg0 gp-1 (the-as vector (-> s4-0 prim-core))))
arg0)
+18 -21
View File
@@ -1,7 +1,6 @@
;;-*-Lisp-*-
(in-package goal)
(bundles "ENGINE.CGO" "GAME.CGO")
(require "kernel-defs.gc")
;; name: collide.gc
@@ -10,23 +9,21 @@
;; DECOMP BEGINS
(define *collide-vif0-init* (the-as (array uint32) (new 'static 'boxed-array :type uint32
#x30000000
#x4d000000
#x4d000000
#x4d000000
#x3f800000
#x5000001
#x20000000
#x40404040
#x1000404
#x0
#x0
#x0
)
)
)
(define *collide-vif0-init*
(the-as (array uint32)
(new 'static
'boxed-array
:type
uint32
#x30000000
#x4d000000
#x4d000000
#x4d000000
#x3f800000
#x5000001
#x20000000
#x40404040
#x1000404
#x0
#x0
#x0)))
+137 -175
View File
@@ -1,7 +1,6 @@
;;-*-Lisp-*-
(in-package goal)
(bundles "ENGINE.CGO" "GAME.CGO")
(require "engine/math/vector-h.gc")
(require "engine/gfx/tie/tie-h.gc")
(require "engine/ps2/vu1-macros.gc")
@@ -17,79 +16,67 @@
;; Used lq/sq
(defun drawable-sphere-box-intersect? ((arg0 drawable) (arg1 bounding-box4w))
(local-vars
(r0-0 int)
(r0-1 int)
(r0-2 uint128)
(r0-3 int)
(v1-1 uint128)
(v1-2 uint128)
(v1-3 uint128)
(a0-1 uint128)
(a1-2 uint128)
(a2-0 uint128)
(f31-0 none)
)
(r0-0 int)
(r0-1 int)
(r0-2 uint128)
(r0-3 int)
(v1-1 uint128)
(v1-2 uint128)
(v1-3 uint128)
(a0-1 uint128)
(a1-2 uint128)
(a2-0 uint128)
(f31-0 none))
(rlet ((vf1 :class vf)
(vf2 :class vf)
(vf3 :class vf)
(vf4 :class vf)
)
(nop!)
(nop!)
(.lvf vf1 (&-> arg0 bsphere quad))
(.add.w.vf vf2 vf1 vf1 :mask #b111)
(let ((v1-0 (-> arg1 min quad)))
(.sub.w.vf vf1 vf1 vf1 :mask #b111)
(let ((a1-1 (-> arg1 max quad)))
(.ftoi.vf vf4 vf2)
(nop!)
(.ftoi.vf vf3 vf1)
(nop!)
(.mov a0-1 vf4)
(nop!)
(.mov a2-0 vf3)
(nop!)
(.pcgtw a1-2 a2-0 a1-1)
)
(.mov r0-0 f31-0)
(.pcgtw v1-1 v1-0 a0-1)
)
(.mov r0-1 f31-0)
(.por v1-2 a1-2 v1-1)
(.mov r0-2 f31-0)
(.ppach v1-3 r0-2 v1-2)
(.mov r0-3 f31-0)
(let ((v1-4 (shl (the-as int v1-3) 16)))
(vf4 :class vf))
(nop!)
(zero? v1-4)
)
)
)
(nop!)
(.lvf vf1 (&-> arg0 bsphere quad))
(.add.w.vf vf2 vf1 vf1 :mask #b111)
(let ((v1-0 (-> arg1 min quad)))
(.sub.w.vf vf1 vf1 vf1 :mask #b111)
(let ((a1-1 (-> arg1 max quad)))
(.ftoi.vf vf4 vf2)
(nop!)
(.ftoi.vf vf3 vf1)
(nop!)
(.mov a0-1 vf4)
(nop!)
(.mov a2-0 vf3)
(nop!)
(.pcgtw a1-2 a2-0 a1-1))
(.mov r0-0 f31-0)
(.pcgtw v1-1 v1-0 a0-1))
(.mov r0-1 f31-0)
(.por v1-2 a1-2 v1-1)
(.mov r0-2 f31-0)
(.ppach v1-3 r0-2 v1-2)
(.mov r0-3 f31-0)
(let ((v1-4 (shl (the-as int v1-3) 16))) (nop!) (zero? v1-4))))
;; definition for function instance-sphere-box-intersect?
;; WARN: Function may read a register that is not set: f31
;; Used lq/sq
(defun
instance-sphere-box-intersect?
((arg0 drawable) (arg1 instance-tie) (arg2 bounding-box4w))
(defun instance-sphere-box-intersect? ((arg0 drawable) (arg1 instance-tie) (arg2 bounding-box4w))
(local-vars
(zero uint128)
(v1-3 uint128)
(v1-4 uint128)
(v1-5 uint128)
(a0-2 uint128)
(a1-2 uint128)
(a2-1 uint128)
(a3-1 uint128)
(a3-3 uint128)
(a3-4 uint128)
(t0-1 uint128)
(t0-2 uint128)
(t1-0 uint128)
(t2-1 uint128)
(t2-2 uint128)
(f31-0 none)
)
(zero uint128)
(v1-3 uint128)
(v1-4 uint128)
(v1-5 uint128)
(a0-2 uint128)
(a1-2 uint128)
(a2-1 uint128)
(a3-1 uint128)
(a3-3 uint128)
(a3-4 uint128)
(t0-1 uint128)
(t0-2 uint128)
(t1-0 uint128)
(t2-1 uint128)
(t2-2 uint128)
(f31-0 none))
(rlet ((acc :class vf)
(vf0 :class vf)
(vf1 :class vf)
@@ -101,86 +88,73 @@
(vf6 :class vf)
(vf7 :class vf)
(vf8 :class vf)
(vf9 :class vf)
)
(init-vf0-vector)
(nop!)
(let ((v1-0 (-> arg1 max-scale)))
(vf9 :class vf))
(init-vf0-vector)
(nop!)
(let ((a3-0 (the-as uint128 (-> arg1 origin vector4h 3 long))))
(nop!)
(let ((t2-0 (the-as uint128 (-> arg1 origin vector4h 0 long))))
(.pextlh a3-1 a3-0 zero)
(let ((t0-0 (the-as uint128 (-> arg1 origin vector4h 1 long))))
(.pw.sra t1-0 a3-1 10)
(let ((a3-2 (the-as uint128 (-> arg1 origin vector4h 2 long))))
(.pextlh t2-1 t2-0 zero)
(.pw.sra t2-2 t2-1 16)
(.pextlh t0-1 t0-0 zero)
(.mov vf8 t1-0)
(.pw.sra t0-2 t0-1 16)
(.mov vf5 t2-2)
(.pextlh a3-3 a3-2 zero)
)
)
)
)
(.mov vf6 t0-2)
(.pw.sra a3-4 a3-3 16)
(.lvf vf9 (&-> arg1 bsphere quad))
(let ((v1-0 (-> arg1 max-scale)))
(nop!)
(let ((a3-0 (the-as uint128 (-> arg1 origin vector4h 3 long))))
(nop!)
(let ((t2-0 (the-as uint128 (-> arg1 origin vector4h 0 long))))
(.pextlh a3-1 a3-0 zero)
(let ((t0-0 (the-as uint128 (-> arg1 origin vector4h 1 long))))
(.pw.sra t1-0 a3-1 10)
(let ((a3-2 (the-as uint128 (-> arg1 origin vector4h 2 long))))
(.pextlh t2-1 t2-0 zero)
(.pw.sra t2-2 t2-1 16)
(.pextlh t0-1 t0-0 zero)
(.mov vf8 t1-0)
(.pw.sra t0-2 t0-1 16)
(.mov vf5 t2-2)
(.pextlh a3-3 a3-2 zero)))))
(.mov vf6 t0-2)
(.pw.sra a3-4 a3-3 16)
(.lvf vf9 (&-> arg1 bsphere quad))
(nop!)
(.mov vf7 a3-4)
(nop!)
(.mov vf10 v1-0))
(.itof.vf vf8 vf8)
(nop!)
(.mov vf7 a3-4)
(vitof12.xyzw vf5 vf5)
(nop!)
(.mov vf10 v1-0)
)
(.itof.vf vf8 vf8)
(nop!)
(vitof12.xyzw vf5 vf5)
(nop!)
(vitof12.xyzw vf6 vf6)
(nop!)
(vitof12.xyzw vf7 vf7)
(nop!)
(.add.vf vf8 vf8 vf9 :mask #b111)
(nop!)
(nop!)
(.lvf vf9 (&-> arg0 bsphere quad))
(vitof12.xyzw vf10 vf10)
(nop!)
(.mul.w.vf vf10 vf10 vf9 :mask #b1)
(nop!)
(.mul.x.vf acc vf5 vf9)
(nop!)
(.add.mul.y.vf acc vf6 vf9 acc)
(let ((v1-2 (-> arg2 min quad)))
(.add.mul.z.vf acc vf7 vf9 acc)
(let ((a1-1 (-> arg2 max quad)))
(.add.mul.w.vf vf1 vf8 vf0 acc)
(nop!)
(.add.x.vf vf2 vf1 vf10 :mask #b111)
(nop!)
(.sub.x.vf vf1 vf1 vf10 :mask #b111)
(nop!)
(.ftoi.vf vf4 vf2)
(nop!)
(.ftoi.vf vf3 vf1)
(nop!)
(.mov a0-2 vf4)
(nop!)
(.mov a2-1 vf3)
(nop!)
(.pcgtw a1-2 a2-1 a1-1)
)
(.pcgtw v1-3 v1-2 a0-2)
)
(.por v1-4 a1-2 v1-3)
(.ppach v1-5 zero v1-4)
(let ((v1-6 (shl (the-as int v1-5) 16)))
(vitof12.xyzw vf6 vf6)
(nop!)
(zero? v1-6)
)
)
)
(vitof12.xyzw vf7 vf7)
(nop!)
(.add.vf vf8 vf8 vf9 :mask #b111)
(nop!)
(nop!)
(.lvf vf9 (&-> arg0 bsphere quad))
(vitof12.xyzw vf10 vf10)
(nop!)
(.mul.w.vf vf10 vf10 vf9 :mask #b1)
(nop!)
(.mul.x.vf acc vf5 vf9)
(nop!)
(.add.mul.y.vf acc vf6 vf9 acc)
(let ((v1-2 (-> arg2 min quad)))
(.add.mul.z.vf acc vf7 vf9 acc)
(let ((a1-1 (-> arg2 max quad)))
(.add.mul.w.vf vf1 vf8 vf0 acc)
(nop!)
(.add.x.vf vf2 vf1 vf10 :mask #b111)
(nop!)
(.sub.x.vf vf1 vf1 vf10 :mask #b111)
(nop!)
(.ftoi.vf vf4 vf2)
(nop!)
(.ftoi.vf vf3 vf1)
(nop!)
(.mov a0-2 vf4)
(nop!)
(.mov a2-1 vf3)
(nop!)
(.pcgtw a1-2 a2-1 a1-1))
(.pcgtw v1-3 v1-2 a0-2))
(.por v1-4 a1-2 v1-3)
(.ppach v1-5 zero v1-4)
(let ((v1-6 (shl (the-as int v1-5) 16))) (nop!) (zero? v1-6))))
;; definition for function instance-tfragment-add-debug-sphere
;; Used lq/sq
@@ -190,37 +164,25 @@
(vf10 :class vf)
(vf11 :class vf)
(vf12 :class vf)
(vf9 :class vf)
)
(init-vf0-vector)
(nop!)
(let ((v1-0 (the-as uint128 (-> arg1 origin vector4h 3 long))))
(.pextlh v1-1 v1-0 r0-0)
)
(.lvf vf9 (&-> arg0 bsphere quad))
(.pw.sra v1-2 v1-1 10)
(.lvf vf10 (&-> arg1 bsphere quad))
(nop!)
(.mov vf12 v1-2)
(.itof.vf vf12 vf12)
(nop!)
(.add.vf vf10 vf10 vf12 :mask #b111)
(nop!)
(.add.vf vf9 vf9 vf10 :mask #b111)
(nop!)
(.add.w.vf vf11 vf0 vf9 :mask #b1)
(nop!)
(.mov a3-0 vf11)
(nop!)
(let ((a2-0 (new-stack-vector0)))
(.svf (&-> a2-0 quad) vf9)
(add-debug-sphere
#t
(bucket-id debug)
a2-0
a3-0
(new 'static 'rgba :r #x80 :g #x80 :b #x80 :a #x80)
)
)
)
)
(vf9 :class vf))
(init-vf0-vector)
(nop!)
(let ((v1-0 (the-as uint128 (-> arg1 origin vector4h 3 long)))) (.pextlh v1-1 v1-0 r0-0))
(.lvf vf9 (&-> arg0 bsphere quad))
(.pw.sra v1-2 v1-1 10)
(.lvf vf10 (&-> arg1 bsphere quad))
(nop!)
(.mov vf12 v1-2)
(.itof.vf vf12 vf12)
(nop!)
(.add.vf vf10 vf10 vf12 :mask #b111)
(nop!)
(.add.vf vf9 vf9 vf10 :mask #b111)
(nop!)
(.add.w.vf vf11 vf0 vf9 :mask #b1)
(nop!)
(.mov a3-0 vf11)
(nop!)
(let ((a2-0 (new-stack-vector0)))
(.svf (&-> a2-0 quad) vf9)
(add-debug-sphere #t (bucket-id debug) a2-0 a3-0 (new 'static 'rgba :r #x80 :g #x80 :b #x80 :a #x80)))))
+57 -59
View File
@@ -1,7 +1,6 @@
;;-*-Lisp-*-
(in-package goal)
(bundles "ENGINE.CGO" "GAME.CGO")
(require "engine/math/math.gc")
;; name: pat-h.gc
@@ -32,15 +31,13 @@
(swamp)
(stopproj)
(rotate)
(neutral)
)
(neutral))
(defenum pat-mode
:type uint8
(ground)
(wall)
(obstacle)
)
(obstacle))
(defenum pat-event
:type uint8
@@ -50,8 +47,7 @@
(burn)
(deadlyup)
(burnup)
(melt)
)
(melt))
;; DECOMP BEGINS
@@ -59,65 +55,67 @@
;; It packs all data into a 32-bit pat-surface type.
(deftype pat-surface (uint32)
((skip uint8 :offset 0 :size 3)
(mode pat-mode :offset 3 :size 3)
(material pat-material :offset 6 :size 6)
(camera uint8 :offset 12 :size 2)
(event pat-event :offset 14 :size 6)
(noentity uint8 :offset 0 :size 1)
(nocamera uint8 :offset 1 :size 1)
(noedge uint8 :offset 2 :size 1)
(nolineofsight uint8 :offset 12 :size 1)
(unknown-bit uint8 :offset 15 :size 1)
)
)
((skip uint8 :offset 0 :size 3)
(mode pat-mode :offset 3 :size 3)
(material pat-material :offset 6 :size 6)
(camera uint8 :offset 12 :size 2)
(event pat-event :offset 14 :size 6)
(noentity uint8 :offset 0 :size 1)
(nocamera uint8 :offset 1 :size 1)
(noedge uint8 :offset 2 :size 1)
(nolineofsight uint8 :offset 12 :size 1)
(unknown-bit uint8 :offset 15 :size 1)))
(defun-debug pat-material->string ((pat pat-surface))
(enum->string pat-material (-> pat material))
)
(enum->string pat-material (-> pat material)))
(defun-debug pat-mode->string ((pat pat-surface))
(enum->string pat-mode (-> pat mode))
)
(enum->string pat-mode (-> pat mode)))
(defun-debug pat-event->string ((pat pat-surface))
(enum->string pat-event (-> pat event))
)
(enum->string pat-event (-> pat event)))
;; for debug drawing pat's by mode.
(deftype pat-mode-info (structure)
((name string)
(wall-angle float)
(color rgba)
(hilite-color rgba)
)
)
((name string)
(wall-angle float)
(color rgba)
(hilite-color rgba)))
(define *pat-mode-info* (new 'static 'inline-array pat-mode-info 4
(new 'static 'pat-mode-info
:name "ground"
:wall-angle 0.2
:color (new 'static 'rgba :r #x7f :a #x40)
:hilite-color (new 'static 'rgba :r #xff :a #x80)
)
(new 'static 'pat-mode-info
:name "wall"
:wall-angle 2.0
:color (new 'static 'rgba :b #x7f :a #x40)
:hilite-color (new 'static 'rgba :b #xff :a #x80)
)
(new 'static 'pat-mode-info
:name "obstacle"
:wall-angle 0.82
:color (new 'static 'rgba :r #x7f :b #x7f :a #x40)
:hilite-color (new 'static 'rgba :r #xff :b #xff :a #x80)
)
(new 'static 'pat-mode-info
:name "pole"
:wall-angle 2.0
:color (new 'static 'rgba :r #x7f :g #x7f :a #x40)
:hilite-color (new 'static 'rgba :r #xff :g #xff :a #x80)
)
)
)
(define *pat-mode-info*
(new 'static
'inline-array
pat-mode-info
4
(new 'static
'pat-mode-info
:name "ground"
:wall-angle 0.2
:color
(new 'static 'rgba :r #x7f :a #x40)
:hilite-color
(new 'static 'rgba :r #xff :a #x80))
(new 'static
'pat-mode-info
:name "wall"
:wall-angle 2.0
:color
(new 'static 'rgba :b #x7f :a #x40)
:hilite-color
(new 'static 'rgba :b #xff :a #x80))
(new 'static
'pat-mode-info
:name "obstacle"
:wall-angle 0.82
:color
(new 'static 'rgba :r #x7f :b #x7f :a #x40)
:hilite-color
(new 'static 'rgba :r #xff :b #xff :a #x80))
(new 'static
'pat-mode-info
:name "pole"
:wall-angle 2.0
:color
(new 'static 'rgba :r #x7f :g #x7f :a #x40)
:hilite-color
(new 'static 'rgba :r #xff :g #xff :a #x80))))
File diff suppressed because it is too large Load Diff
+174 -234
View File
@@ -1,7 +1,6 @@
;;-*-Lisp-*-
(in-package goal)
(bundles "GAME.CGO")
(require "engine/common-obs/nav-enemy.gc")
;; name: babak.gc
@@ -10,241 +9,197 @@
;; DECOMP BEGINS
(deftype babak (nav-enemy)
()
(deftype babak (nav-enemy) ()
(:states
babak-run-to-cannon
)
)
babak-run-to-cannon))
(defskelgroup *babak-sg* babak babak-lod0-jg -1
(defskelgroup *babak-sg*
babak
babak-lod0-jg
-1
((babak-lod0-mg (meters 20)) (babak-lod1-mg (meters 40)) (babak-lod2-mg (meters 999999)))
:bounds (static-spherem 0 2 0 3)
:bounds
(static-spherem 0 2 0 3)
:longest-edge (meters 1)
:shadow babak-shadow-mg
)
:shadow
babak-shadow-mg)
(defstate nav-enemy-patrol (babak)
:virtual #t
:code (behavior ()
(cond
((ja-group? babak-give-up-hop-ja)
(ja-channel-push! 1 (seconds 0.15))
(ja-no-eval :group! babak-walk-ja :num! (seek!) :frame-num (ja-aframe 12.0 0))
(until (ja-done? 0)
(suspend)
(ja :num! (seek!))
)
)
(else
(ja-channel-push! 1 (seconds 0.2))
)
)
((the-as (function none) (-> (method-of-type nav-enemy nav-enemy-patrol) code)))
)
)
:code
(behavior ()
(cond
((ja-group? babak-give-up-hop-ja)
(ja-channel-push! 1 (seconds 0.15))
(ja-no-eval :group! babak-walk-ja :num! (seek!) :frame-num (ja-aframe 12.0 0))
(until (ja-done? 0)
(suspend)
(ja :num! (seek!))))
(else (ja-channel-push! 1 (seconds 0.2))))
((the-as (function none) (-> (method-of-type nav-enemy nav-enemy-patrol) code)))))
(defstate nav-enemy-chase (babak)
:virtual #t
:code (behavior ()
(let ((f30-0 (nav-enemy-rnd-float-range 0.9 1.1)))
(cond
((ja-group? babak-jump-land-ja)
(ja-no-eval :num! (seek!))
(ja-channel-push! 1 (seconds 0.17))
(ja-no-eval :group! (-> self draw art-group data (-> self nav-info run-anim))
:num! (seek! max f30-0)
:frame-num 0.0
)
(until (ja-done? 0)
(ja-blend-eval)
(suspend)
(ja :num! (seek! max f30-0))
)
)
(else
(ja-channel-push! 1 (seconds 0.2))
(ja :group! (-> self draw art-group data (-> self nav-info run-anim)))
(ja :num-func num-func-identity :frame-num 0.0)
)
)
(loop
(suspend)
(ja :num! (loop! f30-0))
)
)
)
)
:code
(behavior ()
(let ((f30-0 (nav-enemy-rnd-float-range 0.9 1.1)))
(cond
((ja-group? babak-jump-land-ja)
(ja-no-eval :num! (seek!))
(ja-channel-push! 1 (seconds 0.17))
(ja-no-eval :group! (-> self draw art-group data (-> self nav-info run-anim)) :num! (seek! max f30-0) :frame-num 0.0)
(until (ja-done? 0)
(ja-blend-eval)
(suspend)
(ja :num! (seek! max f30-0))))
(else
(ja-channel-push! 1 (seconds 0.2))
(ja :group! (-> self draw art-group data (-> self nav-info run-anim)))
(ja :num-func num-func-identity :frame-num 0.0)))
(loop (suspend)
(ja :num! (loop! f30-0))))))
(defstate nav-enemy-stare (babak)
:virtual #t
:code (behavior ()
(set! (-> self turn-time) (seconds 0.2))
(let ((f30-0 (nav-enemy-rnd-float-range 0.8 1.2)))
(when (or (logtest? (-> self nav-enemy-flags) (nav-enemy-flags navenmf8))
(and (nav-enemy-player-vulnerable?) (nav-enemy-rnd-percent? 0.5))
)
(ja-channel-push! 1 (seconds 0.1))
(ja-no-eval :group! babak-win-ja :num! (seek! (ja-aframe 68.0 0) f30-0) :frame-num 0.0)
(until (ja-done? 0)
(suspend)
(ja :num! (seek! (ja-aframe 68.0 0) f30-0))
)
)
(loop
(when (not (nav-enemy-facing-player? 2730.6667))
(logior! (-> self nav-enemy-flags) (nav-enemy-flags enable-travel))
(ja-no-eval :num! (loop!))
(ja-channel-push! 1 (seconds 0.2))
(ja :group! babak-turn-ja)
(ja :num-func num-func-identity :frame-num 0.0)
(until (nav-enemy-facing-player? 1820.4445)
(ja-blend-eval)
(suspend)
(ja :num! (loop! 0.75))
)
(logclear! (-> self nav-enemy-flags) (nav-enemy-flags enable-travel))
)
(if (not (ja-group? babak-idle-ja))
(ja-channel-push! 1 (seconds 0.2))
)
(ja-no-eval :group! babak-idle-ja :num! (seek! max f30-0) :frame-num 0.0)
(until (ja-done? 0)
(suspend)
(ja :num! (seek! max f30-0))
)
(when (nav-enemy-rnd-percent? 0.3)
:code
(behavior ()
(set! (-> self turn-time) (seconds 0.2))
(let ((f30-0 (nav-enemy-rnd-float-range 0.8 1.2)))
(when (or (logtest? (-> self nav-enemy-flags) (nav-enemy-flags navenmf8))
(and (nav-enemy-player-vulnerable?) (nav-enemy-rnd-percent? 0.5)))
(ja-channel-push! 1 (seconds 0.1))
(ja-no-eval :group! babak-win-ja :num! (seek! (ja-aframe 68.0 0) f30-0) :frame-num 0.0)
(until (ja-done? 0)
(suspend)
(ja :num! (seek! (ja-aframe 68.0 0) f30-0))
)
)
)
)
)
)
(ja :num! (seek! (ja-aframe 68.0 0) f30-0))))
(loop (when (not (nav-enemy-facing-player? 2730.6667))
(logior! (-> self nav-enemy-flags) (nav-enemy-flags enable-travel))
(ja-no-eval :num! (loop!))
(ja-channel-push! 1 (seconds 0.2))
(ja :group! babak-turn-ja)
(ja :num-func num-func-identity :frame-num 0.0)
(until (nav-enemy-facing-player? 1820.4445)
(ja-blend-eval)
(suspend)
(ja :num! (loop! 0.75)))
(logclear! (-> self nav-enemy-flags) (nav-enemy-flags enable-travel)))
(if (not (ja-group? babak-idle-ja)) (ja-channel-push! 1 (seconds 0.2)))
(ja-no-eval :group! babak-idle-ja :num! (seek! max f30-0) :frame-num 0.0)
(until (ja-done? 0)
(suspend)
(ja :num! (seek! max f30-0)))
(when (nav-enemy-rnd-percent? 0.3)
(ja-channel-push! 1 (seconds 0.1))
(ja-no-eval :group! babak-win-ja :num! (seek! (ja-aframe 68.0 0) f30-0) :frame-num 0.0)
(until (ja-done? 0)
(suspend)
(ja :num! (seek! (ja-aframe 68.0 0) f30-0))))))))
(defstate nav-enemy-give-up (babak)
:virtual #t
:code (behavior ()
(set! (-> self rotate-speed) 218453.33)
(set! (-> self turn-time) (seconds 0.5))
(ja-channel-push! 1 (seconds 0.15))
(let ((s4-0 (-> self collide-info))
(s5-0 (target-pos 0))
)
(when (< (fabs
(deg-diff (y-angle s4-0) (vector-y-angle (vector-! (new 'stack-no-clear 'vector) s5-0 (-> s4-0 trans))))
)
12743.111
)
(ja-no-eval :group! babak-give-up-ja :num! (seek!) :frame-num 0.0)
(until (ja-done? 0)
(suspend)
(ja :num! (seek!))
)
)
)
(logclear! (-> self nav flags) (nav-control-flags navcf17 navcf19))
(nav-enemy-get-new-patrol-point)
(ja-no-eval :group! babak-give-up-hop-ja :num! (seek!) :frame-num 0.0)
(until (ja-done? 0)
(seek-to-point-toward-point!
(-> self collide-info)
(-> self nav destination-pos)
(-> self rotate-speed)
(-> self turn-time)
)
(suspend)
(ja :num! (seek!))
)
(go-virtual nav-enemy-patrol)
)
)
:code
(behavior ()
(set! (-> self rotate-speed) 218453.33)
(set! (-> self turn-time) (seconds 0.5))
(ja-channel-push! 1 (seconds 0.15))
(let ((s4-0 (-> self collide-info))
(s5-0 (target-pos 0)))
(when (< (fabs (deg-diff (y-angle s4-0) (vector-y-angle (vector-! (new 'stack-no-clear 'vector) s5-0 (-> s4-0 trans)))))
12743.111)
(ja-no-eval :group! babak-give-up-ja :num! (seek!) :frame-num 0.0)
(until (ja-done? 0)
(suspend)
(ja :num! (seek!)))))
(logclear! (-> self nav flags) (nav-control-flags navcf17 navcf19))
(nav-enemy-get-new-patrol-point)
(ja-no-eval :group! babak-give-up-hop-ja :num! (seek!) :frame-num 0.0)
(until (ja-done? 0)
(seek-to-point-toward-point! (-> self collide-info)
(-> self nav destination-pos)
(-> self rotate-speed)
(-> self turn-time))
(suspend)
(ja :num! (seek!)))
(go-virtual nav-enemy-patrol)))
(defstate nav-enemy-jump-land (babak)
:virtual #t
:code (behavior ()
(ja-no-eval :num! (seek!))
(ja-channel-push! 1 (seconds 0.075))
(ja-no-eval :group! (-> self draw art-group data (-> self nav-info jump-land-anim))
:num! (seek! (ja-aframe 32.0 0) 0.5)
:frame-num 0.0
)
(until (ja-done? 0)
(ja-blend-eval)
(suspend)
(ja :num! (seek! (ja-aframe 32.0 0) 0.5))
)
(go-virtual nav-enemy-chase)
)
)
:code
(behavior ()
(ja-no-eval :num! (seek!))
(ja-channel-push! 1 (seconds 0.075))
(ja-no-eval :group!
(-> self draw art-group data (-> self nav-info jump-land-anim))
:num!
(seek! (ja-aframe 32.0 0) 0.5)
:frame-num 0.0)
(until (ja-done? 0)
(ja-blend-eval)
(suspend)
(ja :num! (seek! (ja-aframe 32.0 0) 0.5)))
(go-virtual nav-enemy-chase)))
(define *babak-nav-enemy-info* (new 'static 'nav-enemy-info
:idle-anim 5
:walk-anim 6
:turn-anim 16
:notice-anim 7
:run-anim 8
:jump-anim 13
:jump-land-anim 14
:victory-anim 11
:taunt-anim 11
:die-anim 12
:neck-joint 5
:player-look-at-joint 5
:run-travel-speed (meters 6)
:run-rotate-speed (degrees 2880)
:run-acceleration (meters 1)
:run-turn-time (seconds 0.1)
:walk-travel-speed (meters 3)
:walk-rotate-speed (degrees 720)
:walk-acceleration (meters 1)
:walk-turn-time (seconds 0.5)
:attack-shove-back (meters 3)
:attack-shove-up (meters 2)
:shadow-size (meters 2)
:notice-nav-radius (meters 2)
:nav-nearest-y-threshold (meters 10)
:notice-distance (meters 30)
:proximity-notice-distance (meters 20)
:stop-chase-distance (meters 40)
:frustration-distance (meters 8)
:frustration-time (seconds 4)
:die-anim-hold-frame 24.0
:jump-anim-start-frame 10.0
:jump-land-anim-end-frame 10000000000.0
:jump-height-min (meters 3)
:jump-height-factor 0.5
:jump-start-anim-speed 1.0
:shadow-max-y (meters 1)
:shadow-min-y (meters -1)
:shadow-locus-dist (meters 150)
:use-align #t
:draw-shadow #t
:move-to-ground #t
:hover-if-no-ground #f
:use-momentum #f
:use-flee #t
:use-proximity-notice #t
:use-jump-blocked #t
:use-jump-patrol #f
:gnd-collide-with (collide-kind background)
:debug-draw-neck #f
:debug-draw-jump #f
)
)
(define *babak-nav-enemy-info*
(new 'static
'nav-enemy-info
:idle-anim 5
:walk-anim 6
:turn-anim 16
:notice-anim 7
:run-anim 8
:jump-anim 13
:jump-land-anim 14
:victory-anim 11
:taunt-anim 11
:die-anim 12
:neck-joint 5
:player-look-at-joint 5
:run-travel-speed (meters 6)
:run-rotate-speed (degrees 2880)
:run-acceleration (meters 1)
:run-turn-time (seconds 0.1)
:walk-travel-speed (meters 3)
:walk-rotate-speed (degrees 720)
:walk-acceleration (meters 1)
:walk-turn-time (seconds 0.5)
:attack-shove-back (meters 3)
:attack-shove-up (meters 2)
:shadow-size (meters 2)
:notice-nav-radius (meters 2)
:nav-nearest-y-threshold (meters 10)
:notice-distance (meters 30)
:proximity-notice-distance (meters 20)
:stop-chase-distance (meters 40)
:frustration-distance (meters 8)
:frustration-time (seconds 4)
:die-anim-hold-frame 24.0
:jump-anim-start-frame 10.0
:jump-land-anim-end-frame 10000000000.0
:jump-height-min (meters 3)
:jump-height-factor 0.5
:jump-start-anim-speed 1.0
:shadow-max-y (meters 1)
:shadow-min-y (meters -1)
:shadow-locus-dist (meters 150)
:use-align #t
:draw-shadow #t
:move-to-ground #t
:hover-if-no-ground #f
:use-momentum #f
:use-flee #t
:use-proximity-notice #t
:use-jump-blocked #t
:use-jump-patrol #f
:gnd-collide-with
(collide-kind background)
:debug-draw-neck #f
:debug-draw-jump #f))
(defmethod initialize-collision ((this babak))
(let ((s5-0 (new 'process 'collide-shape-moving this (collide-list-enum usually-hit-by-player))))
(set! (-> s5-0 dynam) (copy *standard-dynamics* 'process))
(set! (-> s5-0 reaction) default-collision-reaction)
(set! (-> s5-0 no-reaction)
(the-as (function collide-shape-moving collide-shape-intersect vector vector none) nothing)
)
(set! (-> s5-0 no-reaction) (the-as (function collide-shape-moving collide-shape-intersect vector vector none) nothing))
(let ((s4-0 (new 'process 'collide-shape-prim-group s5-0 (the-as uint 3) 0)))
(set! (-> s4-0 prim-core collide-as) (collide-kind enemy))
(set! (-> s4-0 collide-with) (collide-kind target))
@@ -257,58 +212,43 @@
(set! (-> s3-0 prim-core action) (collide-action solid))
(set! (-> s3-0 prim-core offense) (collide-offense touch))
(set-vector! (-> s3-0 local-sphere) 0.0 4096.0 0.0 3072.0)
(append-prim s4-0 s3-0)
)
(append-prim s4-0 s3-0))
(let ((s3-1 (new 'process 'collide-shape-prim-sphere s5-0 (the-as uint 3))))
(set! (-> s3-1 prim-core collide-as) (collide-kind enemy))
(set! (-> s3-1 collide-with) (collide-kind target))
(set! (-> s3-1 prim-core action) (collide-action solid))
(set! (-> s3-1 prim-core offense) (collide-offense touch))
(set-vector! (-> s3-1 local-sphere) 0.0 9830.4 0.0 3072.0)
(append-prim s4-0 s3-1)
)
(append-prim s4-0 s3-1))
(let ((s3-2 (new 'process 'collide-shape-prim-sphere s5-0 (the-as uint 1))))
(set! (-> s3-2 prim-core collide-as) (collide-kind enemy))
(set! (-> s3-2 collide-with) (collide-kind target))
(set! (-> s3-2 prim-core offense) (collide-offense normal-attack))
(set! (-> s3-2 transform-index) 6)
(set-vector! (-> s3-2 local-sphere) 0.0 0.0 0.0 2048.0)
(append-prim s4-0 s3-2)
)
)
(append-prim s4-0 s3-2)))
(set! (-> s5-0 nav-radius) 6144.0)
(backup-collide-with-as s5-0)
(set! (-> s5-0 max-iteration-count) (the-as uint 2))
(set! (-> this collide-info) s5-0)
)
(set! (-> this collide-info) s5-0))
0
(none)
)
(none))
(defmethod nav-enemy-method-48 ((this babak))
(initialize-skeleton this *babak-sg* '())
(initialize-skeleton this *babak-sg* ())
(init-defaults! this *babak-nav-enemy-info*)
(set! (-> this neck up) (the-as uint 0))
(set! (-> this neck nose) (the-as uint 1))
(set! (-> this neck ear) (the-as uint 2))
0
(none)
)
(none))
(defmethod nav-enemy-method-59 ((this babak))
(cond
((and (and (-> this entity) (logtest? (-> this entity extra perm status) (entity-perm-status complete)))
(logtest? (-> this enemy-info options) (fact-options has-power-cell))
)
(go (method-of-object this nav-enemy-fuel-cell))
)
((logtest? (-> this enemy-info options) (fact-options fop5))
(go (method-of-object this nav-enemy-wait-for-cue))
)
(else
(go (method-of-object this nav-enemy-idle))
)
)
(logtest? (-> this enemy-info options) (fact-options has-power-cell)))
(go (method-of-object this nav-enemy-fuel-cell)))
((logtest? (-> this enemy-info options) (fact-options fop5)) (go (method-of-object this nav-enemy-wait-for-cue)))
(else (go (method-of-object this nav-enemy-idle))))
0
(none)
)
(none))
+324 -512
View File
@@ -1,284 +1,199 @@
;;-*-Lisp-*-
(in-package goal)
(bundles "GAME.CGO")
(require "engine/common-obs/generic-obs.gc")
(require "engine/target/logic-target.gc")
;; name: basebutton.gc
;; name in dgo: basebutton
;; dgos: GAME, COMMON, L1
;; name in dgo: basebutton
;; dgos: GAME, COMMON, L1
;; DECOMP BEGINS
(deftype basebutton (process-drawable)
((root collide-shape-moving :override)
(down? symbol)
(spawned-by-other? symbol)
(move-to? symbol)
(notify-actor entity-actor)
(timeout float)
(button-id int32)
(event-going-down symbol)
(event-down symbol)
(event-going-up symbol)
(event-up symbol)
(anim-speed float)
(move-to-pos vector :inline)
(move-to-quat quaternion :inline)
)
((root collide-shape-moving :override)
(down? symbol)
(spawned-by-other? symbol)
(move-to? symbol)
(notify-actor entity-actor)
(timeout float)
(button-id int32)
(event-going-down symbol)
(event-down symbol)
(event-going-up symbol)
(event-up symbol)
(anim-speed float)
(move-to-pos vector :inline)
(move-to-quat quaternion :inline))
(:state-methods
basebutton-down-idle
basebutton-going-down
basebutton-going-up
basebutton-startup
basebutton-up-idle
)
basebutton-down-idle
basebutton-going-down
basebutton-going-up
basebutton-startup
basebutton-up-idle)
(:methods
(reset! (_type_) float)
(basebutton-method-26 (_type_) none)
(basebutton-method-27 (_type_) collide-shape-moving)
(arm-trigger-event! (_type_) symbol)
(basebutton-method-29 (_type_ symbol entity) none)
(move-to-vec-or-quat! (_type_ vector quaternion) quaternion)
(press! (_type_ symbol) int)
)
)
(reset! (_type_) float)
(basebutton-method-26 (_type_) none)
(basebutton-method-27 (_type_) collide-shape-moving)
(arm-trigger-event! (_type_) symbol)
(basebutton-method-29 (_type_ symbol entity) none)
(move-to-vec-or-quat! (_type_ vector quaternion) quaternion)
(press! (_type_ symbol) int)))
(defskelgroup *generic-button-sg* generic-button generic-button-lod0-jg generic-button-idle-ja
((generic-button-lod0-mg (meters 999999)))
:bounds (static-spherem 0 0 0 3)
)
(defskelgroup *generic-button-sg*
generic-button
generic-button-lod0-jg
generic-button-idle-ja
((generic-button-lod0-mg (meters 999999)))
:bounds
(static-spherem 0 0 0 3))
(defmethod move-to-vec-or-quat! ((this basebutton) (arg0 vector) (arg1 quaternion))
(set! (-> this move-to?) #t)
(if arg0
(set! (-> this move-to-pos quad) (-> arg0 quad))
(set! (-> this move-to-pos quad) (-> this root trans quad))
)
(if arg1
(quaternion-copy! (-> this move-to-quat) arg1)
(quaternion-copy! (-> this move-to-quat) (-> this root quat))
)
)
(if arg0 (set! (-> this move-to-pos quad) (-> arg0 quad)) (set! (-> this move-to-pos quad) (-> this root trans quad)))
(if arg1 (quaternion-copy! (-> this move-to-quat) arg1) (quaternion-copy! (-> this move-to-quat) (-> this root quat))))
(defstate basebutton-startup (basebutton)
:virtual #t
:code (behavior ()
(if (-> self down?)
(go-virtual basebutton-down-idle)
(go-virtual basebutton-up-idle)
)
)
)
:code
(behavior ()
(if (-> self down?) (go-virtual basebutton-down-idle) (go-virtual basebutton-up-idle))))
(defstate basebutton-up-idle (basebutton)
:virtual #t
:event (behavior ((proc process) (argc int) (message symbol) (block event-message-block))
(case message
(('attack)
(case (-> block param 1)
(('flop)
(basebutton-method-29 self (-> self event-going-down) (-> self notify-actor))
(sound-play "silo-button")
(go-virtual basebutton-going-down)
)
)
)
(('trigger)
(sound-play "silo-button")
(go-virtual basebutton-going-down)
)
(('move-to)
(move-to-vec-or-quat! self (the-as vector (-> block param 0)) (the-as quaternion (-> block param 1)))
)
)
)
:enter (behavior ()
(press! self #f)
)
:trans (behavior ()
(if (-> self move-to?)
(rider-trans)
)
)
:event
(behavior ((proc process) (argc int) (message symbol) (block event-message-block))
(case message
(('attack)
(case (-> block param 1)
(('flop)
(basebutton-method-29 self (-> self event-going-down) (-> self notify-actor))
(sound-play "silo-button")
(go-virtual basebutton-going-down))))
(('trigger) (sound-play "silo-button") (go-virtual basebutton-going-down))
(('move-to) (move-to-vec-or-quat! self (the-as vector (-> block param 0)) (the-as quaternion (-> block param 1))))))
:enter
(behavior ()
(press! self #f))
:trans
(behavior ()
(if (-> self move-to?) (rider-trans)))
:code anim-loop
:post (behavior ()
(when (-> self move-to?)
(set! (-> self move-to?) #f)
(set! (-> self root trans quad) (-> self move-to-pos quad))
(quaternion-copy! (-> self root quat) (-> self move-to-quat))
(rider-post)
)
)
)
:post
(behavior ()
(when (-> self move-to?)
(set! (-> self move-to?) #f)
(set! (-> self root trans quad) (-> self move-to-pos quad))
(quaternion-copy! (-> self root quat) (-> self move-to-quat))
(rider-post))))
(defstate basebutton-going-down (basebutton)
:virtual #t
:event (behavior ((proc process) (argc int) (message symbol) (block event-message-block))
(case message
(('untrigger)
(sound-play "silo-button")
(go-virtual basebutton-going-up)
)
(('move-to)
(move-to-vec-or-quat! self (the-as vector (-> block param 0)) (the-as quaternion (-> block param 1)))
)
)
)
:enter (behavior ()
(press! self #t)
)
:event
(behavior ((proc process) (argc int) (message symbol) (block event-message-block))
(case message
(('untrigger) (sound-play "silo-button") (go-virtual basebutton-going-up))
(('move-to) (move-to-vec-or-quat! self (the-as vector (-> block param 0)) (the-as quaternion (-> block param 1))))))
:enter
(behavior ()
(press! self #t))
:trans rider-trans
:code (behavior ()
(ja-no-eval :num! (seek! max (-> self anim-speed)))
(until (ja-done? 0)
(suspend)
(ja :num! (seek! max (-> self anim-speed)))
)
(basebutton-method-29 self (-> self event-down) (-> self notify-actor))
(go-virtual basebutton-down-idle)
)
:post (behavior ()
(when (-> self move-to?)
(set! (-> self move-to?) #f)
(set! (-> self root trans quad) (-> self move-to-pos quad))
(quaternion-copy! (-> self root quat) (-> self move-to-quat))
)
(rider-post)
)
)
:code
(behavior ()
(ja-no-eval :num! (seek! max (-> self anim-speed)))
(until (ja-done? 0)
(suspend)
(ja :num! (seek! max (-> self anim-speed))))
(basebutton-method-29 self (-> self event-down) (-> self notify-actor))
(go-virtual basebutton-down-idle))
:post
(behavior ()
(when (-> self move-to?)
(set! (-> self move-to?) #f)
(set! (-> self root trans quad) (-> self move-to-pos quad))
(quaternion-copy! (-> self root quat) (-> self move-to-quat)))
(rider-post)))
(defstate basebutton-down-idle (basebutton)
:virtual #t
:event (behavior ((proc process) (argc int) (message symbol) (block event-message-block))
(case message
(('untrigger)
(sound-play "silo-button")
(go-virtual basebutton-going-up)
)
(('move-to)
(move-to-vec-or-quat! self (the-as vector (-> block param 0)) (the-as quaternion (-> block param 1)))
)
)
)
:enter (behavior ()
(press! self #t)
)
:trans (behavior ()
(if (-> self move-to?)
(rider-trans)
)
)
:code (behavior ()
(set-time! (-> self state-time))
(cond
((= (-> self timeout) 0.0)
(anim-loop)
)
(else
(until (time-elapsed? (-> self state-time) (the int (* 300.0 (-> self timeout))))
(suspend)
)
(basebutton-method-29 self (-> self event-going-up) (-> self notify-actor))
(sound-play "silo-button")
(go-virtual basebutton-going-up)
)
)
)
:post (behavior ()
(when (-> self move-to?)
(set! (-> self move-to?) #f)
(set! (-> self root trans quad) (-> self move-to-pos quad))
(quaternion-copy! (-> self root quat) (-> self move-to-quat))
(rider-post)
)
)
)
:event
(behavior ((proc process) (argc int) (message symbol) (block event-message-block))
(case message
(('untrigger) (sound-play "silo-button") (go-virtual basebutton-going-up))
(('move-to) (move-to-vec-or-quat! self (the-as vector (-> block param 0)) (the-as quaternion (-> block param 1))))))
:enter
(behavior ()
(press! self #t))
:trans
(behavior ()
(if (-> self move-to?) (rider-trans)))
:code
(behavior ()
(set-time! (-> self state-time))
(cond
((= (-> self timeout) 0.0) (anim-loop))
(else
(until (time-elapsed? (-> self state-time) (the int (* 300.0 (-> self timeout))))
(suspend))
(basebutton-method-29 self (-> self event-going-up) (-> self notify-actor))
(sound-play "silo-button")
(go-virtual basebutton-going-up))))
:post
(behavior ()
(when (-> self move-to?)
(set! (-> self move-to?) #f)
(set! (-> self root trans quad) (-> self move-to-pos quad))
(quaternion-copy! (-> self root quat) (-> self move-to-quat))
(rider-post))))
(defstate basebutton-going-up (basebutton)
:virtual #t
:event (behavior ((proc process) (argc int) (message symbol) (block event-message-block))
(case message
(('move-to)
(move-to-vec-or-quat! self (the-as vector (-> block param 0)) (the-as quaternion (-> block param 1)))
)
(('trigger)
(sound-play "silo-button")
(go-virtual basebutton-going-down)
)
)
)
:enter (behavior ()
(press! self #f)
)
:event
(behavior ((proc process) (argc int) (message symbol) (block event-message-block))
(case message
(('move-to) (move-to-vec-or-quat! self (the-as vector (-> block param 0)) (the-as quaternion (-> block param 1))))
(('trigger) (sound-play "silo-button") (go-virtual basebutton-going-down))))
:enter
(behavior ()
(press! self #f))
:trans rider-trans
:code (behavior ()
(ja-no-eval :num! (seek! 0.0 (-> self anim-speed)))
(until (ja-done? 0)
(suspend)
(ja :num! (seek! 0.0 (-> self anim-speed)))
)
(basebutton-method-29 self (-> self event-up) (-> self notify-actor))
(go-virtual basebutton-up-idle)
)
:post (behavior ()
(when (-> self move-to?)
(set! (-> self move-to?) #f)
(set! (-> self root trans quad) (-> self move-to-pos quad))
(quaternion-copy! (-> self root quat) (-> self move-to-quat))
)
(rider-post)
)
)
:code
(behavior ()
(ja-no-eval :num! (seek! 0.0 (-> self anim-speed)))
(until (ja-done? 0)
(suspend)
(ja :num! (seek! 0.0 (-> self anim-speed))))
(basebutton-method-29 self (-> self event-up) (-> self notify-actor))
(go-virtual basebutton-up-idle))
:post
(behavior ()
(when (-> self move-to?)
(set! (-> self move-to?) #f)
(set! (-> self root trans quad) (-> self move-to-pos quad))
(quaternion-copy! (-> self root quat) (-> self move-to-quat)))
(rider-post)))
(defmethod press! ((this basebutton) (arg0 symbol))
(set! (-> this down?) arg0)
(cond
(arg0
(if (not (-> this spawned-by-other?))
(process-entity-status! this (entity-perm-status complete) #t)
)
)
(else
(if (not (-> this spawned-by-other?))
(process-entity-status! this (entity-perm-status complete) #f)
)
)
)
)
(arg0 (if (not (-> this spawned-by-other?)) (process-entity-status! this (entity-perm-status complete) #t)))
(else (if (not (-> this spawned-by-other?)) (process-entity-status! this (entity-perm-status complete) #f)))))
(defmethod basebutton-method-29 ((this basebutton) (arg0 symbol) (arg1 entity))
(with-pp
(when arg0
(cond
(arg1
(let ((v1-0 (new 'stack-no-clear 'event-message-block)))
(set! (-> v1-0 from) pp)
(set! (-> v1-0 num-params) 0)
(set! (-> v1-0 message) arg0)
(let ((a1-1 arg1))
(send-event-function
(if a1-1
(-> a1-1 extra process)
)
v1-0
)
)
)
)
(else
(if (nonzero? (-> this link))
(send-to-all (-> this link) arg0)
)
)
)
)
(none)
)
)
(let ((v1-0 (new 'stack-no-clear 'event-message-block)))
(set! (-> v1-0 from) pp)
(set! (-> v1-0 num-params) 0)
(set! (-> v1-0 message) arg0)
(let ((a1-1 arg1)) (send-event-function (if a1-1 (-> a1-1 extra process)) v1-0))))
(else (if (nonzero? (-> this link)) (send-to-all (-> this link) arg0)))))
(none)))
(defmethod reset! ((this basebutton))
(set! (-> this down?) #f)
@@ -290,57 +205,34 @@
(set! (-> this event-down) #f)
(set! (-> this event-going-up) #f)
(set! (-> this event-up) #f)
(set! (-> this anim-speed) 1.0)
)
(set! (-> this anim-speed) 1.0))
(defmethod arm-trigger-event! ((this basebutton))
(let ((v0-0 'trigger))
(set! (-> this event-going-down) v0-0)
v0-0
)
)
(let ((v0-0 'trigger)) (set! (-> this event-going-down) v0-0) v0-0))
(defmethod basebutton-method-26 ((this basebutton))
(initialize-skeleton this *generic-button-sg* '())
(initialize-skeleton this *generic-button-sg* ())
(logior! (-> this skel status) (janim-status inited))
(ja-channel-set! 1)
(cond
((-> this down?)
(let ((s5-0 (-> this skel root-channel 0)))
(joint-control-channel-group-eval!
s5-0
(the-as art-joint-anim (-> this draw art-group data 2))
num-func-identity
)
(set! (-> s5-0 frame-num)
(the float (+ (-> (the-as art-joint-anim (-> this draw art-group data 2)) data 0 length) -1))
)
)
)
(joint-control-channel-group-eval! s5-0 (the-as art-joint-anim (-> this draw art-group data 2)) num-func-identity)
(set! (-> s5-0 frame-num) (the float (+ (-> (the-as art-joint-anim (-> this draw art-group data 2)) data 0 length) -1)))))
(else
(let ((s5-1 (-> this skel root-channel 0)))
(joint-control-channel-group-eval!
s5-1
(the-as art-joint-anim (-> this draw art-group data 2))
num-func-identity
)
(set! (-> s5-1 frame-num) 0.0)
)
)
)
(let ((s5-1 (-> this skel root-channel 0)))
(joint-control-channel-group-eval! s5-1 (the-as art-joint-anim (-> this draw art-group data 2)) num-func-identity)
(set! (-> s5-1 frame-num) 0.0))))
(set! (-> this anim-speed) 2.0)
(update-transforms! (-> this root))
(ja-post)
(none)
)
(none))
(defmethod basebutton-method-27 ((this basebutton))
(let ((s5-0 (new 'process 'collide-shape-moving this (collide-list-enum hit-by-player))))
(set! (-> s5-0 dynam) (copy *standard-dynamics* 'process))
(set! (-> s5-0 reaction) default-collision-reaction)
(set! (-> s5-0 no-reaction)
(the-as (function collide-shape-moving collide-shape-intersect vector vector none) nothing)
)
(set! (-> s5-0 no-reaction) (the-as (function collide-shape-moving collide-shape-intersect vector vector none) nothing))
(alloc-riders s5-0 1)
(let ((s4-0 (new 'process 'collide-shape-prim-group s5-0 (the-as uint 2) 0)))
(set! (-> s4-0 prim-core collide-as) (collide-kind ground-object))
@@ -355,8 +247,7 @@
(set! (-> s3-0 prim-core offense) (collide-offense indestructible))
(set! (-> s3-0 transform-index) 4)
(set-vector! (-> s3-0 local-sphere) 0.0 0.0 0.0 12288.0)
(append-prim s4-0 s3-0)
)
(append-prim s4-0 s3-0))
(let ((s3-1 (new 'process 'collide-shape-prim-mesh s5-0 (the-as uint 1) (the-as uint 0))))
(set! (-> s3-1 prim-core collide-as) (collide-kind ground-object))
(set! (-> s3-1 collide-with) (collide-kind target))
@@ -364,49 +255,33 @@
(set! (-> s3-1 prim-core offense) (collide-offense indestructible))
(set! (-> s3-1 transform-index) 3)
(set-vector! (-> s3-1 local-sphere) 0.0 0.0 0.0 12288.0)
(append-prim s4-0 s3-1)
)
)
(append-prim s4-0 s3-1)))
(set! (-> s5-0 nav-radius) (* 0.75 (-> s5-0 root-prim local-sphere w)))
(backup-collide-with-as s5-0)
(set! (-> this root) s5-0)
s5-0
)
)
s5-0))
(defmethod init-from-entity! ((this basebutton) (arg0 entity-actor))
(reset! this)
(set! (-> this spawned-by-other?) #f)
(set! (-> this button-id) -1)
(let ((v1-4 (res-lump-value (-> this entity) 'extra-id uint128 :default (the-as uint128 -1))))
(if (>= (the-as int v1-4) 0)
(set! (-> this button-id) (the-as int v1-4))
)
)
(if (>= (the-as int v1-4) 0) (set! (-> this button-id) (the-as int v1-4))))
(when (or (res-lump-struct arg0 'next-actor structure) (res-lump-struct arg0 'prev-actor structure))
(set! (-> this link) (new 'process 'actor-link-info this))
(if (< (-> this button-id) 0)
(set! (-> this button-id) (actor-count-before (-> this link)))
)
)
(if (< (-> this button-id) 0) (set! (-> this button-id) (actor-count-before (-> this link)))))
(basebutton-method-27 this)
(process-drawable-from-entity! this arg0)
(let ((v1-16 #f))
(if (and (-> this entity) (logtest? (-> this entity extra perm status) (entity-perm-status complete)))
(set! v1-16 #t)
)
(set! (-> this down?) v1-16)
)
(if (and (-> this entity) (logtest? (-> this entity extra perm status) (entity-perm-status complete))) (set! v1-16 #t))
(set! (-> this down?) v1-16))
(set! (-> this notify-actor) (entity-actor-lookup arg0 'alt-actor 0))
(set! (-> this timeout) (res-lump-float arg0 'timeout))
(if (not (-> this spawned-by-other?))
(nav-mesh-connect this (-> this root) (the-as nav-control #f))
)
(if (not (-> this spawned-by-other?)) (nav-mesh-connect this (-> this root) (the-as nav-control #f)))
(arm-trigger-event! this)
(basebutton-method-26 this)
(go (method-of-object this basebutton-startup))
(none)
)
(none))
(defbehavior basebutton-init-by-other basebutton ((arg0 entity-actor) (arg1 vector) (arg2 quaternion) (arg3 entity-actor) (arg4 symbol) (arg5 float))
(reset! self)
@@ -415,9 +290,7 @@
(set! (-> self down?) arg4)
(set! (-> self notify-actor) arg3)
(set! (-> self timeout) arg5)
(if arg0
(set! (-> self entity) arg0)
)
(if arg0 (set! (-> self entity) arg0))
(basebutton-method-27 self)
(set! (-> self root trans quad) (-> arg1 quad))
(quaternion-copy! (-> self root quat) arg2)
@@ -425,228 +298,167 @@
(arm-trigger-event! self)
(basebutton-method-26 self)
(go-virtual basebutton-startup)
(none)
)
(none))
(define *warp-info* (new 'static 'boxed-array :type string
"training-warp"
"village1-warp"
"village2-warp"
"village3-warp"
"citadel-warp"
)
)
(define *warp-info*
(new 'static 'boxed-array :type string "training-warp" "village1-warp" "village2-warp" "village3-warp" "citadel-warp"))
(deftype warp-gate (process-drawable)
((level symbol)
(level-slot int32)
(min-slot int32)
(max-slot int32)
)
((level symbol)
(level-slot int32)
(min-slot int32)
(max-slot int32))
(:state-methods
idle
active
(use int level)
hidden
)
)
idle
active
(use int level)
hidden))
(defstate use (warp-gate)
:virtual #t
:trans (behavior ()
(send-event *camera* 'joystick 0.0 0.0)
)
:code (behavior ((arg0 int) (arg1 level))
(set-time! (-> self state-time))
(when (not arg1)
(process-release? *target*)
(go-virtual idle)
)
(let ((s4-0 (new 'stack-no-clear 'event-message-block)))
(set! (-> s4-0 from) self)
(set! (-> s4-0 num-params) 3)
(set! (-> s4-0 message) 'change-state)
(set! (-> s4-0 param 0) (the-as uint target-warp-out))
(let ((v1-9 (new 'static 'vector)))
(set! (-> v1-9 quad) (-> self root trans quad))
(set! (-> s4-0 param 1) (the-as uint v1-9))
)
(set! (-> s4-0 param 2) (the-as uint (target-pos 0)))
(send-event-function *target* s4-0)
)
;; og:preserve-this
;; NOTE : added case for "training" here. in the original game, the training level does NOT come
;; with its own code for warp gates and buttons, and uses the villagep-obs imported from village1
;; instead. opengoal loads files different enough that warp from training to anywhere except village1
;; crashes the game due to running unlinked code. the original game also crashes, but it is not consistent.
;; the citadel/lavatube case makes it so we wait until it's safe to unload both levels in the heaps,
;; since the citadel warp gate is located in both levels at once (visually lavatube, technically citadel)
;; we add "training" to the list here so that the training warp gate waits until it's safe to
;; dispose the old code from memory.
(case (-> self level)
(('citadel 'lavatube 'training)
(while (and *target* (not (logtest? (-> *target* draw status) (draw-status hidden))))
(suspend)
)
)
(else
(load-state-want-levels (-> self level) (-> arg1 load-name))
(while (or (not (member (level-status *level* (-> arg1 load-name)) '(loaded active)))
(not (time-elapsed? (-> self state-time) (seconds 2)))
)
(suspend)
)
)
)
(set-blackout-frames (seconds 0.05))
(start 'play (get-continue-by-name *game-info* (-> *warp-info* arg0)))
(logior! (-> self mask) (process-mask sleep))
(suspend)
0
)
)
:trans
(behavior ()
(send-event *camera* 'joystick 0.0 0.0))
:code
(behavior ((arg0 int) (arg1 level))
(set-time! (-> self state-time))
(when (not arg1)
(process-release? *target*)
(go-virtual idle))
(let ((s4-0 (new 'stack-no-clear 'event-message-block)))
(set! (-> s4-0 from) self)
(set! (-> s4-0 num-params) 3)
(set! (-> s4-0 message) 'change-state)
(set! (-> s4-0 param 0) (the-as uint target-warp-out))
(let ((v1-9 (new 'static 'vector)))
(set! (-> v1-9 quad) (-> self root trans quad))
(set! (-> s4-0 param 1) (the-as uint v1-9)))
(set! (-> s4-0 param 2) (the-as uint (target-pos 0)))
(send-event-function *target* s4-0))
;; og:preserve-this
;; NOTE : added case for "training" here. in the original game, the training level does NOT come
;; with its own code for warp gates and buttons, and uses the villagep-obs imported from village1
;; instead. opengoal loads files different enough that warp from training to anywhere except village1
;; crashes the game due to running unlinked code. the original game also crashes, but it is not consistent.
;; the citadel/lavatube case makes it so we wait until it's safe to unload both levels in the heaps,
;; since the citadel warp gate is located in both levels at once (visually lavatube, technically citadel)
;; we add "training" to the list here so that the training warp gate waits until it's safe to
;; dispose the old code from memory.
(case (-> self level)
(('citadel 'lavatube 'training)
(while (and *target* (not (logtest? (-> *target* draw status) (draw-status hidden))))
(suspend)))
(else
(load-state-want-levels (-> self level) (-> arg1 load-name))
(while (or (not (member (level-status *level* (-> arg1 load-name)) '(loaded active)))
(not (time-elapsed? (-> self state-time) (seconds 2))))
(suspend))))
(set-blackout-frames (seconds 0.05))
(start 'play (get-continue-by-name *game-info* (-> *warp-info* arg0)))
(logior! (-> self mask) (process-mask sleep))
(suspend)
0))
(define *warp-jump-mods* (new 'static 'surface
:name 'jump
:turnv 273066.66
:turnvv 1820444.5
:tiltv 32768.0
:tiltvv 131072.0
:transv-max 65536.0
:target-speed 65536.0
:slip-factor 1.0
:slide-factor 1.0
:slope-up-factor 1.0
:slope-down-factor 1.0
:slope-slip-angle 1.0
:impact-fric 1.0
:bend-factor 1.0
:bend-speed 1.0
:alignv 1.0
:slope-up-traction 1.0
:align-speed 1.0
:mode 'air
:flags (surface-flags always-rotate-toward-transv)
)
)
(define *warp-jump-mods*
(new 'static
'surface
:name 'jump
:turnv 273066.66
:turnvv 1820444.5
:tiltv 32768.0
:tiltvv 131072.0
:transv-max 65536.0
:target-speed 65536.0
:slip-factor 1.0
:slide-factor 1.0
:slope-up-factor 1.0
:slope-down-factor 1.0
:slope-slip-angle 1.0
:impact-fric 1.0
:bend-factor 1.0
:bend-speed 1.0
:alignv 1.0
:slope-up-traction 1.0
:align-speed 1.0
:mode 'air
:flags (surface-flags always-rotate-toward-transv)))
(defstate target-warp-out (target)
:event (behavior ((proc process) (argc int) (message symbol) (block event-message-block))
(case message
(('death-end)
(let ((v0-0 (the-as object (logior (-> self draw status) (draw-status hidden)))))
(set! (-> self draw status) (the-as draw-status v0-0))
v0-0
)
)
(else
(target-generic-event-handler proc argc message block)
)
)
)
:enter (behavior ((arg0 vector) (arg1 vector))
(set-time! (-> self state-time))
(logclear! (-> self control status) (cshape-moving-flags onsurf onground tsurf))
(set! (-> self control unknown-surface00) *warp-jump-mods*)
(set! (-> self control unknown-vector102 quad) (-> arg0 quad))
(set! (-> self control unknown-vector103 quad) (-> arg1 quad))
(+! (-> self control unknown-vector102 y) -4096.0)
(set! (-> self control unknown-uint20) (the-as uint #f))
(vector-reset! (-> self control transv))
(logior! (-> self state-flags) (state-flags use-alt-cam-pos))
(set! (-> self alt-cam-pos quad) (-> arg1 quad))
)
:exit (behavior ()
(logclear! (-> self state-flags) (state-flags use-alt-cam-pos))
)
:code (behavior ((arg0 vector) (arg1 vector))
(send-event *camera* 'change-state cam-fixed 0)
(ja-channel-push! 1 (seconds 0.2))
(ja-no-eval :group! eichar-duck-high-jump-ja :num! (seek! (ja-aframe 16.0 0)) :frame-num 0.0)
(until (ja-done? 0)
(suspend)
(ja :num! (seek! (ja-aframe 16.0 0)))
)
(vector-! (-> self control transv) (-> self control unknown-vector102) (-> self control trans))
(vector-xz-normalize! (-> self control transv) 32768.0)
(let ((gp-2 (new-stack-vector0)))
(let ((f0-6 (vector-dot (-> self control dynam gravity-normal) (-> self control transv))))
0.0
(vector-! gp-2 (-> self control transv) (vector-float*! gp-2 (-> self control dynam gravity-normal) f0-6))
)
(let* ((f0-7 (vector-length gp-2))
(f1-1 f0-7)
(f2-4
(- (sqrtf
(* 2.0
(-> self control dynam gravity-length)
(vector-dot
(-> self control dynam gravity-normal)
(vector-! (new 'stack-no-clear 'vector) (-> self control unknown-vector102) (-> self control trans))
)
)
)
(* 0.008333334 (- (-> self control dynam gravity-length)))
)
)
)
(vector+!
(-> self control transv)
(vector-float*! (-> self control transv) (-> self control dynam gravity-normal) f2-4)
(vector-float*! gp-2 gp-2 (/ f0-7 f1-1))
)
)
)
(clear-collide-with-as (-> self control))
(set-time! (-> self state-time))
(set! (-> self trans-hook)
(lambda :behavior target
()
(let ((gp-0 (new-stack-vector0))
(f30-0 (vector-dot (-> self control dynam gravity-normal) (-> self control transv)))
)
0.0
(vector-! gp-0 (-> self control transv) (vector-float*! gp-0 (-> self control dynam gravity-normal) f30-0))
(let* ((f0-3 (vector-length gp-0))
(f1-0 f0-3)
)
(if (< f30-0 0.0)
(set! f30-0 8192.0)
)
(vector+!
(-> self control transv)
(vector-float*! (-> self control transv) (-> self control dynam gravity-normal) f30-0)
(vector-float*! gp-0 gp-0 (/ f0-3 f1-0))
)
)
)
(let ((gp-2 (vector-! (new-stack-vector0) (-> self control unknown-vector102) (-> self control trans))))
(set! (-> gp-2 y) 0.0)
(send-event *target* 'sidekick #f)
(when (and (or (< (vector-dot gp-2 (-> self control transv)) 0.0) (-> self control unknown-spoolanim00))
(time-elapsed? (-> self state-time) (seconds 0.05))
)
(vector-seek! (-> self draw color-mult) (new 'static 'vector) (* 2.0 (seconds-per-frame)))
(set! (-> self control transv x) (* 0.95 (-> self control transv x)))
(set! (-> self control transv z) (* 0.95 (-> self control transv z)))
(when (not (-> self control unknown-spoolanim00))
(send-event self 'do-effect 'death-warp-out -1.0)
(let ((v0-2 #t))
(set! (-> self control unknown-uint20) (the-as uint v0-2))
v0-2
)
)
)
)
)
)
(ja-no-eval :group! eichar-duck-high-jump-ja :num! (seek! (ja-aframe 40.0 0)) :frame-num (ja-aframe 16.0 0))
(until (ja-done? 0)
(suspend)
(ja :num! (seek! (ja-aframe 40.0 0)))
)
(anim-loop)
)
:post target-no-stick-post
)
:event
(behavior ((proc process) (argc int) (message symbol) (block event-message-block))
(case message
(('death-end)
(let ((v0-0 (the-as object (logior (-> self draw status) (draw-status hidden)))))
(set! (-> self draw status) (the-as draw-status v0-0))
v0-0))
(else (target-generic-event-handler proc argc message block))))
:enter
(behavior ((arg0 vector) (arg1 vector))
(set-time! (-> self state-time))
(logclear! (-> self control status) (cshape-moving-flags onsurf onground tsurf))
(set! (-> self control unknown-surface00) *warp-jump-mods*)
(set! (-> self control unknown-vector102 quad) (-> arg0 quad))
(set! (-> self control unknown-vector103 quad) (-> arg1 quad))
(+! (-> self control unknown-vector102 y) -4096.0)
(set! (-> self control unknown-uint20) (the-as uint #f))
(vector-reset! (-> self control transv))
(logior! (-> self state-flags) (state-flags use-alt-cam-pos))
(set! (-> self alt-cam-pos quad) (-> arg1 quad)))
:exit
(behavior ()
(logclear! (-> self state-flags) (state-flags use-alt-cam-pos)))
:code
(behavior ((arg0 vector) (arg1 vector))
(send-event *camera* 'change-state cam-fixed 0)
(ja-channel-push! 1 (seconds 0.2))
(ja-no-eval :group! eichar-duck-high-jump-ja :num! (seek! (ja-aframe 16.0 0)) :frame-num 0.0)
(until (ja-done? 0)
(suspend)
(ja :num! (seek! (ja-aframe 16.0 0))))
(vector-! (-> self control transv) (-> self control unknown-vector102) (-> self control trans))
(vector-xz-normalize! (-> self control transv) 32768.0)
(let ((gp-2 (new-stack-vector0)))
(let ((f0-6 (vector-dot (-> self control dynam gravity-normal) (-> self control transv))))
0.0
(vector-! gp-2 (-> self control transv) (vector-float*! gp-2 (-> self control dynam gravity-normal) f0-6)))
(let* ((f0-7 (vector-length gp-2))
(f1-1 f0-7)
(f2-4 (- (sqrtf (* 2.0
(-> self control dynam gravity-length)
(vector-dot (-> self control dynam gravity-normal)
(vector-! (new 'stack-no-clear 'vector) (-> self control unknown-vector102) (-> self control trans)))))
(* 0.008333334 (- (-> self control dynam gravity-length))))))
(vector+! (-> self control transv)
(vector-float*! (-> self control transv) (-> self control dynam gravity-normal) f2-4)
(vector-float*! gp-2 gp-2 (/ f0-7 f1-1)))))
(clear-collide-with-as (-> self control))
(set-time! (-> self state-time))
(set! (-> self trans-hook)
(lambda :behavior target ()
(let ((gp-0 (new-stack-vector0))
(f30-0 (vector-dot (-> self control dynam gravity-normal) (-> self control transv))))
0.0
(vector-! gp-0 (-> self control transv) (vector-float*! gp-0 (-> self control dynam gravity-normal) f30-0))
(let* ((f0-3 (vector-length gp-0))
(f1-0 f0-3))
(if (< f30-0 0.0) (set! f30-0 8192.0))
(vector+! (-> self control transv)
(vector-float*! (-> self control transv) (-> self control dynam gravity-normal) f30-0)
(vector-float*! gp-0 gp-0 (/ f0-3 f1-0)))))
(let ((gp-2 (vector-! (new-stack-vector0) (-> self control unknown-vector102) (-> self control trans))))
(set! (-> gp-2 y) 0.0)
(send-event *target* 'sidekick #f)
(when (and (or (< (vector-dot gp-2 (-> self control transv)) 0.0) (-> self control unknown-spoolanim00))
(time-elapsed? (-> self state-time) (seconds 0.05)))
(vector-seek! (-> self draw color-mult) (new 'static 'vector) (* 2.0 (seconds-per-frame)))
(set! (-> self control transv x) (* 0.95 (-> self control transv x)))
(set! (-> self control transv z) (* 0.95 (-> self control transv z)))
(when (not (-> self control unknown-spoolanim00))
(send-event self 'do-effect 'death-warp-out -1.0)
(let ((v0-2 #t)) (set! (-> self control unknown-uint20) (the-as uint v0-2)) v0-2))))))
(ja-no-eval :group! eichar-duck-high-jump-ja :num! (seek! (ja-aframe 40.0 0)) :frame-num (ja-aframe 16.0 0))
(until (ja-done? 0)
(suspend)
(ja :num! (seek! (ja-aframe 40.0 0))))
(anim-loop))
:post target-no-stick-post)
+123 -219
View File
@@ -1,7 +1,6 @@
;;-*-Lisp-*-
(in-package goal)
(bundles "GAME.CGO")
(require "engine/common-obs/generic-obs.gc")
(require "engine/game/projectiles.gc")
@@ -43,36 +42,30 @@
(ecdf28)
(ecdf29)
(ecdf30)
(ecdf31)
)
(ecdf31))
;; DECOMP BEGINS
(deftype baseplat (process-drawable)
((root collide-shape-moving :override)
(smush smush-control :inline)
(basetrans vector :inline)
(bouncing symbol)
)
((root collide-shape-moving :override)
(smush smush-control :inline)
(basetrans vector :inline)
(bouncing symbol))
(:methods
(baseplat-method-20 (_type_) none)
(baseplat-method-21 (_type_) none)
(baseplat-method-22 (_type_) none)
(get-unlit-skel (_type_) skeleton-group)
(baseplat-method-24 (_type_) none)
(baseplat-method-25 (_type_) sparticle-launch-group)
(baseplat-method-26 (_type_) none)
)
)
(baseplat-method-20 (_type_) none)
(baseplat-method-21 (_type_) none)
(baseplat-method-22 (_type_) none)
(get-unlit-skel (_type_) skeleton-group)
(baseplat-method-24 (_type_) none)
(baseplat-method-25 (_type_) sparticle-launch-group)
(baseplat-method-26 (_type_) none)))
(defmethod baseplat-method-21 ((this baseplat))
(logior! (-> this skel status) (janim-status inited))
(set! (-> this basetrans quad) (-> this root trans quad))
(set! (-> this bouncing) #f)
0
(none)
)
(none))
(defmethod baseplat-method-22 ((this baseplat))
(activate! (-> this smush) -1.0 60 150 1.0 1.0)
@@ -80,26 +73,20 @@
(logclear! (-> this mask) (process-mask sleep))
(logclear! (-> this mask) (process-mask sleep-code))
0
(none)
)
(none))
(defbehavior plat-code baseplat ()
(transform-post)
(suspend)
(transform-post)
(suspend)
(loop
(when (not (-> self bouncing))
(logior! (-> self mask) (process-mask sleep))
(suspend)
0
)
(loop (when (not (-> self bouncing))
(logior! (-> self mask) (process-mask sleep))
(suspend)
0)
(while (-> self bouncing)
(suspend)
)
)
(none)
)
(suspend)))
(none))
(defbehavior plat-trans baseplat ()
(rider-trans)
@@ -108,216 +95,145 @@
(let ((gp-0 (new 'stack-no-clear 'vector)))
(set! (-> gp-0 quad) (-> self basetrans quad))
(+! (-> gp-0 y) (* 819.2 (update! (-> self smush))))
(move-to-point! (-> self root) gp-0)
)
(if (not (!= (-> self smush amp) 0.0))
(set! (-> self bouncing) #f)
)
)
(else
(move-to-point! (-> self root) (-> self basetrans))
)
)
(none)
)
(move-to-point! (-> self root) gp-0))
(if (not (!= (-> self smush amp) 0.0)) (set! (-> self bouncing) #f)))
(else (move-to-point! (-> self root) (-> self basetrans))))
(none))
(defbehavior plat-post baseplat ()
(baseplat-method-20 self)
(rider-post)
(none)
)
(none))
(defmethod baseplat-method-25 ((this baseplat))
(the-as sparticle-launch-group 0)
)
(the-as sparticle-launch-group 0))
(defmethod baseplat-method-20 ((this baseplat))
(if (nonzero? (-> this part))
(spawn (-> this part) (-> this root trans))
)
(none)
)
(if (nonzero? (-> this part)) (spawn (-> this part) (-> this root trans)))
(none))
(defbehavior plat-event baseplat ((arg0 process) (arg1 int) (arg2 symbol) (arg3 event-message-block))
(case arg2
(('bonk)
(baseplat-method-22 self)
)
)
)
(('bonk) (baseplat-method-22 self))))
(deftype eco-door (process-drawable)
((root collide-shape :override)
(speed float)
(open-distance float)
(close-distance float)
(out-dir vector :inline)
(open-sound sound-name)
(close-sound sound-name)
(state-actor entity-actor)
(flags eco-door-flags)
(locked symbol)
(auto-close symbol)
(one-way symbol)
)
((root collide-shape :override)
(speed float)
(open-distance float)
(close-distance float)
(out-dir vector :inline)
(open-sound sound-name)
(close-sound sound-name)
(state-actor entity-actor)
(flags eco-door-flags)
(locked symbol)
(auto-close symbol)
(one-way symbol))
(:state-methods
door-closed
door-opening
door-open
door-closing
)
door-closed
door-opening
door-open
door-closing)
(:methods
(eco-door-method-24 (_type_) none)
(eco-door-method-25 (_type_) none)
(eco-door-method-26 (_type_) none)
)
)
(eco-door-method-24 (_type_) none)
(eco-door-method-25 (_type_) none)
(eco-door-method-26 (_type_) none)))
(defbehavior eco-door-event-handler eco-door ((arg0 process) (arg1 int) (arg2 symbol) (arg3 event-message-block))
(case arg2
(('trigger)
(set! (-> self locked) (not (-> self locked)))
(cond
((-> self locked)
(if (= (-> self next-state name) 'door-closed)
(sound-play "door-lock")
)
)
(else
(sound-play "door-unlock")
)
)
#t
)
)
)
((-> self locked) (if (= (-> self next-state name) 'door-closed) (sound-play "door-lock")))
(else (sound-play "door-unlock")))
#t)))
eco-door-event-handler
(defstate door-closed (eco-door)
:virtual #t
:event eco-door-event-handler
:code (behavior ()
(ja :num-func num-func-identity :frame-num 0.0)
(suspend)
(update-transforms! (-> self root))
(ja-post)
(loop
(when (and *target*
(>= (-> self open-distance) (vector-vector-distance (-> self root trans) (-> *target* control trans)))
)
(eco-door-method-26 self)
(if (and (not (-> self locked))
(or (and (-> self entity) (logtest? (-> self entity extra perm status) (entity-perm-status complete)))
(send-event *target* 'query 'powerup (pickup-type eco-blue))
(and (-> self one-way) (< (vector4-dot (-> self out-dir) (target-pos 0)) -8192.0))
)
)
(go-virtual door-opening)
)
(level-hint-spawn (text-id zero) (the-as string #f) (-> self entity) *entity-pool* (game-task none))
)
:code
(behavior ()
(ja :num-func num-func-identity :frame-num 0.0)
(suspend)
)
)
)
(update-transforms! (-> self root))
(ja-post)
(loop (when (and *target* (>= (-> self open-distance) (vector-vector-distance (-> self root trans) (-> *target* control trans))))
(eco-door-method-26 self)
(if (and (not (-> self locked))
(or (and (-> self entity) (logtest? (-> self entity extra perm status) (entity-perm-status complete)))
(send-event *target* 'query 'powerup (pickup-type eco-blue))
(and (-> self one-way) (< (vector4-dot (-> self out-dir) (target-pos 0)) -8192.0))))
(go-virtual door-opening))
(level-hint-spawn (text-id zero) (the-as string #f) (-> self entity) *entity-pool* (game-task none)))
(suspend))))
(defstate door-opening (eco-door)
:virtual #t
:event eco-door-event-handler
:code (behavior ()
(let ((gp-0
(and (not (and (-> self entity) (logtest? (-> self entity extra perm status) (entity-perm-status complete))))
(send-event *target* 'query 'powerup (pickup-type eco-blue))
)
)
)
(if gp-0
(sound-play "blue-eco-on" :position (the-as symbol (-> self root trans)))
)
(sound-play-by-name (-> self open-sound) (new-sound-id) 1024 0 0 (sound-group sfx) #t)
(clear-collide-with-as (-> self root))
(until (ja-done? 0)
(ja :num! (seek! max (-> self speed)))
(if (and gp-0 (rand-vu-percent? 0.5))
(spawn-projectile-blue *target*)
)
(suspend)
)
)
(go-virtual door-open)
)
:post transform-post
)
:code
(behavior ()
(let ((gp-0 (and (not (and (-> self entity) (logtest? (-> self entity extra perm status) (entity-perm-status complete))))
(send-event *target* 'query 'powerup (pickup-type eco-blue)))))
(if gp-0 (sound-play "blue-eco-on" :position (the-as symbol (-> self root trans))))
(sound-play-by-name (-> self open-sound) (new-sound-id) 1024 0 0 (sound-group sfx) #t)
(clear-collide-with-as (-> self root))
(until (ja-done? 0)
(ja :num! (seek! max (-> self speed)))
(if (and gp-0 (rand-vu-percent? 0.5)) (spawn-projectile-blue *target*))
(suspend)))
(go-virtual door-open))
:post transform-post)
(defstate door-open (eco-door)
:virtual #t
:event eco-door-event-handler
:code (behavior ()
(set-time! (-> self state-time))
(process-entity-status! self (entity-perm-status complete) #t)
(clear-collide-with-as (-> self root))
(ja :num-func num-func-identity :frame-num max)
(logior! (-> self draw status) (draw-status hidden))
(suspend)
(update-transforms! (-> self root))
(ja-post)
(loop
(let ((f30-0 (vector4-dot (-> self out-dir) (target-pos 0)))
(f28-0 (vector4-dot (-> self out-dir) (camera-pos)))
)
(when (and (-> self auto-close)
(or (not *target*)
(< (-> self close-distance) (vector-vector-distance (-> self root trans) (-> *target* control trans)))
)
)
(if (and (>= (* f30-0 f28-0) 0.0) (< 16384.0 (fabs f28-0)))
(go-virtual door-closing)
)
)
)
:code
(behavior ()
(set-time! (-> self state-time))
(process-entity-status! self (entity-perm-status complete) #t)
(clear-collide-with-as (-> self root))
(ja :num-func num-func-identity :frame-num max)
(logior! (-> self draw status) (draw-status hidden))
(suspend)
)
)
)
(update-transforms! (-> self root))
(ja-post)
(loop (let ((f30-0 (vector4-dot (-> self out-dir) (target-pos 0)))
(f28-0 (vector4-dot (-> self out-dir) (camera-pos))))
(when (and (-> self auto-close)
(or (not *target*)
(< (-> self close-distance) (vector-vector-distance (-> self root trans) (-> *target* control trans)))))
(if (and (>= (* f30-0 f28-0) 0.0) (< 16384.0 (fabs f28-0))) (go-virtual door-closing))))
(suspend))))
(defstate door-closing (eco-door)
:virtual #t
:event eco-door-event-handler
:code (behavior ()
(restore-collide-with-as (-> self root))
(logclear! (-> self draw status) (draw-status hidden))
(let ((gp-0 (new 'stack 'overlaps-others-params)))
(set! (-> gp-0 options) (the-as uint 1))
(set! (-> gp-0 tlist) #f)
(while (find-overlapping-shapes (-> self root) gp-0)
(suspend)
)
)
(sound-play-by-name (-> self close-sound) (new-sound-id) 1024 0 0 (sound-group sfx) #t)
(until (ja-done? 0)
(ja :num! (seek! 0.0 (-> self speed)))
(suspend)
)
(if (-> self locked)
(sound-play "door-lock")
)
(go-virtual door-closed)
)
:post transform-post
)
:code
(behavior ()
(restore-collide-with-as (-> self root))
(logclear! (-> self draw status) (draw-status hidden))
(let ((gp-0 (new 'stack 'overlaps-others-params)))
(set! (-> gp-0 options) (the-as uint 1))
(set! (-> gp-0 tlist) #f)
(while (find-overlapping-shapes (-> self root) gp-0)
(suspend)))
(sound-play-by-name (-> self close-sound) (new-sound-id) 1024 0 0 (sound-group sfx) #t)
(until (ja-done? 0)
(ja :num! (seek! 0.0 (-> self speed)))
(suspend))
(if (-> self locked) (sound-play "door-lock"))
(go-virtual door-closed))
:post transform-post)
(defmethod eco-door-method-26 ((this eco-door))
(when (-> this state-actor)
(if (logtest? (-> this state-actor extra perm status) (entity-perm-status complete))
(set! (-> this locked) (logtest? (-> this flags) (eco-door-flags ecdf01)))
(set! (-> this locked) (logtest? (-> this flags) (eco-door-flags ecdf00)))
)
)
(set! (-> this locked) (logtest? (-> this flags) (eco-door-flags ecdf01)))
(set! (-> this locked) (logtest? (-> this flags) (eco-door-flags ecdf00)))))
0
(none)
)
(none))
(defmethod eco-door-method-24 ((this eco-door))
(let ((s5-0 (new 'process 'collide-shape this (collide-list-enum hit-by-player))))
@@ -328,36 +244,27 @@ eco-door-event-handler
(set! (-> s4-0 prim-core offense) (collide-offense indestructible))
(set! (-> s4-0 transform-index) 0)
(set-vector! (-> s4-0 local-sphere) 0.0 0.0 0.0 16384.0)
(set-root-prim! s5-0 s4-0)
)
(set-root-prim! s5-0 s4-0))
(set! (-> s5-0 nav-radius) (* 0.75 (-> s5-0 root-prim local-sphere w)))
(backup-collide-with-as s5-0)
(set! (-> this root) s5-0)
)
(set! (-> this root) s5-0))
0
(none)
)
(none))
(defmethod eco-door-method-25 ((this eco-door))
0
(none)
)
(none))
(defmethod init-from-entity! ((this eco-door) (arg0 entity-actor))
(eco-door-method-24 this)
(process-drawable-from-entity! this arg0)
(let ((f0-0 (res-lump-float (-> this entity) 'scale :default 1.0)))
(set-vector! (-> this root scale) f0-0 f0-0 f0-0 1.0)
)
(set-vector! (-> this root scale) f0-0 f0-0 f0-0 1.0))
(set! (-> this open-distance) 32768.0)
(set! (-> this close-distance) 49152.0)
(set! (-> this speed) 1.0)
(set! (-> this state-actor) #f)
(let ((v1-5 (entity-actor-lookup arg0 'state-actor 0)))
(if v1-5
(set! (-> this state-actor) v1-5)
)
)
(let ((v1-5 (entity-actor-lookup arg0 'state-actor 0))) (if v1-5 (set! (-> this state-actor) v1-5)))
(set! (-> this locked) #f)
(set! (-> this flags) (res-lump-value arg0 'flags eco-door-flags))
(eco-door-method-26 this)
@@ -369,10 +276,7 @@ eco-door-event-handler
(eco-door-method-25 this)
(if (and (not (-> this auto-close))
(-> this entity)
(logtest? (-> this entity extra perm status) (entity-perm-status complete))
)
(go (method-of-object this door-open))
(go (method-of-object this door-closed))
)
(none)
)
(logtest? (-> this entity extra perm status) (entity-perm-status complete)))
(go (method-of-object this door-open))
(go (method-of-object this door-closed)))
(none))
File diff suppressed because it is too large Load Diff
File diff suppressed because it is too large Load Diff
File diff suppressed because it is too large Load Diff