jak-project/goal_src/jak2/engine/geometry/bounding-box.gc

;;-*-Lisp-*-
(in-package goal)

;; name: bounding-box.gc
;; name in dgo: bounding-box
;; dgos: ENGINE, GAME

#|@file
Implementation of bounding box functions.
These boxes are used as a primitive in the foreground collision system.
|#

;; DECOMP BEGINS

(defmethod inside-xyz? ((this bounding-box) (arg0 vector))
  "Is the point in the box?"
  (and (< (-> this min x) (-> arg0 x))
       (< (-> this min y) (-> arg0 y))
       (< (-> this min z) (-> arg0 z))
       (< (-> arg0 x) (-> this max x))
       (< (-> arg0 y) (-> this max y))
       (< (-> arg0 z) (-> this max z))
       )
  )

(defmethod inside-xz? ((this bounding-box) (arg0 vector))
  "Is the point in the box? Check xz only."
  (and (< (-> this min x) (-> arg0 x))
       (< (-> this min z) (-> arg0 z))
       (< (-> arg0 x) (-> this max x))
       (< (-> arg0 z) (-> this max z))
       )
  )

(defun box-vector-enside? ((arg0 bounding-box) (arg1 vector))
  "Is the point in the box? On the edge doesn't count."
  (and (< (-> arg0 min x) (-> arg1 x))
       (< (-> arg0 min y) (-> arg1 y))
       (< (-> arg0 min z) (-> arg1 z))
       (< (-> arg1 x) (-> arg0 max x))
       (< (-> arg1 y) (-> arg0 max y))
       (< (-> arg1 z) (-> arg0 max z))
       )
  )

(defun box-vector-inside? ((arg0 bounding-box) (arg1 vector))
  "Is the point in the box? On the edge counts."
  (and (>= (-> arg1 x) (-> arg0 min x))
       (>= (-> arg1 y) (-> arg0 min y))
       (>= (-> arg1 z) (-> arg0 min z))
       (>= (-> arg0 max x) (-> arg1 x))
       (>= (-> arg0 max y) (-> arg1 y))
       (>= (-> arg0 max z) (-> arg1 z))
       )
  )

(defmethod set-from-point-offset! ((this bounding-box) (arg0 vector) (arg1 vector))
  "Set to the smallest box containing arg0, (arg0 + arg1)"
  (rlet ((vf0 :class vf)
         (vf1 :class vf)
         (vf2 :class vf)
         (vf3 :class vf)
         (vf4 :class vf)
         (vf5 :class vf)
         )
    (init-vf0-vector)
    (.lvf vf3 (&-> arg1 quad))
    (.lvf vf4 (&-> arg0 quad))
    (.add.vf vf5 vf4 vf3)
    (.min.vf vf1 vf4 vf5)
    (.max.vf vf2 vf4 vf5)
    (.mov.vf.w vf1 vf0)
    (.mov.vf.w vf2 vf0)
    (.svf (&-> this min quad) vf1)
    (.svf (&-> this max quad) vf2)
    0
    (none)
    )
  )

(defmethod add-point! ((this bounding-box) (arg0 vector))
  "Expand the box as needed to contain the given point."
  (rlet ((vf1 :class vf)
         (vf2 :class vf)
         (vf3 :class vf)
         )
    (.lvf vf1 (&-> this min quad))
    (.lvf vf2 (&-> this max quad))
    (.lvf vf3 (&-> arg0 quad))
    (.min.vf vf1 vf1 vf3)
    (.max.vf vf2 vf2 vf3)
    (.svf (&-> this min quad) vf1)
    (.svf (&-> this max quad) vf2)
    0
    (none)
    )
  )

(defmethod add-box! ((this bounding-box) (arg0 bounding-box))
  "Expand the box as needed to contain the given box."
  (rlet ((vf1 :class vf)
         (vf2 :class vf)
         (vf3 :class vf)
         (vf4 :class vf)
         )
    (.lvf vf1 (&-> this min quad))
    (.lvf vf2 (&-> this max quad))
    (.lvf vf3 (&-> arg0 min quad))
    (.lvf vf4 (&-> arg0 max quad))
    (.min.vf vf1 vf1 vf3)
    (.max.vf vf2 vf2 vf4)
    (.svf (&-> this min quad) vf1)
    (.svf (&-> this max quad) vf2)
    0
    )
  )

(defmethod set-to-point! ((this bounding-box) (arg0 vector))
  "Set the box to be a single point."
  (set! (-> this min quad) (-> arg0 quad))
  (set! (-> this max quad) (-> arg0 quad))
  0
  (none)
  )

(defmethod set-from-point-offset-pad! ((this bounding-box) (arg0 vector) (arg1 vector) (arg2 float))
  "Set the box to contain arg0, arg0 + offset, with some padding."
  (rlet ((vf0 :class vf)
         (vf1 :class vf)
         (vf2 :class vf)
         (vf3 :class vf)
         (vf4 :class vf)
         (vf5 :class vf)
         (vf6 :class vf)
         )
    (init-vf0-vector)
    (.lvf vf4 (&-> arg1 quad))
    (.lvf vf5 (&-> arg0 quad))
    (.mov vf1 arg2)
    (.add.vf vf6 vf5 vf4)
    (.min.vf vf2 vf5 vf6)
    (.max.vf vf3 vf5 vf6)
    (.add.x.vf.xyz vf3 vf3 vf1)
    (.sub.x.vf.xyz vf2 vf2 vf1)
    (.mov.vf.w vf2 vf0)
    (.mov.vf.w vf3 vf0)
    (.svf (&-> this min quad) vf2)
    (.svf (&-> this max quad) vf3)
    0
    )
  )

(defmethod set-from-sphere! ((this bounding-box) (arg0 sphere))
  "Set the box to contain a single sphere."
  (rlet ((vf0 :class vf)
         (vf1 :class vf)
         (vf2 :class vf)
         (vf3 :class vf)
         )
    (init-vf0-vector)
    (.lvf vf1 (&-> arg0 quad))
    (.sub.w.vf.xyz vf2 vf1 vf1)
    (.add.w.vf.xyz vf3 vf1 vf1)
    (.mov.vf.w vf2 vf0)
    (.mov.vf.w vf3 vf0)
    (.svf (&-> this min quad) vf2)
    (.svf (&-> this max quad) vf3)
    0
    (none)
    )
  )

;;;;;;;;;;;;;;;;;;;;;;;;;
;; multi-sphere methods
;;;;;;;;;;;;;;;;;;;;;;;;;

;; these are used in the collision system to build bounding boxes around collision geometries, so they are quite optimized.

(defmethod add-spheres! ((this bounding-box) (spheres (inline-array sphere)) (count int))
  "Add count spheres."
  ;; the PS2 implementation is very optimized
  ;; It is unrolled and 'software pipelined' to do 4 at a time.
  ;; This is slightly less optimized.
  (rlet ((current-min :class vf)
         (current-max :class vf)
         (sph-min :class vf)
         (sph-max :class vf)
         (sph :class vf))

    (when (nonzero? count)
      ;; load these outside the loop
      (.lvf current-min (-> this min))
      (.lvf current-max (-> this max))

      (dotimes (i count)
        (.lvf sph (-> spheres i))
        (.sub.w.vf.xyz sph-min sph sph)
        (.add.w.vf.xyz sph-max sph sph)
        (.min.vf.xyz current-min current-min sph-min)
        (.max.vf.xyz current-max current-max sph-max)
        )

      (.svf (-> this min) current-min)
      (.svf (-> this max) current-max)
      )
    )
  0
  )

(defmethod set-from-spheres! ((this bounding-box) (spheres (inline-array sphere)) (count int))
  "Reset box to hold the given spheres. Note: this implementation could be optimized."
  ;; This is also unrolled, but does 7 at a time.
  (rlet ((vf0 :class vf)
         (current-min :class vf)
         (current-max :class vf)
         (sph-min :class vf)
         (sph-max :class vf)
         (sph :class vf))
    ;; init constant
    (init-vf0-vector)
    ;; init min/max. in the case we don't have any spheres, we should return (0,0,0,1) for min/max.
    (set! current-min vf0)
    (set! current-max vf0)

    (dotimes (i count)
      (.lvf sph (-> spheres i))
      (.sub.w.vf.xyz sph-min sph sph)
      (.add.w.vf.xyz sph-max sph sph)
      (cond
        ((zero? i)
         (set! current-min sph-min)
         (set! current-max sph-max)
         )
        (else
         (.min.vf.xyz current-min current-min sph-min)
         (.max.vf.xyz current-max current-max sph-max)
         )
        )
      )

    (.svf (-> this min) current-min)
    (.svf (-> this max) current-max)
    )
  0
  )


(defmethod get-bounding-sphere ((this bounding-box) (arg0 vector))
  "Get a bounding sphere for a bounding box."
  (let* ((a1-2 (vector-! (new 'stack-no-clear 'vector) (-> this max) (-> this min)))
         (a0-3 (vector-float*! (new 'stack-no-clear 'vector) a1-2 0.5))
         )
    (vector+! arg0 (-> this min) a0-3)
    (set! (-> arg0 w) (vector-length a0-3))
    )
  arg0
  )

;;;;;;;;;;;;;;
;; line clip
;;;;;;;;;;;;;;

;; The "liang-barsky" algorithm for line clipping is just using the parametric equation for a line.
;; this is used to implement a "line segment intersects square in xz plane" check.

(deftype liang-barsky-line-clip-params (structure)
  ((te float  :offset-assert   0)
   (tl float  :offset-assert   4)
   )
  :method-count-assert 9
  :size-assert         #x8
  :flag-assert         #x900000008
  )

(defun liang-barsky-line-clipt ((arg0 liang-barsky-line-clip-params) (arg1 float) (arg2 float))
  "Clip test in 1 dimension. Is arg1 in arg2?"
  (cond
    ((< 0.0 arg1)
     (let ((f0-2 (/ arg2 arg1)))
       (if (< (-> arg0 tl) f0-2)
           (return #f)
           )
       (if (< (-> arg0 te) f0-2)
           (set! (-> arg0 te) f0-2)
           )
       )
     )
    ((< arg1 0.0)
     (let ((f0-5 (/ arg2 arg1)))
       (if (< f0-5 (-> arg0 te))
           (return #f)
           )
       (if (< f0-5 (-> arg0 tl))
           (set! (-> arg0 tl) f0-5)
           )
       )
     )
    (else
      (if (< 0.0 arg2)
          (return #f)
          )
      )
    )
  #t
  )

(defmethod intersects-line-segment? ((this bounding-box) (arg0 vector) (arg1 vector))
  "Check intersection in xz plane, using liang-barsky. Not sure if this actually
   a useful check or not..."
  (let ((f28-0 (- (-> arg1 x) (-> arg0 x)))
        (f30-0 (- (-> arg1 z) (-> arg0 z)))
        )
    (cond
      ((and (= f28-0 0.0) (= f30-0 0.0))
       (let ((f1-2 (-> arg0 x))
             (f0-4 (-> arg0 z))
             )
         (and (>= f1-2 (-> this min x)) (>= (-> this max x) f1-2) (>= f0-4 (-> this min z)) (>= (-> this max z) f0-4))
         )
       )
      (else
        (let ((s4-0 (new 'stack-no-clear 'liang-barsky-line-clip-params)))
          (set! (-> s4-0 te) 0.0)
          (set! (-> s4-0 tl) 1.0)
          (and (liang-barsky-line-clipt s4-0 f28-0 (- (-> this min x) (-> arg0 x)))
               (liang-barsky-line-clipt s4-0 (- f28-0) (- (-> arg0 x) (-> this max x)))
               (liang-barsky-line-clipt s4-0 f30-0 (- (-> this min z) (-> arg0 z)))
               (liang-barsky-line-clipt s4-0 (- f30-0) (- (-> arg0 z) (-> this max z)))
               )
          )
        )
      )
    )
  )