Files
jak-project/goal_src/engine/debug/debug.gc
T
2021-08-13 21:48:56 -04:00

1042 lines
34 KiB
Common Lisp

;;-*-Lisp-*-
(in-package goal)
;; name: debug.gc
;; name in dgo: debug
;; dgos: GAME, ENGINE
;; This file contains functions for debug drawing.
;; In general, the 3d functions draw using the camera and the 2d functions draw in screen coordinated.
;; Most functions take a boolean as their first argument. If the boolean is set to #f, it will skip drawing the point.
(defun transform-float-point ((in vector) (out vector4w))
"Transform point in and store the result in out.
This uses the cached vf register transformation matrix
Note that the input/output order of the arguments is swapped from usual"
(with-vf0
(with-vf (vf4 vf1 vf2 vf3 vf9 vf8 vf6)
(rlet ((acc :class vf)
(Q :class vf)
(vf5 :class vf)
)
(.lvf vf5 (&-> in quad))
(.mul.w.vf acc vf4 vf5)
(.add.mul.x.vf acc vf1 vf5 acc)
(.add.mul.y.vf acc vf2 vf5 acc)
(.add.mul.z.vf vf5 vf3 vf5 acc)
(.div.vf Q vf9 vf5 :fsf #b0 :ftf #b11)
(.wait.vf)
(.mul.vf vf5 vf5 Q :mask #b111)
(.add.vf vf5 vf5 vf8)
(.max.x.vf vf5 vf5 vf0 :mask #b1000)
(.min.x.vf vf5 vf5 vf6 :mask #b1000)
(vftoi4.xyzw vf5 vf5)
(.svf (&-> out quad) vf5)
out
)
)
)
)
;;;;;;;;;;;;;;;;;;
;; Debug Draw
;;;;;;;;;;;;;;;;;;
;; All of these functions are super slow and probably very old.
;; They do a DMA packet per thing drawn.
(defun-debug add-debug-point ((enable-draw symbol) (bucket bucket-id) (pt vector))
"Draw a point.
The point is actually a pretty large square with some weird rgb gradient."
(if (not enable-draw)
(return #f)
)
(let ((s5-0 (new 'stack 'vector4w-2)))
;; transform the input point and convert to fixed point
(set! (-> pt w) 1.0)
(when (transform-point-qword! (-> s5-0 vector 0) pt)
(with-dma-buffer-add-bucket ((v1-7 (current-display-frame debug-buf)) (current-display-frame bucket-group) bucket)
(with-cnt-vif-block (v1-7)
(dma-buffer-add-gif-tag v1-7
(new 'static 'gif-tag64 :nloop 1 :eop 1 :pre 1 :nreg 8 :prim (gif-prim tri-strip))
(gs-reg-list rgbaq xyzf2 rgbaq xyzf2 rgbaq xyzf2 rgbaq xyzf2)
)
;; upper point is red
(set! (-> s5-0 vector 1 x) 255) ;; r
(set! (-> s5-0 vector 1 y) 128)
(set! (-> s5-0 vector 1 z) 128)
(set! (-> s5-0 vector 1 w) 128)
(+! (-> s5-0 vector 0 y) 160)
(dma-buffer-add-uint128 v1-7
(-> s5-0 quad 1)
(-> s5-0 quad 0)
)
;; left point is green
(+! (-> s5-0 vector 0 x) -256)
(+! (-> s5-0 vector 0 y) -160)
(set! (-> s5-0 vector 1 x) 128)
(set! (-> s5-0 vector 1 y) 255) ;; g
(dma-buffer-add-uint128 v1-7
(-> s5-0 quad 1)
(-> s5-0 quad 0)
)
;; right point is blue
(+! (-> s5-0 vector 0 x) 512)
(set! (-> s5-0 vector 1 y) 128)
(set! (-> s5-0 vector 1 z) 255)
(dma-buffer-add-uint128 v1-7
(-> s5-0 quad 1)
(-> s5-0 quad 0)
)
;; bottom point is red again
(+! (-> s5-0 vector 0 x) -256)
(+! (-> s5-0 vector 0 y) -160)
(set! (-> s5-0 vector 1 x) 255)
(set! (-> s5-0 vector 1 y) 128)
(dma-buffer-add-uint128 v1-7
(-> s5-0 quad 1)
(-> s5-0 quad 0)
)
)
)
)
)
#f
)
(defun-debug internal-draw-debug-line ((arg0 bucket-id) (arg1 vector) (arg2 vector) (arg3 rgba) (arg4 symbol) (arg5 rgba))
(let ((sv-80 arg2)
(s2-0 arg3)
(s3-0 arg4)
(s5-0 arg5)
)
(let ((a0-4 (current-display-frame debug-buf)))
(if (< (the-as uint (shr (+ (&- (-> a0-4 end) (the-as uint (-> a0-4 base))) 15) 4)) (the-as uint #x8000))
(return (the-as pointer #f))
)
)
(if (or (zero? (+ s5-0 (the-as uint 1)))
(= s5-0 (static-rgba #xff #xff #xff #xff))
)
(set! s5-0 s2-0)
)
(case s3-0
(('fade)
(set! s5-0 (new 'static 'rgba
:r (shr (-> s5-0 r) 1)
:g (shr (-> s5-0 g) 1)
:b (shr (-> s5-0 b) 1)
:a (-> s5-0 a)
))
)
)
(let ((s4-0 (new 'stack 'vector4w-2))
(s1-0 (new 'stack 'vector4w-2))
)
(set! (-> arg1 w) 1.0)
(set! (-> sv-80 w) 1.0)
(when (and (transform-point-qword! (-> s4-0 vector 0) arg1)
(transform-point-qword! (-> s4-0 vector 1) sv-80)
)
(with-dma-buffer-add-bucket ((v1-28 (current-display-frame debug-buf)) (current-display-frame bucket-group) arg0)
(with-cnt-vif-block (v1-28)
(dma-buffer-add-gif-tag v1-28 (new 'static 'gif-tag64 :nloop 1 :eop 1 :pre 1 :nreg 4
:prim (gif-prim line))
(gs-reg-list rgbaq xyzf2 rgbaq xyzf2)
)
(case s3-0
(('fade-depth)
(let ((f0-3 (fminmax (* (1/ #xffffff) (the float (-> s4-0 vector 0 z))) 0.2 1.0)))
(set! (-> s1-0 vector 0 x) (the int (* (the float (-> s2-0 r)) f0-3)))
(set! (-> s1-0 vector 0 y) (the int (* (the float (-> s2-0 g)) f0-3)))
(set! (-> s1-0 vector 0 z) (the int (* (the float (-> s2-0 b)) f0-3)))
)
(set! (-> s1-0 vector 0 w) (the-as int (-> s2-0 a)))
)
(else
(set! (-> s1-0 vector 0 x) (the-as int (-> s2-0 r)))
(set! (-> s1-0 vector 0 y) (the-as int (-> s2-0 g)))
(set! (-> s1-0 vector 0 z) (the-as int (-> s2-0 b)))
(set! (-> s1-0 vector 0 w) (the-as int (-> s2-0 a)))
)
)
(cond
((= s3-0 'fade-depth)
(let ((f0-7 (fminmax (* (1/ #xffffff) (the float (-> s4-0 vector 1 z))) 0.2 1.0)))
(set! (-> s1-0 vector 1 x) (the int (* (the float (-> s5-0 r)) f0-7)))
(set! (-> s1-0 vector 1 y) (the int (* (the float (-> s5-0 g)) f0-7)))
(set! (-> s1-0 vector 1 z) (the int (* (the float (-> s5-0 b)) f0-7)))
)
(set! (-> s1-0 vector 1 w) (the-as int (-> s5-0 a)))
)
(else
(set! (-> s1-0 vector 1 x) (the-as int (-> s5-0 r)))
(set! (-> s1-0 vector 1 y) (the-as int (-> s5-0 g)))
(set! (-> s1-0 vector 1 z) (the-as int (-> s5-0 b)))
(set! (-> s1-0 vector 1 w) (the-as int (-> s5-0 a)))
)
)
(+! (-> s4-0 vector 0 z) -8192)
(+! (-> s4-0 vector 1 z) -8192)
(dma-buffer-add-uint128 v1-28 (-> s1-0 quad 0)
(-> s4-0 quad 0)
(-> s1-0 quad 1)
(-> s4-0 quad 1)
)
)
)
)
)
)
)
(defun-debug internal-draw-debug-text-3d ((arg0 bucket-id) (arg1 string) (arg2 vector) (arg3 rgba) (arg4 vector2h))
(let ((s2-0 (new 'stack-no-clear 'vector4w)))
(set! (-> s2-0 quad) (the-as uint128 0))
(when (transform-point-qword! (the-as vector4w s2-0) arg2)
(with-dma-buffer-add-bucket ((s3-0 (current-display-frame debug-buf)) (current-display-frame bucket-group) arg0)
(let ((a2-2 (new 'stack 'font-context *font-default-matrix*
(+ (+ (-> arg4 x) -1792) (/ (-> s2-0 x) 16))
(- (+ (+ (-> arg4 y) -8) (/ (-> s2-0 y) 16))
(-> *video-parms* screen-miny)
)
0.0
(the-as int arg3)
(the-as uint 3)
)))
(let ((v1-9 a2-2))
(set! (-> v1-9 origin z) (the float (/ (-> s2-0 z) 16)))
)
(draw-string arg1 s3-0 a2-2)
)
)
)
)
)
(defun-debug add-debug-outline-triangle ((arg0 symbol) (arg1 bucket-id) (arg2 vector) (arg3 vector) (arg4 vector) (arg5 rgba))
(when arg0
(add-debug-line #t arg1 arg2 arg3 arg5 #f (the-as rgba -1))
(add-debug-line #t arg1 arg3 arg4 arg5 #f (the-as rgba -1))
(add-debug-line #t arg1 arg4 arg2 arg5 #f (the-as rgba -1))
)
#f
)
(defun-debug add-debug-triangle-normal ((arg0 symbol) (arg1 bucket-id) (arg2 vector) (arg3 vector) (arg4 vector) (arg5 rgba))
(when arg0
(let ((s4-0 (new 'stack-no-clear 'vector))
(s3-0 (vector-3pt-cross! (new 'stack-no-clear 'vector) arg2 arg3 arg4))
)
(vector-float/! s3-0 s3-0 (* (1/ METER_LENGTH) (vector-length s3-0)))
(vector+! s4-0 arg2 arg3)
(vector+! s4-0 s4-0 arg4)
(vector-float/! s4-0 s4-0 3.0)
(vector+! s3-0 s3-0 s4-0)
(add-debug-line #t arg1 s4-0 s3-0 arg5 #f (the-as rgba -1))
)
)
#f
)
(defun-debug add-debug-flat-triangle ((enable-draw symbol) (bucket bucket-id) (p0 vector) (p1 vector) (p2 vector) (arg5 rgba))
(if (not enable-draw)
(return #f)
)
(let ((s5-0 (new 'stack 'vector4w-3))
(s4-0 (new 'stack 'vector4w-3))
)
(set! (-> p0 w) 1.0)
(set! (-> p1 w) 1.0)
(set! (-> p2 w) 1.0)
(when (and (transform-point-qword! (-> s5-0 vector 0) p0)
(transform-point-qword! (-> s5-0 vector 1) p1)
(transform-point-qword! (-> s5-0 vector 2) p2)
)
(with-dma-buffer-add-bucket ((v1-9 (current-display-frame debug-buf)) (current-display-frame bucket-group) bucket)
(with-cnt-vif-block (v1-9)
(dma-buffer-add-gif-tag v1-9 (new 'static 'gif-tag64 :nloop 1 :eop 1 :pre 1 :nreg 6 :prim (gif-prim tri))
(gs-reg-list rgbaq xyzf2 rgbaq xyzf2 rgbaq xyzf2)
)
(set! (-> s4-0 vector 0 x) (the-as int (-> arg5 r)))
(set! (-> s4-0 vector 0 y) (the-as int (-> arg5 g)))
(set! (-> s4-0 vector 0 z) (the-as int (-> arg5 b)))
(set! (-> s4-0 vector 0 w) (the-as int (-> arg5 a)))
(set! (-> s5-0 vector 0 z) (+ (-> s5-0 vector 0 z) -8192))
(set! (-> s5-0 vector 1 z) (+ (-> s5-0 vector 1 z) -8192))
(set! (-> s5-0 vector 2 z) (+ (-> s5-0 vector 2 z) -8192))
(dma-buffer-add-uint128 v1-9 (-> s4-0 quad 0)
(-> s5-0 quad 0) ;; xyz 1
(-> s4-0 quad 0)
(-> s5-0 quad 1) ;; xyz 2
(-> s4-0 quad 0)
(-> s5-0 quad 2) ;; xyz 3
)
)
)
)
)
#f
)
(when *debug-segment*
(deftype debug-line (structure)
((flags int32 :offset-assert 0)
(bucket bucket-id :offset-assert 4)
(v1 vector :inline :offset-assert 16)
(v2 vector :inline :offset-assert 32)
(color rgba :offset-assert 48)
(mode symbol :offset-assert 52)
(color2 rgba :offset-assert 56)
)
:method-count-assert 9
:size-assert #x3c
:flag-assert #x90000003c
)
(deftype debug-text-3d (structure)
((flags int32 :offset-assert 0)
(bucket bucket-id :offset-assert 4)
(pos vector :inline :offset-assert 16)
(color uint64 :offset-assert 32)
(offset vector2h :inline :offset-assert 40)
(str string :offset-assert 44)
)
:method-count-assert 9
:size-assert #x30
:flag-assert #x900000030
)
(deftype debug-tracking-thang (basic)
((length int32 :offset-assert 4)
(allocated-length int32 :offset-assert 8)
)
:method-count-assert 9
:size-assert #xc
:flag-assert #x90000000c
)
(define *debug-lines* (the (inline-array debug-line) (malloc 'debug #x100000)))
(define *debug-lines-trk* (new 'debug 'debug-tracking-thang))
(set! (-> *debug-lines-trk* allocated-length) 16384)
(define *debug-text-3ds* (the (inline-array debug-text-3d) (malloc 'debug #x6000)))
(define *debug-text-3d-trk* (new 'debug 'debug-tracking-thang))
(set! (-> *debug-text-3d-trk* allocated-length) 512)
(dotimes (i (-> *debug-text-3d-trk* allocated-length))
(set! (-> *debug-text-3ds* i str) (new 'debug 'string 80 (the string #f)))
)
)
(defun-debug get-debug-line ()
(cond
((< (-> *debug-lines-trk* length) (-> *debug-lines-trk* allocated-length))
(+! (-> *debug-lines-trk* length) 1)
(-> *debug-lines* (+ (-> *debug-lines-trk* length) -1))
)
(else
(the-as debug-line #f)
)
)
)
(defun-debug get-debug-text-3d ()
(cond
((< (-> *debug-text-3d-trk* length) (-> *debug-text-3d-trk* allocated-length))
(+! (-> *debug-text-3d-trk* length) 1)
(-> *debug-text-3ds* (+ (-> *debug-text-3d-trk* length) -1))
)
(else
(the-as debug-text-3d #f)
)
)
)
(defun-debug debug-reset-buffers ()
(set! (-> *debug-lines-trk* length) 0)
(set! (-> *debug-text-3d-trk* length) 0)
(set! *debug-draw-pauseable* #f)
#f
)
(defun-debug debug-draw-buffers ()
(dotimes (gp-0 (-> *debug-lines-trk* length))
(let ((v1-1 (-> *debug-lines* gp-0)))
(internal-draw-debug-line
(-> v1-1 bucket)
(-> v1-1 v1)
(-> v1-1 v2)
(-> v1-1 color)
(-> v1-1 mode)
(-> v1-1 color2)
)
)
)
(dotimes (gp-1 (-> *debug-text-3d-trk* length))
(let ((v1-8 (-> *debug-text-3ds* gp-1)))
(internal-draw-debug-text-3d
(-> v1-8 bucket)
(-> v1-8 str)
(-> v1-8 pos)
(the-as rgba (-> v1-8 color))
(-> v1-8 offset)
)
)
)
#f
)
(defun-debug add-debug-line ((arg0 symbol) (arg1 bucket-id) (arg2 vector) (arg3 vector) (arg4 rgba) (arg5 symbol) (arg6 rgba))
(when arg0
(cond
(*debug-draw-pauseable*
(let ((v1-2 (get-debug-line)))
(when v1-2
(set! (-> v1-2 bucket) arg1)
(set! (-> v1-2 v1 quad) (-> arg2 quad))
(set! (-> v1-2 v2 quad) (-> arg3 quad))
(set! (-> v1-2 color) arg4)
(set! (-> v1-2 color2) arg6)
(set! (-> v1-2 mode) arg5)
)
)
)
(else
(internal-draw-debug-line arg1 arg2 arg3 arg4 arg5 arg6)
)
)
)
#f
)
(defun-debug add-debug-line2d ((arg0 symbol) (arg1 bucket-id) (arg2 vector) (arg3 vector) (arg4 vector))
(if (not arg0)
(return #f)
)
(with-dma-buffer-add-bucket ((s4-0 (current-display-frame debug-buf)) (current-display-frame bucket-group) arg1)
(let ((s2-0 (new 'stack 'vector4w))
(v1-7 (new 'stack 'vector4w))
)
(set! (-> s2-0 quad) (-> arg2 quad))
(set! (-> v1-7 quad) (-> arg3 quad))
(set! (-> s2-0 x) (* (+ (-> s2-0 x) 2048) 16))
(set! (-> s2-0 y) (* -16 (- 2048 (-> s2-0 y))))
(set! (-> s2-0 z) #x7fffff)
(set! (-> v1-7 x) (* (+ (-> v1-7 x) 2048) 16))
(set! (-> v1-7 y) (* -16 (- 2048 (-> v1-7 y))))
(set! (-> v1-7 z) #x7fffff)
(with-cnt-vif-block (s4-0)
(dma-buffer-add-gif-tag s4-0 (new 'static 'gif-tag64 :nloop 1 :eop 1 :pre 1 :nreg 4 :prim (gif-prim line))
(gs-reg-list rgbaq xyzf2 rgbaq xyzf2)
)
(dma-buffer-add-uint128 s4-0 (-> arg4 quad)
(-> s2-0 quad)
)
(dma-buffer-add-uint128 s4-0 (-> arg4 quad)
(-> v1-7 quad)
)
)
)
)
#f
)
(defun-debug add-debug-box ((arg0 symbol) (arg1 bucket-id) (arg2 vector) (arg3 vector) (arg4 rgba))
(let ((s5-0 (new-stack-vector0)))
(set! (-> s5-0 quad) (-> arg2 quad))
(let ((s1-0 (new-stack-vector0)))
(set! (-> s1-0 quad) (-> arg2 quad))
(when arg0
(set! (-> s1-0 x) (-> arg3 x))
(add-debug-line #t arg1 s5-0 s1-0 arg4 #f (the-as rgba -1))
(set! (-> s1-0 x) (-> arg2 x))
(set! (-> s1-0 y) (-> arg3 y))
(add-debug-line #t arg1 s5-0 s1-0 arg4 #f (the-as rgba -1))
(set! (-> s1-0 y) (-> arg2 y))
(set! (-> s1-0 z) (-> arg3 z))
(add-debug-line #t arg1 s5-0 s1-0 arg4 #f (the-as rgba -1))
(set! (-> s5-0 y) (-> arg3 y))
(set! (-> s1-0 y) (-> arg3 y))
(add-debug-line #t arg1 s5-0 s1-0 arg4 #f (the-as rgba -1))
(set! (-> s1-0 z) (-> arg2 z))
(set! (-> s1-0 x) (-> arg3 x))
(add-debug-line #t arg1 s5-0 s1-0 arg4 #f (the-as rgba -1))
(set! (-> s1-0 y) (-> arg2 y))
(set! (-> s5-0 x) (-> arg3 x))
(add-debug-line #t arg1 s5-0 s1-0 arg4 #f (the-as rgba -1))
(set! (-> s5-0 quad) (-> arg3 quad))
(set! (-> s1-0 quad) (-> arg3 quad))
(set! (-> s1-0 x) (-> arg2 x))
(add-debug-line #t arg1 s5-0 s1-0 arg4 #f (the-as rgba -1))
(set! (-> s1-0 x) (-> arg3 x))
(set! (-> s1-0 y) (-> arg2 y))
(add-debug-line #t arg1 s5-0 s1-0 arg4 #f (the-as rgba -1))
(set! (-> s1-0 y) (-> arg3 y))
(set! (-> s1-0 z) (-> arg2 z))
(add-debug-line #t arg1 s5-0 s1-0 arg4 #f (the-as rgba -1))
(set! (-> s5-0 y) (-> arg2 y))
(set! (-> s1-0 y) (-> arg2 y))
(add-debug-line #t arg1 s5-0 s1-0 arg4 #f (the-as rgba -1))
(set! (-> s1-0 z) (-> arg3 z))
(set! (-> s1-0 x) (-> arg2 x))
(add-debug-line #t arg1 s5-0 s1-0 arg4 #f (the-as rgba -1))
(set! (-> s1-0 y) (-> arg3 y))
(set! (-> s5-0 x) (-> arg2 x))
(add-debug-line #t arg1 s5-0 s1-0 arg4 #f (the-as rgba -1))
)
)
)
#f
)
(defun-debug add-debug-x ((arg0 symbol) (arg1 bucket-id) (arg2 vector) (arg3 rgba))
(if (not arg0)
(return #f)
)
(let ((s3-0 (new-stack-vector0))
(s2-0 (new-stack-vector0))
)
(vector+! s3-0 arg2 (new 'static 'vector :x -1228.8))
(vector+! s2-0 arg2 (new 'static 'vector :x 1228.8))
(add-debug-line #t arg1 s3-0 s2-0 arg3 #f (the-as rgba -1))
(vector+! s3-0 arg2 (new 'static 'vector :z -1228.8))
(vector+! s2-0 arg2 (new 'static 'vector :z 1228.8))
(add-debug-line #t arg1 s3-0 s2-0 arg3 #f (the-as rgba -1))
)
#f
)
(defun-debug add-debug-text-3d ((arg0 symbol) (arg1 bucket-id) (arg2 string) (arg3 vector) (arg4 rgba) (arg5 vector2h))
(when arg0
(cond
(*debug-draw-pauseable*
(let ((v1-2 (get-debug-text-3d)))
(when v1-2
(set! (-> v1-2 flags) 0)
(set! (-> v1-2 bucket) arg1)
(set! (-> v1-2 pos quad) (-> arg3 quad))
(cond
(arg5
(set! (-> v1-2 offset x) (-> arg5 x))
(set! (-> v1-2 offset y) (-> arg5 y))
)
(else
(set! (-> v1-2 offset x) 0)
(set! (-> v1-2 offset y) 0)
0
)
)
(set! (-> v1-2 color) (the-as uint arg4))
(let ((a0-6 0)
(a1-2 (-> arg2 data))
(v1-4 (-> v1-2 str data))
)
(while (and (nonzero? (-> a1-2 0)) (< a0-6 79))
(set! (-> v1-4 0) (-> a1-2 0))
(set! a1-2 (&-> a1-2 1))
(set! v1-4 (&-> v1-4 1))
(+! a0-6 1)
)
(set! (-> v1-4 0) (the-as uint 0))
)
0
)
)
)
(else
(internal-draw-debug-text-3d arg1 arg2 arg3 arg4 (if arg5
arg5
(new 'static 'vector2h)
)
)
)
)
)
#f
)
(defun-debug add-debug-sphere-with-transform ((arg0 symbol) (arg1 bucket-id) (arg2 vector) (arg3 float) (arg4 matrix) (arg5 rgba))
(rlet ((acc :class vf)
(vf0 :class vf)
(vf1 :class vf)
(vf2 :class vf)
(vf3 :class vf)
(vf4 :class vf)
(vf5 :class vf)
)
(init-vf0-vector)
(when arg0
(.lvf vf5 (&-> arg2 quad))
(.lvf vf1 (&-> arg4 vector 0 quad))
(.lvf vf2 (&-> arg4 vector 1 quad))
(.lvf vf3 (&-> arg4 vector 2 quad))
(.lvf vf4 (&-> arg4 vector 3 quad))
(.mul.w.vf acc vf4 vf0)
(.add.mul.x.vf acc vf1 vf5 acc)
(.add.mul.y.vf acc vf2 vf5 acc)
(.add.mul.z.vf vf5 vf3 vf5 acc)
(let ((a2-1 (new 'stack-no-clear 'vector)))
(.svf (&-> a2-1 quad) vf5)
(add-debug-sphere arg0 arg1 a2-1 arg3 arg5)
)
)
#f
)
)
(defun-debug add-debug-sphere ((arg0 symbol) (arg1 bucket-id) (arg2 vector) (arg3 float) (arg4 rgba))
(if arg0
(add-debug-sphere-from-table arg1 arg2 arg3 arg4)
)
#f
)
(defun-debug add-debug-text-sphere ((arg0 symbol) (arg1 bucket-id) (arg2 vector) (arg3 float) (arg4 string) (arg5 rgba))
(add-debug-sphere arg0 arg1 arg2 arg3 arg5)
(add-debug-text-3d arg0 arg1 arg4 arg2 (new 'static 'rgba) (the-as vector2h #f))
#f
)
(defun-debug add-debug-spheres ((arg0 symbol) (arg1 bucket-id) (arg2 (inline-array vector)) (arg3 int) (arg4 rgba))
(when arg0
(let ((s4-0 (-> arg2 0)))
(countdown (s3-0 arg3)
(add-debug-sphere #t arg1 s4-0 (-> s4-0 w) arg4)
(&+! s4-0 16)
)
)
)
#f
)
(defun-debug add-debug-circle ((arg0 symbol) (arg1 bucket-id) (arg2 vector) (arg3 float) (arg4 rgba) (arg5 matrix))
""
"note: you may pass #f for orientation"
(if (not arg0)
(return #f)
)
(let ((f30-0 0.0)
(s1-0 (new-stack-vector0))
(s0-0 (new-stack-vector0))
)
(dotimes (sv-48 12)
(set-vector! s1-0 (* arg3 (cos f30-0))
0.0
(* arg3 (sin f30-0))
1.0)
(set! f30-0 (+ 5461.3335 f30-0))
(set-vector! s0-0 (* arg3 (cos f30-0))
0.0
(* arg3 (sin f30-0))
1.0)
(when arg5
(vector-matrix*! s1-0 s1-0 arg5)
(vector-matrix*! s0-0 s0-0 arg5)
)
(vector+! s1-0 s1-0 arg2)
(vector+! s0-0 s0-0 arg2)
(add-debug-line #t arg1 s1-0 s0-0 arg4 #f (the-as rgba -1))
)
)
#f
)
(defun-debug add-debug-vector ((arg0 symbol) (arg1 bucket-id) (arg2 vector) (arg3 vector) (arg4 meters) (arg5 rgba))
(if (not arg0)
(return #f)
)
(let ((v1-2 (new-stack-vector0)))
(set! (-> v1-2 x) (+ (-> arg2 x) (* (-> arg3 x) arg4)))
(set! (-> v1-2 y) (+ (-> arg2 y) (* (-> arg3 y) arg4)))
(set! (-> v1-2 z) (+ (-> arg2 z) (* (-> arg3 z) arg4)))
(add-debug-line #t arg1 arg2 v1-2 arg5 #f (the-as rgba -1))
)
#f
)
(defun-debug add-debug-matrix ((arg0 symbol) (arg1 bucket-id) (arg2 matrix))
(add-debug-vector arg0 arg1 (-> arg2 vector 3) (-> arg2 vector 0) (meters 2) (new 'static 'rgba :r #xff :a #x80))
(add-debug-vector arg0 arg1 (-> arg2 vector 3) (-> arg2 vector 1) (meters 2) (new 'static 'rgba :g #xff :a #x80))
(add-debug-vector arg0 arg1 (-> arg2 vector 3) (-> arg2 vector 2) (meters 2) (new 'static 'rgba :b #xff :a #x80))
arg2
)
(defun-debug add-debug-rot-matrix ((arg0 symbol) (arg1 bucket-id) (arg2 matrix) (arg3 vector))
(add-debug-vector arg0 arg1 arg3 (-> arg2 vector 0) (meters 2) (new 'static 'rgba :r #xff :a #x80))
(add-debug-vector arg0 arg1 arg3 (-> arg2 vector 1) (meters 2) (new 'static 'rgba :g #xff :a #x80))
(add-debug-vector arg0 arg1 arg3 (-> arg2 vector 2) (meters 2) (new 'static 'rgba :b #xff :a #x80))
arg2
)
(defun-debug add-debug-yrot-vector ((arg0 symbol) (arg1 bucket-id) (arg2 vector) (arg3 float) (arg4 float) (arg5 rgba))
(let ((sv-32 arg3)
(s0-0 arg4)
(s3-0 arg5)
)
(if (not arg0)
(return #f)
)
(let ((s1-0 (new-stack-vector0)))
(set-vector! s1-0 (+ (-> arg2 x) (* (sin sv-32) s0-0))
(-> arg2 y)
(+ (-> arg2 z) (* (cos sv-32) s0-0))
1.0
)
(add-debug-line arg0 arg1 s1-0 arg2 s3-0 #f (the-as rgba -1))
)
)
#f
)
(defun-debug add-debug-arc ((arg0 symbol) (arg1 bucket-id) (arg2 vector) (arg3 float) (arg4 float) (arg5 float) (arg6 rgba) (arg7 matrix))
""
"note: you may pass #f for orientation"
(if (not arg0)
(return #f)
)
(let ((f30-0 arg3)
(sv-48 (new-stack-vector0))
(sv-64 (new-stack-vector0))
)
(dotimes (sv-80 12)
(set-vector! sv-48 (* arg5 (sin f30-0))
0.0
(* arg5 (cos f30-0))
1.0)
(+! f30-0 (the float (/ (the int (- arg4 arg3)) 12)))
(set-vector! sv-64 (* arg5 (sin f30-0))
0.0
(* arg5 (cos f30-0))
1.0)
(when arg7
(vector-matrix*! sv-48 sv-48 arg7)
(vector-matrix*! sv-64 sv-64 arg7)
)
(vector+! sv-48 sv-48 arg2)
(vector+! sv-64 sv-64 arg2)
(add-debug-line #t arg1 sv-48 sv-64 arg6 #f (the-as rgba -1))
(cond
((zero? sv-80)
(add-debug-line #t arg1 sv-48 arg2 arg6 #f (the-as rgba -1))
)
((= sv-80 11)
(add-debug-line #t arg1 sv-64 arg2 arg6 #f (the-as rgba -1))
)
)
)
)
#f
)
(defun-debug add-debug-curve ((arg0 symbol) (arg1 bucket-id) (arg2 pointer) (arg3 int) (arg4 (inline-array vector)) (arg5 int) (arg6 rgba))
(if (not arg0)
(return #f)
)
(let ((s0-0 (new-stack-vector0))
(sv-48 (new-stack-vector0))
(sv-64 (* arg3 4))
)
(curve-evaluate! sv-48 (-> arg4 0 x) arg2 arg3 arg4 arg5)
(let ((sv-80 0))
(while (< sv-80 sv-64)
(set! (-> s0-0 quad) (-> sv-48 quad))
(curve-evaluate! sv-48 (/ (the float (+ sv-80 1)) (the float sv-64)) arg2 arg3 arg4 arg5)
(add-debug-line #t arg1 s0-0 sv-48 arg6 #f (the-as rgba -1))
(set! sv-80 (+ sv-80 1))
)
)
)
#f
)
(defun-debug add-debug-curve2 ((arg0 symbol) (arg1 bucket-id) (arg2 curve) (arg3 rgba) (arg4 symbol))
(if arg0
(add-debug-curve #t arg1
(-> arg2 cverts)
(-> arg2 num-cverts)
(-> arg2 knots)
(-> arg2 num-knots)
arg3
)
)
#f
)
(defun-debug add-debug-points ((arg0 symbol) (arg1 bucket-id) (arg2 (inline-array vector)) (arg3 int) (arg4 rgba) (arg5 float) (arg6 int))
(when arg0
(dotimes (s0-0 arg3)
(let ((sv-96 (new 'stack-no-clear 'vector)))
(set! (-> sv-96 quad) (the-as uint128 0))
(set! (-> sv-96 quad) (-> arg2 s0-0 quad))
(if (!= arg5 0.0)
(set! (-> sv-96 y) arg5)
)
(add-debug-text-3d #t arg1 (string-format "~d" s0-0) sv-96 (the rgba 1) (the vector2h #f))
(add-debug-x #t arg1 sv-96 (if (= s0-0 arg6)
(static-rgba #xff #xff #xff #x80)
arg4
))
)
)
)
#f
)
(defun-debug debug-percent-bar ((arg0 symbol) (arg1 bucket-id) (arg2 int) (arg3 int) (arg4 float) (arg5 rgba))
(if (not arg0)
(return #f)
)
(with-dma-buffer-add-bucket ((s0-0 (current-display-frame debug-buf)) (current-display-frame bucket-group) arg1)
(draw-sprite2d-xy s0-0 arg2 arg3 255 14 (new 'static 'rgba :a #x40))
(draw-sprite2d-xy s0-0 arg2 (+ arg3 2) (the int (* 255.0 arg4)) 10 arg5)
)
#f
)
;; this function is broken and unused
;; TODO fix it (expand array)
(defun-debug debug-pad-display ((arg0 cpad-info))
(let
((gp-0
(new 'static 'inline-array vector 32 ;; was originally 8, which is too small and would cause memory corruption
(new 'static 'vector)
(new 'static 'vector)
(new 'static 'vector)
(new 'static 'vector)
(new 'static 'vector)
(new 'static 'vector)
(new 'static 'vector)
(new 'static 'vector)
)
)
)
(let ((v1-0 31))
(while (nonzero? v1-0)
(+! v1-0 -1)
(set! (-> gp-0 (+ v1-0 1) quad) (-> gp-0 v1-0 quad))
)
)
(set! (-> gp-0 0 x) (* (sin (-> arg0 stick0-dir)) (-> arg0 stick0-speed)))
(set! (-> gp-0 0 y) (* (cos (-> arg0 stick0-dir)) (-> arg0 stick0-speed)))
(dotimes (s5-1 32)
(let* ((s3-0 (current-display-frame debug-buf))
(s4-0 (-> s3-0 base))
)
(draw-sprite2d-xy
s3-0
(the int (* 120.0 (-> gp-0 s5-1 x)))
(the int (* 144.0 (-> gp-0 s5-1 y)))
10
10
(new 'static 'rgba :a #x80 :r (- 255 (* 7 s5-1)))
)
(let ((a3-1 (-> s3-0 base)))
(let ((v1-12 (the-as dma-packet (-> s3-0 base))))
(set! (-> v1-12 dma) (new 'static 'dma-tag :id (dma-tag-id next)))
(set! (-> v1-12 vif0) (new 'static 'vif-tag))
(set! (-> v1-12 vif1) (new 'static 'vif-tag))
(set! (-> s3-0 base) (&+ (the-as pointer v1-12) 16))
)
(dma-bucket-insert-tag
(current-display-frame bucket-group)
(bucket-id debug-draw0)
s4-0
(the-as (pointer dma-tag) a3-1)
)
)
)
)
)
#f
)
(defun-debug add-debug-light ((arg0 symbol) (arg1 bucket-id) (arg2 light) (arg3 vector) (arg4 string))
(if (not arg0)
(return #f)
)
(when (!= (-> arg2 levels x) 0.0)
(add-debug-vector arg0 arg1
arg3
(-> arg2 direction)
(meters 3)
(static-rgba #xff #xff #xff #x80)
)
;; this might be wrong
(let ((light-vec-end (vector+*! (new-stack-vector0) arg3 (-> arg2 direction) (* (meters 3) (-> arg2 levels x))))
(light-rgba (new 'static 'rgba :r (the int (* 128.0 (-> arg2 color x)))
:g (the int (* 128.0 (-> arg2 color y)))
:b (the int (* 128.0 (-> arg2 color z)))
:a (the int (* 128.0 (-> arg2 color w)))
))
)
(add-debug-text-sphere arg0 arg1
light-vec-end
(* (meters 0.5) (-> arg2 levels x))
(string-format "~S ~,,2f" arg4 (-> arg2 levels x))
light-rgba
)
)
)
#f
)
(defun-debug add-debug-lights ((arg0 symbol) (arg1 bucket-id) (arg2 (inline-array light)) (arg3 vector))
(if (not arg0)
(return #f)
)
(add-debug-light arg0 arg1 (-> arg2 0) arg3 "dir0")
(add-debug-light arg0 arg1 (-> arg2 1) arg3 "dir1")
(add-debug-light arg0 arg1 (-> arg2 2) arg3 "dir2")
(add-debug-light arg0 arg1 (-> arg2 3) arg3 "ambi")
#f
)
(defun-extern drawable-frag-count drawable int)
(defun-debug drawable-frag-count ((arg0 drawable))
(let ((gp-0 0))
(cond
((not arg0)
)
((type-type? (-> arg0 type) drawable-group)
(dotimes (s4-0 (-> (the drawable-group arg0) length))
(+! gp-0 (drawable-frag-count (-> (the drawable-group arg0) data s4-0)))
)
)
(else
(+! gp-0 1)
)
)
gp-0
)
)
(defmethod inspect debug-vertex-stats ((obj debug-vertex-stats))
(format #t "[~8x] ~A~%" obj (-> obj type))
(format #t "~Tlength: ~D~%" (-> obj length))
(format #t "~Tpos-count: ~D~%" (-> obj pos-count))
(format #t "~Tdata[~D]: @ #x~X~%" (-> obj length) (-> obj vertex))
(dotimes (s5-0 (-> obj length))
(let ((s4-0 (-> obj vertex s5-0)))
(format #t " ~D : trans: ~D ~D ~D ~D" s5-0
(-> s4-0 trans x)
(-> s4-0 trans y)
(-> s4-0 trans z)
(-> s4-0 trans w)
)
(format #t " st: ~D ~D~%" (-> s4-0 st x) (-> s4-0 st y))
(format #t " col: ~X norm: ~D ~D ~D~%"
(-> s4-0 color)
(-> s4-0 normal x)
(-> s4-0 normal y)
(-> s4-0 normal z)
)
)
)
obj
)
(defun-debug history-init ((arg0 pos-history) (arg1 int))
(set! (-> arg0 num-points) arg1)
(set! (-> arg0 points) (the (inline-array vector) #f))
arg0
)
(defun-debug history-draw-and-update ((arg0 pos-history) (arg1 int) (arg2 vector))
(if (and arg1 (not (-> arg0 points)))
(set! (-> arg0 points) (the (inline-array vector) (malloc 'debug (* (-> arg0 num-points) 16))))
)
(when (-> arg0 points)
(set! (-> (-> arg0 points) (-> arg0 h-first) quad) (-> arg2 quad))
(set! (-> arg0 h-first) (+ (-> arg0 h-first) 1))
(when (>= (-> arg0 h-first) (-> arg0 num-points))
(set! (-> arg0 h-first) 0)
)
)
(when arg1
(dotimes (s5-1 (1- (-> arg0 num-points)))
(if (!= (+ s5-1 1) (-> arg0 h-first))
(add-debug-line #t (bucket-id debug-draw1)
(-> arg0 points s5-1)
(-> arg0 points (1+ s5-1))
(static-rgba #x80 #xc0 #x80 #x80) #f (the-as rgba -1))
)
)
)
#f
)
(defun-debug dma-timeout-cam ()
(let ((a0-0 (new-stack-vector0))
(a1-0 (new-stack-matrix0))
)
(set! (-> a0-0 x) -666764.4)
(set! (-> a0-0 y) 21102.984)
(set! (-> a0-0 z) 51613.348)
(set! (-> a0-0 w) 1.0)
(set! (-> a1-0 vector 0 x) -0.911)
(set! (-> a1-0 vector 0 y) 0.0)
(set! (-> a1-0 vector 0 z) 0.4122)
(set! (-> a1-0 vector 0 w) 0.0)
(set! (-> a1-0 vector 1 x) -0.0984)
(set! (-> a1-0 vector 1 y) 0.971)
(set! (-> a1-0 vector 1 z) -0.2174)
(set! (-> a1-0 vector 1 w) 0.0)
(set! (-> a1-0 vector 2 x) -0.4003)
(set! (-> a1-0 vector 2 y) -0.2387)
(set! (-> a1-0 vector 2 z) -0.8847)
(set! (-> a1-0 vector 2 w) 0.0)
(set! (-> a1-0 vector 3 x) 0.0)
(set! (-> a1-0 vector 3 y) 0.0)
(set! (-> a1-0 vector 3 z) 0.0)
(set! (-> a1-0 vector 3 w) 1.0)
(debug-set-camera-pos-rot! a0-0 a1-0)
)
)
(defun-debug display-file-info ()
(when (and *display-file-info* (!= *master-mode* 'menu))
(dotimes (gp-0 (-> *level* length))
(let ((v1-7 (-> *level* level gp-0)))
(when (= (-> v1-7 status) 'active)
(let ((s5-0 (-> v1-7 bsp)))
(format *stdcon* "file name: ~S~%" (-> s5-0 info file-name))
(format *stdcon* "version: ~D.~D~%" (-> s5-0 info major-version) (-> s5-0 info minor-version))
(format *stdcon* "maya file: ~S~%" (-> s5-0 info maya-file-name))
(format *stdcon* "mdb file: ~S~%" (-> s5-0 info mdb-file-name))
(format *stdcon* "~S" (-> s5-0 info tool-debug))
)
)
)
)
)
0
)