jak-project/goal_src/jak1/engine/collide/collide-shape.gc

;;-*-Lisp-*-
(in-package goal)
(bundles "ENGINE.CGO" "GAME.CGO")
(require "engine/camera/camera-h.gc")
(require "engine/geometry/cylinder.gc")
(require "engine/collide/collide-target-h.gc")
(require "engine/math/transformq.gc")
(require "engine/collide/collide-probe.gc")
(require "engine/collide/collide-mesh.gc")
(require "engine/collide/collide-edge-grab.gc")
(require "engine/gfx/sprite/sparticle/sparticle-launcher.gc")
(require "engine/gfx/background/subdivide-h.gc")
(require "engine/collide/collide-touch.gc")

;; A penetration shallower than this is ignored by do-push-aways!. Solid shapes rest against each
;; other with a fraction of a millimeter of overlap all the time, and acting on that would jitter.
(defconstant PUSH-AWAY-MIN-OVERLAP -81.92)

;; Cache padding used when filling the collide cache for the shape about to be pushed, and the number
;; of push-and-resolve passes attempted before giving up on separating the pair.
(defconstant PUSH-AWAY-CACHE-PADDING 8192.0)

(defconstant PUSH-AWAY-PASSES 3)

;; The contact point that aims a push is clamped into this band above the pushed shape's trans, so a
;; hit on the head or at the feet still produces a roughly horizontal shove.
(defconstant PUSH-AWAY-CONTACT-LOW 2867.2)

(defconstant PUSH-AWAY-CONTACT-BAND 5734.4)

;; poly-angle at or below this faces far enough downward for the contact to count as a ceiling.
(defconstant COLLIDE-CEILING-POLY-ANGLE -0.2)

;; coverage at or above this is a clean standing contact rather than a glancing one on an edge.
(defconstant COLLIDE-GROUND-COVERAGE 0.9)

;; DECOMP BEGINS

;; The collide shape system is used to handle collision reactions.

;;;;;;;;;;;;;;;;;;;;;;;
;; Should Push Away
;;;;;;;;;;;;;;;;;;;;;;;

;; The overlap algorithm determines whether the new position of this shape should push the other
;; shape away.

;; If shapes are far away, it will abort early and just return #f.
;; both check collision flags and require "solid" flags. So this is only for solid collisions.
;; the collision isn't symmetric [collide(a, b) != collide(b, a)] because the with/as flags.
;; so there's some weirdness to get all the method dispatch stuff to work around (you can only dispatch on one type)

(defmethod should-push-away ((this collide-shape) (other-shape collide-shape) (overlap-result collide-overlap-result))
  "Find the overlap between two collide shapes.  This is the main entry point for the overlap algorithm.
   The result is returned in overlap-result. The this is collided _with_ other-shape (meaning this uses its collide-with, other-shape uses colide-as).
   The best-dist is only valid if the result is #t (it should be negative then)"
  ;; this method begins the recursive traversal through the tree of collide-shape-prims, starting with the
  ;; root of each shape.
  (local-vars
    (our-solid collide-action)
    (spheres-apart float)
    (their-edgegrab collide-action)
    (their-solid collide-action))
  (rlet ((acc :class vf)
         (vf0 :class vf)
         (our-sphere :class vf)
         (their-sphere :class vf)
         (delta :class vf)
         (radius-sum :class vf)
         (gap :class vf))
    (init-vf0-vector)
    ;; reset the overlap result
    (let ((result-data overlap-result))
      (set! (-> result-data best-dist) 0.0)
      (set! (-> result-data best-from-prim) #f)
      (set! (-> result-data best-to-prim) #f))
    ;; grab the roots
    (let ((our-root (-> this root-prim))
          (their-root (-> other-shape root-prim)))
      (let ((our-with (-> our-root collide-with)) ;; this object's collide with
            (their-as (-> their-root prim-core collide-as)) ;; the incoming object's as
            (our-action (-> our-root prim-core action)) ;; our action
            )
        (let ((their-action (-> their-root prim-core action))) ;; their action
          ;; reject if (logand with as) fails
          (b! (zero? (logand our-with their-as)) reject :delay (set! their-solid (logand their-action (collide-action solid))))
          ;; reject if non-solid
          (b! (zero? their-solid) reject :delay (set! their-edgegrab (logand their-action (collide-action edgegrab-active)))))
        ;; reject if edgegrab-active on us fails (not sure what this means yet)
        (b! (nonzero? their-edgegrab) reject :delay (set! our-solid (logand our-action (collide-action solid)))))
      ;; reject if non-solid
      (b! (zero? our-solid) reject :delay (nop!))
      ;; if we're here, our collision types allow us to collide
      (.lvf our-sphere (&-> our-root prim-core world-sphere quad))
      (.lvf their-sphere (&-> their-root prim-core world-sphere quad))
      ;; see if bsphere's overlap
      ;; The bsphere test used by every method in this file. delta starts as the center difference,
      ;; the three multiply-accumulates fold its squared length into w, and the last subtract leaves
      ;; d^2 - (r1+r2)^2 there, which is negative exactly when the spheres overlap. The final
      ;; .add.w.vf.x copies that w lane into x so the .mov can read it as an ordinary float; the .mov
      ;; would otherwise pick up the stale x lane.
      (.sub.vf delta our-sphere their-sphere)
      (.add.w.vf.w radius-sum our-sphere their-sphere)
      (.mul.vf.xyz delta delta delta)
      (.mul.w.vf.w radius-sum radius-sum radius-sum)
      (.mul.x.vf.w acc vf0 delta)
      (.add.mul.y.vf.w acc vf0 delta acc)
      (.add.mul.z.vf.w delta vf0 delta acc)
      (.sub.w.vf.w gap delta radius-sum)
      (let ((zero-distance 0.0))
        (.add.w.vf.x gap vf0 gap)
        (.mov spheres-apart gap)
        (b! (<= zero-distance spheres-apart) reject) ;; they don't, fail!
        )
      ;; our bsphere's overlap. We need a more detailed test to know for sure
      ;; this will dispatch a more specific method for our-root.
      (should-push-away-test our-root their-root overlap-result))
    ;; return the result of the more detailed test.
    (let ((result (< (-> overlap-result best-dist) 0.0)))
      (b! #t done :delay (nop!))
      (label reject)
      (set! result #f)
      (label done)
      result)))

;; the should-push-away-test will update the collide-overlap-result. The best-dist will be negative if they overlap.
;; it works on collide prims.

(defmethod should-push-away-test ((this collide-shape-prim) (other-prim collide-shape-prim) (overlap-result collide-overlap-result))
  "Should be impossible to call - collide-shape-prim is abstract."
  (format 0 "ERROR: collide-shape-prim::should-push-away-test was called illegally!~%")
  (none))

(defmethod should-push-away-test ((this collide-shape-prim-group) (other-prim collide-shape-prim) (overlap-result collide-overlap-result))
  "Update test for a group against an unknown prim.
   The grouip prims use their collide with "
  (local-vars (spheres-apart float))
  (rlet ((acc :class vf)
         (vf0 :class vf)
         (other-sphere :class vf)
         (child-sphere :class vf)
         (delta :class vf)
         (radius-sum :class vf))
    (init-vf0-vector)
    (nop!)
    (let ((prim-list (-> this prims))
          (prims-left (-> this num-prims-u)))
      (nop!)
      ;; very similar to compute-overlap.
      ;; check collide-as/collide-with and solid
      (let ((their-as (-> other-prim prim-core collide-as)))
        (nop!)
        (.lvf other-sphere (&-> other-prim prim-core world-sphere quad))
        (label next-prim)
        (b! (zero? prims-left) done :delay (nop!))
        (+! prims-left -1)
        (let ((child-prim (-> prim-list 0)))
          (set! prim-list (&-> prim-list 1))
          (let ((child-with (-> child-prim collide-with)))
            (nop!)
            (let* ((child-action (-> child-prim prim-core action))
                   (with-as-overlap (logand child-with their-as))
                   (child-solid (logand child-action (collide-action solid))))
              ;; on reject, just move to the next thing in the group.
              (b! (zero? with-as-overlap) next-prim :delay (.lvf child-sphere (&-> child-prim prim-core world-sphere quad)))
              (b! (zero? child-solid) next-prim :delay (nop!))))
          ;; check bspheres
          (.sub.vf delta child-sphere other-sphere)
          (.add.w.vf.w radius-sum child-sphere other-sphere)
          (.mul.vf.xyz delta delta delta)
          (.mul.w.vf.w radius-sum radius-sum radius-sum)
          (.mul.x.vf.w acc vf0 delta)
          (.add.mul.y.vf.w acc vf0 delta acc)
          (.add.mul.z.vf.w delta vf0 delta acc)
          (.sub.w.vf.w delta delta radius-sum)
          (let ((zero-distance 0.0))
            (.add.w.vf.x delta vf0 delta)
            (.mov spheres-apart delta)
            (b! (<= zero-distance spheres-apart) next-prim))
          ;; bspheres overlap, more accurate test is required.
          (should-push-away-test child-prim other-prim overlap-result))
        (set! their-as (-> other-prim prim-core collide-as))))
    (b! #t next-prim :delay (.lvf other-sphere (&-> other-prim prim-core world-sphere quad)))
    (label done)
    0
    (none)))

(defmethod should-push-away-reverse-test ((this collide-shape-prim) (other-group collide-shape-prim-group) (overlap-result collide-overlap-result))
  "This is a flipped version of should-push-away-test.
   the group uses their collide-as"
  (local-vars (spheres-apart float))
  (rlet ((acc :class vf)
         (vf0 :class vf)
         (child-sphere :class vf)
         (our-sphere :class vf)
         (delta :class vf)
         (radius-sum :class vf))
    (init-vf0-vector)
    (nop!)
    (let ((prim-list (-> other-group prims))
          (prims-left (-> other-group num-prims-u)))
      (nop!)
      (let ((our-with (-> this collide-with)))
        (nop!)
        (.lvf our-sphere (&-> this prim-core world-sphere quad))
        (label next-prim)
        (b! (zero? prims-left) done :delay (nop!))
        (+! prims-left -1)
        (let ((child-prim (-> prim-list 0)))
          (set! prim-list (&-> prim-list 1))
          (let ((child-as (-> child-prim prim-core collide-as)))
            (nop!)
            (let* ((child-action (-> child-prim prim-core action))
                   (with-as-overlap (logand our-with child-as))
                   (child-solid (logand child-action (collide-action solid))))
              (b! (zero? with-as-overlap) next-prim :delay (.lvf child-sphere (&-> child-prim prim-core world-sphere quad)))
              (b! (zero? child-solid) next-prim :delay (nop!))))
          (.sub.vf delta our-sphere child-sphere)
          (.add.w.vf.w radius-sum our-sphere child-sphere)
          (.mul.vf.xyz delta delta delta)
          (.mul.w.vf.w radius-sum radius-sum radius-sum)
          (.mul.x.vf.w acc vf0 delta)
          (.add.mul.y.vf.w acc vf0 delta acc)
          (.add.mul.z.vf.w delta vf0 delta acc)
          (.sub.w.vf.w delta delta radius-sum)
          (let ((zero-distance 0.0))
            (.add.w.vf.x delta vf0 delta)
            (.mov spheres-apart delta)
            (b! (<= zero-distance spheres-apart) next-prim))
          (should-push-away-test this child-prim overlap-result))
        (set! our-with (-> this collide-with))))
    (b! #t next-prim :delay (.lvf our-sphere (&-> this prim-core world-sphere quad)))
    (label done)
    0
    (none)))

(defmethod should-push-away-test ((this collide-shape-prim-mesh) (other-prim collide-shape-prim) (overlap-result collide-overlap-result))
  "Collide a prim with a mesh. The prim must be a sphere or group of spheres"
  ;; first, check the prim type
  (let ((other-prim-type (-> other-prim prim-core prim-type)))
    (b! (nonzero? other-prim-type) not-a-group :delay (nop!))
    ;; if we got a group, recurse.
    (should-push-away-reverse-test this (the-as collide-shape-prim-group other-prim) overlap-result)
    (b! #t done :delay (nop!))
    (label not-a-group)
    ;; mesh to mesh. abort!
    (b! (> other-prim-type 0) mesh-vs-mesh :delay (nop!)))
  (let ((mesh (-> this mesh)))
    ;; if we don't have a mesh, then abort.
    (b! (not mesh) nothing-to-report :delay (nop!)) ;; empty-form
    ;; we must put the mesh in the cache before we can collide.
    ;; NOTE: this is not the full collide-cache, but instead a smaller, simpler collide-mesh-cche.
    (let ((mesh-cache *collide-mesh-cache*))
      (let ((cache-id (-> mesh-cache id)))
        ;; if we already got it, don't bother populating the cache again.
        (b! (= (-> this mesh-cache-id) cache-id) cache-ready :delay (nop!)))
      ;; "allocate" triangles.
      (let ((cache-tris (allocate! mesh-cache (* (size-of collide-mesh-cache-tri) (-> mesh num-tris)))))
        (b! (not cache-tris) cache-full :delay (nop!))
        ;; remember that we got these triangles
        (set! (-> this mesh-cache-tris) (the-as (inline-array collide-mesh-cache-tri) cache-tris)))
      ;; and remember the cache has this
      (set! (-> this mesh-cache-id) (-> mesh-cache id)))
    ;; load this mesh into the cache.
    ;; strangely, they transform the entire mesh.
    (populate-cache! mesh
                     (the-as collide-mesh-cache-tri (-> this mesh-cache-tris))
                     (-> this cshape process node-list data (-> this transform-index) bone transform))
    (b! #t cache-ready :delay (nop!))
    (label cache-full) ;; cache failure abort
    (b! #t return-none :delay (nop!))
    (the-as none 0)
    (label cache-ready)
    ;; now, use the cache!
    (let ((tri-result (new 'stack-no-clear 'collide-tri-result)))
      (let ((overlap-dist (should-push-away-test mesh
                                                 (the-as collide-mesh-cache-tri (-> this mesh-cache-tris))
                                                 tri-result
                                                 (the-as vector (-> other-prim prim-core))
                                                 (-> overlap-result best-dist))))
        ;; did we find something closer?
        (b! (>= overlap-dist (-> overlap-result best-dist)) nothing-to-report :delay #f)
        ;; we did!
        (set! (-> overlap-result best-dist) overlap-dist))
      ;; remeber this triangle!
      (set! (-> overlap-result best-from-prim) this)
      (set! (-> overlap-result best-to-prim) other-prim)
      (vector-copy! (-> overlap-result best-from-tri vertex 0) (-> tri-result vertex 0))
      (vector-copy! (-> overlap-result best-from-tri vertex 1) (-> tri-result vertex 1))
      (vector-copy! (-> overlap-result best-from-tri vertex 2) (-> tri-result vertex 2))
      (vector-copy! (-> overlap-result best-from-tri intersect) (-> tri-result intersect))
      (vector-copy! (-> overlap-result best-from-tri normal) (-> tri-result normal))
      (set! (-> overlap-result best-from-tri pat) (-> tri-result pat))))
  (label nothing-to-report)
  (b! #t done :delay (nop!))
  (label mesh-vs-mesh)
  (format 0 "ERROR: Attempted unsupported mesh -> mesh test in collide-shape-prim::should-push-away-test!~%")
  (label done)
  0
  (label return-none)
  (none))

(defmethod should-push-away-test ((this collide-shape-prim-sphere) (other-prim collide-shape-prim) (overlap-result collide-overlap-result))
  "The push away where we manually dispatch on the type of the second."
  (local-vars (separation-gpr float))
  (rlet ((acc :class vf)
         (Q :class vf)
         (vf0 :class vf)
         (our-sphere :class vf)
         (their-sphere :class vf)
         (to-other :class vf)
         (center-distance :class vf)
         (radius-sum :class vf)
         (separation-vf :class vf))
    (init-vf0-vector)
    (let ((other-prim-type (-> other-prim prim-core prim-type)))
      (b! (nonzero? other-prim-type) not-a-group :delay (nop!))
      ;; we're colliding with group, we've got a whole other function for that.
      (should-push-away-reverse-test this (the-as collide-shape-prim-group other-prim) overlap-result)
      (b! #t done :delay (nop!))
      (label not-a-group)
      (b! (> other-prim-type 0) other-is-mesh :delay (nop!)))
    ;; if we're here, it's sphere->sphere.
    ;; Unlike the bsphere reject elsewhere in this file, this one needs the signed distance rather than
    ;; its square, because best-dist is a penetration depth. center-distance holds the componentwise
    ;; squares, then d^2 in w, then d itself in x once the square root comes back from the scalar
    ;; pipeline. separation is d - (r1 + r2), negative when the spheres overlap.
    (.lvf our-sphere (&-> this prim-core world-sphere quad))
    (.lvf their-sphere (&-> other-prim prim-core world-sphere quad))
    (.sub.vf.xyz to-other their-sphere our-sphere)
    (.add.w.vf.w radius-sum our-sphere their-sphere)
    (.mul.vf.xyz center-distance to-other to-other)
    (.mul.x.vf.w acc vf0 center-distance)
    (.add.mul.y.vf.w acc vf0 center-distance acc)
    (.add.mul.z.vf.w center-distance vf0 center-distance acc)
    (.sqrt.vf Q center-distance :ftf #b11)
    (.mov.vf.w to-other vf0)
    (.add.w.vf.x radius-sum vf0 radius-sum)
    (let ((previous-best (-> overlap-result best-dist)))
      (.wait.vf)
      (nop!)
      (.add.vf.x center-distance vf0 Q)
      (.sub.x.vf.x separation-vf center-distance radius-sum)
      ;; This scales the center difference by d, so the vector stored as the contact normal has
      ;; magnitude d^2 instead of one, and the contact point derived from it below sits nowhere near
      ;; the sphere surface. Only the normal's sign is read by do-push-aways!, which then normalizes
      ;; the push vector, so the error does not show up there; anything that wants a real normal or a
      ;; real contact point out of a sphere/sphere push-away cannot use these fields.
      (.mul.x.vf.xyz to-other to-other center-distance)
      (.mov separation-gpr separation-vf)
      (let ((separation separation-gpr))
        (b! (<= previous-best separation) done)
        (let ((sphere-pat (-> this pat)))
          (set! (-> overlap-result best-dist) separation)
          (set! (-> overlap-result best-from-prim) this)
          (set! (-> overlap-result best-to-prim) other-prim)
          (.svf (&-> overlap-result best-from-tri normal quad) to-other)
          (set! (-> overlap-result best-from-tri pat) sphere-pat))))
    ;; make up a triangle.
    (let ((hit-normal (-> overlap-result best-from-tri normal))
          (hit-point (-> overlap-result best-from-tri intersect)))
      (vector-float*! hit-point hit-normal (-> this prim-core world-sphere w))
      (vector+! hit-point hit-point (the-as vector (-> this prim-core)))
      (vector-copy! (-> overlap-result best-from-tri vertex 0) hit-point)
      (point-in-plane-<-point+normal! (-> overlap-result best-from-tri vertex 1) hit-point hit-normal)
      (let* ((tangent (vector-normalize! (vector-! (new 'stack-no-clear 'vector)
                                                   (-> overlap-result best-from-tri vertex 1)
                                                   (the-as vector (-> overlap-result best-from-tri)))
                                         1.0))
             (bitangent (vector-cross! (new 'stack-no-clear 'vector) hit-normal tangent)))
        (vector+*! (-> overlap-result best-from-tri vertex 2) hit-point bitangent 4096.0)))
    (b! #t done :delay (nop!))
    ;; Mesh. this is the same as the above function. start with populating the cache.
    (label other-is-mesh)
    (let ((mesh (-> (the-as collide-shape-prim-mesh other-prim) mesh)))
      (b! (not mesh) done)
      (let ((mesh-cache *collide-mesh-cache*))
        (let ((cache-id (-> mesh-cache id)))
          (b! (= (-> (the-as collide-shape-prim-mesh other-prim) mesh-cache-id) cache-id) cache-ready))
        (let ((cache-tris (allocate! mesh-cache (* (size-of collide-mesh-cache-tri) (-> mesh num-tris)))))
          (b! (not cache-tris) cache-full :delay (nop!))
          (set! (-> (the-as collide-shape-prim-mesh other-prim) mesh-cache-tris)
                (the-as (inline-array collide-mesh-cache-tri) cache-tris)))
        (set! (-> (the-as collide-shape-prim-mesh other-prim) mesh-cache-id) (-> mesh-cache id)))
      (populate-cache! mesh
                       (the-as collide-mesh-cache-tri (-> (the-as collide-shape-prim-mesh other-prim) mesh-cache-tris))
                       (-> (the-as collide-shape-prim-mesh other-prim)
                           cshape
                           process
                           node-list
                           data
                           (-> (the-as collide-shape-prim-mesh other-prim) transform-index)
                           bone
                           transform))
      (b! #t cache-ready :delay (nop!))
      (label cache-full)
      (b! #t return-none :delay (nop!))
      (the-as none 0)
      (label cache-ready)
      ;; do the collision
      (let ((tri-result (new 'stack-no-clear 'collide-tri-result)))
        (let ((overlap-dist (should-push-away-test mesh
                                                   (the-as collide-mesh-cache-tri (-> (the-as collide-shape-prim-mesh other-prim) mesh-cache-tris))
                                                   tri-result
                                                   (the-as vector (-> this prim-core))
                                                   (-> overlap-result best-dist))))
          (b! (>= overlap-dist (-> overlap-result best-dist)) done :delay #f)
          (set! (-> overlap-result best-dist) overlap-dist))
        ;; but this time, we need a tri from the sphere. So make one up again.
        (set! (-> overlap-result best-from-prim) this)
        (set! (-> overlap-result best-to-prim) other-prim)
        (let ((hit-normal2 (-> overlap-result best-from-tri normal)))
          (vector-! hit-normal2 (-> tri-result intersect) (the-as vector (-> this prim-core)))
          (vector-normalize! hit-normal2 1.0)
          (let ((hit-point2 (-> overlap-result best-from-tri intersect)))
            (vector-float*! hit-point2 hit-normal2 (-> this prim-core world-sphere w))
            (vector+! hit-point2 hit-point2 (the-as vector (-> this prim-core)))
            (vector-copy! (-> overlap-result best-from-tri vertex 0) hit-point2)
            (point-in-plane-<-point+normal! (-> overlap-result best-from-tri vertex 1) hit-point2 hit-normal2)
            (let* ((tangent2 (vector-normalize! (vector-! (new 'stack-no-clear 'vector)
                                                          (-> overlap-result best-from-tri vertex 1)
                                                          (the-as vector (-> overlap-result best-from-tri)))
                                                1.0))
                   (bitangent2 (vector-cross! (new 'stack-no-clear 'vector) hit-normal2 tangent2)))
              (vector+*! (-> overlap-result best-from-tri vertex 2) hit-point2 bitangent2 4096.0))))))
    (set! (-> overlap-result best-from-tri pat) (-> this pat))
    (label done)
    0
    (label return-none)
    (none)))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Moving Collision Resolutions
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

;; These functions see if we canmove a given length in a given direction.
;; If not, they adjust the length so we are just touching, and add the prim to the touching list.

;; these use the "offense". The offense of the thing in the cache must be higher. If the cache has 0, we reject always.
;; these use the "solid" bit of action. This must be set on both.

(defmethod collide-with-collide-cache-prim-mesh ((this collide-shape-prim) (isect collide-shape-intersect) (cache-prim collide-cache-prim))
  "abstract base class version."
  (format 0 "ERROR: Unsupported prim type in collide-shape-prim::collide-with-collide-cache-prim-mesh!~%")
  (none))

(defmethod collide-with-collide-cache-prim-mesh ((this collide-shape-prim-sphere) (isect collide-shape-intersect) (cache-prim collide-cache-prim))
  "Collide this sphere with the mesh in the real collide cache."
  (local-vars (offense-difference collide-offense))
  (rlet ((hit-intersect :class vf)
         (hit-normal :class vf)
         (hit-vertex-0 :class vf)
         (hit-vertex-1 :class vf)
         (hit-vertex-2 :class vf))
    (let* ((tri-result (new 'stack-no-clear 'collide-tri-result))
           ;; try to move the sphere by best-u.
           (hit-u (resolve-moving-sphere-tri cache-prim
                                             tri-result
                                             (-> this prim-core)
                                             (-> isect move-vec)
                                             (-> isect best-u)
                                             (-> this prim-core action))))
      ;; did we hit something?
      (when (>= hit-u 0.0)
        ;; yup.
        (let ((hit-prim (the-as collide-shape-prim #f)))
          ;; not really sure why we do this, need to learn more about the stuff in the collide cache
          ;; prim-type 2 is the background and water pseudo-prims, so hit-prim stays #f for those and
          ;; only a foreground actor ends up on the touching list.
          (let ((cache-prim-type (-> cache-prim prim-core prim-type))
                (background-prim-type 2)
                (cache-prim (-> cache-prim prim))
                (zero-offense 0)
                (cache-offense (-> cache-prim prim-core offense)))
            (b! (!= cache-prim-type background-prim-type) prim-chosen :likely-delay (set! hit-prim cache-prim))
            (label prim-chosen)
            (nop!)
            (let ((our-offense (-> this prim-core offense)))
              (nop!)
              (let ((our-action (-> this prim-core action)))
                (nop!)
                (let ((cache-action (-> cache-prim prim-core action)))
                  (b! (= cache-offense zero-offense) skip-record :delay (set! offense-difference (- our-offense cache-offense)))
                  (let ((action-overlap (logand our-action cache-action))
                        (hit-pat (-> tri-result pat)))
                    (let ((solid-bits (logand action-overlap (collide-action solid))))
                      (.lvf hit-intersect (&-> tri-result intersect quad))
                      (b! (> (the-as int offense-difference) 0) skip-record :delay (.lvf hit-normal (&-> tri-result normal quad)))
                      (b! (zero? solid-bits) skip-record :delay (.lvf hit-vertex-0 (&-> tri-result vertex 0 quad))))
                    (.lvf hit-vertex-1 (&-> tri-result vertex 1 quad))
                    (.lvf hit-vertex-2 (&-> tri-result vertex 2 quad))
                    ;; remember what we hit
                    (set! (-> isect best-u) hit-u)
                    (set! (-> isect best-to-prim) hit-prim)
                    (set! (-> isect best-from-prim) this)
                    (set! (-> isect best-tri pat) hit-pat))))))
          ;; remember the tri
          (.svf (&-> isect best-tri intersect quad) hit-intersect)
          (.svf (&-> isect best-tri normal quad) hit-normal)
          (.svf (&-> isect best-tri vertex 0 quad) hit-vertex-0)
          (.svf (&-> isect best-tri vertex 1 quad) hit-vertex-1)
          (.svf (&-> isect best-tri vertex 2 quad) hit-vertex-2)
          (nop!)
          (label skip-record)
          (b! (= hit-prim #f) done :delay (nop!))
          ;; add prim to list.
          (add-touching-prims *touching-list* this hit-prim hit-u (the-as collide-tri-result #f) tri-result))
        (label done)
        0))
    0
    (none)))

(defmethod collide-with-collide-cache-prim-mesh ((this collide-shape-prim-mesh) (isect collide-shape-intersect) (cache-prim collide-cache-prim))
  "Test this foreground primitive against one cached mesh
   primitive and update intersection when it supplies an earlier compatible hit."
  (format 0 "ERROR: collide-shape-prim-mesh vs. collide-cache-prim mesh is not currently supported!~%")
  (none))

(defmethod collide-with-collide-cache-prim-mesh ((this collide-shape-prim-group) (isect collide-shape-intersect) (cache-prim collide-cache-prim))
  "Test this foreground primitive against one cached mesh
   primitive and update intersection when it supplies an earlier compatible hit."
  (let ((cache-as (-> cache-prim prim-core collide-as)))
    (dotimes (i (-> this num-prims))
      (let ((child-prim (-> this prims i)))
        (if (logtest? (-> child-prim collide-with) cache-as) (collide-with-collide-cache-prim-mesh child-prim isect cache-prim)))))
  (none))

(defmethod collide-with-collide-cache-prim-sphere ((this collide-shape-prim) (isect collide-shape-intersect) (cache-prim collide-cache-prim))
  "Test this foreground primitive against one cached
   sphere primitive and update intersection when it supplies an earlier compatible hit."
  (format 0 "ERROR: Unsupported prim type in collide-shape-prim::collide-with-collide-cache-prim-sphere!~%")
  (none))

(defmethod collide-with-collide-cache-prim-sphere ((this collide-shape-prim-sphere) (isect collide-shape-intersect) (cache-prim collide-cache-prim))
  "Test this foreground primitive against one cached
   sphere primitive and update intersection when it supplies an earlier compatible hit."
  (local-vars (offense-difference collide-offense) (hit-pat pat-surface))
  (rlet ((hit-intersect :class vf)
         (hit-normal :class vf)
         (hit-vertex-0 :class vf)
         (hit-vertex-1 :class vf)
         (hit-vertex-2 :class vf))
    (let* ((tri-result (new 'stack-no-clear 'collide-tri-result))
           (hit-u (resolve-moving-sphere-sphere cache-prim
                                                tri-result
                                                (-> this prim-core)
                                                (-> isect move-vec)
                                                (-> isect best-u)
                                                (-> this prim-core action))))
      (when (>= hit-u 0.0)
        (let ((zero-offense 0)
              (our-action (-> this prim-core action)))
          (nop!)
          (let ((cache-action (-> cache-prim prim-core action)))
            (nop!)
            (let ((cache-offense (-> cache-prim prim-core offense))
                  (action-overlap (logand our-action cache-action))
                  (cache-prim (-> cache-prim prim)))
              (let ((solid-bits (logand action-overlap (collide-action solid)))
                    (our-offense (-> this prim-core offense)))
                (b! (zero? solid-bits) skip-record :delay (set! hit-pat (-> tri-result pat)))
                (b! (= cache-offense zero-offense) skip-record :delay (set! offense-difference (- our-offense cache-offense))))
              (b! (> (the-as int offense-difference) 0) skip-record :delay (.lvf hit-intersect (&-> tri-result intersect quad)))
              (.lvf hit-normal (&-> tri-result normal quad))
              (.lvf hit-vertex-0 (&-> tri-result vertex 0 quad))
              (.lvf hit-vertex-1 (&-> tri-result vertex 1 quad))
              (.lvf hit-vertex-2 (&-> tri-result vertex 2 quad))
              (set! (-> isect best-u) hit-u)
              (set! (-> isect best-to-prim) cache-prim)
              (set! (-> isect best-from-prim) this)
              (set! (-> isect best-tri pat) hit-pat)
              (.svf (&-> isect best-tri intersect quad) hit-intersect)
              (.svf (&-> isect best-tri normal quad) hit-normal)
              (.svf (&-> isect best-tri vertex 0 quad) hit-vertex-0)
              (.svf (&-> isect best-tri vertex 1 quad) hit-vertex-1)
              (.svf (&-> isect best-tri vertex 2 quad) hit-vertex-2)
              (label skip-record)
              (add-touching-prims *touching-list* this cache-prim hit-u (the-as collide-tri-result #f) tri-result))))))
    0
    (none)))

(defmethod collide-with-collide-cache-prim-sphere ((this collide-shape-prim-mesh) (isect collide-shape-intersect) (cache-prim collide-cache-prim))
  "Test this foreground primitive against one cached
   sphere primitive and update intersection when it supplies an earlier compatible hit."
  (format 0 "ERROR: collide-shape-prim-mesh vs. collide-cache-prim sphere is not currently supported!~%")
  (none))

(defmethod collide-with-collide-cache-prim-sphere ((this collide-shape-prim-group) (isect collide-shape-intersect) (cache-prim collide-cache-prim))
  "Test this foreground primitive against one cached
   sphere primitive and update intersection when it supplies an earlier compatible hit."
  (let ((cache-as (-> cache-prim prim-core collide-as)))
    (dotimes (i (-> this num-prims))
      (let ((child-prim (-> this prims i)))
        (if (logtest? (-> child-prim collide-with) cache-as) (collide-with-collide-cache-prim-sphere child-prim isect cache-prim)))))
  (none))

;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Target Specific Stuff
;;;;;;;;;;;;;;;;;;;;;;;;;;;

;; This implements the default collision reaction function.
;; This is a target-specific reaction.

(defun find-ground-point ((target-ctrl control-info) (ground-result vector) (start-length float) (max-length float))
  "Search eight alternating headings around target-ctrl for safe ground. Each ray begins
   start-length forward and five meters above the target, extends downward, and rejects dangerous
   or steep results. Copy the first direction with two acceptable hits to ground-result."
  (local-vars (direction-index int) (hit-count int))
  ;; first, let's find our heading
  (let ((current-heading (if (< 819.2 (vector-xz-length (-> target-ctrl transv))) ;; if we're moving in the xz plane
                           (vector-y-angle (-> target-ctrl transv)) ;; use the direction we're moving
                           (y-angle target-ctrl) ;; otherwise, use the direction we're facing.
                           ))
        ;; the current position of jak
        (current-position (-> target-ctrl trans))
        (probe-direction (new 'stack-no-clear 'vector))
        (result-tri (new 'stack-no-clear 'collide-tri-result)))
    ;; create a bounding box, centered around our current location.
    (let ((bbox (new 'stack-no-clear 'bounding-box)))
      (set! (-> ground-result w) 0.0)
      ;; look at most max-length away from where we are..
      (dotimes (axis-index 3)
        (set! (-> bbox min data axis-index) (- (-> current-position data axis-index) max-length))
        (set! (-> bbox max data axis-index) (+ (-> current-position data axis-index) max-length)))
      ;; except for in y (height). Look 10m down, and 5m up.
      (set! (-> bbox min y) (+ -40960.0 (-> current-position y)))
      (set! (-> bbox max y) (+ 20480.0 (-> current-position y)))
      ;; fill the collide cache will all the triangles in bounding box.
      (fill-using-bounding-box *collide-cache*
                               bbox
                               (-> target-ctrl root-prim collide-with)
                               (-> target-ctrl process)
                               (new 'static 'pat-surface :noentity #x1)))
    ;; loop over 8 directions to check.
    (set! direction-index 0)
    (while (< direction-index 8)
      ;; this picks starts with the current direction, then a little to the left, then a little to the right,
      ;; then a little more to the left.... so ideally we go in the direction the player is facing, if that's possible.
      (let ((probe-heading (+ current-heading
                              (if (zero? (logand direction-index 1))
                                (* 8192.0 (the float (/ direction-index 2)))
                                (* -8192.0 (the float (/ direction-index 2)))))))
        ;; this will count the number of hits we have in this direction.
        (set! hit-count 0)
        ;; we don't know anything, so assume we can go the maximum length in this direction
        (let ((max-length-this-direction max-length))
          ;; but, if we did max-length bounce in this direction, we might hit some wall mid-bounce.
          ;; start with a probe of max len, pointing straight forward.
          (set-vector! probe-direction 0.0 0.0 max-length 1.0)
          ;; rotate to point along our heading
          (vector-rotate-y! probe-direction probe-direction probe-heading)
          ;; See how far we can go from five meters above the current target.
          ;; this is likely checking to see if we'll hit a wall mid-bounce
          (if (>= (probe-using-line-sphere *collide-cache*
                                           (vector+! (new 'stack-no-clear 'vector) current-position (new 'static 'vector :y 20480.0 :w 1.0))
                                           probe-direction
                                           2048.0
                                           (-> target-ctrl root-prim collide-with)
                                           result-tri
                                           (new 'static 'pat-surface :noentity #x1))
                  0.0)
            (set! max-length-this-direction (+ -6144.0 (vector-vector-xz-distance current-position (-> result-tri intersect)))))
          ;; now, let's search between start-length and max-len-this-dir to see if there's somewhere safe to bounce.
          (let ((current-length start-length))
            (while (>= max-length-this-direction current-length)
              ;; probe heading
              (set-vector! probe-direction 0.0 0.0 current-length 1.0)
              (vector-rotate-y! probe-direction probe-direction probe-heading)
              ;; put probe dir at the end of the probe
              (vector+! probe-direction current-position probe-direction)
              ;; Start five meters above the current position.
              (set! (-> probe-direction y) (+ 20480.0 (-> current-position y)))
              ;; Probe straight down to find the first ground along this heading.
              (when (>= (probe-using-line-sphere *collide-cache*
                                                 probe-direction
                                                 (new 'static 'vector :y -251658240.0 :w 1.0)
                                                 10240.0
                                                 (-> target-ctrl root-prim collide-with)
                                                 result-tri
                                                 (new 'static 'pat-surface :noentity #x1))
                        0.0)
                (cond
                  ((and (= (-> result-tri pat mode) (pat-mode ground)) ;; we found ground
                        (= (-> result-tri pat event) (pat-event none)) ;; and it's not more dangerous ground
                        (< 0.7 (-> result-tri normal y)) ;; and it's pretty flat
                        )
                   (vector-copy! ground-result (-> result-tri intersect)) ;; remember it
                   ;; count this as a success
                   (set! hit-count (+ hit-count 1))
                   ;; if we get 2 or more hits, it seems like a good place to land, let's do it!
                   (if (>= hit-count 2) (return ground-result)))
                  ((and (= (-> result-tri pat mode) (pat-mode wall)) (< (+ 4096.0 (-> current-position y)) (-> result-tri intersect y)))
                   ;; give up on this direction. There's a wall in the way (missed by the earlier fast wall check)
                   (goto next-direction))))
              ;; move 1m out more.
              (set! current-length (+ 4096.0 current-length))))))
      (label next-direction)
      (set! direction-index (+ direction-index 1))))
  (the-as vector #f))

(defun target-attack-up ((tgt target) (event-type symbol) (attack-mode symbol))
  "Handle an attack up. This launches the player in the air, forcing them back to a safe location."
  ;; attempt to find a safe ground.
  (let ((safe-ground (find-ground-point (-> tgt control) (new 'stack-no-clear 'vector) (meters 2) (meters 10))))
    (set! safe-ground
          (cond
            (safe-ground ;; if we found it, use that
             safe-ground)
            (else
             ;; failed to find it. Use the last known safe ground point instaed.
             (-> tgt control last-known-safe-ground))))
    (let* ((jump-direction (vector-! (new 'stack-no-clear 'vector) safe-ground (-> tgt control trans))) ;; jump direction
           (jump-distance (fmax (meters 2) (fmin (meters 10) (vector-xz-length jump-direction)))) ;; distance we should jump (limited)
           )
      ;; note: the above limit is the same as the limit passed into find-ground-point. So the limiting should only kick in
      ;; if we use last safe ground.
      (cond
        ((< (fabs (vector-dot (-> tgt control dynam gravity-normal)
                              (vector-! (new 'stack-no-clear 'vector) safe-ground (-> tgt control trans))))
            (meters 10))
         ;; if we reach here, we have to jump up or down less than 10m.
         ;; reduce our jump direction to within reasonable distance
         (vector-xz-normalize! jump-direction jump-distance)
         ;; send an attack
         ;; the shove is proportional to how high we jump (and has a min, so we at least get off the ground)
         (send-event tgt
                     event-type
                     #f
                     (static-attack-info ((mode attack-mode)
                                          (vector jump-direction)
                                          (shove-up (+ (lerp-scale (meters 1) (meters 4) jump-distance (meters 1) (meters 10))
                                                       (fmax 0.0 (- (-> safe-ground y) (-> tgt control trans y)))))
                                          (angle 'up)))))
        (else
         ;; the last safest place we jumped is too high. just launch jak in the air and hope for the best.
         ;; fire canyon skip jumps
         (send-event tgt
                     event-type
                     #f
                     (static-attack-info ((mode attack-mode) (vector (new 'static 'vector :y (meters 10) :w 1.0)) (shove-up (meters 10)) (angle 'up) (control 1.0))))))))
  (none))

(defmethod set-and-handle-pat! ((this collide-shape-moving) (pat pat-surface))
  "Handle landing on the given pat-surface. This is likely target-specific."
  ;; set our pat
  (set! (-> this cur-pat) pat)
  (set! (-> this poly-pat) pat)
  ;; set our surface
  (case (-> pat material)
    (((pat-material ice)) (set! (-> this surf) *ice-surface*))
    (((pat-material quicksand)) (set! (-> this surf) *quicksand-surface*))
    (((pat-material tube)) (set! (-> this surf) *no-walk-surface*))
    (((pat-material rotate)) (set! (-> this surf) *rotate-surface*))
    (else (set! (-> this surf) *standard-ground-surface*)))
  ;; racer gets set whenever you get on the zoomer. If we are on the zoomer, just go to "race-track"
  (if (logtest? (-> this root-prim prim-core action) (collide-action racer)) (set! (-> this surf) *race-track-surface*))
  (when (nonzero? (-> pat event))
    (case (-> pat event)
      (((pat-event deadly))
       ;; deadly. Send a deadly event
       (send-event (-> this process) 'attack #f (static-attack-info ((mode 'deadly) (shove-up (meters 3))))))
      (((pat-event burn))
       ;; burn. Send a burn event
       (send-event (-> this process) 'attack #f (static-attack-info ((mode 'burn) (shove-up (meters 3))))))
      (((pat-event deadlyup))
       ;; deadlyup. Launch!
       (target-attack-up (the-as target (-> this process)) 'attack-or-shove 'deadlyup))
      (((pat-event burnup))
       ;; burnup (like fire canyon lava).
       ;; only send if we don't have racer (on zoomer)
       (if (zero? (logand (-> (the-as target (-> this process)) control root-prim prim-core action) (collide-action racer)))
         (target-attack-up (the-as target (-> this process)) 'attack-or-shove 'burnup)))
      (((pat-event melt))
       ;; just send melt
       (send-event (-> this process) 'attack-invinc #f (static-attack-info ((mode 'melt)))))
      (((pat-event endlessfall))
       ;; endless pit death plane.
       (send-event (-> this process) 'attack-invinc #f (static-attack-info ((mode 'endlessfall)))))))
  0
  (none))

(defun default-collision-reaction ((cshape collide-shape-moving) (isect collide-shape-intersect) (vel-out vector) (vel-in vector))
  "Move cshape to the earliest intersection, process its surface material, classify the contact,
   and remove velocity directed into the surface. Store the adjusted velocity in vel-out and
   return the collide-status bits produced by the contact."
  (local-vars
    (center-direction vector)
    (surface-normal vector)
    (adjusted-input-velocity vector)
    (status-mask collide-status)
    (wall? symbol))
  (set! center-direction (new-stack-vector0))
  (set! surface-normal (new-stack-vector0))
  (set! adjusted-input-velocity (new 'stack-no-clear 'vector))
  (set! status-mask (collide-status))
  (vector-copy! adjusted-input-velocity vel-in)
  ;; move along the vector by the best move-vec
  ;; this will hit the best-tri
  (let ((move-amount (new 'stack-no-clear 'vector)))
    (vector-float*! move-amount (-> isect move-vec) (-> isect best-u))
    (move-by-vector! cshape move-amount))
  ;; so handle hitting that tri
  (set-and-handle-pat! cshape (-> isect best-tri pat))
  (vector-! center-direction (the-as vector (-> isect best-from-prim prim-core)) (-> isect best-tri intersect))
  (set! (-> center-direction w) 1.0)
  (vector-normalize! center-direction 1.0)
  (set! (-> cshape coverage) (vector-dot center-direction (-> isect best-tri normal)))
  (let ((center-direction-quad (-> center-direction quad))) (set! (-> surface-normal quad) center-direction-quad))
  ;; ?
  (if (= (-> isect best-u) 0.0) (move-by-vector! cshape surface-normal))
  ;;
  (vector-copy! (-> cshape surface-normal) surface-normal)
  (vector-copy! (-> cshape poly-normal) (-> isect best-tri normal))
  (set! (-> cshape surface-angle) (vector-dot surface-normal (-> cshape dynam gravity-normal)))
  (set! (-> cshape poly-angle) (vector-dot (-> cshape poly-normal) (-> cshape dynam gravity-normal)))
  (set! (-> cshape touch-angle)
        (vector-dot surface-normal (vector-normalize! (vector-negate! (new-stack-vector0) adjusted-input-velocity) 1.0)))
  (if (< (-> cshape poly-angle) COLLIDE-CEILING-POLY-ANGLE)
    (set! status-mask (logior status-mask (collide-status touch-ceiling))))
  (set! wall? (< (fabs (-> cshape surface-angle)) (-> *pat-mode-info* (-> cshape cur-pat mode) wall-angle)))
  (when (zero? (logand (-> cshape prev-status) (collide-status on-surface)))
    ;; hit the ground!
    (set! (-> cshape ground-impact-vel) (- (vector-dot (-> cshape transv) (-> cshape dynam gravity-normal))))
    (when (not wall?)
      (let ((remaining-impact-fraction (- 1.0 (-> cshape surf impact-fric))))
        (when (< remaining-impact-fraction 1.0)
          (let ((lateral-velocity (new-stack-vector0))
                (gravity-speed (vector-dot (-> cshape dynam gravity-normal) adjusted-input-velocity)))
            0.0
            (vector-! lateral-velocity
                      adjusted-input-velocity
                      (vector-float*! lateral-velocity (-> cshape dynam gravity-normal) gravity-speed))
            (let* ((lateral-speed (vector-length lateral-velocity))
                   (lateral-speed-copy lateral-speed))
              (if (< gravity-speed 0.0) (set! gravity-speed (* gravity-speed remaining-impact-fraction)))
              (vector+! adjusted-input-velocity
                        (vector-float*! adjusted-input-velocity (-> cshape dynam gravity-normal) gravity-speed)
                        (vector-float*! lateral-velocity lateral-velocity (/ lateral-speed lateral-speed-copy)))))))))
  ;; set t-surf (touching a surface)
  (set! status-mask (logior status-mask (collide-status touch-surface)))
  ;; Bit five is touch-actor rather than touch-ceiling. best-to-prim is only filled in when the cached
  ;; primitive that was hit belongs to a foreground actor, so this marks actor contact.
  (if (-> isect best-to-prim)
    (set! status-mask (logior status-mask (collide-status touch-actor))) ;; t-ceil. not sure why this is the case.
    )
  (cond
    (wall?
     (set! status-mask (logior status-mask (collide-status touch-wall))) ;; using it as a wall
     (set! (-> cshape cur-pat mode) (pat-mode wall)))
    (else
     (set! status-mask (logior status-mask (collide-status on-surface))) ;; on.
     (vector-copy! (-> cshape local-normal) surface-normal)))
  (vector-reflect-flat! vel-out adjusted-input-velocity surface-normal)
  (when (and (not wall?) (>= (-> cshape coverage) COLLIDE-GROUND-COVERAGE))
    (set! status-mask (logior status-mask (collide-status on-ground)))
    (vector-copy! (-> cshape ground-poly-normal) (-> cshape poly-normal))
    (when (!= (-> cshape poly-pat mode) (pat-mode wall))
      (set! (-> cshape ground-pat) (-> cshape poly-pat))
      (vector-copy! (-> cshape ground-touch-point) (-> isect best-tri intersect))))
  (logior! (-> cshape status) status-mask)
  (the-as collide-status status-mask))

(defun simple-collision-reaction ((cshape collide-shape-moving) (isect collide-shape-intersect) (vel-out vector) (vel-in vector))
  "Move cshape to the earliest intersection and reflect its velocity by one-and-a-half times the
   incoming normal component. Store the result in vel-out and return the basic contact status."
  (let ((status-mask (collide-status)))
    (let ((move-amount (new 'stack-no-clear 'vector)))
      ;; move by the amount we should.
      (vector-float*! move-amount (-> isect move-vec) (-> isect best-u))
      (move-by-vector! cshape move-amount))
    (let ((normal-speed (vector-dot (-> cshape transv) (-> isect best-tri normal)))
          (bounce-vector (new 'stack-no-clear 'vector)))
      ;; bounce off
      (vector-float*! bounce-vector (-> isect best-tri normal) (* 1.5 normal-speed))
      (vector-! (-> cshape transv) (-> cshape transv) bounce-vector))
    (let ((new-status (logior status-mask (collide-status on-surface on-ground touch-surface))))
      (logior! (-> cshape status) new-status)
      (the-as collide-status new-status))))

(defmethod step-collison! ((this collide-shape-moving) (vel-out vector) (vel-in vector) (step-fraction float))
  "Take 1 step in the collision. Attempt to move at velocity of vel-in, for step-fraction of a step.
   The resulting velocity is stored in vel-out. The amount of a step actually taken is returned."
  (local-vars (prims-left int))
  (let ((isect (new 'stack 'collide-shape-intersect))
        (move-vec (new 'stack-no-clear 'vector)))
    ;; integrate our velocity, get the "move vector"
    ;; which is what we'd move if we hit nothing.
    (vector-float*! move-vec vel-in (* step-fraction (-> *display* seconds-per-frame)))
    ;; initialize the collision data.
    (init! isect move-vec)
    ;; only if we have something in the collide cache, I guess.
    (let* ((root-prim (-> this root-prim))
           (ccache *collide-cache*)
           (cache-prim (the-as collide-cache-prim (-> ccache prims))))
      (set! prims-left (-> ccache num-prims))
      ;; collide with everything in the collide cache.
      (while (nonzero? prims-left)
        (set! prims-left (+ prims-left -1))
        (when (logtest? (-> root-prim collide-with) (-> cache-prim prim-core collide-as))
          ;; pick between sphere and mesh.
          (if (>= (-> cache-prim prim-core prim-type) 0)
            (collide-with-collide-cache-prim-mesh root-prim isect cache-prim)
            (collide-with-collide-cache-prim-sphere root-prim isect cache-prim)))
        (set! cache-prim (-> (the-as (inline-array collide-cache-prim) cache-prim) 1))))
    ;; now we've collided with everything. If we have a best-u of > 0, it means we can't do the full move.
    (let ((hit-u (-> isect best-u)))
      (cond
        ((>= hit-u 0.0)
         (let ((debug-in-vel (new 'stack-no-clear 'vector)))
           ;; if debugging, remember our input velocity.
           (if *display-collision-marks* (vector-copy! debug-in-vel vel-in))
           ;; do the collision reaction! this function should move the collide shape.
           (set! (-> this prev-status) (the-as collide-status ((-> this reaction) this isect vel-out vel-in)))
           ;; debug draw collision marks.
           (when *display-collision-marks*
             (let ((tri-color (-> *pat-mode-info* (-> isect best-tri pat mode) hilite-color)))
               (add-debug-outline-triangle #t
                                           (bucket-id debug-no-zbuf)
                                           (the-as vector (-> isect best-tri))
                                           (-> isect best-tri vertex 1)
                                           (-> isect best-tri vertex 2)
                                           tri-color))
             (add-debug-vector #t
                               (bucket-id debug-no-zbuf)
                               (-> isect best-tri intersect)
                               debug-in-vel
                               (meters 0.00007324219)
                               (new 'static 'rgba :r #xff :g #xa0 :a #x80))
             (add-debug-vector #t
                               (bucket-id debug-no-zbuf)
                               (-> isect best-tri intersect)
                               vel-out
                               (meters 0.00007324219)
                               (new 'static 'rgba :r #xff :g #xff :b #xff :a #x80))
             (if (= (-> this process type) target)
               (add-debug-vector #t
                                 (bucket-id debug-no-zbuf)
                                 (-> isect best-tri intersect)
                                 (-> this surface-normal)
                                 (meters 0.5)
                                 (-> *pat-mode-info* (-> this cur-pat mode) hilite-color)))))
         ;; and return the step size we could take.
         (return hit-u))
        (else
         ;; didn't hit anything! call the no-reaction function.
         (set! (-> this reaction-flag) (cshape-reaction-flags))
         ((-> this no-reaction) this isect vel-out vel-in)
         (set! (-> this prev-status) (collide-status))
         ;; and do the move ourself
         (move-by-vector! this move-vec)
         ;; velocity is unchanged
         (vector-copy! vel-out vel-in)
         ;; moved the whole way!
         (return 1.0)))))
  1.0)

(defmethod integrate-and-collide! ((this collide-shape) (velocity vector))
  "For a non-moving collide shape, we just move ourself. We have no reaction to anything we hit."
  (local-vars (seconds-per-frame-bits int))
  (rlet ((vf0 :class vf)
         (move-amount-vf :class vf)
         (seconds-vf :class vf))
    (init-vf0-vector)
    ;; velocity times seconds-per-frame, with w forced to one so the result is a usable vector. The
    ;; scalar has to cross through an integer register on its way to VU0, since there is no move from
    ;; an FPU register into a vf lane.
    (let ((move-function (method-of-object this move-by-vector!))
          (move-amount (new 'stack-no-clear 'vector)))
      (.lvf move-amount-vf (&-> velocity quad))
      (let ((seconds-per-frame (-> *display* seconds-per-frame))) (.mov seconds-per-frame-bits seconds-per-frame))
      (.mov seconds-vf seconds-per-frame-bits)
      (.mov.vf.w move-amount-vf vf0)
      (.mul.x.vf.xyz move-amount-vf move-amount-vf seconds-vf)
      (.svf (&-> move-amount quad) move-amount-vf)
      (move-function this move-amount))
    (none)))

(defmethod integrate-and-collide! ((this collide-shape-moving) (velocity vector))
  "Integrate forward, with collisions and collision responses.
  This will adjust our velocity based on collision.
  It will process updates from hitting triangles with pat-surfaces
  It will update the touching list.
  It will update the current surface and surface flags."
  ;; update the world-spheres for us and our children.
  (update-transforms! this)
  ;; remember our history
  (vector-copy! (-> this trans-old 2) (-> this trans-old 1))
  (vector-copy! (-> this trans-old 1) (-> this trans-old 0))
  (vector-copy! (-> this trans-old 0) (-> this trans))
  (set! (-> this prev-status) (-> this status))
  ;; setup
  (logclear! (-> this status)
             (collide-status on-surface
                             on-ground
                             touch-surface
                             touch-wall
                             touch-ceiling
                             touch-actor
                             on-special-surface
                             touch-edge
                             blocked
                             on-water
                             impact-surface
                             touch-background
                             stuck))
  (vector-copy! (-> this local-normal) (-> this dynam gravity-normal))
  (vector-copy! (-> this surface-normal) (-> this dynam gravity-normal))
  (vector-copy! (-> this poly-normal) (-> this dynam gravity-normal))
  (set! (-> this coverage) 0.0)
  (set! (-> this touch-angle) 0.0)
  ;; we want to take a step of 1.0
  (let ((fraction-remaining 1.0)
        (iteration 0) ;; iterations
        )
    (while (and (< 0.05 fraction-remaining) ;; at least 5% left
                (and (< iteration (the-as int (-> this max-iteration-count))) ;; iterations left
                     (not (and (= (-> velocity x) 0.0) (= (-> velocity y) 0.0) (= (-> velocity z) 0.0))) ;; nonzero velocity
                     ))
      ;; note that in between step-collision! and update-from-step-szie, the touching list is in an invalid state.
      (let ((fraction-used (step-collison! this velocity velocity fraction-remaining))) ;; step forward!
        (update-from-step-size *touching-list* fraction-used) ;; update touching list.
        (set! fraction-remaining (- fraction-remaining (* fraction-used fraction-remaining))) ;; advance the fraction of the remaining step.
        )
      (+! iteration 1)))
  0
  (none))

(defmethod integrate-and-collide! ((this control-info) (velocity vector))
  "Apply the animation collision offset, run moving-shape collision integration, track how much
   commanded motion was blocked, and update the achieved horizontal-velocity fraction."
  ;; time it
  (stopwatch-start (-> *collide-stats* total-target))
  ;; check and correct massive velocity.
  (when (< 1638400.0 (vector-length velocity))
    (format 0 "WARNING: target vel is ~M m/s, reseting to zero.~%" (vector-length velocity))
    (vector-reset! velocity))
  ;; The animation collision track moves the body independently of its ordinary velocity. Rotate
  ;; that offset to world space, feed its per-frame delta into collision, and cancel the same
  ;; displacement from the drawn model because the animation already contains it.
  (vector-copy! (-> this old-anim-collide-offset-world) (-> this anim-collide-offset-world))
  (vector-matrix*! (-> this anim-collide-offset-world) (-> this anim-collide-offset-local) (-> this root-orientation))
  (vector-! (-> this anim-collide-offset-delta-world)
            (-> this anim-collide-offset-world)
            (-> this old-anim-collide-offset-world))
  (let ((total-draw-offset (vector-! (new 'stack-no-clear 'vector) (-> this draw-offset) (-> this anim-collide-offset-world))))
    (vector-seek! (-> this cspace-offset) total-draw-offset (* 16384.0 (-> *display* seconds-per-frame))))
  (let ((velocity-with-anim-offset (vector+float*! (new-stack-vector0) velocity (-> this anim-collide-offset-delta-world) 60.0))
        (saved-input-velocity (new 'stack-no-clear 'vector)))
    (vector-copy! saved-input-velocity velocity)
    ;; call the normal integrate.
    (let ((parent-integrate (method-of-type collide-shape-moving integrate-and-collide!)))
      (parent-integrate this velocity-with-anim-offset))
    (let ((before-direction (new-stack-vector0)))
      (set! (-> before-direction quad) (-> saved-input-velocity quad))
      (let ((after-direction (new-stack-vector0)))
        (set! (-> after-direction quad) (-> velocity-with-anim-offset quad))
        (let ((lateral-before (new-stack-vector0)))
          (let ((gravity-speed-before (vector-dot (-> this dynam gravity-normal) before-direction)))
            0.0
            (vector-! lateral-before
                      before-direction
                      (vector-float*! lateral-before (-> this dynam gravity-normal) gravity-speed-before)))
          (let* ((lateral-length-before (vector-length lateral-before))
                 (lateral-length-before-copy lateral-length-before)
                 (gravity-weight-before 0.0))
            (vector+! before-direction
                      (vector-float*! before-direction (-> this dynam gravity-normal) gravity-weight-before)
                      (vector-float*! lateral-before lateral-before (/ lateral-length-before lateral-length-before-copy)))))
        (let ((lateral-after (new-stack-vector0)))
          (let ((gravity-speed-after (vector-dot (-> this dynam gravity-normal) after-direction)))
            0.0
            (vector-! lateral-after
                      after-direction
                      (vector-float*! lateral-after (-> this dynam gravity-normal) gravity-speed-after)))
          (let* ((lateral-length-after (vector-length lateral-after))
                 (lateral-length-after-copy lateral-length-after)
                 (gravity-weight-after 0.0))
            (vector+! after-direction
                      (vector-float*! after-direction (-> this dynam gravity-normal) gravity-weight-after)
                      (vector-float*! lateral-after lateral-after (/ lateral-length-after lateral-length-after-copy)))))
        (vector-normalize! before-direction 1.0)
        (vector-normalize! after-direction 1.0)
        (let ((before-after-dot (vector-dot before-direction after-direction)))
          (cond
            ((and (!= (vector-length (-> this target-transv)) 0.0)
                  (if (logtest? (-> this status) (collide-status touch-wall)) (< before-after-dot 0.9999) (< before-after-dot 0.95)))
             (set! (-> this blocked-factor) (seek (-> this blocked-factor) 1.0 (* 4.0 (-> *display* seconds-per-frame))))
             (set! (-> this blocked-in-air-factor)
                   (seek (-> this blocked-in-air-factor)
                         (if (= (-> this mod-surface mode) 'air) 1.0 0.0)
                         (* 4.0 (-> *display* seconds-per-frame))))
             (logior! (-> this status) (collide-status blocked)))
            (else
             (set! (-> this blocked-factor) (seek (-> this blocked-factor) 0.0 (* 2.0 (-> *display* seconds-per-frame))))
             (set! (-> this blocked-in-air-factor)
                   (seek (-> this blocked-in-air-factor) 0.0 (* 2.0 (-> *display* seconds-per-frame)))))))))
    (if (logtest? (-> this status) (collide-status on-surface))
      (vector-copy! velocity velocity-with-anim-offset)
      (vector--float*! velocity velocity-with-anim-offset (-> this anim-collide-offset-delta-world) 60.0))
    (if (and (logtest? (-> this status) (collide-status on-surface))
             (and (not (logtest? (-> this status) (collide-status touch-wall blocked)))
                  (< (vector-length (-> this btransv)) (vector-length saved-input-velocity))))
      (vector-copy! (-> this btransv) saved-input-velocity)))
  (let ((align-xz-direction (vector-normalize-copy! (new 'stack-no-clear 'vector) (-> this align-xz-vel) 1.0))
        (align-xz-speed (vector-length (-> this align-xz-vel))))
    (set! (-> this zx-vel-frac)
          (if (= align-xz-speed 0.0) 0.0 (fmax 0.0 (/ (vector-dot (-> this transv) align-xz-direction) align-xz-speed)))))
  (stopwatch-stop (-> *collide-stats* total-target))
  0
  (none))

(defmethod move-to-ground-point! ((this collide-shape-moving) (ground-point vector) (velocity vector) (ground-normal vector))
  "Move the collide shape to the ground immediately:
   ground-point: ground point
   velocity: velocity (will be modified)
   ground-normal: ground normal.
   Even if the ground is sloped, transv.y is set to 0."
  (move-to-point! this ground-point)
  (set! (-> velocity y) 0.0)
  (logior! (-> this status) (collide-status on-surface on-ground touch-surface))
  (vector-copy! (-> this poly-normal) ground-normal)
  (vector-copy! (-> this surface-normal) ground-normal)
  (vector-copy! (-> this local-normal) ground-normal)
  (vector-copy! (-> this ground-poly-normal) ground-normal)
  (set! (-> this ground-impact-vel) (- (vector-dot velocity (-> this dynam gravity-normal))))
  (vector-copy! (-> this ground-touch-point) ground-point)
  0
  (none))

(defmethod integrate-no-collide! ((this collide-shape-moving) (velocity vector))
  "Integrate, but ignore all collisions.
   Will set both trans and shadow-pos"
  (local-vars (seconds-per-frame-bits int))
  (rlet ((vf0 :class vf)
         (move-amount-vf :class vf)
         (seconds-vf :class vf))
    (init-vf0-vector)
    (update-transforms! this)
    (vector-copy! (-> this trans-old 2) (-> this trans-old 1))
    (vector-copy! (-> this trans-old 1) (-> this trans-old 0))
    (vector-copy! (-> this trans-old 0) (-> this trans))
    (set! (-> this prev-status) (-> this status))
    (logclear! (-> this status)
               (collide-status on-surface
                               on-ground
                               touch-surface
                               touch-wall
                               touch-ceiling
                               touch-actor
                               on-special-surface
                               touch-edge
                               blocked
                               on-water
                               impact-surface
                               touch-background
                               stuck))
    (vector-copy! (-> this local-normal) (-> this dynam gravity-normal))
    (vector-copy! (-> this surface-normal) (-> this dynam gravity-normal))
    (vector-copy! (-> this poly-normal) (-> this dynam gravity-normal))
    (set! (-> this coverage) 0.0)
    (set! (-> this touch-angle) 0.0)
    (let* ((shape-to-move this)
           (move-function (method-of-object shape-to-move move-by-vector!))
           (move-amount (new 'stack-no-clear 'vector)))
      (.lvf move-amount-vf (&-> velocity quad))
      (let ((seconds-per-frame (-> *display* seconds-per-frame))) (.mov seconds-per-frame-bits seconds-per-frame))
      (.mov seconds-vf seconds-per-frame-bits)
      (.mov.vf.w move-amount-vf vf0)
      (.mul.x.vf.xyz move-amount-vf move-amount-vf seconds-vf)
      (.svf (&-> move-amount quad) move-amount-vf)
      (move-function shape-to-move move-amount))
    (vector-copy! (-> this shadow-pos) (-> this trans))
    0
    (none)))

(defmethod integrate-and-revert-if-blocked! ((this collide-shape-moving) (velocity vector))
  "Move one frame without a sweep, then run a solid exact-overlap
   query. Restore trans-old[0] and return true when an overlap is found; shadow-pos remains at the
   attempted destination."
  ;; not sure yet. moves shadow-pos, but possibly not trans.
  (integrate-no-collide! this velocity)
  (let ((overlap-params (new 'stack-no-clear 'overlaps-others-params)))
    (set! (-> overlap-params options) (overlaps-others-options solid-only))
    (set! (-> overlap-params tlist) *touching-list*)
    (when (find-overlapping-shapes this overlap-params)
      (move-to-point! this (the-as vector (-> this trans-old)))
      (return #t)))
  #f)

(defmethod move-to-tri! ((this collide-shape-moving) (triangle collide-tri-result) (position vector))
  "Move to position, copy triangle's PAT and normal state, and mark a clean supporting-surface
   contact."
  (move-to-point! this position)
  (logior! (-> this status) (collide-status on-surface on-ground touch-surface))
  (let ((triangle-normal (-> triangle normal)))
    (vector-copy! (-> this poly-normal) triangle-normal)
    (vector-copy! (-> this surface-normal) triangle-normal)
    (vector-copy! (-> this local-normal) triangle-normal)
    (vector-copy! (-> this ground-poly-normal) triangle-normal))
  (set! (-> this poly-pat) (-> triangle pat))
  (set! (-> this cur-pat) (-> triangle pat))
  (set! (-> this ground-pat) (-> triangle pat))
  (vector-copy! (-> this ground-touch-point) position)
  0
  (none))

(defmethod integrate-for-enemy-with-move-to-ground! ((this collide-shape-moving) (velocity vector) (ground-kind collide-kind) (probe-y-offset float) (revert-when-blocked? symbol) (hover-without-ground? symbol) (use-misty-ground? symbol))
  "Integrate an enemy, probe or synthesize its ground point, optionally hover when no ground is
   found, and optionally restore the old position when foreground collision is blocked.
   use-misty-ground? selects the analytic Misty height probe, which returns a fraction without
   filling the triangle result."
  (local-vars (probe-start-height float) (ground-triangle collide-tri-result))
  (set! probe-start-height probe-y-offset)
  (let ((revert-when-blocked? revert-when-blocked?))
    (let ((hover-without-ground? hover-without-ground?)
          (use-misty-ground? use-misty-ground?))
      (if *debug-segment*
        (add-frame (-> *display* frames (-> *display* on-screen) frame profile-bar 0)
                   'draw
                   (new 'static 'rgba :r #x40 :b #x40 :a #x80)))
      ;; move us forward!
      (integrate-no-collide! this velocity)
      ;; set our position to shadow (not sure why)
      (let ((probe-position (-> this shadow-pos)))
        (vector-copy! probe-position (-> this trans))
        (set! ground-triangle (new 'stack-no-clear 'collide-tri-result))
        ;; move off the ground by the given height probe offset
        (+! (-> probe-position y) probe-start-height)
        0.0
        ;; Probe the ground. The analytic Misty probe returns only a height fraction; unlike the
        ;; mesh probe, it does not fill ground-triangle.
        (let ((probe-u (if use-misty-ground?
                         (misty-ambush-height-probe probe-position 81920.0)
                         (fill-and-probe-using-line-sphere *collide-cache*
                                                           probe-position
                                                           (new 'static 'vector :y -81920.0 :w 1.0) ;; probe down.
                                                           40.96
                                                           ground-kind
                                                           (-> this process)
                                                           ground-triangle
                                                           (new 'static 'pat-surface :noentity #x1)))))
          (cond
            ((>= probe-u 0.0)
             ;; found the ground!
             (let ((probe-direction (new 'static 'vector :y -81920.0 :w 1.0)))
               ;; set probe-position to the ground.
               (vector+float*! probe-position probe-position probe-direction probe-u))
             (when (>= (-> probe-position y) (-> this trans y))
               ;; we're in the ground, move us out of the ground.
               (move-to-tri! this ground-triangle probe-position)
               ;; remember how hard we hit
               (set! (-> this ground-impact-vel) (- (vector-dot velocity (-> this dynam gravity-normal))))
               ;; and kill our vertical velocity.
               (set! (-> velocity y) 0.0)))
            (hover-without-ground?
             ;; no ground. if the hover flag is set, we just hover.
             (set! (-> this trans y) (-> this trans-old 0 y)))))))
    ;; if we need to collide with things.
    (when (logtest? (-> this root-prim collide-with) (collide-kind hit-by-player usually-hit-by-player hit-by-others target))
      (let ((overlap-params (new 'stack-no-clear 'overlaps-others-params)))
        (set! (-> overlap-params options) (overlaps-others-options solid-only))
        (set! (-> overlap-params tlist) *touching-list*)
        ;; compute overlaps.
        (when (find-overlapping-shapes this overlap-params)
          ;; if we have the revert move if blocked, go back to our old point.
          (if revert-when-blocked? (move-to-point! this (the-as vector (-> this trans-old))))))))
  (if *debug-segment*
    (add-frame (-> *display* frames (-> *display* on-screen) frame profile-bar 0) 'draw (new 'static 'rgba :g #xff :a #x80)))
  0
  (none))

(defmethod move-to-ground ((this collide-shape-moving) (snap-up-height float) (search-below float) (warn-on-fail? symbol) (ground-kind collide-kind))
  "Probe from snap-up-height above the shape to search-below beneath it, move to the first triangle
   matching ground-kind, and return true. Return false and optionally warn when no ground is found."
  (if *debug-segment*
    (add-frame (-> *display* frames (-> *display* on-screen) frame profile-bar 0)
               'draw
               (new 'static 'rgba :r #x40 :b #x40 :a #x80)))
  (let ((probe-position (new 'stack-no-clear 'vector))
        (ground-triangle (new 'stack-no-clear 'collide-tri-result)))
    (let ((probe-length (+ snap-up-height search-below)))
      (vector-copy! probe-position (-> this trans))
      (+! (-> probe-position y) snap-up-height)
      0.0
      ;; find the ground
      (let ((probe-u (fill-and-probe-using-y-probe *collide-cache*
                                                   probe-position
                                                   probe-length
                                                   ground-kind
                                                   (-> this process)
                                                   ground-triangle
                                                   (new 'static 'pat-surface :noentity #x1))))
        (when (< probe-u 0.0)
          (if warn-on-fail?
            (format 0
                    "WARNING: move-to-ground: (~f ~f) failed to locate ground [~S type ~S]~%"
                    (* 0.00024414062 (-> probe-position y))
                    (* 0.00024414062 probe-length)
                    (-> this process name)
                    (-> this process type symbol)))
          (return #f))
        ;; calulate the ground position.
        (set! (-> probe-position y) (- (-> probe-position y) (* probe-u probe-length)))))
    ;; move our shadow there too
    (vector-copy! (-> this shadow-pos) probe-position)
    ;; and move us there!
    (move-to-tri! this ground-triangle probe-position))
  (if *debug-segment*
    (add-frame (-> *display* frames (-> *display* on-screen) frame profile-bar 0)
               'draw
               (new 'static 'rgba :r #xff :g #xff :b #xff :a #x80)))
  #t)

(defmethod compute-acc-due-to-gravity ((this collide-shape-moving) (acceleration-out vector) (slopiness float))
  "Store gravity plus the slope-parallel acceleration selected by slopiness in acceleration-out
   and return that vector."
  (let* ((negative-gravity (vector-negate! (new-stack-vector0) (-> this dynam gravity))) ;; this is the acceleration from gravity.
         (slope-normal (-> this local-normal))
         (slide-acceleration (vector-reflect-flat! (new-stack-vector0) negative-gravity slope-normal)) ;; figure out the accleration from sliding down a sloped wall.
         )
    ;; apply that. note that we scale the slopiness by slopiness
    ;; (this is not really how things work.)
    (vector--float*! acceleration-out
                     negative-gravity
                     slide-acceleration
                     (cond
                       ((logtest? (-> this status) (collide-status on-surface)) (empty) slopiness)
                       (else 0.0))))
  acceleration-out)

(defmethod fill-cache-integrate-and-collide! ((this collide-shape) (velocity vector) (kind collide-kind))
  "Fill the collision cache for one frame of velocity, adding one meter of reach for the target,
   then run the shape's integration method."
  (local-vars (seconds-per-frame-bits int))
  (rlet ((vf0 :class vf)
         (move-amount-vf :class vf)
         (seconds-vf :class vf))
    (init-vf0-vector)
    ;; scale the velocity, to see how far we can go, at max.
    (let ((move-amount (new 'stack-no-clear 'vector)))
      (let ((move-amount-pointer move-amount))
        (.lvf move-amount-vf (&-> velocity quad))
        (let ((seconds-per-frame (-> *display* seconds-per-frame))) (.mov seconds-per-frame-bits seconds-per-frame))
        (.mov seconds-vf seconds-per-frame-bits)
        (.mov.vf.w move-amount-vf vf0)
        (.mul.x.vf.xyz move-amount-vf move-amount-vf seconds-vf)
        (.svf (&-> move-amount-pointer quad) move-amount-vf))
      ;; add a bonus size if we are target.
      (let ((cache-radius (+ (vector-length move-amount) (if (= (-> this process type) target) 4096.0 0.0))))
        ;; and now fill the cache with all things we could hit
        (fill-cache-for-shape! this cache-radius kind)))
    ;; do the integration, colliding with stuff in the cache.
    (integrate-and-collide! this velocity)
    (none)))

(defmethod fill-cache-for-shape! ((this collide-shape) (padding-distance float) (kind collide-kind))
  "Build this shape's compatible world bounds with padding-distance and fill the shared collision
   cache, or clear the cache when no primitive contributes."
  (let ((bbox (new 'stack-no-clear 'bounding-box)))
    (cond
      ((build-bounding-box-for-shape this bbox padding-distance kind) ;; <- this generates the box
       ;; fill with the gox
       (fill-using-bounding-box *collide-cache* bbox kind (-> this process) (-> this pat-ignore-mask))
       ;; only draw collide cache, if we're the target
       (when (and *display-collide-cache* (= (-> this process type) target))
         (debug-draw *collide-cache*)
         ;; og:preserve-this added
         (add-debug-box #t (bucket-id debug) (-> bbox min) (-> bbox max) (new 'static 'rgba :a #x80 :b #x70 :g #x70))))
      (else
       ;; no need. the cache can be empty.
       (initialize *collide-cache*))))
  (none))

;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; bounding box of shape
;;;;;;;;;;;;;;;;;;;;;;;;;;;

(#when PC_PORT
  ;; og:preserve-this these functions don't obey calling conventions, so they are modified for the PC port.
  ;; The original passes the accumulated bounds and the expanded radius between these methods in three
  ;; VU0 registers that survive the virtual calls. Nothing guarantees that on the host, so each method
  ;; reloads them from this global on entry and writes them back before returning or recursing. The
  ;; recursive group walkers save around every nested call for the same reason.
  (deftype pc-bounding-box-work (structure)
    ((spill-min    vector :inline)
     (spill-max    vector :inline)
     (spill-radius vector :inline)))
  (define *pc-bounding-box-work* (new 'global 'pc-bounding-box-work))
  (defmacro save-bounding-box-work ()
    `(begin
      (.svf (&-> *pc-bounding-box-work* spill-radius quad) expanded-radius)
      (.svf (&-> *pc-bounding-box-work* spill-max quad) bounds-max)
      (.svf (&-> *pc-bounding-box-work* spill-min quad) bounds-min)))
  (defmacro load-bounding-box-work ()
    `(begin
      (.lvf bounds-min (&-> *pc-bounding-box-work* spill-min quad))
      (.lvf bounds-max (&-> *pc-bounding-box-work* spill-max quad))
      (.lvf expanded-radius (&-> *pc-bounding-box-work* spill-radius quad))))
  (defmethod build-bounding-box-for-shape ((this collide-shape) (box bounding-box) (padding-distance float) (kind collide-kind))
    "Build a bounding box containing the whole shape.
   If the box is empty, returns #f."
    (rlet ((vf0 :class vf)
           (one-millimeter-vf :class vf)
           (bounds-min :class vf)
           (bounds-max :class vf)
           (expanded-radius :class vf))
      (init-vf0-vector)
      (let ((padding-vector (new 'static 'vector :x 4.096))
            (root-prim (-> this root-prim)))
        (cond
          ((logtest? (-> root-prim collide-with) kind)
           (.mov expanded-radius padding-distance)
           (.lvf one-millimeter-vf (&-> padding-vector quad))
           (.add.x.vf.x expanded-radius expanded-radius one-millimeter-vf)
           (.svf (&-> *pc-bounding-box-work* spill-radius quad) expanded-radius) ;; added
           (cond
             ((add-to-bounding-box root-prim kind)
              (.lvf bounds-min (&-> *pc-bounding-box-work* spill-min quad)) ;; added
              (.lvf bounds-max (&-> *pc-bounding-box-work* spill-max quad)) ;; added
              (.mov.vf.w bounds-min vf0)
              (.mov.vf.w bounds-max vf0)
              (.svf (&-> box min quad) bounds-min)
              (.svf (&-> box max quad) bounds-max)
              (return #t))
             (else (return #f)))
           (the-as none 0))
          (else (return #f))))
      (the-as symbol 0)))
  ;; ERROR: Bad vector register dependency: vf31
  (defmethod add-to-bounding-box ((this collide-shape-prim) (kind collide-kind))
    "Add a single prim to the bounding box. (just adds the bsphere)"
    (rlet ((prim-sphere :class vf)
           (radius :class vf)
           (bounds-min :class vf)
           (bounds-max :class vf)
           (expanded-radius :class vf))
      (load-bounding-box-work)
      (.lvf prim-sphere (&-> this prim-core world-sphere quad))
      (.add.w.vf.x radius expanded-radius prim-sphere)
      (.add.x.vf.xyz bounds-max prim-sphere radius)
      (.sub.x.vf.xyz bounds-min prim-sphere radius)
      (save-bounding-box-work)
      #t))
  (defmethod add-to-bounding-box ((this collide-shape-prim-group) (kind collide-kind))
    "Add a group of prims."
    (local-vars (child-byte-offset int) (initial-min-marker none) (updated-max-marker float) (i int))
    (rlet ((prim-sphere :class vf)
           (radius :class vf)
           (bounds-min :class vf)
           (leaf-min :class vf)
           (bounds-max :class vf)
           (expanded-radius :class vf)
           (leaf-max :class vf))
      (load-bounding-box-work)
      ;; this first loop looks for a non-empty group.
      ;; The branch delay slots still compute child-byte-offset, which nothing reads.
      (let ((prim-count (-> this num-prims))
            (i 0))
        (label find-first-leaf)
        (b! (= i prim-count) no-compatible-leaf :delay (set! child-byte-offset (* i 4)))
        (let ((child-prim (-> this prims i)))
          (when (logtest? (-> child-prim collide-with) kind)
            (cond
              ((= (-> child-prim type) collide-shape-prim-group)
               (save-bounding-box-work)
               (when (add-to-bounding-box child-prim kind)
                 (load-bounding-box-work)
                 (empty)
                 (goto first-leaf-ready))
               (load-bounding-box-work))
              (else
               (.lvf prim-sphere (&-> child-prim prim-core world-sphere quad))
               (.add.w.vf.x radius expanded-radius prim-sphere)
               (.add.x.vf.xyz bounds-max prim-sphere radius)
               (b! #t first-leaf-ready :delay (.sub.x.vf.xyz bounds-min prim-sphere radius))
               (.mov initial-min-marker bounds-min)))))
        ;; and now
        (b! #t find-first-leaf :delay (set! i (+ i 1)))
        (label no-compatible-leaf)
        (let ((result #f))
          (b! #t give-up :delay (nop!))
          (label first-leaf-ready)
          (let ((i (+ i 1)))
            (label add-remaining-leaves)
            (b! (= i prim-count) bounds-complete :delay (set! child-byte-offset (* i 4)))
            (let ((child-prim (-> this prims i)))
              (when (logtest? (-> child-prim collide-with) kind)
                (cond
                  ((= (-> child-prim type) collide-shape-prim-group)
                   (save-bounding-box-work)
                   (add-to-non-empty-bounding-box (the-as collide-shape-prim-group child-prim) kind)
                   (load-bounding-box-work))
                  (else
                   (.lvf prim-sphere (&-> child-prim prim-core world-sphere quad))
                   (.add.w.vf.x radius expanded-radius prim-sphere)
                   (.add.x.vf.xyz leaf-max prim-sphere radius)
                   (.sub.x.vf.xyz leaf-min prim-sphere radius)
                   (.min.vf bounds-min bounds-min leaf-min)
                   (.max.vf bounds-max bounds-max leaf-max)
                   (.mov updated-max-marker bounds-max)))))
            (b! #t add-remaining-leaves :delay (set! i (+ i 1))))
          (label bounds-complete)
          (save-bounding-box-work)
          (return #t)
          (label give-up)
          (save-bounding-box-work)
          result))))
  (defmethod add-to-non-empty-bounding-box ((this collide-shape-prim-group) (kind collide-kind))
    "Expand an already initialized shared bounding box with every
   compatible leaf in this group."
    (local-vars (child-byte-offset int) (updated-max-marker float))
    (rlet ((prim-sphere :class vf)
           (radius :class vf)
           (bounds-min :class vf)
           (leaf-min :class vf)
           (bounds-max :class vf)
           (expanded-radius :class vf)
           (leaf-max :class vf))
      (load-bounding-box-work)
      (let ((prim-count (-> this num-prims))
            (i 0))
        (label add-leaves)
        (b! (= i prim-count) done :delay (set! child-byte-offset (* i 4)))
        (let ((child-prim (-> this prims i)))
          (when (logtest? (-> child-prim collide-with) kind)
            (cond
              ((= (-> child-prim type) collide-shape-prim-group)
               (save-bounding-box-work)
               (add-to-non-empty-bounding-box (the-as collide-shape-prim-group child-prim) kind)
               (load-bounding-box-work))
              (else
               (.lvf prim-sphere (&-> child-prim prim-core world-sphere quad))
               (.add.w.vf.x radius expanded-radius prim-sphere)
               (.add.x.vf.xyz leaf-max prim-sphere radius)
               (.sub.x.vf.xyz leaf-min prim-sphere radius)
               (.min.vf bounds-min bounds-min leaf-min)
               (.max.vf bounds-max bounds-max leaf-max)
               (.mov updated-max-marker bounds-max)))))
        (b! #t add-leaves :delay (set! i (+ i 1))))
      (label done)
      (save-bounding-box-work)
      0
      (none))))

(#unless PC_PORT
  ;; These methods share three VU0 registers across virtual calls. expanded-radius contains the
  ;; caller's padding plus one millimeter, while bounds-min and bounds-max carry the accumulated
  ;; xyz limits. The primitive methods deliberately do not use the ordinary register convention.
  (defmethod build-bounding-box-for-shape ((this collide-shape) (box bounding-box) (padding-distance float) (kind collide-kind))
    "Fill box with the bounds of root primitives compatible with kind, expanded by padding-distance
   plus one millimeter. Return false when none contribute."
    (rlet ((padding-vf :reg vf1)
           (bounds-min :reg vf29)
           (bounds-max :reg vf30)
           (expanded-radius :reg vf31)
           (vf0 :reg vf0))
      (init-vf0-vector)
      (let ((one-millimeter (new 'static 'vector :x 4.096))
            (root-prim (-> this root-prim)))
        (cond
          ((logtest? (-> root-prim collide-with) kind)
           (m expanded-radius padding-distance)
           (l.vf padding-vf one-millimeter)
           (add.x.vf.x expanded-radius expanded-radius padding-vf)
           (cond
             ((add-to-bounding-box root-prim kind)
              ;; The recursive call leaves xyz bounds in the shared registers. Their w lanes are
              ;; pointer tags in a GOAL vector, so restore those lanes before storing the box.
              (move.w.vf bounds-min vf0)
              (move.w.vf bounds-max vf0)
              (s.vf bounds-min box (offset-of bounding-box min))
              (s.vf bounds-max box (offset-of bounding-box max))
              (return #t))
             (else (return #f))))
          (else (return #f))))
      #f))
  (defmethod add-to-bounding-box ((this collide-shape-prim) (kind collide-kind))
    "Seed the shared bounds from this primitive's world sphere."
    (rlet ((prim-sphere :reg vf1)
           (radius :reg vf2)
           (bounds-min :reg vf29)
           (bounds-max :reg vf30)
           (expanded-radius :reg vf31))
      (l.vf prim-sphere this (offset-of collide-shape-prim prim-core world-sphere))
      (add.w.vf.x radius expanded-radius prim-sphere)
      (add.x.vf.xyz bounds-max prim-sphere radius)
      (sub.x.vf.xyz bounds-min prim-sphere radius)
      #t))
  (defmethod add-to-bounding-box ((this collide-shape-prim-group) (kind collide-kind))
    "Seed the shared bounds from the first compatible leaf, then expand them with every remaining
   compatible leaf in this group."
    (rlet ((prim-sphere :reg vf1)
           (radius :reg vf2)
           (leaf-min :reg vf3)
           (leaf-max :reg vf4)
           (bounds-min :reg vf29)
           (bounds-max :reg vf30)
           (expanded-radius :reg vf31))
      ;; Find the first compatible leaf. A nested group may be empty, so keep looking when its
      ;; recursive call returns false.
      (let ((prim-count (-> this num-prims))
            (i 0))
        (label find-first-leaf)
        (b.eq i prim-count no-compatible-leaf :delay (nop!))
        (let ((child-prim (-> this prims i)))
          (when (logtest? (-> child-prim collide-with) kind)
            (cond
              ((= (-> child-prim type) collide-shape-prim-group) (when (add-to-bounding-box child-prim kind) (goto first-leaf-ready)))
              (else
               (l.vf prim-sphere child-prim (offset-of collide-shape-prim prim-core world-sphere))
               (add.w.vf.x radius expanded-radius prim-sphere)
               (add.x.vf.xyz bounds-max prim-sphere radius)
               (sub.x.vf.xyz bounds-min prim-sphere radius)
               (goto first-leaf-ready)))))
        (b find-first-leaf :delay (+! i 1))
        (label no-compatible-leaf)
        (return #f)
        ;; The first leaf initialized both limits. Remaining leaves can update them independently.
        (label first-leaf-ready)
        (+! i 1)
        (label add-remaining-leaves)
        (b.eq i prim-count bounds-complete :delay (nop!))
        (let ((child-prim (-> this prims i)))
          (when (logtest? (-> child-prim collide-with) kind)
            (cond
              ((= (-> child-prim type) collide-shape-prim-group)
               (add-to-non-empty-bounding-box (the-as collide-shape-prim-group child-prim) kind))
              (else
               (l.vf prim-sphere child-prim (offset-of collide-shape-prim prim-core world-sphere))
               (add.w.vf.x radius expanded-radius prim-sphere)
               (add.x.vf.xyz leaf-max prim-sphere radius)
               (sub.x.vf.xyz leaf-min prim-sphere radius)
               (min.vf bounds-min bounds-min leaf-min)
               (max.vf bounds-max bounds-max leaf-max)))))
        (b add-remaining-leaves :delay (+! i 1))
        (label bounds-complete)
        #t)))
  (defmethod add-to-non-empty-bounding-box ((this collide-shape-prim-group) (kind collide-kind))
    "Expand the initialized shared bounds with every compatible leaf in this group."
    (rlet ((prim-sphere :reg vf1)
           (radius :reg vf2)
           (leaf-min :reg vf3)
           (leaf-max :reg vf4)
           (bounds-min :reg vf29)
           (bounds-max :reg vf30)
           (expanded-radius :reg vf31))
      (let ((prim-count (-> this num-prims))
            (i 0))
        (label add-leaves)
        (b.eq i prim-count done :delay (nop!))
        (let ((child-prim (-> this prims i)))
          (when (logtest? (-> child-prim collide-with) kind)
            (cond
              ((= (-> child-prim type) collide-shape-prim-group)
               (add-to-non-empty-bounding-box (the-as collide-shape-prim-group child-prim) kind))
              (else
               (l.vf prim-sphere child-prim (offset-of collide-shape-prim prim-core world-sphere))
               (add.w.vf.x radius expanded-radius prim-sphere)
               (add.x.vf.xyz leaf-max prim-sphere radius)
               (sub.x.vf.xyz leaf-min prim-sphere radius)
               (min.vf bounds-min bounds-min leaf-min)
               (max.vf bounds-max bounds-max leaf-max)))))
        (b add-leaves :delay (+! i 1)))
      (label done)
      (none))))

;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; prim lookup
;;;;;;;;;;;;;;;;;;;;;;;;;;;

(defmethod find-prim-by-id ((this collide-shape) (id-to-find uint))
  "Find a prim in this shape with the given id."
  (find-prim-by-id (-> this root-prim) id-to-find))

(defmethod find-prim-by-id ((this collide-shape-prim) (id-to-find uint))
  "Find a prim in this shape or its children with the given id."
  (if (= (-> this prim-id) id-to-find) ;; it's us!
    (return this))
  (the-as collide-shape-prim #f))

(defmethod find-prim-by-id ((this collide-shape-prim-group) (id-to-find uint))
  "Find a prim in this shape or its children with the given id."
  (if (= (-> this prim-id) id-to-find) ;; it's us
    (return this))
  (countdown (i (-> this num-prims))
    (let ((child-prim (-> this prims i)))
      (cond
        ((= (-> child-prim type) collide-shape-prim-group)
         (let ((found (find-prim-by-id child-prim id-to-find))) (if found (return found))))
        (else
         ;; just check here, to avoid the virtual call
         (if (= (-> child-prim prim-id) id-to-find) (return child-prim))))))
  (the-as collide-shape-prim #f))

;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; debug
;;;;;;;;;;;;;;;;;;;;;;;;;;;

(defun-debug collide-shape-draw-debug-marks ()
  "Draw collision debug."
  (add-debug-sphere (or *display-collision-marks* *display-target-marks*)
                    (bucket-id debug)
                    (target-pos 0)
                    819.2
                    (new 'static 'rgba :r #xff :g #xff :b #xff :a #x80))
  (when *display-collision-marks*
    (iterate-engine-connections (node *collide-player-list*)
                                (let ((cshape (-> (the-as connection node) param1)))
                                  (if (or (and (not *display-actor-anim*) (not *display-process-anim*))
                                          (or (= (-> (the-as collide-shape cshape) process) *target*)
                                              (name= *display-actor-anim* (-> (the-as collide-shape cshape) process name))
                                              (= (ppointer->process *display-process-anim*) (-> (the-as collide-shape cshape) process))))
                                    (debug-draw (the-as collide-shape cshape)))))
    (iterate-engine-connections (node *collide-hit-by-player-list*)
                                (let ((cshape (-> (the-as connection node) param1)))
                                  (if (or (and (not *display-actor-anim*) (not *display-process-anim*))
                                          (or (= (-> (the-as collide-shape cshape) process) *target*)
                                              (name= *display-actor-anim* (-> (the-as collide-shape cshape) process name))
                                              (= (ppointer->process *display-process-anim*) (-> (the-as collide-shape cshape) process))))
                                    (debug-draw (the-as collide-shape cshape)))))
    (iterate-engine-connections (node *collide-usually-hit-by-player-list*)
                                (let ((cshape (-> (the-as connection node) param1)))
                                  (if (or (and (not *display-actor-anim*) (not *display-process-anim*))
                                          (or (= (-> (the-as collide-shape cshape) process) *target*)
                                              (name= *display-actor-anim* (-> (the-as collide-shape cshape) process name))
                                              (= (ppointer->process *display-process-anim*) (-> (the-as collide-shape cshape) process))))
                                    (debug-draw (the-as collide-shape cshape)))))
    (iterate-engine-connections (node *collide-hit-by-others-list*)
                                (let ((cshape (-> (the-as connection node) param1)))
                                  (if (or (and (not *display-actor-anim*) (not *display-process-anim*))
                                          (or (= (-> (the-as collide-shape cshape) process) *target*)
                                              (name= *display-actor-anim* (-> (the-as collide-shape cshape) process name))
                                              (= (ppointer->process *display-process-anim*) (-> (the-as collide-shape cshape) process))))
                                    (debug-draw (the-as collide-shape cshape))))))
  0
  (none))

(defmethod debug-draw ((this collide-shape))
  "Draw a collide shape"
  (if (sphere-in-view-frustum? (the-as sphere (-> this root-prim prim-core))) (debug-draw-world-sphere (-> this root-prim)))
  (none))

(define *col-timer* (new 'global 'stopwatch))

(define *frame-timer* (new 'global 'stopwatch))

(define *col-timer-enable* #t)

(defun debug-report-col-stats ()
  "When collision timing is enabled, print the collision and frame times, then restart both
   stopwatches for the next frame."
  (when *col-timer-enable*
    (stopwatch-end *frame-timer*)
    (format *stdcon* "col stats:~%")
    (format *stdcon* " col       ~F ms~%" (* 1000.0 (stopwatch-elapsed-seconds *col-timer*)))
    (format *stdcon* " frame     ~F ms~%" (* 1000.0 (stopwatch-elapsed-seconds *frame-timer*)))
    (stopwatch-init *col-timer*)
    (stopwatch-init *frame-timer*)
    (stopwatch-begin *frame-timer*)))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; transform spheres by joints
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(defmethod update-transforms! ((this collide-shape))
  "Update all transforms for this shape. After this is called, you can use the
   world-spheres."
  (update-transforms! (-> this root-prim) (-> this process))
  #f)

(defmethod update-transforms! ((this collide-shape-prim) (owner process-drawable))
  "Update our world sphere, and our children's world sphere's too."
  ;; transform-index selects where the world sphere comes from. Zero or above is an index into the
  ;; owner's joint node list, so the local sphere is carried through that bone. -2 means the sphere
  ;; simply follows the collide-shape's trans. -1 means leave the world sphere alone; something else
  ;; is maintaining it. A prim with a joint index but no node list also falls through to the trans
  ;; case, so the two branches deliberately test different sentinels.
  (local-vars (world-sphere-result float))
  (rlet ((acc :class vf)
         (Q :class vf)
         (vf0 :class vf)
         (center :class vf)
         (row-x :class vf)
         (row-y :class vf)
         (row-z :class vf)
         (row-trans :class vf))
    (init-vf0-vector)
    (let ((nodes (-> owner node-list))
          (shape (-> this cshape))
          (transform-index (-> this transform-index)))
      (cond
        ((nonzero? nodes)
         (cond
           ((>= transform-index 0)
            (let ((bone-transform (-> nodes data transform-index bone transform)))
              (.lvf row-trans (&-> bone-transform vector 3 quad))
              (.lvf center (&-> this local-sphere quad))
              (.lvf row-x (&-> bone-transform vector 0 quad))
              (.mul.w.vf acc row-trans vf0)
              (.div.vf Q vf0 row-trans :fsf #b11 :ftf #b11)
              (.lvf row-y (&-> bone-transform vector 1 quad))
              (.add.mul.x.vf acc row-x center acc)
              (.lvf row-z (&-> bone-transform vector 2 quad)))
            (.add.mul.y.vf acc row-y center acc)
            ;; Only xyz are written here and by the Q multiply below, so the radius that came in from
            ;; local-sphere's w lane survives into the stored world sphere. The divide by the bone
            ;; transform's own w is the homogeneous divide; a bone with w other than one scales the
            ;; joint's position but not this radius.
            (.add.mul.z.vf.xyz center row-z center acc)
            (.mul.vf.xyz center center Q)
            (.svf (&-> this prim-core world-sphere quad) center)
            (.mov world-sphere-result center))
           (else
            (when (= transform-index -2)
              ;; row-x is borrowed as the shape translation here; there is no matrix on this path.
              (.lvf center (&-> this local-sphere quad))
              (.lvf row-x (&-> shape trans quad))
              (.add.vf.xyz center center row-x)
              (.svf (&-> this prim-core world-sphere quad) center)
              (.mov world-sphere-result center)))))
        (else
         (when (!= transform-index -1)
           (.lvf center (&-> this local-sphere quad))
           (.lvf row-x (&-> shape trans quad))
           (.add.vf.xyz center center row-x)
           (.svf (&-> this prim-core world-sphere quad) center)
           (.mov world-sphere-result center)))))
    (when (= (-> this type) collide-shape-prim-group)
      (countdown (i (-> (the-as collide-shape-prim-group this) num-prims))
        (update-transforms! (-> (the-as collide-shape-prim-group this) prims i) owner))
      #f)))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; move by vector, move to point
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(defmethod move-by-vector! ((this collide-shape) (offset vector))
  "Adjust our position by the given vector"
  (vector+! (-> this trans) (-> this trans) offset)
  (move-by-vector! (-> this root-prim) offset)
  (none))

(defmethod move-by-vector! ((this collide-shape-prim) (offset vector))
  "Adjust our position by the given vector"
  (vector+! (the-as vector (-> this prim-core)) (the-as vector (-> this prim-core)) offset)
  (set! (-> this prim-core world-sphere w) (-> this local-sphere w))
  (none))

(defmethod move-by-vector! ((this collide-shape-prim-group) (offset vector))
  "Adjust our position by the given vector"
  (vector+! (the-as vector (-> this prim-core)) (the-as vector (-> this prim-core)) offset)
  (set! (-> this prim-core world-sphere w) (-> this local-sphere w))
  (countdown (i (-> this num-prims))
    (let ((child-prim (-> this prims i)))
      (cond
        ((= (-> child-prim type) collide-shape-prim-group) (move-by-vector! child-prim offset))
        (else
         (vector+! (the-as vector (-> child-prim prim-core)) (the-as vector (-> child-prim prim-core)) offset)
         (set! (-> child-prim prim-core world-sphere w) (-> child-prim local-sphere w))))))
  (none))

(defmethod move-to-point! ((this collide-shape) (destination vector))
  "Move us to exactly the given position."
  (let ((offset (new 'stack-no-clear 'vector))) (vector-! offset destination (-> this trans)) (move-by-vector! this offset))
  (none))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; construction functions
;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(defmethod set-root-prim! ((this collide-shape) (prim collide-shape-prim))
  "Install prim as the root and return it."
  (set! (-> this root-prim) prim)
  prim)

(defmethod set-collide-with! ((this collide-shape-prim) (kind collide-kind))
  "Set collide-with on this primitive and every child primitive."
  (set! (-> this collide-with) kind)
  0
  (none))

(defmethod set-collide-with! ((this collide-shape-prim-group) (kind collide-kind))
  "Set collide-with on this primitive and every child primitive."
  (set! (-> this collide-with) kind)
  (dotimes (i (-> this num-prims))
    (set-collide-with! (-> this prims i) kind))
  0
  (none))

(defmethod set-collide-as! ((this collide-shape-prim) (kind collide-kind))
  "Set collide-as on this primitive and every child primitive."
  (set! (-> this prim-core collide-as) kind)
  0
  (none))

(defmethod set-collide-as! ((this collide-shape-prim-group) (kind collide-kind))
  "Set collide-as on this primitive and every child primitive."
  (set! (-> this prim-core collide-as) kind)
  (dotimes (i (-> this num-prims))
    (set-collide-as! (-> this prims i) kind))
  0
  (none))

(defmethod set-root-prim-collide-with! ((this collide-shape) (kind collide-kind))
  "Set collide-with throughout the root primitive hierarchy."
  (set-collide-with! (-> this root-prim) kind)
  0
  (none))

(defmethod set-root-prim-collide-as! ((this collide-shape) (kind collide-kind))
  "Set collide-as throughout the root primitive hierarchy."
  (set-collide-as! (-> this root-prim) kind)
  0
  (none))

(defmethod append-prim ((this collide-shape-prim-group) (prim collide-shape-prim))
  "Append prim when capacity remains; print an error and leave the group unchanged
   when it is full."
  (let ((prim-count (-> this num-prims)))
    (cond
      ((>= prim-count (-> this allocated-prims))
       (format 0 "collide-shape-prim-group::append-prim : Exceeded max # of prims!~%"))
      (else (set! (-> this prims prim-count) prim) (set! (-> this num-prims) (+ prim-count 1)))))
  (none))

(defmethod find-collision-meshes ((this collide-shape))
  "Resolve every mesh primitive from the process drawable's collision mesh
   group, report unresolved entries, update transforms, and return that update result."
  (let ((failure-count 0))
    (let ((draw (-> this process draw)))
      (when (and (nonzero? draw) (-> draw jgeo))
        (let ((mesh-group (res-lump-struct (-> draw jgeo extra) 'collide-mesh-group structure)))
          (if mesh-group (set! failure-count (num-mesh (-> this root-prim) (the-as collide-shape-prim mesh-group)))))))
    (if (nonzero? failure-count)
      (format 0 "ERROR: Failed to find collision meshes for ~D prim(s) in ~A!~%" failure-count (-> this process name))))
  (update-transforms! this))

(defmethod num-mesh ((this collide-shape-prim) (mesh-group collide-shape-prim))
  "Resolve mesh primitives from mesh-group and return the number which could not be
   resolved."
  (local-vars (unreachable-result int))
  (return 0)
  unreachable-result)

(defmethod num-mesh ((this collide-shape-prim-mesh) (mesh-group collide-shape-prim))
  "Resolve mesh primitives from mesh-group and return the number which could not be
   resolved."
  ;; mesh-group is really the collide-mesh-group resource, an (array collide-mesh), not a primitive.
  ;; The declared parameter type only matters because this method has to share a slot with the group
  ;; and base versions, and the array's length and data land at the same offsets that a
  ;; collide-shape-prim would read.
  (let ((mesh-index (-> this mesh-id)))
    (cond
      ((and (>= mesh-index 0) (< mesh-index (length mesh-group)))
       (set! (-> this mesh) (-> (the-as (array collide-mesh) mesh-group) mesh-index))
       (return 0))
      (else (set! (-> this mesh) #f) (return 1))))
  (the-as int 0))

(defmethod num-mesh ((this collide-shape-prim-group) (mesh-group collide-shape-prim))
  "Resolve mesh primitives from mesh-group and return the number which could not be
   resolved."
  (let ((failure-count 0))
    (countdown (i (-> this num-prims))
      (+! failure-count (num-mesh (-> this prims i) mesh-group)))
    failure-count))

(defmethod change-mesh ((this collide-shape-prim-mesh) (new-mesh-id int))
  "Change our mesh to the given mesh ID."
  (when (!= (-> this mesh-id) new-mesh-id) ;; only if we don't have the right one.
    (let ((draw (-> this cshape process draw)))
      (when (and (nonzero? draw) (-> draw jgeo)) ;; and we have jgeo
        ;; look up the collide mesh array!
        (let ((mesh-array (res-lump-struct (-> draw jgeo extra) 'collide-mesh-group (array collide-mesh))))
          (when mesh-array ;; we got it
            (cond
              ((and (>= new-mesh-id 0) (< new-mesh-id (length mesh-array))) ;; in range
               (set! (-> this mesh) (-> mesh-array new-mesh-id)) ;; grab it!
               (set! (-> this mesh-id) new-mesh-id)
               ;; kill the collide mesh cache.
               (let* ((mesh-cache *collide-mesh-cache*)
                      (cache-id (-> mesh-cache id)))
                 (set! (-> mesh-cache used-size) (the-as uint 0))
                 (let ((next-id (the-as int (+ cache-id 1))))
                   (b! (zero? (the-as uint next-id)) id-ok :likely-delay (set! next-id 1))
                   (label id-ok)
                   (set! (-> mesh-cache id) (the-as uint next-id)))))
              (else (format 0 "ERROR: ~%~%collide-shape-prim-mesh::change-mesh():  Failed to find collision mesh!~%"))))))))
  (none))

(defmethod init! ((this collide-shape-intersect) (direction vector))
  "Initialize the intersection in the given direction."
  (vector-copy! (-> this move-vec) direction)
  (set! (-> this best-u) COLLISION_MISS)
  (set! (-> this best-from-prim) #f)
  (set! (-> this best-to-prim) #f)
  #f)

(defmethod debug-draw-world-sphere ((this collide-shape-prim))
  "Draw our sphere"
  (add-debug-sphere #t
                    (bucket-id debug)
                    (the-as vector (-> this prim-core))
                    (-> this local-sphere w)
                    (new 'static 'rgba :r #xff :g #xff :b #xff :a #x40)))

(defmethod debug-draw-world-sphere ((this collide-shape-prim-sphere))
  "Draw our sphere"
  (add-debug-sphere #t
                    (bucket-id debug)
                    (the-as vector (-> this prim-core))
                    (-> this local-sphere w)
                    (cond
                      ((and (zero? (-> this prim-core collide-as)) (zero? (-> this collide-with)))
                       (new 'static 'rgba :r #x80 :g #x80 :b #x80 :a #x40))
                      ((logtest? (-> this prim-core action) (collide-action solid)) (new 'static 'rgba :r #xff :g #xff :a #x40))
                      (else (new 'static 'rgba :r #xff :g #x80 :a #x40)))))

(defmethod debug-draw-world-sphere ((this collide-shape-prim-mesh))
  "Draw our sphere"
  (add-debug-sphere #t
                    (bucket-id debug)
                    (the-as vector (-> this prim-core))
                    (-> this local-sphere w)
                    (new 'static 'rgba :b #xff :a #x40)))

(defmethod debug-draw-world-sphere ((this collide-shape-prim-group))
  "Draw our sphere"
  (add-debug-sphere #t
                    (bucket-id debug)
                    (the-as vector (-> this prim-core))
                    (-> this local-sphere w)
                    (new 'static 'rgba :g #xff :a #x10))
  (countdown (i (-> this num-prims))
    (debug-draw-world-sphere (-> this prims i)))
  #f)

(defmethod do-push-aways! ((this collide-shape))
  "This is the main function to call to respond"
  ;; One loop, written out four times, once for each foreground collide list this shape can reach: the
  ;; player list first, then cak-1, usually-hit-by-player and hit-by-others. Only the list global and the label names differ.
  ;; A single pass rejects on collide-as, skips this shape's own process, runs the exact overlap test,
  ;; and when the penetration is deeper than PUSH-AWAY-MIN-OVERLAP fills the collide cache around the
  ;; other shape and shoves it out with up to PUSH-AWAY-PASSES separating moves.
  ;;
  ;; The shove goes through integrate-and-collide! rather than move-by-vector! so that the shape being
  ;; pushed cannot be driven through a wall. That means it has to be handed over as a velocity, so the
  ;; separation distance is scaled by frames-per-second here and the integrator's own multiply by
  ;; seconds-per-frame turns it back into a distance. status is saved and restored across the call
  ;; because this is not the pushed shape's own frame of motion and must not leave contact flags on it.
  ;;
  ;; with-mask is re-read from the root prim after every push, since a reaction is free to change
  ;; collide-with underneath the loop.
  (local-vars (frames-per-second-bits int) (normal-side-bits int))
  (rlet ((vf0 :class vf)
         (dot-products :class vf)
         (push-direction :class vf)
         (contact-point :class vf)
         (push-anchor :class vf)
         (contact-normal :class vf))
    (init-vf0-vector)
    ;; kill the mesh cache
    (let* ((mesh-cache *collide-mesh-cache*)
           (current-cache-id (-> mesh-cache id)))
      (set! (-> mesh-cache used-size) (the-as uint 0))
      (let ((next-cache-id (the-as int (+ current-cache-id 1))))
        (b! (zero? (the-as uint next-cache-id)) id-ok :likely-delay (set! next-cache-id 1))
        (label id-ok)
        (set! (-> mesh-cache id) (the-as uint next-cache-id))))
    ;; loop over everything!
    (let ((with-mask (-> this root-prim collide-with)))
      ;; we collide with target, so check the player list.
      (when (logtest? with-mask (collide-kind target))
        (iterate-engine-connections (node *collide-player-list*)
                                    (let ((victim (the-as collide-shape-moving (-> (the-as connection node) param1))))
                                      (when (logtest? with-mask (-> victim root-prim prim-core collide-as))
                                        ;; we might collide with this!
                                        (when (!= (-> this process) (-> victim process)) ;; self check
                                          ;; see if we collide!
                                          (let ((overlap-result (new 'stack-no-clear 'collide-overlap-result)))
                                            (when (and (should-push-away this victim overlap-result) (>= PUSH-AWAY-MIN-OVERLAP (-> overlap-result best-dist))) ;; we collide!
                                              ;; fill the collide cache.
                                              (fill-cache-for-shape! victim PUSH-AWAY-CACHE-PADDING (-> victim root-prim collide-with))
                                              ;; 3 iterations to solve it.
                                              (let ((iterations-left PUSH-AWAY-PASSES))
                                                (until (or (<= iterations-left 0) (not (should-push-away this victim overlap-result))) ;; run until we're out.
                                                  (let ((push-vector (new 'stack-no-clear 'vector)))
                                                    (let ((clamped-center (new 'stack-no-clear 'vector)))
                                                      (vector-copy! clamped-center (-> victim trans))
                                                      ;; this is... a bit of a hack.
                                                      ;; this adjusts our collision to be within 0.7 - 1.4m of our base.
                                                      ;; (note, this only applies for intermediate iterations of this loop)
                                                      (let* ((minimum-push-y (+ PUSH-AWAY-CONTACT-LOW (-> clamped-center y))) ;; minimum-push-y = 0.7 m above use
                                                             (maximum-push-y (+ PUSH-AWAY-CONTACT-BAND minimum-push-y)) ;; 1.4m above us
                                                             (contact-y (-> overlap-result best-from-tri intersect y)))
                                                        (cond
                                                          ((< contact-y minimum-push-y) (set! contact-y minimum-push-y))
                                                          ((< maximum-push-y contact-y) (set! contact-y maximum-push-y)))
                                                        (set! (-> clamped-center y) contact-y))
                                                      (.lvf push-anchor (&-> clamped-center quad)))
                                                    (.lvf contact-point (&-> overlap-result best-from-tri intersect quad))
                                                    (.lvf contact-normal (&-> overlap-result best-from-tri normal quad))
                                                    (.sub.vf push-direction push-anchor contact-point)
                                                    (.mul.vf dot-products contact-normal push-direction)
                                                    (.add.x.vf.y dot-products dot-products dot-products)
                                                    (.add.z.vf.y dot-products dot-products dot-products)
                                                    ;; The dot product is in the y lane. normal-side-bits must stay an int so
                                                    ;; this move is 64 bits wide and the sign test below reads bit 63, which is
                                                    ;; y's sign. Declaring it float narrows the move to lane x and silently
                                                    ;; tests contact-normal.x * push-direction.x instead. The EE does the same
                                                    ;; thing with qmfc2.i followed by bltzl.
                                                    (.mov normal-side-bits dot-products)
                                                    (b! (< (the-as int normal-side-bits) 0) dir-ready-player :likely-delay (.sub.vf push-direction vf0 push-direction))
                                                    (label dir-ready-player)
                                                    (.svf (&-> push-vector quad) push-direction)
                                                    (vector-normalize! push-vector 1.0)
                                                    (vector-float*! push-vector push-vector (- (-> overlap-result best-dist)))
                                                    ;; Distance to velocity for the integrator. dot-products and
                                                    ;; push-direction are reused here as plain vector temporaries.
                                                    (let ((push-vector push-vector))
                                                      (.lvf dot-products (&-> push-vector quad))
                                                      (let ((frames-per-second (-> *display* frames-per-second))) (.mov frames-per-second-bits frames-per-second))
                                                      (.mov push-direction frames-per-second-bits)
                                                      (.mov.vf.w dot-products vf0)
                                                      (.mul.x.vf.xyz dot-products dot-products push-direction)
                                                      (.svf (&-> push-vector quad) dot-products))
                                                    (let ((saved-status (-> victim status)))
                                                      ;; step.
                                                      (integrate-and-collide! victim push-vector)
                                                      (set! (-> victim status) saved-status)))
                                                  (+! iterations-left -1)))
                                              (set! with-mask (-> this root-prim collide-with)))))))))
      (when (logtest? with-mask (collide-kind hit-by-player usually-hit-by-player hit-by-others))
        ;; The same loop again for cak-1, usually-hit-by-player and hit-by-others.
        (when (logtest? with-mask (collide-kind hit-by-player))
          (iterate-engine-connections (node *collide-hit-by-player-list*)
                                      (let ((victim (the-as collide-shape-moving (-> (the-as connection node) param1))))
                                        (when (logtest? with-mask (-> victim root-prim prim-core collide-as))
                                          (when (!= (-> this process) (-> victim process))
                                            (let ((overlap-result (new 'stack-no-clear 'collide-overlap-result)))
                                              (when (and (should-push-away this victim overlap-result) (>= PUSH-AWAY-MIN-OVERLAP (-> overlap-result best-dist)))
                                                (fill-cache-for-shape! victim PUSH-AWAY-CACHE-PADDING (-> victim root-prim collide-with))
                                                (let ((iterations-left PUSH-AWAY-PASSES))
                                                  (until (or (<= iterations-left 0) (not (should-push-away this victim overlap-result)))
                                                    (let ((push-vector (new 'stack-no-clear 'vector)))
                                                      (let ((clamped-center (new 'stack-no-clear 'vector)))
                                                        (vector-copy! clamped-center (-> victim trans))
                                                        (let* ((minimum-push-y (+ PUSH-AWAY-CONTACT-LOW (-> clamped-center y)))
                                                               (maximum-push-y (+ PUSH-AWAY-CONTACT-BAND minimum-push-y))
                                                               (contact-y (-> overlap-result best-from-tri intersect y)))
                                                          (cond
                                                            ((< contact-y minimum-push-y) (set! contact-y minimum-push-y))
                                                            ((< maximum-push-y contact-y) (set! contact-y maximum-push-y)))
                                                          (set! (-> clamped-center y) contact-y))
                                                        (.lvf push-anchor (&-> clamped-center quad)))
                                                      (.lvf contact-point (&-> overlap-result best-from-tri intersect quad))
                                                      (.lvf contact-normal (&-> overlap-result best-from-tri normal quad))
                                                      (.sub.vf push-direction push-anchor contact-point)
                                                      (.mul.vf dot-products contact-normal push-direction)
                                                      (.add.x.vf.y dot-products dot-products dot-products)
                                                      (.add.z.vf.y dot-products dot-products dot-products)
                                                      (.mov normal-side-bits dot-products)
                                                      (b! (< (the-as int normal-side-bits) 0) dir-ready-hit-by-player :likely-delay (.sub.vf push-direction vf0 push-direction))
                                                      (label dir-ready-hit-by-player)
                                                      (.svf (&-> push-vector quad) push-direction)
                                                      (vector-normalize! push-vector 1.0)
                                                      (vector-float*! push-vector push-vector (- (-> overlap-result best-dist)))
                                                      (let ((push-vector push-vector))
                                                        (.lvf dot-products (&-> push-vector quad))
                                                        (let ((frames-per-second (-> *display* frames-per-second))) (.mov frames-per-second-bits frames-per-second))
                                                        (.mov push-direction frames-per-second-bits)
                                                        (.mov.vf.w dot-products vf0)
                                                        (.mul.x.vf.xyz dot-products dot-products push-direction)
                                                        (.svf (&-> push-vector quad) dot-products))
                                                      (let ((saved-status (-> victim status)))
                                                        (integrate-and-collide! victim push-vector)
                                                        (set! (-> victim status) saved-status)))
                                                    (+! iterations-left -1)))
                                                (set! with-mask (-> this root-prim collide-with)))))))))
        (when (logtest? with-mask (collide-kind usually-hit-by-player))
          (iterate-engine-connections (node *collide-usually-hit-by-player-list*)
                                      (let ((victim (the-as collide-shape-moving (-> (the-as connection node) param1))))
                                        (when (logtest? with-mask (-> victim root-prim prim-core collide-as))
                                          (when (!= (-> this process) (-> victim process))
                                            (let ((overlap-result (new 'stack-no-clear 'collide-overlap-result)))
                                              (when (and (should-push-away this victim overlap-result) (>= PUSH-AWAY-MIN-OVERLAP (-> overlap-result best-dist)))
                                                (fill-cache-for-shape! victim PUSH-AWAY-CACHE-PADDING (-> victim root-prim collide-with))
                                                (let ((iterations-left PUSH-AWAY-PASSES))
                                                  (until (or (<= iterations-left 0) (not (should-push-away this victim overlap-result)))
                                                    (let ((push-vector (new 'stack-no-clear 'vector)))
                                                      (let ((clamped-center (new 'stack-no-clear 'vector)))
                                                        (vector-copy! clamped-center (-> victim trans))
                                                        (let* ((minimum-push-y (+ PUSH-AWAY-CONTACT-LOW (-> clamped-center y)))
                                                               (maximum-push-y (+ PUSH-AWAY-CONTACT-BAND minimum-push-y))
                                                               (contact-y (-> overlap-result best-from-tri intersect y)))
                                                          (cond
                                                            ((< contact-y minimum-push-y) (set! contact-y minimum-push-y))
                                                            ((< maximum-push-y contact-y) (set! contact-y maximum-push-y)))
                                                          (set! (-> clamped-center y) contact-y))
                                                        (.lvf push-anchor (&-> clamped-center quad)))
                                                      (.lvf contact-point (&-> overlap-result best-from-tri intersect quad))
                                                      (.lvf contact-normal (&-> overlap-result best-from-tri normal quad))
                                                      (.sub.vf push-direction push-anchor contact-point)
                                                      (.mul.vf dot-products contact-normal push-direction)
                                                      (.add.x.vf.y dot-products dot-products dot-products)
                                                      (.add.z.vf.y dot-products dot-products dot-products)
                                                      (.mov normal-side-bits dot-products)
                                                      (b! (< (the-as int normal-side-bits) 0) dir-ready-usually-hit-by-player :likely-delay (.sub.vf push-direction vf0 push-direction))
                                                      (label dir-ready-usually-hit-by-player)
                                                      (.svf (&-> push-vector quad) push-direction)
                                                      (vector-normalize! push-vector 1.0)
                                                      (vector-float*! push-vector push-vector (- (-> overlap-result best-dist)))
                                                      (let ((push-vector push-vector))
                                                        (.lvf dot-products (&-> push-vector quad))
                                                        (let ((frames-per-second (-> *display* frames-per-second))) (.mov frames-per-second-bits frames-per-second))
                                                        (.mov push-direction frames-per-second-bits)
                                                        (.mov.vf.w dot-products vf0)
                                                        (.mul.x.vf.xyz dot-products dot-products push-direction)
                                                        (.svf (&-> push-vector quad) dot-products))
                                                      (let ((saved-status (-> victim status)))
                                                        (integrate-and-collide! victim push-vector)
                                                        (set! (-> victim status) saved-status)))
                                                    (+! iterations-left -1)))
                                                (set! with-mask (-> this root-prim collide-with)))))))))
        (when (logtest? with-mask (collide-kind hit-by-others))
          (iterate-engine-connections (node *collide-hit-by-others-list*)
                                      (let ((victim (the-as collide-shape-moving (-> (the-as connection node) param1))))
                                        (when (logtest? with-mask (-> victim root-prim prim-core collide-as))
                                          (when (!= (-> this process) (-> victim process))
                                            (let ((overlap-result (new 'stack-no-clear 'collide-overlap-result)))
                                              (when (and (should-push-away this victim overlap-result) (>= PUSH-AWAY-MIN-OVERLAP (-> overlap-result best-dist)))
                                                (fill-cache-for-shape! victim PUSH-AWAY-CACHE-PADDING (-> victim root-prim collide-with))
                                                (let ((iterations-left PUSH-AWAY-PASSES))
                                                  (until (or (<= iterations-left 0) (not (should-push-away this victim overlap-result)))
                                                    (let ((push-vector (new 'stack-no-clear 'vector)))
                                                      (let ((clamped-center (new 'stack-no-clear 'vector)))
                                                        (vector-copy! clamped-center (-> victim trans))
                                                        (let* ((minimum-push-y (+ PUSH-AWAY-CONTACT-LOW (-> clamped-center y)))
                                                               (maximum-push-y (+ PUSH-AWAY-CONTACT-BAND minimum-push-y))
                                                               (contact-y (-> overlap-result best-from-tri intersect y)))
                                                          (cond
                                                            ((< contact-y minimum-push-y) (set! contact-y minimum-push-y))
                                                            ((< maximum-push-y contact-y) (set! contact-y maximum-push-y)))
                                                          (set! (-> clamped-center y) contact-y))
                                                        (.lvf push-anchor (&-> clamped-center quad)))
                                                      (.lvf contact-point (&-> overlap-result best-from-tri intersect quad))
                                                      (.lvf contact-normal (&-> overlap-result best-from-tri normal quad))
                                                      (.sub.vf push-direction push-anchor contact-point)
                                                      (.mul.vf dot-products contact-normal push-direction)
                                                      (.add.x.vf.y dot-products dot-products dot-products)
                                                      (.add.z.vf.y dot-products dot-products dot-products)
                                                      (.mov normal-side-bits dot-products)
                                                      (b! (< (the-as int normal-side-bits) 0) dir-ready-hit-by-others :likely-delay (.sub.vf push-direction vf0 push-direction))
                                                      (label dir-ready-hit-by-others)
                                                      (.svf (&-> push-vector quad) push-direction)
                                                      (vector-normalize! push-vector 1.0)
                                                      (vector-float*! push-vector push-vector (- (-> overlap-result best-dist)))
                                                      (let ((push-vector push-vector))
                                                        (.lvf dot-products (&-> push-vector quad))
                                                        (let ((frames-per-second (-> *display* frames-per-second))) (.mov frames-per-second-bits frames-per-second))
                                                        (.mov push-direction frames-per-second-bits)
                                                        (.mov.vf.w dot-products vf0)
                                                        (.mul.x.vf.xyz dot-products dot-products push-direction)
                                                        (.svf (&-> push-vector quad) dot-products))
                                                      (let ((saved-status (-> victim status)))
                                                        (integrate-and-collide! victim push-vector)
                                                        (set! (-> victim status) saved-status)))
                                                    (+! iterations-left -1)))
                                                (set! with-mask (-> this root-prim collide-with))))))))
          #f)))))

;;;;;;;;;;;;;;;;;;;;;;;
;; overlap test
;;;;;;;;;;;;;;;;;;;;;;;

(defmethod find-overlapping-shapes ((this collide-shape) (params overlaps-others-params))
  "Search compatible foreground collision lists for overlaps with this
   shape. The root-sphere option accepts a broad-phase overlap directly; otherwise leaf geometry is
   tested, and an optional touching list receives exact pairs. Return true when any overlap is found."
  ;; Structured like do-push-aways!: one loop repeated for each of the four foreground collide lists.
  ;; A pass rejects on collide-as, rejects on the two root bspheres, skips this shape's own process,
  ;; and then either accepts the root-sphere overlap outright when accept-root-sphere-overlap is set or
  ;; recurses into the leaves through overlaps-others-test.
  ;;
  ;; found-any? holds #f until an overlap turns up, at which point it is set to the integer zero; the
  ;; tail converts anything that is not #f into #t. When no touching list was supplied the first
  ;; overlap jumps straight to finish, since nothing more can be learned. With a touching list the
  ;; loops run to the end so that every touching pair is recorded.
  (local-vars
    (direct-hit? symbol)
    (root-overlap-option overlaps-others-options)
    (touching-list touching-list)
    (sphere-separation-squared float)
    (options overlaps-others-options)
    (hit? symbol))
  (rlet ((acc :class vf)
         (vf0 :class vf)
         (our-sphere :class vf)
         (other-sphere :class vf)
         (delta :class vf)
         (radius-sum :class vf))
    (init-vf0-vector)
    (let* ((mesh-cache *collide-mesh-cache*)
           (current-cache-id (-> mesh-cache id)))
      (set! (-> mesh-cache used-size) (the-as uint 0))
      (let ((next-cache-id (the-as int (+ current-cache-id 1))))
        (b! (zero? (the-as uint next-cache-id)) id-ok :likely-delay (set! next-cache-id 1))
        (label id-ok)
        (set! (-> mesh-cache id) (the-as uint next-cache-id))))
    (let ((found-any? (the-as object #f)))
      (let ((our-root (-> this root-prim)))
        (.lvf our-sphere (&-> our-root prim-core world-sphere quad))
        (let ((with-mask (-> our-root collide-with)))
          (b! (zero? (logand with-mask (collide-kind target))) after-player-list)
          (iterate-engine-connections (node *collide-player-list*)
                                      (let* ((other-shape (the-as collide-shape-moving (-> (the-as connection node) param1)))
                                             (other-root (-> other-shape root-prim)))
                                        (when (logtest? with-mask (-> other-root prim-core collide-as))
                                          (.lvf other-sphere (&-> other-root prim-core world-sphere quad))
                                          (.sub.vf delta our-sphere other-sphere)
                                          (.add.w.vf.w radius-sum our-sphere other-sphere)
                                          (.mul.vf.xyz delta delta delta)
                                          (.mul.w.vf.w radius-sum radius-sum radius-sum)
                                          (.mul.x.vf.w acc vf0 delta)
                                          (.add.mul.y.vf.w acc vf0 delta acc)
                                          (.add.mul.z.vf.w delta vf0 delta acc)
                                          (.sub.w.vf.w delta delta radius-sum)
                                          (let ((zero-distance 0.0))
                                            (.add.w.vf.x delta vf0 delta)
                                            (let ((our-process (-> this process)))
                                              (.mov sphere-separation-squared delta)
                                              (let ((other-process (-> other-shape process)))
                                                (b! (< zero-distance sphere-separation-squared) next-player :delay (set! options (-> params options)))
                                                (b! (= our-process other-process)
                                                    next-player
                                                    :delay
                                                    (set! root-overlap-option (logand options (overlaps-others-options accept-root-sphere-overlap)))))))
                                          (b! (zero? root-overlap-option) leaf-test-player :delay (set! touching-list (-> params tlist)))
                                          (b! (= touching-list #f) after-test-player :delay (set! direct-hit? #t))
                                          (set! hit? direct-hit?)
                                          (add-touching-prims touching-list
                                                              our-root
                                                              other-root
                                                              -1.0
                                                              (the-as collide-tri-result #f)
                                                              (the-as collide-tri-result #f))
                                          (b! #t after-test-player :delay #t)
                                          (label leaf-test-player)
                                          (set! hit? (overlaps-others-test our-root params other-root))
                                          (label after-test-player)
                                          (.lvf our-sphere (&-> our-root prim-core world-sphere quad))
                                          (b! (= hit? #f) next-player :delay (set! with-mask (-> our-root collide-with)))
                                          (b! (= (-> params tlist) #f) finish :delay (set! found-any? 0))
                                          (label next-player)
                                          0)))
          (label after-player-list)
          (when (logtest? with-mask (collide-kind hit-by-player usually-hit-by-player hit-by-others))
            ;; The same loop again for cak-1, usually-hit-by-player and hit-by-others.
            (when (logtest? with-mask (collide-kind hit-by-player))
              (iterate-engine-connections (node *collide-hit-by-player-list*)
                                          (let* ((other-shape (the-as collide-shape-moving (-> (the-as connection node) param1)))
                                                 (other-root (-> other-shape root-prim)))
                                            (when (logtest? with-mask (-> other-root prim-core collide-as))
                                              (.lvf other-sphere (&-> other-root prim-core world-sphere quad))
                                              (.sub.vf delta our-sphere other-sphere)
                                              (.add.w.vf.w radius-sum our-sphere other-sphere)
                                              (.mul.vf.xyz delta delta delta)
                                              (.mul.w.vf.w radius-sum radius-sum radius-sum)
                                              (.mul.x.vf.w acc vf0 delta)
                                              (.add.mul.y.vf.w acc vf0 delta acc)
                                              (.add.mul.z.vf.w delta vf0 delta acc)
                                              (.sub.w.vf.w delta delta radius-sum)
                                              (let ((zero-distance 0.0))
                                                (.add.w.vf.x delta vf0 delta)
                                                (let ((our-process (-> this process)))
                                                  (.mov sphere-separation-squared delta)
                                                  (let ((other-process (-> other-shape process)))
                                                    (b! (< zero-distance sphere-separation-squared) next-hit-by-player :delay (set! options (-> params options)))
                                                    (b! (= our-process other-process)
                                                        next-hit-by-player
                                                        :delay
                                                        (set! root-overlap-option (logand options (overlaps-others-options accept-root-sphere-overlap)))))))
                                              (b! (zero? root-overlap-option) leaf-test-hit-by-player :delay (set! touching-list (-> params tlist)))
                                              (b! (= touching-list #f) after-test-hit-by-player :delay (set! direct-hit? #t))
                                              (set! hit? direct-hit?)
                                              (add-touching-prims touching-list
                                                                  our-root
                                                                  other-root
                                                                  -1.0
                                                                  (the-as collide-tri-result #f)
                                                                  (the-as collide-tri-result #f))
                                              (b! #t after-test-hit-by-player :delay #t)
                                              (label leaf-test-hit-by-player)
                                              (set! hit? (overlaps-others-test our-root params other-root))
                                              (label after-test-hit-by-player)
                                              (.lvf our-sphere (&-> our-root prim-core world-sphere quad))
                                              (b! (= hit? #f) next-hit-by-player :delay (set! with-mask (-> our-root collide-with)))
                                              (b! (= (-> params tlist) #f) finish :delay (set! found-any? 0))
                                              (label next-hit-by-player)
                                              0))))
            (when (logtest? with-mask (collide-kind usually-hit-by-player))
              (iterate-engine-connections (node *collide-usually-hit-by-player-list*)
                                          (let* ((other-shape (the-as collide-shape-moving (-> (the-as connection node) param1)))
                                                 (other-root (-> other-shape root-prim)))
                                            (when (logtest? with-mask (-> other-root prim-core collide-as))
                                              (.lvf other-sphere (&-> other-root prim-core world-sphere quad))
                                              (.sub.vf delta our-sphere other-sphere)
                                              (.add.w.vf.w radius-sum our-sphere other-sphere)
                                              (.mul.vf.xyz delta delta delta)
                                              (.mul.w.vf.w radius-sum radius-sum radius-sum)
                                              (.mul.x.vf.w acc vf0 delta)
                                              (.add.mul.y.vf.w acc vf0 delta acc)
                                              (.add.mul.z.vf.w delta vf0 delta acc)
                                              (.sub.w.vf.w delta delta radius-sum)
                                              (let ((zero-distance 0.0))
                                                (.add.w.vf.x delta vf0 delta)
                                                (let ((our-process (-> this process)))
                                                  (.mov sphere-separation-squared delta)
                                                  (let ((other-process (-> other-shape process)))
                                                    (b! (< zero-distance sphere-separation-squared) next-usually-hit-by-player :delay (set! options (-> params options)))
                                                    (b! (= our-process other-process)
                                                        next-usually-hit-by-player
                                                        :delay
                                                        (set! root-overlap-option (logand options (overlaps-others-options accept-root-sphere-overlap)))))))
                                              (b! (zero? root-overlap-option) leaf-test-usually-hit-by-player :delay (set! touching-list (-> params tlist)))
                                              (b! (= touching-list #f) after-test-usually-hit-by-player :delay (set! direct-hit? #t))
                                              (set! hit? direct-hit?)
                                              (add-touching-prims touching-list
                                                                  our-root
                                                                  other-root
                                                                  -1.0
                                                                  (the-as collide-tri-result #f)
                                                                  (the-as collide-tri-result #f))
                                              (b! #t after-test-usually-hit-by-player :delay #t)
                                              (label leaf-test-usually-hit-by-player)
                                              (set! hit? (overlaps-others-test our-root params other-root))
                                              (label after-test-usually-hit-by-player)
                                              (.lvf our-sphere (&-> our-root prim-core world-sphere quad))
                                              (b! (= hit? #f) next-usually-hit-by-player :delay (set! with-mask (-> our-root collide-with)))
                                              (b! (= (-> params tlist) #f) finish :delay (set! found-any? 0))
                                              (label next-usually-hit-by-player)
                                              0))))
            (when (logtest? with-mask (collide-kind hit-by-others))
              (iterate-engine-connections (node *collide-hit-by-others-list*)
                                          (let* ((other-shape (the-as collide-shape-moving (-> (the-as connection node) param1)))
                                                 (other-root (-> other-shape root-prim)))
                                            (when (logtest? with-mask (-> other-root prim-core collide-as))
                                              (.lvf other-sphere (&-> other-root prim-core world-sphere quad))
                                              (.sub.vf delta our-sphere other-sphere)
                                              (.add.w.vf.w radius-sum our-sphere other-sphere)
                                              (.mul.vf.xyz delta delta delta)
                                              (.mul.w.vf.w radius-sum radius-sum radius-sum)
                                              (.mul.x.vf.w acc vf0 delta)
                                              (.add.mul.y.vf.w acc vf0 delta acc)
                                              (.add.mul.z.vf.w delta vf0 delta acc)
                                              (.sub.w.vf.w delta delta radius-sum)
                                              (let ((zero-distance 0.0))
                                                (.add.w.vf.x delta vf0 delta)
                                                (let ((our-process (-> this process)))
                                                  (.mov sphere-separation-squared delta)
                                                  (let ((other-process (-> other-shape process)))
                                                    (b! (< zero-distance sphere-separation-squared) next-hit-by-others :delay (set! options (-> params options)))
                                                    (b! (= our-process other-process)
                                                        next-hit-by-others
                                                        :delay
                                                        (set! root-overlap-option (logand options (overlaps-others-options accept-root-sphere-overlap)))))))
                                              (b! (zero? root-overlap-option) leaf-test-hit-by-others :delay (set! touching-list (-> params tlist)))
                                              (b! (= touching-list #f) after-test-hit-by-others :delay (set! direct-hit? #t))
                                              (set! hit? direct-hit?)
                                              (add-touching-prims touching-list
                                                                  our-root
                                                                  other-root
                                                                  -1.0
                                                                  (the-as collide-tri-result #f)
                                                                  (the-as collide-tri-result #f))
                                              (b! #t after-test-hit-by-others :delay #t)
                                              (label leaf-test-hit-by-others)
                                              (set! hit? (overlaps-others-test our-root params other-root))
                                              (label after-test-hit-by-others)
                                              (.lvf our-sphere (&-> our-root prim-core world-sphere quad))
                                              (b! (= hit? #f) next-hit-by-others :delay (set! with-mask (-> our-root collide-with)))
                                              (b! (= (-> params tlist) #f) finish :delay (set! found-any? 0))
                                              (label next-hit-by-others)
                                              0)))))))
      (label finish)
      (b! (= (the-as int found-any?) #f) done :delay (nop!))
      (set! found-any? #t)
      (label done)
      (the-as symbol found-any?))))

(defmethod overlaps-others-test ((this collide-shape-prim) (params overlaps-others-params) (other-prim collide-shape-prim))
  "Test this primitive against another primitive, optionally requiring
   solid leaf actions and recording exact touching pairs. Return whether any overlap is found."
  (format 0 "ERROR: Unsupported call to collide-shape-prim::overlaps-others-test!~%")
  #f)

(defmethod overlaps-others-test ((this collide-shape-prim-group) (params overlaps-others-params) (other-prim collide-shape-prim))
  "Test this primitive against another primitive, optionally requiring
   solid leaf actions and recording exact touching pairs. Return whether any overlap is found."
  (local-vars (spheres-apart float))
  (rlet ((acc :class vf)
         (vf0 :class vf)
         (other-sphere :class vf)
         (child-sphere :class vf)
         (delta :class vf)
         (radius-sum :class vf))
    (init-vf0-vector)
    (let ((prim-list (-> this prims))
          (prims-left (-> this num-prims-u))
          (any-hit? (the-as object #f)))
      (let ((other-as (-> other-prim prim-core collide-as)))
        (nop!)
        (.lvf other-sphere (&-> other-prim prim-core world-sphere quad))
        (label next-prim)
        (b! (zero? prims-left) done :delay (nop!))
        (+! prims-left -1)
        (let ((child-prim (-> prim-list 0)))
          (set! prim-list (&-> prim-list 1))
          (let ((with-as-overlap (logand (-> child-prim collide-with) other-as)))
            (.lvf child-sphere (&-> child-prim prim-core world-sphere quad))
            (b! (zero? with-as-overlap) next-prim :delay (.sub.vf delta child-sphere other-sphere)))
          (.add.w.vf.w radius-sum child-sphere other-sphere)
          (.mul.vf.xyz delta delta delta)
          (.mul.w.vf.w radius-sum radius-sum radius-sum)
          (.mul.x.vf.w acc vf0 delta)
          (.add.mul.y.vf.w acc vf0 delta acc)
          (.add.mul.z.vf.w delta vf0 delta acc)
          (.sub.w.vf.w delta delta radius-sum)
          (let ((zero-distance 0.0))
            (.add.w.vf.x delta vf0 delta)
            (.mov spheres-apart delta)
            (b! (< zero-distance spheres-apart) next-prim))
          (let ((child-hit? (overlaps-others-test child-prim params other-prim)))
            (set! other-as (-> other-prim prim-core collide-as))
            (b! (= child-hit? #f) next-prim :delay (.lvf other-sphere (&-> other-prim prim-core world-sphere quad))))))
      ;; A hit with a touching list continues the loop so the remaining children are recorded too;
      ;; without one, the first hit is enough and this falls through. The delay slot marks any-hit? by
      ;; setting it to the integer zero, which the tail turns into #t.
      (b! (!= (-> params tlist) #f) next-prim :delay (set! any-hit? 0))
      (label done)
      (b! (= (the-as int any-hit?) #f) have-hit :delay (nop!))
      (set! any-hit? #t)
      (label have-hit)
      (the-as symbol any-hit?))))

(defmethod overlaps-others-group ((this collide-shape-prim) (params overlaps-others-params) (other-group collide-shape-prim-group))
  "Overlap, from group."
  (local-vars (spheres-apart float))
  (rlet ((acc :class vf)
         (vf0 :class vf)
         (child-sphere :class vf)
         (our-sphere :class vf)
         (delta :class vf)
         (radius-sum :class vf))
    (init-vf0-vector)
    (let ((prim-list (-> other-group prims))
          (prims-left (-> other-group num-prims-u))
          (any-hit? (the-as object #f)))
      (let ((our-with (-> this collide-with)))
        (nop!)
        (.lvf our-sphere (&-> this prim-core world-sphere quad))
        (label next-prim)
        (b! (zero? prims-left) done :delay (nop!))
        (+! prims-left -1)
        (let ((child-prim (-> prim-list 0)))
          (set! prim-list (&-> prim-list 1))
          (let ((with-as-overlap (logand our-with (-> child-prim prim-core collide-as))))
            (.lvf child-sphere (&-> child-prim prim-core world-sphere quad))
            (b! (zero? with-as-overlap) next-prim :delay (.sub.vf delta our-sphere child-sphere)))
          (.add.w.vf.w radius-sum our-sphere child-sphere)
          (.mul.vf.xyz delta delta delta)
          (.mul.w.vf.w radius-sum radius-sum radius-sum)
          (.mul.x.vf.w acc vf0 delta)
          (.add.mul.y.vf.w acc vf0 delta acc)
          (.add.mul.z.vf.w delta vf0 delta acc)
          (.sub.w.vf.w delta delta radius-sum)
          (let ((zero-distance 0.0))
            (.add.w.vf.x delta vf0 delta)
            (.mov spheres-apart delta)
            (b! (< zero-distance spheres-apart) next-prim))
          (let ((child-hit? (overlaps-others-test this params child-prim)))
            (set! our-with (-> this collide-with))
            (b! (= child-hit? #f) next-prim :delay (.lvf our-sphere (&-> this prim-core world-sphere quad))))))
      (b! (!= (-> params tlist) #f) next-prim :delay (set! any-hit? 0))
      (label done)
      (b! (= (the-as int any-hit?) #f) have-hit :delay (nop!))
      (set! any-hit? #t)
      (label have-hit)
      (the-as symbol any-hit?))))

(defmethod overlaps-others-test ((this collide-shape-prim-sphere) (params overlaps-others-params) (other-prim collide-shape-prim))
  "Test this primitive against another primitive, optionally requiring
   solid leaf actions and recording exact touching pairs. Return whether any overlap is found."
  (local-vars (our-action collide-action))
  (let ((other-prim-type (-> other-prim prim-core prim-type)))
    (b! (nonzero? other-prim-type) not-a-group :delay (nop!))
    (let ((result (overlaps-others-group this params (the-as collide-shape-prim-group other-prim))))
      (b! #t done :delay (nop!))
      (label not-a-group)
      (b! (> other-prim-type 0) other-is-mesh :delay (nop!))
      (b! #t overlap-found :delay (nop!))
      (label other-is-mesh)
      (let ((mesh (-> (the-as collide-shape-prim-mesh other-prim) mesh)))
        (b! (not mesh) no-overlap)
        (let ((mesh-cache *collide-mesh-cache*))
          (let ((cache-id (-> mesh-cache id)))
            (b! (= (-> (the-as collide-shape-prim-mesh other-prim) mesh-cache-id) cache-id) cache-ready))
          (let ((cache-tris (allocate! mesh-cache (* (size-of collide-mesh-cache-tri) (-> mesh num-tris)))))
            (b! (not cache-tris) cache-full :delay (nop!))
            (set! (-> (the-as collide-shape-prim-mesh other-prim) mesh-cache-tris)
                  (the-as (inline-array collide-mesh-cache-tri) cache-tris)))
          (set! (-> (the-as collide-shape-prim-mesh other-prim) mesh-cache-id) (-> mesh-cache id)))
        (populate-cache! mesh
                         (the-as collide-mesh-cache-tri (-> (the-as collide-shape-prim-mesh other-prim) mesh-cache-tris))
                         (-> (the-as collide-shape-prim-mesh other-prim)
                             cshape
                             process
                             node-list
                             data
                             (-> (the-as collide-shape-prim-mesh other-prim) transform-index)
                             bone
                             transform))
        (b! #t cache-ready :delay (nop!))
        (label cache-full)
        (set! result #f)
        (b! #t done :delay (nop!))
        (the-as none 0)
        (label cache-ready)
        (b! (not (overlap-test mesh
                               (the-as collide-mesh-cache-tri (-> (the-as collide-shape-prim-mesh other-prim) mesh-cache-tris))
                               (the-as vector (-> this prim-core))))
            no-overlap))
      (b! #t overlap-found :delay (nop!))
      (the-as none 0)
      (label no-overlap)
      (set! result #f)
      (b! #t done :delay (nop!))
      (label overlap-found)
      (let ((touching-list (-> params tlist)))
        (b! (= touching-list #f) solid-check :delay (nop!))
        (add-touching-prims touching-list this other-prim -1.0 (the-as collide-tri-result #f) (the-as collide-tri-result #f)))
      (label solid-check)
      (b! (not (logtest? (-> params options) (overlaps-others-options solid-only)))
          accept
          :delay
          (set! our-action (-> this prim-core action)))
      (let ((other-action (-> other-prim prim-core action)))
        (b! (logtest? (logand our-action (collide-action solid)) other-action) accept :delay (nop!)))
      (set! result #f)
      (b! #t done :delay (nop!))
      (label accept)
      (set! result #t)
      (label done)
      result)))

(defmethod overlaps-others-test ((this collide-shape-prim-mesh) (params overlaps-others-params) (other-prim collide-shape-prim))
  "Test this primitive against another primitive, optionally requiring
   solid leaf actions and recording exact touching pairs. Return whether any overlap is found."
  (local-vars (our-action collide-action))
  (let ((other-prim-type (-> other-prim prim-core prim-type)))
    (b! (nonzero? other-prim-type) not-a-group :delay (nop!))
    (let ((result (overlaps-others-group this params (the-as collide-shape-prim-group other-prim))))
      (b! #t done :delay (nop!))
      (label not-a-group)
      (b! (> other-prim-type 0) mesh-vs-mesh :delay (nop!))
      (let ((mesh (-> this mesh)))
        (b! (not mesh) no-overlap)
        (let ((mesh-cache *collide-mesh-cache*))
          (let ((cache-id (-> mesh-cache id))) (b! (= (-> this mesh-cache-id) cache-id) cache-ready))
          (let ((cache-tris (allocate! mesh-cache (* (size-of collide-mesh-cache-tri) (-> mesh num-tris)))))
            (b! (not cache-tris) cache-full :delay (nop!))
            (set! (-> this mesh-cache-tris) (the-as (inline-array collide-mesh-cache-tri) cache-tris)))
          (set! (-> this mesh-cache-id) (-> mesh-cache id)))
        (populate-cache! mesh
                         (the-as collide-mesh-cache-tri (-> this mesh-cache-tris))
                         (-> this cshape process node-list data (-> this transform-index) bone transform))
        (b! #t cache-ready :delay (nop!))
        (label cache-full)
        (set! result #f)
        (b! #t done :delay (nop!))
        (the-as none 0)
        (label cache-ready)
        (b! (not (overlap-test mesh (the-as collide-mesh-cache-tri (-> this mesh-cache-tris)) (the-as vector (-> other-prim prim-core))))
            no-overlap))
      (b! #t overlap-found :delay (nop!))
      (the-as none 0)
      (label no-overlap)
      (set! result #f)
      (b! #t done :delay (nop!))
      (label mesh-vs-mesh)
      (format 0 "ERROR: Unsupported mesh -> mesh test attempted in collide-shape-prim-mesh::overlaps-others-test!~%")
      (set! result #f)
      (b! #t done :delay (nop!))
      (label overlap-found)
      (let ((touching-list (-> params tlist)))
        (b! (= touching-list #f) solid-check :delay (nop!))
        (add-touching-prims touching-list this other-prim -1.0 (the-as collide-tri-result #f) (the-as collide-tri-result #f)))
      (label solid-check)
      (b! (not (logtest? (-> params options) (overlaps-others-options solid-only)))
          accept
          :delay
          (set! our-action (-> this prim-core action)))
      (let ((other-action (-> other-prim prim-core action)))
        (b! (logtest? (logand our-action (collide-action solid)) other-action) accept :delay (nop!)))
      (set! result #f)
      (b! #t done :delay (nop!))
      (label accept)
      (set! result #t)
      (label done)
      result)))

(defmethod clear-collide-with-as ((this collide-shape))
  "Disable the root primitive's collide-with and collide-as masks."
  (set! (-> this root-prim collide-with) (collide-kind))
  (set! (-> this root-prim prim-core collide-as) (collide-kind))
  0
  (none))

(defmethod backup-collide-with-as ((this collide-shape))
  "Save the root primitive's collide-with and collide-as masks."
  (set! (-> this backup-collide-with) (-> this root-prim collide-with))
  (set! (-> this backup-collide-as) (-> this root-prim prim-core collide-as))
  0
  (none))

(defmethod restore-collide-with-as ((this collide-shape))
  "Restore the root primitive's masks saved by backup-collide-with-as."
  (set! (-> this root-prim collide-with) (-> this backup-collide-with))
  (set! (-> this root-prim prim-core collide-as) (-> this backup-collide-as))
  0
  (none))

(defmethod set-collide-kinds ((this collide-shape) (prim-id-mask int) (clear-kind collide-kind) (set-kind collide-kind))
  "For each root or immediate child whose primitive id shares a bit with
   prim-id-mask, clear clear-kind and then add set-kind to collide-as."
  (let ((root-prim (-> this root-prim)))
    (if (logtest? (-> root-prim prim-id) prim-id-mask)
      (set! (-> root-prim prim-core collide-as) (logior (logclear (-> root-prim prim-core collide-as) clear-kind) set-kind)))
    (let ((group (if (and (nonzero? root-prim) (type-type? (-> root-prim type) collide-shape-prim-group)) root-prim)))
      (when group
        (dotimes (i (-> (the-as collide-shape-prim-group group) num-prims))
          (let ((child-prim (-> (the-as collide-shape-prim-group group) prims i)))
            (if (logtest? (-> child-prim prim-id) prim-id-mask)
              (set! (-> child-prim prim-core collide-as) (logior (logclear (-> child-prim prim-core collide-as) clear-kind) set-kind))))))))
  0
  (none))

(defmethod set-collide-offense ((this collide-shape) (prim-id-mask int) (offense collide-offense))
  "Set offense on each root or immediate child whose primitive id shares a
   bit with prim-id-mask."
  (let ((root-prim (-> this root-prim)))
    (if (logtest? (-> root-prim prim-id) prim-id-mask) (set! (-> root-prim prim-core offense) offense))
    (let ((group (if (and (nonzero? root-prim) (type-type? (-> root-prim type) collide-shape-prim-group)) root-prim)))
      (when group
        (dotimes (i (-> (the-as collide-shape-prim-group group) num-prims))
          (let ((child-prim (-> (the-as collide-shape-prim-group group) prims i)))
            (if (logtest? (-> child-prim prim-id) prim-id-mask) (set! (-> child-prim prim-core offense) offense)))))))
  0
  (none))

(defmethod send-shove-back ((this collide-shape) (other-process process) (touch-entry touching-shapes-entry) (minimum-up-dot float) (shove-up-velocity float) (minimum-xz-velocity float))
  "When the touching pair supplies an upward-enough direction, send other-process
   a shove event whose horizontal velocity follows its current motion or facing and whose vertical
   velocity is shove-up-velocity."
  (local-vars (current-process process))
  (with-pp
    (when touch-entry
      (let ((touching-prims (-> touch-entry head)))
        (set! current-process other-process)
        (let ((shove-target (if (and (nonzero? current-process) (type-type? (-> current-process type) process-drawable)) current-process)))
          (when (and touching-prims shove-target)
            (let ((touched-prim (get-touched-prim touching-prims this touch-entry)))
              (get-touched-prim touching-prims (the-as collide-shape (-> (the-as process-drawable shove-target) root)) touch-entry)
              (let* ((overlap-midpoint (get-middle-of-bsphere-overlap touching-prims (new 'stack-no-clear 'vector)))
                     (shove-direction (vector-! (new 'stack-no-clear 'vector) overlap-midpoint (the-as vector (-> touched-prim prim-core)))))
                (vector-normalize! shove-direction 1.0)
                (when (< minimum-up-dot (-> shove-direction y))
                  (let ((shove-vector (new 'stack-no-clear 'vector)))
                    (vector-copy! shove-vector (-> (the-as process-drawable shove-target) root transv))
                    (let ((xz-speed (vector-xz-length (-> (the-as process-drawable shove-target) root transv))))
                      (if (= xz-speed 0.0)
                        (vector-copy! shove-vector (vector-z-quaternion! shove-vector (-> (the-as process-drawable shove-target) root quat))))
                      (vector-xz-normalize! shove-vector (fmax xz-speed minimum-xz-velocity)))
                    (set! (-> shove-vector y) shove-up-velocity)
                    (let ((shove-event (new 'stack-no-clear 'event-message-block)))
                      (set! (-> shove-event from) pp)
                      (set! (-> shove-event num-params) 2)
                      (set! (-> shove-event message) 'shove)
                      (set! (-> shove-event param 0) (the-as uint touch-entry))
                      (let ((shove-attack (new 'static 'attack-info :mask #x802)))
                        (vector-copy! (-> shove-attack vector) shove-vector)
                        (set! (-> shove-attack angle) 'jump)
                        (set! (-> shove-event param 1) (the-as uint shove-attack)))
                      (send-event-function shove-target shove-event))))))))))
    (none)))

(defmethod calc-shove-up ((this collide-shape) (attack attack-info) (shove-up-amount float))
  "Set attack.shove-up, find the closest point on the process path to the target,
   store its path distance in attack.shove-back, and return attack's launch vector."
  (set! (-> attack shove-up) shove-up-amount)
  (let* ((attack-path (-> this process path))
         (point-count (-> attack-path curve num-cverts))
         (target-position (target-pos 0))
         (path-point (new 'stack-no-clear 'vector))
         (closest-point (new 'stack-no-clear 'vector)))
    (let ((best-distance-squared -1.0))
      (dotimes (i point-count)
        (eval-path-curve-div! attack-path path-point (the float i) 'interp)
        (let ((distance-squared (vector-vector-distance-squared target-position path-point)))
          (when (or (< best-distance-squared 0.0) (< distance-squared best-distance-squared))
            (set! best-distance-squared distance-squared)
            (vector-copy! closest-point path-point)))))
    (vector-! (-> attack vector) closest-point target-position)))