mirror of
https://github.com/open-goal/jak-project
synced 2026-08-06 09:54:10 -04:00
98 lines
4.8 KiB
Common Lisp
98 lines
4.8 KiB
Common Lisp
;;-*-Lisp-*-
|
|
(in-package goal)
|
|
(bundles "ENGINE.CGO" "GAME.CGO")
|
|
(require "engine/math/vector-h.gc")
|
|
(require "engine/debug/debug-h.gc")
|
|
(require "engine/math/math.gc")
|
|
(defconstant DEBUG_SPHERE_SEC_AMT (#if (user? dass) 5 10))
|
|
|
|
(defconstant DEBUG_SPHERE_SEC_H DEBUG_SPHERE_SEC_AMT)
|
|
|
|
(defconstant DEBUG_SPHERE_SEC_W DEBUG_SPHERE_SEC_AMT)
|
|
|
|
;; DECOMP BEGINS
|
|
|
|
;; Three unit-sphere points per latitude/longitude cell: the cell point, its next point around the
|
|
;; latitude ring, and its next point along the longitude.
|
|
(deftype debug-sphere-table (basic)
|
|
((point vector 300 :inline)))
|
|
|
|
(defun make-debug-sphere-table ((table debug-sphere-table))
|
|
"Fill table with a unit-sphere latitude/longitude grid. Each cell stores its current point, the
|
|
next point around the same latitude, and the next point along the same longitude so drawing
|
|
needs no trigonometry."
|
|
(local-vars (longitude-index int))
|
|
(let ((unit-center (new-stack-vector0))
|
|
(unit-radius 1.0)
|
|
(point-index 0))
|
|
(set-vector! unit-center 0.0 0.0 0.0 1.0)
|
|
(dotimes (latitude-index DEBUG_SPHERE_SEC_H)
|
|
(let ((ring-radius (* unit-radius (sin (* (degrees (/ 180 DEBUG_SPHERE_SEC_H)) (the float latitude-index)))))
|
|
(next-ring-radius (* unit-radius (sin (* (degrees (/ 180 DEBUG_SPHERE_SEC_H)) (the float (+ latitude-index 1))))))
|
|
(cell-point (new-stack-vector0))
|
|
(longitude-neighbor (new-stack-vector0))
|
|
(latitude-neighbor (new-stack-vector0)))
|
|
(set! (-> cell-point y)
|
|
(+ (-> unit-center y) (* (cos (* (degrees (/ 180 DEBUG_SPHERE_SEC_H)) (the float latitude-index))) unit-radius)))
|
|
(set! (-> longitude-neighbor y) (-> cell-point y))
|
|
(set! (-> latitude-neighbor y)
|
|
(+ (-> unit-center y) (* (cos (* (degrees (/ 180 DEBUG_SPHERE_SEC_H)) (the float (+ latitude-index 1)))) unit-radius)))
|
|
(set! longitude-index 0)
|
|
(while (< longitude-index DEBUG_SPHERE_SEC_W)
|
|
(set! (-> cell-point x)
|
|
(+ (-> unit-center x) (* (cos (* (degrees (/ 360 DEBUG_SPHERE_SEC_W)) (the float longitude-index))) ring-radius)))
|
|
(set! (-> cell-point z)
|
|
(+ (-> unit-center z) (* (sin (* (degrees (/ 360 DEBUG_SPHERE_SEC_W)) (the float longitude-index))) ring-radius)))
|
|
(set! (-> longitude-neighbor x)
|
|
(+ (-> unit-center x) (* (cos (* (degrees (/ 360 DEBUG_SPHERE_SEC_W)) (the float (+ longitude-index 1)))) ring-radius)))
|
|
(set! (-> longitude-neighbor z)
|
|
(+ (-> unit-center z) (* (sin (* (degrees (/ 360 DEBUG_SPHERE_SEC_W)) (the float (+ longitude-index 1)))) ring-radius)))
|
|
(set! (-> latitude-neighbor x)
|
|
(+ (-> unit-center x) (* (cos (* (degrees (/ 360 DEBUG_SPHERE_SEC_W)) (the float longitude-index))) next-ring-radius)))
|
|
(set! (-> latitude-neighbor z)
|
|
(+ (-> unit-center z) (* (sin (* (degrees (/ 360 DEBUG_SPHERE_SEC_W)) (the float longitude-index))) next-ring-radius)))
|
|
(set! (-> table point point-index quad) (-> cell-point quad))
|
|
(set! (-> table point (+ point-index 1) quad) (-> longitude-neighbor quad))
|
|
(set! (-> table point (+ point-index 2) quad) (-> latitude-neighbor quad))
|
|
(+! point-index 3)
|
|
(+! longitude-index 1)))))
|
|
0
|
|
(none))
|
|
|
|
(define *debug-sphere-table* (new 'static 'debug-sphere-table))
|
|
|
|
(make-debug-sphere-table *debug-sphere-table*)
|
|
|
|
(defun add-debug-sphere-from-table ((bucket bucket-id) (center vector) (radius float) (color rgba))
|
|
"Draw a wireframe sphere in bucket by scaling the cached unit grid by radius, translating it to
|
|
center, and drawing one latitude edge and one longitude edge from every grid cell in color."
|
|
(rlet ((vf1 :class vf)
|
|
(vf2 :class vf)
|
|
(vf3 :class vf)
|
|
(vf4 :class vf)
|
|
(vf5 :class vf))
|
|
(let ((cell-point (new-stack-vector0))
|
|
(longitude-neighbor (new-stack-vector0))
|
|
(latitude-neighbor (new-stack-vector0))
|
|
(points (-> *debug-sphere-table* point)))
|
|
(.lvf vf1 (&-> center quad))
|
|
(.mov vf2 radius)
|
|
(dotimes (i (* DEBUG_SPHERE_SEC_W DEBUG_SPHERE_SEC_H))
|
|
(.lvf vf3 (&-> points 0 quad))
|
|
(.lvf vf4 (&-> points 1 quad))
|
|
(.lvf vf5 (&-> points 2 quad))
|
|
(set! points (the-as (inline-array vector) (-> points 3)))
|
|
(.mul.x.vf vf3 vf3 vf2)
|
|
(.mul.x.vf vf4 vf4 vf2)
|
|
(.mul.x.vf vf5 vf5 vf2)
|
|
(.add.vf vf3 vf3 vf1)
|
|
(.add.vf vf4 vf4 vf1)
|
|
(.add.vf vf5 vf5 vf1)
|
|
(.svf (&-> cell-point quad) vf3)
|
|
(.svf (&-> longitude-neighbor quad) vf4)
|
|
(.svf (&-> latitude-neighbor quad) vf5)
|
|
(add-debug-line #t bucket cell-point longitude-neighbor color #f (the-as rgba -1))
|
|
(add-debug-line #t bucket cell-point latitude-neighbor color #f (the-as rgba -1))))
|
|
0
|
|
(none)))
|