[jak3] More headers, up to load-dgo (#3363)

path-h, sparticle-h, load-dgo, nav-control-h, nav-mesh-h, rigid-body-h,
actor-hash-h, spatial-hash-h
This commit is contained in:
water111
2024-02-03 15:03:10 -05:00
committed by GitHub
parent af2fa6acbc
commit 8b1c7759ea
25 changed files with 5273 additions and 252 deletions
File diff suppressed because it is too large Load Diff
@@ -285,7 +285,6 @@
"(method 46 nav-mesh)": [2, 3],
"(method 32 nav-mesh)": [1, 2],
"(method 33 nav-mesh)": [1, 2],
"(method 42 nav-mesh)": [1, 2, 3, 7],
"point-poly-distance-min": [0, 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12],
"(method 34 nav-mesh)": [1, 2, 3, 7],
"(method 35 nav-mesh)": [2, 4],
@@ -473,7 +472,6 @@
"(method 19 nav-control)": [9, 10],
"(method 19 nav-mesh)": [7],
"(method 18 nav-mesh)": [9],
"(method 40 nav-state)": [1, 2],
"(method 45 nav-mesh)": [5, 6],
"(method 43 nav-mesh)": [0, 1, 2, 12, 13, 14, 15, 16, 17, 18, 19, 20],
@@ -12,5 +12,8 @@
"rotate-vector-to-vector": [[16, "quaternion"]],
"init-for-transform": [[192, "vector"]],
"show-mc-info": [[16, "mc-slot-info"]],
"joint-mod-blend-world-callback": [[16, "joint-mod-blend-world-work"]]
"joint-mod-blend-world-callback": [[16, "joint-mod-blend-world-work"]],
"(method 42 nav-mesh)": [[16, "vector"], [32, "vector"]],
"(method 44 nav-mesh)": [[16, "vector"], [32, "vector"]]
}
@@ -348,5 +348,30 @@
[[27, 29], "a1", "qword"],
[[35, 37], "a3", "qword"],
[[35, 37], "a2", "qword"]
],
"(method 3 sparticle-cpuinfo)": [[110, "f0", "float"]],
"(method 0 path-control)": [["_stack_", 16, "res-tag"]],
"str-load": [[[18, 44], "s2", "load-chunk-msg"]],
"str-load-status": [
[[18, 22], "v1", "load-chunk-msg"],
[26, "v1", "load-chunk-msg"]
],
"str-play-async": [[[7, 40], "s2", "play-chunk-msg"]],
"str-play-stop": [[[7, 36], "s4", "play-chunk-msg"]],
"str-play-queue": [[[7, 98], "s4", "play-chunk-msg"]],
"str-ambient-play": [[[7, 20], "s5", "play-chunk-msg"]],
"str-ambient-stop": [[[7, 20], "s5", "play-chunk-msg"]],
"dgo-load-begin": [[[19, 43], "s1", "load-dgo-msg"]],
"dgo-load-get-next": [[[14, 31], "v1", "load-dgo-msg"]],
"dgo-load-continue": [[[5, 23], "gp", "load-dgo-msg"]],
"dgo-load-cancel": [[[3, 8], "v0", "sound-rpc-cancel-dgo"]],
"dgo-load-link": [
[7, "s4", "uint"],
[17, "s4", "uint"],
[55, "s4", "uint"],
[27, "s4", "uint"],
[37, "s4", "uint"],
[60, "s4", "pointer"]
]
}
@@ -847,5 +847,137 @@
},
"free-eye-index": {
"args": ["idx"]
},
"(method 0 rpc-buffer)": {
"args": [
"allocation",
"type-to-make",
"elt-size",
"elt-count"
]
},
"(method 0 rpc-buffer-pair)": {
"args": [
"allocation",
"type-to-make",
"elt-size",
"elt-count",
"rpc-port"
]
},
"(method 9 rpc-buffer-pair)": {
"args": [
"this",
"fno",
"recv-buffer",
"recv-buffer-size"
]
},
"(method 12 rpc-buffer-pair)": {
"args": [
"this",
"print-stall-warning"
]
},
"(method 0 path-control)": {
"args": ["allocation", "type-to-make", "proc", "lump-name", "lump-time", "lump-actor", "must-exist"]
},
"(method 0 curve-control)": {
"args": ["allocation", "type-to-make", "proc", "lump-name", "lump-time", "lump-actor", "must-exist"]
},
"point-poly-intersection?": {
"args": [
"mesh",
"pt",
"num-verts",
"verts"
]
},
"str-load": {
"args": [
"name",
"chunk-idx",
"dest-addr",
"max-len"
]
},
"str-load-status": {
"args": [
"maxlen-out"
]
},
"str-play-async": {
"args": [
"name",
"id",
"chunk-idx",
"group"
]
},
"str-play-stop": {
"args": [
"name",
"id"
]
},
"str-play-queue": {
"args": [
"name0",
"name1",
"name2",
"name3",
"ids",
"mask"
]
},
"str-ambient-play": {
"args": [
"name"
]
},
"str-ambient-stop": {
"args": [
"name"
]
},
"dgo-load-begin": {
"args": [
"name",
"buffer1",
"buffer2",
"buffer-top"
]
},
"dgo-load-get-next": {
"args": [
"done-out"
]
},
"dgo-load-continue": {
"args": [
"buffer1",
"buffer2",
"buffer-top"
]
},
"find-temp-buffer": {
"args": [
"size"
]
},
"dgo-load-link": {
"args": [
"object-file",
"heap",
"end-of-buffer",
"print-login",
"loaded-from-top"
]
},
"destroy-mem": {
"args": [
"start",
"end"
]
}
}
@@ -6,6 +6,7 @@
;; dgos: GAME
(define-extern math-camera-matrix (function matrix))
(define-extern camera-pos (function vector))
;; DECOMP BEGINS
+1 -1
View File
@@ -5,7 +5,7 @@
;; name in dgo: game-h
;; dgos: GAME
(declare-type nav-control basic)
(declare-type nav-control structure)
(declare-type path-control basic)
(declare-type vol-control basic)
(declare-type fact-info basic)
+225
View File
@@ -5,5 +5,230 @@
;; name in dgo: path-h
;; dgos: GAME
(defenum path-control-flag
:bitfield #t
:type uint32
(display 0)
(draw-line 1) ;; TODO - only seen it used to control debug drawing so far
(draw-point 2) ;; TODO - only seen it used to control debug drawing so far
(draw-text 3) ;; TODO - only seen it used to control debug drawing so far
(not-found 4)
)
;; DECOMP BEGINS
(deftype path-control (basic)
"The path-control is a reference a path data, which is just a list of points.
Although it contains a `curve`, the knot part is not populated, so it's just treated as
a bunch of line segments from the control points.
The child class curve-control does fill out the knot data and is a proper b-spline.
These path-controls are typically allocated on a process heap."
((flags path-control-flag)
(name symbol)
(process process-drawable)
(curve curve :inline)
(num-cverts int32 :overlay-at (-> curve num-cverts))
(cverts uint32 :overlay-at (-> curve cverts))
)
(:methods
(new (symbol type process symbol float entity symbol) _type_)
(path-control-method-9 () none)
(path-control-method-10 () none)
(path-control-method-11 () none)
(path-control-method-12 () none)
(path-control-method-13 () none)
(path-control-method-14 () none)
(path-control-method-15 () none)
(path-control-method-16 () none)
(get-num-segments (_type_) float)
(path-control-method-18 () none)
(get-num-verts (_type_) int)
(segement-duration->path-duration (_type_ float) float)
(path-duration->segment-duration (_type_ float) float)
(path-control-method-22 () none)
(path-control-method-23 () none)
(path-control-method-24 () none)
(path-control-method-25 () none)
(path-control-method-26 () none)
(path-control-method-27 () none)
(path-control-method-28 () none)
(path-control-method-29 () none)
(should-display-marks? (_type_) symbol)
(path-control-method-31 () none)
)
)
(set! (-> path-control method-table 9) nothing)
(deftype curve-control (path-control)
"A curve-control is like a path control, but it has both control points and knot points."
()
(:methods
(new (symbol type process symbol float) _type_)
)
)
;; ERROR: Stack slot load at 32 mismatch: defined as size 4, got size 16
;; ERROR: Stack slot load at 32 mismatch: defined as size 4, got size 16
;; WARN: Return type mismatch object vs path-control.
(defmethod new path-control ((allocation symbol)
(type-to-make type)
(proc process)
(lump-name symbol)
(lump-time float)
(lump-actor entity)
(must-exist symbol)
)
"Allocate a new path-control, set up the curve to point to the specified lump data."
(local-vars (v0-3 object) (sv-16 res-tag) (sv-32 float))
(set! sv-32 lump-time)
(let ((s0-0 lump-actor)
(s1-0 must-exist)
)
(if (not s0-0)
(set! s0-0 (-> proc entity))
)
(when (= lump-name 'path)
(let ((v0-0 (entity-actor-lookup s0-0 'path-actor 0)))
(if v0-0
(set! s0-0 v0-0)
)
)
)
(let ((s2-0 (the-as object 0)))
(set! sv-16 (new 'static 'res-tag))
(let* ((t9-1 (method-of-type res-lump get-property-data))
(a1-2 lump-name)
(a2-2 'interp)
(t0-1 #f)
(t1-1 (the-as (pointer res-tag) (& sv-16)))
(t2-1 *res-static-buf*)
(s0-1 (t9-1 s0-0 a1-2 a2-2 sv-32 (the-as pointer t0-1) t1-1 t2-1))
)
(cond
(s0-1
(set! s2-0 (object-new allocation type-to-make (the-as int (-> type-to-make size))))
(set! v0-3 (cond
((nonzero? (the-as path-control s2-0))
(set! (-> (the-as path-control s2-0) process) (the-as process-drawable proc))
(set! (-> (the-as path-control s2-0) name) lump-name)
(set! (-> (the-as path-control s2-0) curve cverts) (the-as (inline-array vector) s0-1))
(set! v0-3 (-> sv-16 elt-count))
(set! (-> (the-as path-control s2-0) curve num-cverts) (the-as int v0-3))
v0-3
)
(else
(go process-drawable-art-error "memory")
)
)
)
)
(else
(when (not s1-0)
(set! s2-0 (object-new allocation type-to-make (the-as int (-> type-to-make size))))
(cond
((nonzero? (the-as path-control s2-0))
(logior! (-> (the-as path-control s2-0) flags) (path-control-flag not-found))
(set! (-> (the-as path-control s2-0) process) (the-as process-drawable proc))
(set! (-> (the-as path-control s2-0) name) lump-name)
(set! (-> (the-as path-control s2-0) curve cverts) (the-as (inline-array vector) #f))
(set! (-> (the-as path-control s2-0) curve num-cverts) 0)
0
)
(else
(go process-drawable-art-error "memory")
)
)
)
)
)
)
(the-as path-control s2-0)
)
)
)
(defmethod should-display-marks? ((this path-control))
(and *display-path-marks* (logtest? (-> this flags) (path-control-flag display)))
)
(defmethod get-num-segments ((this path-control))
(the float (+ (-> this curve num-cverts) -1))
)
(defmethod get-num-verts ((this path-control))
(-> this curve num-cverts)
)
(defmethod segement-duration->path-duration ((this path-control) (arg0 float))
(* arg0 (get-num-segments this))
)
(defmethod path-duration->segment-duration ((this path-control) (arg0 float))
(/ arg0 (get-num-segments this))
)
(defmethod new curve-control ((allocation symbol) (type-to-make type) (proc process) (lump-name symbol) (lump-time float))
(let ((gp-0 (object-new allocation type-to-make (the-as int (-> type-to-make size)))))
(set! (-> gp-0 process) (the-as process-drawable proc))
(set! (-> gp-0 name) lump-name)
(let* ((s3-1 (-> proc entity))
(v1-2 lump-name)
(s2-0
(cond
((= v1-2 'path)
'path-k
)
((= v1-2 'flow)
'flow-k
)
((= v1-2 'intro)
'intro-k
)
((= v1-2 'pathshort)
'pathshort-k
)
((= v1-2 'patha)
'patha-k
)
((= v1-2 'pathb)
'pathb-k
)
(else
(format
0
"WARNING: curve-control is being asked to look up an unknown name '~A', it will have to do so by string.~%"
lump-name
)
(let ((s2-1 string->symbol))
(format (clear *temp-string*) "~A-k" lump-name)
(s2-1 *temp-string*)
)
)
)
)
)
(let ((v1-3 (entity-actor-lookup s3-1 'path-actor 0)))
(if v1-3
(set! s3-1 v1-3)
)
)
(when (not (get-curve-data! s3-1 (-> gp-0 curve) lump-name s2-0 lump-time))
(cond
((> (-> gp-0 curve num-cverts) 0)
(set! (-> gp-0 type) path-control)
)
(else
(logior! (-> gp-0 flags) (path-control-flag not-found))
(set! (-> gp-0 curve cverts) (the-as (inline-array vector) #f))
(set! (-> gp-0 curve num-cverts) 0)
0
)
)
)
)
gp-0
)
)
@@ -5,5 +5,88 @@
;; name in dgo: sparticle-h
;; dgos: GAME
(declare-type sprite-vec-data-2d structure)
(defenum sp-cpuinfo-flag
:bitfield #t
:type uint32
)
;; DECOMP BEGINS
(define *sp-60-hz* #t)
(deftype sparticle-cpuinfo (structure)
"The per-particle information. This stays on the CPU, and isn't uploaded to the VU."
((sprite sprite-vec-data-2d)
(adgif adgif-shader)
(radius float)
(omega float)
(vel-sxvel vector :inline)
(rot-syvel vector :inline)
(fade rgbaf :inline)
(acc vector :inline)
(rotvel3d quaternion :inline)
(vel vector3s :inline :overlay-at (-> vel-sxvel data 0))
(accel vector3s :inline :overlay-at (-> acc data 0))
(scalevelx float :overlay-at (-> vel-sxvel data 3))
(scalevely float :overlay-at (-> rot-syvel data 3))
(friction float)
(timer int32)
(flags sp-cpuinfo-flag)
(user-int32 int32)
(user-uint32 uint32 :overlay-at user-int32)
(user-float float :overlay-at user-int32)
(user-pntr uint32 :overlay-at user-int32)
(user-object basic :overlay-at user-int32)
(user-sprite sprite-vec-data-2d :overlay-at user-int32)
(sp-func (function sparticle-system sparticle-cpuinfo sprite-vec-data-3d uint none))
(next-time uint32)
(next-launcher basic)
(cache-alpha float)
(valid uint8)
(clock-index uint8)
(user1-int16 uint16)
(key sparticle-launch-control)
(binding sparticle-launch-state)
(data uint32 1 :overlay-at omega)
(datab int8 4 :overlay-at omega)
(dataf float 1 :overlay-at omega)
(datac uint8 1 :overlay-at omega)
)
)
(deftype sparticle-launchinfo (structure)
"Settings for launching a particle. These are a temporary thing consumed by the assembly particle code, and modified by particle callbacks."
((launchrot vector :inline)
(conerot vector :inline)
(rotate-x float)
(rotate-y float)
(rotate-z float)
(coneradius float)
(rotate vector :inline :overlay-at rotate-x)
(scale-x float)
(scale-y float)
(scale-z float)
(dummy float)
(scale vector :inline :overlay-at scale-x)
(data uint8 1 :overlay-at (-> launchrot data 0))
)
)
(deftype sparticle-system (basic)
"An entire particle 'system', which is a pipeline for spawning, updating, and generating sprite-renderer DMA data.
There are separate systems for different modes of sprite rendering: 2D/billboard, full 3D, and screen-space (HUD)"
((blocks int32 2)
(length int32 2)
(num-alloc int32 2)
(is-3d basic)
(flags uint32)
(alloc-table (pointer uint64))
(cpuinfo-table (inline-array sparticle-cpuinfo))
(vecdata-table pointer)
(adgifdata-table (inline-array adgif-shader))
)
)
+377
View File
@@ -5,5 +5,382 @@
;; name in dgo: load-dgo
;; dgos: GAME
(defenum load-msg-result
:type uint16
:bitfield #f
(done 0)
(error 1)
(more 2)
(aborted 3)
(invalid 666)
)
(define-extern *load-dgo-rpc* rpc-buffer-pair)
(define-extern *load-str-rpc* rpc-buffer-pair)
(define-extern *play-str-rpc* rpc-buffer-pair)
(define-extern *load-str-lock* symbol)
(define-extern *que-str-lock* symbol)
(define-extern *dgo-name* string)
;; DECOMP BEGINS
(deftype load-dgo-msg (structure)
"IOP RPC message for loading a dgo."
((rsvd uint16)
(result load-msg-result)
(b1 pointer)
(b2 pointer)
(bt pointer)
(name uint128)
(address uint32 :overlay-at b1)
(id uint128)
(pad uint32 7)
)
)
(deftype load-chunk-msg (structure)
"IOP RPC message for loading a chunk of a chunked animation"
((rsvd uint16)
(result load-msg-result)
(address pointer)
(section uint32)
(maxlen uint32)
(dummy uint32 4)
(basename sound-stream-name :inline)
)
)
(deftype play-chunk-msg (structure)
"IOP RPC message for playing some streamed audio."
((rsvd uint16)
(result uint16)
(address pointer)
(section uint32)
(volume int32 :overlay-at section)
(maxlen uint32)
(group uint8 :overlay-at maxlen)
(id uint32 4)
(basename sound-stream-name 4 :inline)
)
)
(when (zero? *load-dgo-rpc*)
(set! *load-dgo-rpc* (new 'global 'rpc-buffer-pair (the-as uint 64) (the-as uint 1) 3))
(set! *load-str-rpc* (new 'global 'rpc-buffer-pair (the-as uint 80) (the-as uint 1) 4))
(set! *play-str-rpc* (new 'global 'rpc-buffer-pair (the-as uint 256) (the-as uint 4) 5))
(set! *load-str-lock* #f)
(set! *que-str-lock* #f)
(set! *dgo-name* (new 'global 'string 64 (the-as string #f)))
)
(defun str-load ((name string) (chunk-idx int) (dest-addr pointer) (max-len int))
"Send a message to the IOP to start loading a chunk of a .STR file to the EE."
(if (or (check-busy *load-str-rpc*) *load-str-lock*)
(return #f)
)
(let ((s2-0 (the-as load-chunk-msg (add-element *load-str-rpc*))))
(set! (-> s2-0 result) (load-msg-result invalid))
(set! (-> s2-0 address) dest-addr)
(set! (-> s2-0 section) (the-as uint chunk-idx))
(set! (-> s2-0 maxlen) (the-as uint max-len))
(copyn-charp<-string (the-as (pointer uint8) (-> s2-0 basename)) name 48)
(call *load-str-rpc* (the-as uint 0) (the-as pointer s2-0) (the-as uint 32))
)
(set! *load-str-lock* #t)
(set! *que-str-lock* #t)
#t
)
(defun str-load-status ((maxlen-out (pointer int32)))
"Get the status of the most recent load.
Return 'busy if in progress, 'error if failed, or 'complete.
If 'complete, returns the maxlen value from the IOP."
(if (check-busy *load-str-rpc*)
(return 'busy)
)
(set! *load-str-lock* #f)
(set! *que-str-lock* #t)
(let ((v1-7 (the-as load-chunk-msg (pop-last-received *load-str-rpc*))))
(if (= (-> v1-7 result) (load-msg-result error))
(return 'error)
)
(set! (-> maxlen-out 0) (the-as int (-> v1-7 maxlen)))
)
'complete
)
(defun str-load-cancel ()
"Cancel a streaming load. Note that this does not actually stop the transfer, so the IOP may continue writing to the buffer."
(set! *load-str-lock* #f)
(set! *que-str-lock* #t)
0
(none)
)
(defun str-play-async ((name string) (id sound-id) (chunk-idx int) (group int))
"Start playing a streaming audio."
(set! *que-str-lock* #t)
(let ((s2-0 (the-as play-chunk-msg (add-element *play-str-rpc*))))
(copyn-charp<-string (the-as (pointer uint8) (-> s2-0 basename)) name 48)
(copyn-charp<-string (the-as (pointer uint8) (-> s2-0 basename 1)) "" 48)
(copyn-charp<-string (the-as (pointer uint8) (-> s2-0 basename 2)) "" 48)
(copyn-charp<-string (the-as (pointer uint8) (-> s2-0 basename 3)) "" 48)
(set! (-> s2-0 id 0) (the-as uint id))
(set! (-> s2-0 id 1) (the-as uint 0))
(set! (-> s2-0 id 2) (the-as uint 0))
(set! (-> s2-0 id 3) (the-as uint 0))
(set! (-> s2-0 section) (the-as uint chunk-idx))
(set! (-> s2-0 maxlen) (the-as uint 0))
(set! (-> s2-0 group) (the-as uint group))
(set! (-> s2-0 result) (the-as uint 0))
)
0
0
(none)
)
(defun str-play-stop ((name string) (id sound-id))
"Stop playing streaming audio."
(set! *que-str-lock* #t)
(let ((s4-0 (the-as play-chunk-msg (add-element *play-str-rpc*))))
(copyn-charp<-string (the-as (pointer uint8) (-> s4-0 basename)) name 48)
(copyn-charp<-string (the-as (pointer uint8) (-> s4-0 basename 1)) "" 48)
(copyn-charp<-string (the-as (pointer uint8) (-> s4-0 basename 2)) "" 48)
(copyn-charp<-string (the-as (pointer uint8) (-> s4-0 basename 3)) "" 48)
(set! (-> s4-0 id 0) (the-as uint id))
(set! (-> s4-0 id 1) (the-as uint 0))
(set! (-> s4-0 id 2) (the-as uint 0))
(set! (-> s4-0 id 3) (the-as uint 0))
(set! (-> s4-0 result) (the-as uint 1))
)
0
(none)
)
(defun str-play-queue ((name0 string) (name1 string) (name2 string) (name3 string) (ids (pointer uint32)) (mask pointer))
"Queue up streaming data, allowing it to start playing without delay."
(when (and (not (check-busy *play-str-rpc*)) (not *que-str-lock*))
(let ((s4-0 (the-as play-chunk-msg (add-element *play-str-rpc*))))
(if name0
(copyn-charp<-string (the-as (pointer uint8) (-> s4-0 basename)) name0 48)
(copyn-charp<-string (the-as (pointer uint8) (-> s4-0 basename)) "" 48)
)
(if name1
(copyn-charp<-string (the-as (pointer uint8) (-> s4-0 basename 1)) name1 48)
(copyn-charp<-string (the-as (pointer uint8) (-> s4-0 basename 1)) "" 48)
)
(if name2
(copyn-charp<-string (the-as (pointer uint8) (-> s4-0 basename 2)) name2 48)
(copyn-charp<-string (the-as (pointer uint8) (-> s4-0 basename 2)) "" 48)
)
(if name3
(copyn-charp<-string (the-as (pointer uint8) (-> s4-0 basename 3)) name3 48)
(copyn-charp<-string (the-as (pointer uint8) (-> s4-0 basename 3)) "" 48)
)
(dotimes (v1-14 4)
(set! (-> s4-0 id v1-14) (-> ids v1-14))
)
(set! (-> s4-0 address) mask)
(set! (-> s4-0 result) (the-as uint 2))
)
)
(set! *que-str-lock* #f)
0
(none)
)
(defun str-ambient-play ((name string))
"Start playing ambient (unused?)."
(set! *que-str-lock* #t)
(let ((s5-0 (the-as play-chunk-msg (add-element *play-str-rpc*))))
(set! (-> s5-0 basename 0 name 0) (the-as uint 36))
(copyn-charp<-string (&-> s5-0 basename 0 name 1) name 48)
(set! (-> s5-0 result) (the-as uint 0))
)
0
0
(none)
)
(defun str-ambient-stop ((name string))
"Stop playing ambient (unused?)."
(set! *que-str-lock* #t)
(let ((s5-0 (the-as play-chunk-msg (add-element *play-str-rpc*))))
(set! (-> s5-0 basename 0 name 0) (the-as uint 36))
(copyn-charp<-string (&-> s5-0 basename 0 name 1) name 48)
(set! (-> s5-0 result) (the-as uint 1))
)
0
(none)
)
(defun str-play-kick ()
"Do an empty RPC on play so the IOP code runs and can update buffers."
(cond
((check-busy *play-str-rpc*)
)
(else
(call *play-str-rpc* (the-as uint 0) (the-as pointer 0) (the-as uint 0))
)
)
0
(none)
)
(define *dgo-time* (the-as time-frame 0))
(defun dgo-load-begin ((name string) (buffer1 uint128) (buffer2 pointer) (buffer-top pointer) (arg4 pointer))
"Start a DGO load!"
(set! *dgo-time* (-> *display* real-clock integral-frame-counter))
(format 0 "Starting level load clock~%")
(sync *load-dgo-rpc* #t)
(let ((s1-0 (the-as load-dgo-msg (add-element *load-dgo-rpc*))))
(set! (-> s1-0 result) (load-msg-result invalid))
(set! (-> s1-0 b1) buffer2)
(set! (-> s1-0 b2) buffer-top)
(set! (-> s1-0 bt) arg4)
(set! (-> s1-0 name) (string->sound-name name))
(set! (-> s1-0 id) buffer1)
(call *load-dgo-rpc* (the-as uint 0) (the-as pointer s1-0) (the-as uint 32))
s1-0
)
)
(defun dgo-load-get-next ((done-out (pointer symbol)))
"Get the address of the most recently loaded object. #f is there is none. Returns if this is the last by arg0."
(set! (-> done-out 0) #f)
(let ((gp-0 (the-as pointer #f)))
(when (not (check-busy *load-dgo-rpc*))
(let ((v1-4 (the-as load-dgo-msg (pop-last-received *load-dgo-rpc*))))
(when v1-4
(when (or (= (-> v1-4 result) (load-msg-result done)) (= (-> v1-4 result) (load-msg-result more)))
(set! gp-0 (-> v1-4 b1))
(set! (-> done-out 0) #t)
)
(if (= (-> v1-4 result) (load-msg-result more))
(set! (-> done-out 0) #f)
)
(if (= (-> v1-4 result) (load-msg-result done))
(format
0
"Elapsed time for level = ~Fs~%"
(* 0.016666668 (the float (- (-> *display* real-clock integral-frame-counter) *dgo-time*)))
)
)
)
)
)
gp-0
)
)
(defun dgo-load-continue ((buffer1 pointer) (buffer2 pointer) (buffer-top pointer))
"Inform the IOP that it is safe to start loading the next object."
(let ((gp-0 (the-as load-dgo-msg (add-element *load-dgo-rpc*))))
(set! (-> gp-0 result) (load-msg-result invalid))
(set! (-> gp-0 b1) buffer1)
(set! (-> gp-0 b2) buffer2)
(set! (-> gp-0 bt) buffer-top)
(set! (-> gp-0 name) (the-as uint128 0))
(call *load-dgo-rpc* (the-as uint 1) (the-as pointer gp-0) (the-as uint 32))
gp-0
)
)
(defun dgo-load-cancel ((arg0 int))
"Abort a DGO load."
(let ((v1-0 (the-as sound-rpc-cancel-dgo (get-sound-buffer-entry))))
(set! (-> v1-0 command) (the-as uint 49))
(set! (-> v1-0 id) (the-as uint arg0))
)
0
(none)
)
(defun find-temp-buffer ((size int))
"Unused function to find some temporary leftover space in DMA buffer.
Unused since jak 1, and checks the same buffer twice??"
(let ((gp-0 (+ (/ size 16) 2)))
(cond
((< (the-as uint gp-0)
(the-as uint (dma-buffer-free (-> *display* frames (-> *display* on-screen) global-buf)))
)
(logand -16 (&+ (-> *display* frames (-> *display* on-screen) global-buf base) 15))
)
((< (the-as uint gp-0)
(the-as uint (dma-buffer-free (-> *display* frames (-> *display* on-screen) global-buf)))
)
(logand -16 (&+ (-> *display* frames (-> *display* on-screen) global-buf base) 15))
)
)
)
)
(defun dgo-load-link ((object-file dgo-header) (heap kheap) (end-of-buffer uint) (print-login symbol) (loaded-from-top symbol))
"Start the async linker on a GOAL object file that was just loaded."
(let ((s4-0 (the-as object (&+ object-file 64))))
(let ((v1-0 end-of-buffer))
(cond
((>= (the-as int (+ (the-as uint s4-0) (-> object-file length))) (the-as int (-> heap top-base)))
(format
0
"ERROR: -----> dgo file header ~g #x~X has overrun heap #x~X by ~D bytes. This is very bad!~%"
(-> object-file rootname)
object-file
heap
(- (+ (the-as uint s4-0) (-> object-file length)) (the-as uint (-> heap top-base)))
)
)
((and (< (the-as int object-file) (the-as int v1-0))
(>= (the-as int (+ (the-as uint s4-0) (-> object-file length))) (the-as int v1-0))
)
(format
0
"ERROR: -----> dgo file header ~g #x~X has overrun heap #x~X by ~D bytes. This is very bad!~%"
(-> object-file rootname)
object-file
heap
(- (+ (the-as uint s4-0) (-> object-file length)) v1-0)
)
)
)
)
(if loaded-from-top
(format
0
"NOTICE: loaded ~g, ~D bytes (~f K) at top ~D at #x~X - #x~X~%"
(-> object-file rootname)
(-> object-file length)
(* 0.0009765625 (the float (-> object-file length)))
(- (+ (the-as uint s4-0) (-> object-file length)) (the-as uint (-> heap base)))
object-file
(&+ (the-as pointer s4-0) (-> object-file length))
)
)
(string<-charp (clear *dgo-name*) (-> object-file rootname))
(nonzero? (link-begin
(the-as pointer s4-0)
(-> *dgo-name* data)
(the-as int (-> object-file length))
heap
(if print-login
(link-flag output-load-msg output-load-true-msg execute-login print-login fast-link)
(link-flag output-load-msg output-load-true-msg execute-login fast-link)
)
)
)
)
)
(defun destroy-mem ((start (pointer uint32)) (end (pointer uint32)))
"Overwrite memory with #xffffffff for debugging."
(while (< (the-as int start) (the-as int end))
(set! (-> start 0) (the-as uint #xffffffff))
(set! start (&-> start 1))
)
0
(none)
)
+210
View File
@@ -5,5 +5,215 @@
;; name in dgo: nav-control-h
;; dgos: GAME
(defenum nav-state-flag
:type uint32
:bitfield #t
(display-marks 0)
(recovery-mode 1)
(initialized 2)
(debug 3)
(directional-mode 4)
(trapped-by-sphere 5)
(target-poly-dirty 6)
(blocked 7)
(in-target-poly 8)
(at-target 9)
(target-inside 10)
(in-mesh 11)
(avoiding-sphere 12)
(touching-sphere 13)
(at-gap 14)
(use-position 15)
)
(defenum nav-control-flag
:type uint32
:bitfield #t
(display-marks 0) ;; 1
(debug 1) ;; 2
(no-redirect-in-clamp 2) ;; 4
(limit-rotation-rate 3) ;; 8
(update-heading-from-facing 4) ;; 16
(use-momentum 5) ;; 32
(momentum-ignore-heading 6) ;; 64
(output-sphere-hash 7) ;; 128
(kernel-run 8) ;; 256
)
;; DECOMP BEGINS
(deftype check-vector-collision-with-nav-spheres-info (structure)
((u float)
(intersect vector :inline)
(normal vector :inline)
)
)
(deftype nav-gap-info (structure)
((dest vector :inline)
(poly nav-poly)
)
)
(deftype nav-avoid-spheres-params (structure)
((current-pos vector :inline)
(travel vector :inline)
(pref-dir vector :inline)
(out-travel vector 2 :inline)
(closest-sphere-dist2 float)
(avoiding-sphere? symbol)
)
)
(deftype nav-callback-info (structure)
((callback-count int32)
(callback-array (function object nav-control none) 10)
)
)
(deftype nav-state (structure)
((flags nav-state-flag)
(nav nav-control)
(user-poly nav-poly)
(mesh nav-mesh)
(current-poly nav-poly)
(virtual-current-poly nav-poly)
(next-poly nav-poly)
(target-poly nav-poly)
(rotation-rate float)
(speed meters)
(prev-speed meters)
(pad0 uint32 1)
(travel vector :inline)
(target-pos vector :inline)
(current-pos vector :inline)
(current-pos-local vector :inline)
(virtual-current-pos-local vector :inline)
(velocity vector :inline)
(heading vector :inline)
(target-dir vector :inline)
(accel vector :inline :overlay-at target-dir)
(user-position vector :inline :overlay-at virtual-current-pos-local)
)
(:methods
(nav-state-method-9 () none)
(nav-state-method-10 () none)
(nav-state-method-11 () none)
(nav-state-method-12 () none)
(nav-state-method-13 () none)
(nav-state-method-14 () none)
(nav-state-method-15 () none)
(nav-state-method-16 () none)
(nav-state-method-17 () none)
(nav-state-method-18 () none)
(nav-state-method-19 () none)
(nav-state-method-20 () none)
(nav-state-method-21 () none)
(nav-state-method-22 () none)
(nav-state-method-23 () none)
(nav-state-method-24 () none)
(nav-state-method-25 () none)
(nav-state-method-26 () none)
(nav-state-method-27 () none)
(nav-state-method-28 () none)
(nav-state-method-29 () none)
(nav-state-method-30 () none)
(nav-state-method-31 () none)
(nav-state-method-32 () none)
(nav-state-method-33 () none)
(nav-state-method-34 () none)
(nav-state-method-35 () none)
(nav-state-method-36 () none)
(nav-state-method-37 () none)
(nav-state-method-38 () none)
(nav-state-method-39 () none)
(nav-state-method-40 () none)
(nav-state-method-41 () none)
(nav-state-method-42 () none)
(nav-state-method-43 () none)
(nav-state-method-44 () none)
(nav-state-method-45 () none)
(nav-state-method-46 () none)
(nav-state-method-47 () none)
(nav-state-method-48 () none)
(nav-state-method-49 () none)
(nav-state-method-50 () none)
(nav-state-method-51 () none)
(nav-state-method-52 () none)
(nav-state-method-53 () none)
(nav-state-method-54 () none)
(nav-state-method-55 () none)
)
)
(deftype nav-control (structure)
((flags nav-control-flag)
(callback-info nav-callback-info)
(process process)
(pad0 uint32)
(shape collide-shape)
(nearest-y-threshold meters)
(nav-cull-radius meters)
(sec-per-frame float)
(target-speed meters)
(acceleration meters)
(turning-acceleration meters)
(max-rotation-rate float)
(speed-scale float)
(sphere-count int32)
(sphere-array (inline-array sphere))
(root-sphere-id uint8)
(sphere-mask uint8)
(pad1 uint8 2)
(sphere-id-array uint8 16)
(extra-nav-sphere vector :inline)
(root-nav-sphere vector :inline)
(state nav-state :inline)
(mesh basic :overlay-at (-> state mesh))
)
(:methods
(nav-control-method-9 () none)
(nav-control-method-10 () none)
(nav-control-method-11 () none)
(nav-control-method-12 () none)
(nav-control-method-13 () none)
(nav-control-method-14 () none)
(nav-control-method-15 () none)
(nav-control-method-16 () none)
(nav-control-method-17 () none)
(nav-control-method-18 () none)
(nav-control-method-19 () none)
(nav-control-method-20 () none)
(nav-control-method-21 () none)
(nav-control-method-22 () none)
(nav-control-method-23 () none)
(nav-control-method-24 () none)
(nav-control-method-25 () none)
(nav-control-method-26 () none)
(nav-control-method-27 () none)
(nav-control-method-28 () none)
(nav-control-method-29 () none)
(nav-control-method-30 () none)
(nav-control-method-31 () none)
(nav-control-method-32 () none)
(nav-control-method-33 () none)
(nav-control-method-34 () none)
(nav-control-method-35 () none)
(nav-control-method-36 () none)
(nav-control-method-37 () none)
(nav-control-method-38 () none)
(nav-control-method-39 () none)
(nav-control-method-40 () none)
(nav-control-method-41 () none)
(nav-control-method-42 () none)
(nav-control-method-43 () none)
(nav-control-method-44 () none)
(nav-control-method-45 () none)
(nav-control-method-46 () none)
)
)
+540
View File
@@ -5,5 +5,545 @@
;; name in dgo: nav-mesh-h
;; dgos: GAME
(declare-type grid-hash structure)
(declare-type sphere-hash structure)
(defenum nav-mesh-flag
:type uint8
:bitfield #t
(water 0)
(dummy 1)
)
;; DECOMP BEGINS
(deftype nav-mesh-work-debug (structure)
"Debug outputs for the nav-mesh assembly functions"
((debug-vec1 vector :inline)
(debug-vec2 vector :inline)
(debug-vec3 vector :inline)
(debug-vec4 vector :inline)
(debug-vec5 vector :inline)
(debug-vec6 vector :inline)
(debug-vec7 vector :inline)
(debug-vec8 vector :inline)
(debug-vec9 vector :inline)
(debug-vec10 vector :inline)
(debug-vec11 vector :inline)
(debug-vec12 vector :inline)
(sphere-array sphere 16 :inline)
)
)
(deftype nav-mesh-work (structure)
"Workspace for nav-mesh processing functions."
((vert0-table int8 4)
(vert1-table int8 4)
(edge-mask-table uint8 3)
(pad0 uint32)
(deg-to-rad float)
(rad-to-deg float)
(nav-poly-min-dist float)
(nav-poly-epsilon float)
(sphere-array sphere 16 :inline)
(debug nav-mesh-work-debug)
(work-struct-in-scratch int8)
(mesh-struct-in-scratch int8)
(polys-in-scratch int8)
(mesh nav-mesh)
(nav basic)
(poly0 nav-poly)
(poly1 nav-poly)
(poly-id int32)
)
)
(deftype nav-mesh-link (structure)
"Link between two different meshes"
((id uint32)
(dest-mesh-id uint32)
(src-link-poly-id uint8)
(src-switch-poly-id uint8)
(dest-link-poly-id uint8)
(dest-switch-poly-id uint8)
(dest-mesh nav-mesh)
)
)
(deftype nav-poly (structure)
"Polygon within a nav-mesh. Can be a tri or quad.
Based on the implementation of point-poly-intersection?, these should likely be convex."
((data uint8 64 :offset 0)
(vertex vector 4 :inline :overlay-at (-> data 0))
(vertex0 vector :inline :overlay-at (-> vertex 0))
(vertex1 vector :inline :overlay-at (-> vertex 1))
(vertex2 vector :inline :overlay-at (-> vertex 2))
(vertex3 vector :inline :overlay-at (-> vertex 3))
(id uint8 :overlay-at (-> data 12))
(pat uint8 :overlay-at (-> data 13))
(vertex-count uint8 :overlay-at (-> data 14))
(link uint8 :overlay-at (-> data 15))
(adj-poly uint8 4 :overlay-at (-> data 28))
(adj-poly0 uint8 :overlay-at (-> adj-poly 0))
(adj-poly1 uint8 :overlay-at (-> adj-poly 1))
(adj-poly2 uint8 :overlay-at (-> adj-poly 2))
(adj-poly3 uint8 :overlay-at (-> adj-poly 3))
(min-y float :overlay-at (-> data 44))
(max-y float :overlay-at (-> data 60))
)
)
(deftype nav-vertex (vector)
()
)
(deftype nav-sphere (structure)
((trans sphere :inline)
)
)
(deftype nav-ray (structure)
((current-pos vector :inline)
(dir vector :inline)
(dest-pos vector :inline)
(current-poly nav-poly)
(next-poly nav-poly)
(len meters)
(last-edge int8)
(ignore uint8)
(terminated symbol)
(reached-dest symbol)
(hit-boundary symbol)
(hit-gap symbol)
)
)
(deftype nav-route-portal (structure)
((vertex nav-vertex 2 :inline)
(next-poly nav-poly)
(edge-index int8)
)
)
(deftype nav-find-poly-parms (structure)
((point vector :inline)
(y-threshold float)
(ignore uint8)
(poly nav-poly)
(dist float)
(point-inside? symbol)
)
)
(deftype clamp-travel-vector-to-mesh-return-info (structure)
((found-boundary symbol)
(intersection vector :inline)
(boundary-normal vector :inline)
(prev-normal vector :inline)
(next-normal vector :inline)
(poly nav-poly)
(gap-poly nav-poly)
(edge int8)
(ignore uint8)
(vert-prev vector :inline)
(vert-0 vector :inline)
(vert-1 vector :inline)
(vert-next vector :inline)
)
)
(deftype nav-mesh (basic)
"Mesh used for creature/enemy navigation."
((work nav-mesh-work)
(poly-array (inline-array nav-poly))
(static-sphere-count uint8)
(poly-count uint8)
(nav-control-count uint8)
(max-nav-control-count uint8)
(route (pointer uint8))
(poly-hash grid-hash)
(nav-control-array (inline-array nav-control))
(sphere-hash sphere-hash)
(static-sphere (inline-array sphere))
(user-list engine)
(next-nav-mesh surface)
(prev-nav-mesh surface)
(bounds sphere :inline)
(origin vector :inline :overlay-at (-> bounds data 0))
(entity entity)
(link-array (inline-array nav-mesh-link))
(link-count uint8)
(flags nav-mesh-flag)
(pad1 uint8 2)
(nearest-y-threshold meters)
(water-max-height meters)
(pad2 uint32 7)
)
(:methods
(nav-mesh-method-9 () none)
(nav-mesh-method-10 () none)
(nav-mesh-method-11 () none)
(nav-mesh-method-12 () none)
(nav-mesh-method-13 () none)
(nav-mesh-method-14 () none)
(nav-mesh-method-15 () none)
(nav-mesh-method-16 () none)
(nav-mesh-method-17 () none)
(advance-ray-to-nearest-poly-edge-or-dest! (_type_ nav-ray) none)
(nav-mesh-method-19 () none)
(nav-mesh-method-20 () none)
(nav-mesh-method-21 () none)
(nav-mesh-method-22 () none)
(nav-mesh-method-23 () none)
(nav-mesh-method-24 () none)
(nav-mesh-method-25 () none)
(nav-mesh-method-26 () none)
(nav-mesh-method-27 () none)
(nav-mesh-method-28 () none)
(nav-mesh-method-29 () none)
(nav-mesh-method-30 () none)
(nav-mesh-method-31 () none)
(nav-mesh-method-32 () none)
(nav-mesh-method-33 () none)
(nav-mesh-method-34 () none)
(nav-mesh-method-35 () none)
(nav-mesh-method-36 () none)
(nav-mesh-method-37 () none)
(nav-mesh-method-38 () none)
(nav-mesh-method-39 () none)
(point-in-poly? (_type_ nav-poly vector) symbol)
(nav-mesh-method-41 () none)
(closest-point-on-boundary (_type_ nav-poly vector vector) vector)
(nav-mesh-method-43 () none)
(project-point-into-poly-2d (_type_ nav-poly vector vector) vector)
(nav-mesh-method-45 () none)
(nav-mesh-method-46 () none)
(nav-mesh-method-47 () none)
(nav-mesh-method-48 () none)
(nav-mesh-method-49 () none)
)
)
(defun vector-normalize-unity! ((arg0 vector))
"Normalize a vector (xyz only) in place."
(rlet ((acc :class vf)
(Q :class vf)
(vf0 :class vf)
(vf1 :class vf)
(vf2 :class vf)
(vf3 :class vf)
)
(init-vf0-vector)
(let ((v0-0 arg0))
(let ((f0-0 1.0))
(.lvf vf1 (&-> v0-0 quad))
(.mul.vf vf2 vf1 vf1 :mask #b111)
(let ((v1-1 f0-0))
(.mov vf3 v1-1)
)
)
(.mul.x.vf acc vf0 vf2 :mask #b1000)
(.add.mul.y.vf acc vf0 vf2 acc :mask #b1000)
(.add.mul.z.vf vf2 vf0 vf2 acc :mask #b1000)
(.isqrt.vf Q vf3 vf2 :fsf #b0 :ftf #b11)
(.wait.vf)
(.mul.vf vf1 vf1 Q :mask #b111)
(.nop.vf)
(.nop.vf)
(.nop.vf)
(.svf (&-> v0-0 quad) vf1)
v0-0
)
)
)
(defun vector-normalize-unity-copy! ((arg0 vector) (arg1 vector))
"Normalize a vector (xyz only)"
(rlet ((acc :class vf)
(Q :class vf)
(vf0 :class vf)
(vf1 :class vf)
(vf2 :class vf)
(vf3 :class vf)
)
(init-vf0-vector)
(set! (-> arg0 quad) (-> arg1 quad))
(let ((v0-0 arg0))
(let ((f0-0 1.0))
(.lvf vf1 (&-> v0-0 quad))
(.mul.vf vf2 vf1 vf1 :mask #b111)
(let ((v1-2 f0-0))
(.mov vf3 v1-2)
)
)
(.mul.x.vf acc vf0 vf2 :mask #b1000)
(.add.mul.y.vf acc vf0 vf2 acc :mask #b1000)
(.add.mul.z.vf vf2 vf0 vf2 acc :mask #b1000)
(.isqrt.vf Q vf3 vf2 :fsf #b0 :ftf #b11)
(.wait.vf)
(.mul.vf vf1 vf1 Q :mask #b111)
(.nop.vf)
(.nop.vf)
(.nop.vf)
(.svf (&-> v0-0 quad) vf1)
v0-0
)
)
)
(defun-debug debug-validate-current-poly ()
"Not implemented."
#f
)
(defun init-ray ((arg0 nav-ray))
"Set up a nav-ray. Assumes that dest-pos and current-pos are set."
(rlet ((acc :class vf)
(Q :class vf)
(vf0 :class vf)
(vf1 :class vf)
(vf2 :class vf)
(vf3 :class vf)
)
(init-vf0-vector)
(vector-! (-> arg0 dir) (-> arg0 dest-pos) (-> arg0 current-pos))
(set! (-> arg0 dir y) 0.0)
(let ((v1-1 (-> arg0 dir)))
(let ((f0-1 1.0))
(.lvf vf1 (&-> v1-1 quad))
(.mul.vf vf2 vf1 vf1 :mask #b111)
(let ((a1-2 f0-1))
(.mov vf3 a1-2)
)
)
(.mul.x.vf acc vf0 vf2 :mask #b1000)
(.add.mul.y.vf acc vf0 vf2 acc :mask #b1000)
(.add.mul.z.vf vf2 vf0 vf2 acc :mask #b1000)
(.isqrt.vf Q vf3 vf2 :fsf #b0 :ftf #b11)
(.wait.vf)
(.mul.vf vf1 vf1 Q :mask #b111)
(.nop.vf)
(.nop.vf)
(.nop.vf)
(.svf (&-> v1-1 quad) vf1)
)
(set! (-> arg0 next-poly) #f)
(set! (-> arg0 len) 0.0)
(set! (-> arg0 last-edge) -1)
(set! (-> arg0 terminated) #f)
(set! (-> arg0 reached-dest) #f)
(set! (-> arg0 hit-boundary) #f)
(set! (-> arg0 hit-gap) #f)
(set! (-> arg0 ignore) (the-as uint 3))
0
(none)
)
)
(defun point-poly-intersection? ((mesh nav-mesh) (pt vector) (num-verts int) (verts (inline-array vector)))
"Check if a point is inside a poly."
(let ((v1-1 (-> mesh work vert0-table))
(a0-2 (-> mesh work vert1-table))
)
(dotimes (t0-0 num-verts)
(let* ((t1-3 (-> verts (-> v1-1 t0-0)))
(t2-3 (-> verts (-> a0-2 t0-0)))
(f0-1 (- (-> t1-3 z) (-> t2-3 z)))
(f1-2 (- (-> t2-3 x) (-> t1-3 x)))
(f2-2 (- (-> pt x) (-> t1-3 x)))
(f3-2 (- (-> pt z) (-> t1-3 z)))
(f0-3 (+ (* f2-2 f0-1) (* f3-2 f1-2)))
)
(if (< 0.0 f0-3)
(return #f)
)
)
)
)
#t
)
(defmethod point-in-poly? ((this nav-mesh) (arg0 nav-poly) (arg1 vector))
"Check if a point is inside a poly of this mesh"
(let* ((a3-0 this)
(v1-0 arg1)
(a0-1 (-> arg0 vertex-count))
(a1-1 (-> arg0 vertex))
(a2-2 (-> a3-0 work vert0-table))
(a3-2 (-> a3-0 work vert1-table))
)
(dotimes (t0-0 (the-as int a0-1))
(let* ((t1-3 (-> a1-1 (-> a2-2 t0-0)))
(t2-3 (-> a1-1 (-> a3-2 t0-0)))
(f0-1 (- (-> t1-3 z) (-> t2-3 z)))
(f1-2 (- (-> t2-3 x) (-> t1-3 x)))
(f2-2 (- (-> v1-0 x) (-> t1-3 x)))
(f3-2 (- (-> v1-0 z) (-> t1-3 z)))
(f0-3 (+ (* f2-2 f0-1) (* f3-2 f1-2)))
)
(if (< 0.0 f0-3)
(return #f)
)
)
)
)
#t
)
(defmethod closest-point-on-boundary ((this nav-mesh) (arg0 nav-poly) (arg1 vector) (arg2 vector))
"Find the point on the polygon edge that is closest to the query point."
(local-vars (sv-48 vector) (sv-52 vector) (sv-56 number))
(set! sv-48 (new 'stack-no-clear 'vector))
(set! sv-52 (new 'stack-no-clear 'vector))
(set! sv-56 10000000000000000000000000000000000000.0)
(let* ((s3-0 (-> arg0 vertex-count))
(v1-3 (the-as int (+ s3-0 -1)))
)
(dotimes (s2-0 (the-as int s3-0))
(let ((f0-1 (vector-segment-distance-point! arg2 (-> arg0 vertex v1-3) (-> arg0 vertex s2-0) sv-48)))
(when (< f0-1 (the-as float sv-56))
(set! sv-56 f0-1)
(set! (-> sv-52 quad) (-> sv-48 quad))
)
)
(set! v1-3 s2-0)
)
)
(set! (-> arg1 quad) (-> sv-52 quad))
arg1
)
(defmethod project-point-into-poly-2d ((this nav-mesh) (arg0 nav-poly) (arg1 vector) (arg2 vector))
"Find the point in the polygon closest to the query point."
(local-vars (sv-48 vector) (sv-52 vector) (sv-56 number))
(cond
((point-in-poly? this arg0 arg2)
(set! (-> arg1 quad) (-> arg2 quad))
)
(else
(let ((s5-1 arg1))
(set! sv-48 (new 'stack-no-clear 'vector))
(set! sv-52 (new 'stack-no-clear 'vector))
(set! sv-56 10000000000000000000000000000000000000.0)
(let* ((s2-0 (-> arg0 vertex-count))
(v1-6 (the-as int (+ s2-0 -1)))
)
(dotimes (s1-0 (the-as int s2-0))
(let ((f0-1 (vector-segment-distance-point! arg2 (-> arg0 vertex v1-6) (-> arg0 vertex s1-0) sv-48)))
(when (< f0-1 (the-as float sv-56))
(set! sv-56 f0-1)
(set! (-> sv-52 quad) (-> sv-48 quad))
)
)
(set! v1-6 s1-0)
)
)
(set! (-> s5-1 quad) (-> sv-52 quad))
)
)
)
arg1
)
(defmethod advance-ray-to-nearest-poly-edge-or-dest! ((this nav-mesh) (arg0 nav-ray))
(local-vars
(sv-16 int)
(sv-24 nav-mesh-work)
(sv-28 nav-poly)
(sv-32 uint)
(sv-36 (pointer int8))
(sv-40 (pointer int8))
(sv-44 float)
(sv-48 float)
(sv-52 vector)
(sv-56 vector)
(sv-60 float)
(sv-64 float)
(sv-68 uint)
)
(set! sv-16 -1)
(set! sv-24 (-> this work))
(set! sv-28 (-> arg0 current-poly))
(set! sv-32 (-> arg0 current-poly vertex-count))
(set! sv-36 (-> this work vert0-table))
(set! sv-40 (-> this work vert1-table))
(set! sv-44 (- (-> arg0 dest-pos x) (-> arg0 current-pos x)))
(set! sv-48 (- (-> arg0 dest-pos z) (-> arg0 current-pos z)))
(dotimes (v1-9 (the-as int sv-32))
(set! sv-52 (-> sv-28 vertex (-> sv-36 v1-9)))
(set! sv-56 (-> sv-28 vertex (-> sv-40 v1-9)))
(set! sv-60 (- (-> sv-52 z) (-> sv-56 z)))
(set! sv-64 (- (-> sv-56 x) (-> sv-52 x)))
(let ((f0-10 (+ (* sv-44 sv-60) (* sv-48 sv-64))))
(when (< 0.0 f0-10)
(let ((f1-10
(+ (* sv-60 (- (-> sv-52 x) (-> arg0 current-pos x))) (* sv-64 (- (-> sv-52 z) (-> arg0 current-pos z))))
)
)
(when (< f1-10 f0-10)
(set! sv-16 v1-9)
(let ((f0-12 (fmax 0.0 (/ f1-10 f0-10))))
(set! sv-44 (* sv-44 f0-12))
(set! sv-48 (* sv-48 f0-12))
)
)
)
)
)
)
(let ((f0-16 (+ (* sv-44 (-> arg0 dir x)) (* sv-48 (-> arg0 dir z)))))
(+! (-> arg0 len) f0-16)
)
0
(set! (-> arg0 next-poly) #f)
(cond
((= sv-16 -1)
(set! (-> arg0 current-pos quad) (-> arg0 dest-pos quad))
(set! (-> arg0 reached-dest) #t)
(set! (-> arg0 terminated) #t)
)
(else
(+! (-> arg0 current-pos x) sv-44)
(+! (-> arg0 current-pos z) sv-48)
(set! sv-68 (-> sv-28 adj-poly sv-16))
(if (!= sv-68 255)
(set! (-> arg0 next-poly) (-> this poly-array sv-68))
)
(cond
((and (-> arg0 next-poly) (not (logtest? (-> arg0 next-poly pat) (-> arg0 ignore))))
(set! (-> arg0 current-poly) (-> arg0 next-poly))
)
(else
(set! (-> arg0 last-edge) sv-16)
(if (-> arg0 next-poly)
(set! (-> arg0 hit-gap) #t)
(set! (-> arg0 hit-boundary) #t)
)
(set! (-> arg0 terminated) #t)
)
)
)
)
0
(none)
)
(defun-debug nav-sphere-from-cam ()
"Print out a SPHEREM from the current camera position, possibly used by their level-building tool."
(let ((v1-0 (camera-pos)))
(format #t "SPHEREM(~4,,1M, ~4,,1M, ~4,,1M, 1.0)~%" (-> v1-0 x) (-> v1-0 y) (-> v1-0 z))
)
0
(none)
)
@@ -5,5 +5,249 @@
;; name in dgo: rigid-body-h
;; dgos: GAME
;; +++rigid-body-h:rigid-body-flag
(defenum rigid-body-flag
:bitfield #t
:type uint32
(display-marks 0)
(enable-physics 1)
(enable-collision 2)
(active 3)
(debug 4)
(blocker 5)
)
;; ---rigid-body-h:rigid-body-flag
;; +++rigid-body-h:rigid-body-object-flag
(defenum rigid-body-object-flag
:bitfield #t
:type uint64
(enable-collision 0)
(disturbed 1)
(damaged 2)
(dead 3)
(player-touching 4)
(player-edge-grabbing 5)
(player-standing-on 6)
(player-impulse-force 7)
(player-contact-force 8)
(persistent 9)
(in-air 10)
(on-ground 11)
(on-flight-level 12)
(riding 13)
(player-driving 14)
(waiting-for-player 15)
(ignition 16)
(turbo-boost 17)
(reverse-gear 18)
(slide 19)
(hard-turn 20)
(jump 21)
(jump-sound 22)
(ai-driving 23)
(traffic-managed 24)
(flight-level-transition 25)
(flight-level-transition-ending 26)
(camera-bike-mode 27)
(camera-rapid-track-mode 28)
(camera 29)
(alert 30)
(in-pursuit 31)
(target-in-sight 32)
(rammed-target 33)
(draw-marks 34)
(hack-edit-graph-mode 35)
(measure-control-parameters 36)
(lights-on 37)
(lights-update 38)
(lights-dead 39)
(no-hijack 40)
(player-grabbed 41)
(nav-spheres 42)
(idle-sound 43)
)
;; ---rigid-body-h:rigid-body-object-flag
;; DECOMP BEGINS
(deftype rigid-body-info (structure)
((mass float)
(inv-mass float)
(linear-damping float)
(angular-damping float)
(bounce-factor float)
(friction-factor float)
(bounce-mult-factor float)
(cm-offset-joint vector :inline)
(inv-inertial-tensor matrix :inline)
(inertial-tensor matrix :inline)
(inertial-tensor-box meters 3)
)
(:methods
(rigid-body-info-method-9 () none)
)
)
(deftype rigid-body-object-extra-info (structure)
((max-time-step float)
(gravity meters)
(idle-distance meters)
(attack-force-scale float)
)
:pack-me
)
(deftype rigid-body-object-constants (structure)
((info rigid-body-info :inline)
(mass float :overlay-at (-> info mass))
(inv-mass float :overlay-at (-> info inv-mass))
(cm-joint-x meters :overlay-at (-> info cm-offset-joint data 0))
(cm-joint-y meters :overlay-at (-> info cm-offset-joint data 1))
(cm-joint-z meters :overlay-at (-> info cm-offset-joint data 2))
(linear-damping float :overlay-at (-> info linear-damping))
(angular-damping float :overlay-at (-> info angular-damping))
(bounce-factor float :overlay-at (-> info bounce-factor))
(friction-factor float :overlay-at (-> info friction-factor))
(inertial-tensor-x meters :overlay-at (-> info inertial-tensor-box 0))
(inertial-tensor-y meters :overlay-at (-> info inertial-tensor-box 1))
(inertial-tensor-z meters :overlay-at (-> info inertial-tensor-box 2))
(extra rigid-body-object-extra-info :inline)
(max-time-step float :overlay-at (-> extra max-time-step))
(gravity meters :overlay-at (-> extra gravity))
(idle-distance meters :overlay-at (-> extra idle-distance))
(attack-force-scale float :overlay-at (-> extra attack-force-scale))
(name symbol)
)
)
(deftype rigid-body-impact (structure)
((point vector :inline)
(normal vector :inline)
(velocity vector :inline)
(impulse float)
(pat pat-surface)
(process basic)
(prim-id uint32)
)
)
(deftype rigid-body-control (basic)
((flags rigid-body-flag)
(info rigid-body-info)
(force-callback basic)
(process process)
(blocked-by basic)
(time-remaining float)
(step-count int16)
(linear-damping float)
(angular-damping float)
(bounce-factor float)
(friction-factor float)
(position vector :inline)
(rot vector :inline)
(rotation quaternion :inline :overlay-at (-> rot data 0))
(lin-momentum vector :inline)
(ang-momentum vector :inline)
(force vector :inline)
(torque vector :inline)
(lin-velocity vector :inline)
(ang-velocity vector :inline)
(matrix matrix :inline)
(inv-i-world matrix :inline)
)
(:methods
(new (symbol type) _type_)
(rigid-body-control-method-9 () none)
(rigid-body-control-method-10 () none)
(rigid-body-control-method-11 () none)
(rigid-body-control-method-12 () none)
(rigid-body-control-method-13 () none)
(rigid-body-control-method-14 () none)
(rigid-body-control-method-15 () none)
(rigid-body-control-method-16 () none)
(rigid-body-control-method-17 () none)
(rigid-body-control-method-18 () none)
(rigid-body-control-method-19 () none)
(rigid-body-control-method-20 () none)
(rigid-body-control-method-21 () none)
(rigid-body-control-method-22 () none)
(rigid-body-control-method-23 () none)
(rigid-body-control-method-24 () none)
(rigid-body-control-method-25 () none)
(rigid-body-control-method-26 () none)
(rigid-body-control-method-27 () none)
(rigid-body-control-method-28 () none)
(rigid-body-control-method-29 () none)
(rigid-body-control-method-30 () none)
(rigid-body-control-method-31 () none)
(rigid-body-control-method-32 () none)
(rigid-body-control-method-33 () none)
)
)
(deftype rigid-body-object (process-focusable)
((info rigid-body-object-constants)
(flags rigid-body-object-flag)
(max-time-step float)
(incoming-attack-id uint32)
(player-touch-time time-frame)
(disturbed-time time-frame)
(player-force-position vector :inline)
(player-force vector :inline)
)
(:methods
(rigid-body-object-method-28 () none)
(rigid-body-object-method-29 () none)
(rigid-body-object-method-30 () none)
(rigid-body-object-method-31 () none)
(rigid-body-object-method-32 () none)
(rigid-body-object-method-33 () none)
(rigid-body-object-method-34 () none)
(rigid-body-object-method-35 () none)
(rigid-body-object-method-36 () none)
(rigid-body-object-method-37 () none)
(rigid-body-object-method-38 () none)
(rigid-body-object-method-39 () none)
(rigid-body-object-method-40 () none)
(rigid-body-object-method-41 () none)
(rigid-body-object-method-42 () none)
(rigid-body-object-method-43 () none)
(rigid-body-object-method-44 () none)
(rigid-body-object-method-45 () none)
(rigid-body-object-method-46 () none)
(rigid-body-object-method-47 () none)
(rigid-body-object-method-48 () none)
(rigid-body-object-method-49 () none)
(rigid-body-object-method-50 () none)
(rigid-body-object-method-51 () none)
(rigid-body-object-method-52 () none)
(rigid-body-object-method-53 () none)
(rigid-body-object-method-54 () none)
(rigid-body-object-method-55 () none)
)
)
(deftype rigid-body-queue (structure)
((count int8)
(manager uint64)
(array handle 128)
)
(:methods
(rigid-body-queue-method-9 () none)
(rigid-body-queue-method-10 () none)
(rigid-body-queue-method-11 () none)
(rigid-body-queue-method-12 () none)
(rigid-body-queue-method-13 () none)
(rigid-body-queue-method-14 () none)
(rigid-body-queue-method-15 () none)
(rigid-body-queue-method-16 () none)
)
)
+189
View File
@@ -7,3 +7,192 @@
;; DECOMP BEGINS
(deftype rpc-buffer (basic)
"Buffer for storing input/output data for a remote procedure call to the overlord driver on the IOP."
((elt-size uint32)
(elt-count uint32)
(elt-used uint32)
(busy symbol)
(base pointer)
(data uint8 :dynamic :offset 32)
)
(:methods
(new (symbol type uint uint) _type_)
)
)
(defmethod new rpc-buffer ((allocation symbol) (type-to-make type) (elt-size uint) (elt-count uint))
(let* ((a2-2 (+ (-> type-to-make size) 63 (* (the-as int elt-size) (the-as int elt-count))))
(v0-0 (object-new allocation type-to-make (the-as int a2-2)))
)
(set! (-> v0-0 elt-size) elt-size)
(set! (-> v0-0 elt-count) elt-count)
(set! (-> v0-0 elt-used) (the-as uint 0))
(set! (-> v0-0 busy) #f)
(set! (-> v0-0 base) (logand -64 (&-> (-> v0-0 data) 63)))
v0-0
)
)
(deftype rpc-buffer-pair (basic)
"A double buffer of RPC buffers. This is used to let the game queue up data in one buffer while
the other is being read/written by overlord."
((buffer rpc-buffer 2)
(current rpc-buffer)
(last-recv-buffer pointer)
(rpc-port int32)
)
(:methods
(new (symbol type uint uint int) rpc-buffer-pair)
(call (rpc-buffer-pair uint pointer uint) int)
(add-element (rpc-buffer-pair) pointer)
(decrement-elt-used (rpc-buffer-pair) int)
(sync (rpc-buffer-pair symbol) int)
(check-busy (rpc-buffer-pair) symbol)
(pop-last-received (rpc-buffer-pair) pointer)
)
)
(defmethod new rpc-buffer-pair ((allocation symbol) (type-to-make type) (elt-size uint) (elt-count uint) (rpc-port int))
(let ((s3-0 (object-new allocation type-to-make (the-as int (-> type-to-make size)))))
(set! (-> s3-0 buffer 0) (new 'global 'rpc-buffer elt-size elt-count))
(set! (-> s3-0 buffer 1) (new 'global 'rpc-buffer elt-size elt-count))
(set! (-> s3-0 current) (-> s3-0 buffer 0))
(set! (-> s3-0 last-recv-buffer) (the-as pointer #f))
(set! (-> s3-0 rpc-port) rpc-port)
s3-0
)
)
(defmethod sync ((this rpc-buffer-pair) (print-stall-warning symbol))
"Wait for an in-progress rpc to finish."
(let ((s5-0 (if (= (-> this current) (-> this buffer 0))
(-> this buffer 1)
(-> this buffer 0)
)
)
)
(when (-> s5-0 busy)
(when (nonzero? (rpc-busy? (-> this rpc-port)))
(if print-stall-warning
(format 0 "STALL: waiting for IOP on RPC port #~D~%" (-> this rpc-port))
)
(while (nonzero? (rpc-busy? (-> this rpc-port)))
(nop!)
(nop!)
(nop!)
(nop!)
(nop!)
(nop!)
(nop!)
(nop!)
)
)
(set! (-> s5-0 busy) #f)
(set! (-> s5-0 elt-used) (the-as uint 0))
0
)
)
0
)
(defmethod check-busy ((this rpc-buffer-pair))
"Check to see if an rpc is in progress."
(let ((gp-0 (if (= (-> this current) (-> this buffer 0))
(-> this buffer 1)
(-> this buffer 0)
)
)
)
(when (-> gp-0 busy)
(if (nonzero? (rpc-busy? (-> this rpc-port)))
(return #t)
)
(set! (-> gp-0 busy) #f)
(set! (-> gp-0 elt-used) (the-as uint 0))
0
)
)
#f
)
(defmethod call ((this rpc-buffer-pair) (fno uint) (recv-buffer pointer) (recv-buffer-size uint))
"Start an async RPC call. If there is already one in progress, stall and wait for it to finish."
(when (nonzero? (-> this current elt-used))
(let ((s2-0 (if (= (-> this current) (-> this buffer 0))
(-> this buffer 1)
(-> this buffer 0)
)
)
)
(when (-> s2-0 busy)
(when (nonzero? (rpc-busy? (-> this rpc-port)))
(format 0 "STALL: waiting for IOP on RPC port #~D~%" (-> this rpc-port))
(while (nonzero? (rpc-busy? (-> this rpc-port)))
(nop!)
(nop!)
(nop!)
(nop!)
(nop!)
(nop!)
(nop!)
(nop!)
)
)
(set! (-> s2-0 busy) #f)
(set! (-> s2-0 elt-used) (the-as uint 0))
0
)
(let ((s1-0 (-> this current)))
(rpc-call
(-> this rpc-port)
fno
(the-as uint 1)
(the-as uint (-> s1-0 base))
(the-as int (* (-> s1-0 elt-size) (-> s1-0 elt-used)))
(the-as uint recv-buffer)
(the-as int recv-buffer-size)
)
(set! (-> s1-0 busy) #t)
)
(set! (-> this last-recv-buffer) recv-buffer)
(set! (-> this current) s2-0)
)
)
0
)
(defmethod pop-last-received ((this rpc-buffer-pair))
"Pop the response from the most recently completed rpc call."
(let ((v0-0 (-> this last-recv-buffer)))
(set! (-> this last-recv-buffer) (the-as pointer #f))
v0-0
)
)
(defmethod add-element ((this rpc-buffer-pair))
"Add an element. If the buffer is full, flush it!"
(let ((v1-0 (-> this current)))
(when (= (-> v1-0 elt-used) (-> v1-0 elt-count))
(if (zero? (-> this rpc-port))
(format 0 "WARNING: too many sound commands queued~%")
)
(call this (the-as uint 0) (the-as pointer 0) (the-as uint 0))
(set! v1-0 (-> this current))
)
(let ((v0-2 (&+ (-> v1-0 base) (* (-> v1-0 elt-used) (-> v1-0 elt-size)))))
(+! (-> v1-0 elt-used) 1)
v0-2
)
)
)
(defmethod decrement-elt-used ((this rpc-buffer-pair))
"Remove the most recently queued element."
(if (> (-> this current elt-used) 0)
(+! (-> this current elt-used) -1)
)
0
)
+4
View File
@@ -24,6 +24,8 @@
:bitfield #t
)
(define-extern get-sound-buffer-entry (function pointer))
;; DECOMP BEGINS
(deftype sound-stream-name (structure)
@@ -47,6 +49,8 @@
()
)
(define-extern string->sound-name (function string sound-name))
(deftype sound-rpc-cmd (structure)
((rsvd1 uint16)
(command uint16)
@@ -7,3 +7,6 @@
;; DECOMP BEGINS
(define *actor-list* (the-as (pointer collide-shape) (malloc 'global 1024)))
(define *actor-list-length* 0)
@@ -5,5 +5,120 @@
;; name in dgo: spatial-hash-h
;; dgos: GAME
(declare-type grid-hash-work structure)
;; DECOMP BEGINS
(deftype grid-hash-word (uint8)
()
)
(deftype grid-hash-box (structure)
"Integer coordinate box for the spatial hash grid."
((min int8 3)
(max int8 3)
)
:pack-me
)
(deftype grid-hash (basic)
"The grid-hash is the basic 3D grid used in the spatial-hash, which is used for runtime
actor collision dectection by hashing actor spheres into grid cells, and avoiding the typical
O(n^2) 'check everybody against everybody' collision loop."
((work grid-hash-work)
(search-box grid-hash-box :inline)
(bucket-size int16)
(axis-scale float 3)
(dimension-array int8 3)
(vertical-cell-count int8)
(bucket-array (pointer grid-hash-word))
(box-min float 3)
(box-max float 3)
(object-count int16)
(bucket-count int16)
(min-cell-size float)
(bucket-memory-size int32)
(mem-bucket-array (pointer grid-hash-word))
(spr-bucket-array (pointer grid-hash-word))
(debug-draw symbol)
(use-scratch-ram symbol)
)
(:methods
(new (symbol type int) _type_)
(update-grid-for-objects-in-box (_type_ int vector vector) none)
(clear-bucket-array (_type_) none)
(setup-search-box (_type_ int vector vector vector) none)
(search-for-point (_type_ vector) (pointer uint8))
(search-for-sphere (_type_ vector float) (pointer uint8))
(draw (_type_ rgba) none)
(dump-grid-info (_type_) none)
(verify-bits-in-bucket (_type_ grid-hash-box grid-hash-box) none)
(box-of-everything (_type_ object grid-hash-box) none)
(grid-hash-method-18 (_type_ grid-hash-box int) none)
(grid-hash-method-19 (_type_ grid-hash-box int) none)
(do-search! (_type_ grid-hash-box (pointer uint8)) none)
(set-up-box (_type_ grid-hash-box vector vector) none)
(sphere-to-grid-box (_type_ grid-hash-box sphere) none)
(line-sphere-to-grid-box (_type_ grid-hash-box vector vector float) none)
(update-grid (_type_) none)
)
)
(deftype find-nav-sphere-ids-params (structure)
((bsphere sphere :inline)
(y-threshold float)
(len int16)
(max-len int16)
(mask uint8)
(array (pointer uint8))
)
)
(deftype sphere-hash (grid-hash)
"An extension of grid hash that holds spheres inside of the grid."
((sphere-array (inline-array sphere))
(max-object-count int16)
(pad int16)
(mem-sphere-array uint32)
(spr-sphere-array uint32)
)
(:methods
(new (symbol type int int) _type_)
(clear-objects! (_type_) none)
(add-a-sphere (_type_ vector) int)
(add-a-sphere-with-flag (_type_ vector int) int)
(update-from-spheres (_type_) none)
(sphere-hash-method-29 (_type_ find-nav-sphere-ids-params int int int) none)
(find-nav-sphere-ids (_type_ find-nav-sphere-ids-params) none)
(add-sphere-with-mask-and-id (_type_ vector int int) symbol)
(sphere-hash-method-32 (_type_ vector vector float int) symbol)
)
)
(deftype hash-object-info (structure)
((object basic)
)
)
(deftype spatial-hash (sphere-hash)
"An extension of sphere-hash that associates an object with each sphere."
((object-array (inline-array hash-object-info))
(mem-object-array (inline-array hash-object-info))
(spr-object-array (inline-array hash-object-info))
)
(:methods
(new (symbol type int int) _type_)
(spatial-hash-method-33 () none)
(add-an-object (_type_ vector hash-object-info) int)
(fill-actor-list-for-box (_type_ bounding-box (pointer collide-shape) int) int)
(fill-actor-list-for-sphere (_type_ sphere (pointer collide-shape) int) int)
(fill-actor-list-for-line-sphere (_type_ vector vector float (pointer collide-shape) int int) int)
(fill-actor-list-for-vec+r (_type_ vector (pointer collide-shape) int) int)
(spatial-hash-method-39 (_type_ object hash-object-info) int)
)
)
+268
View File
@@ -0,0 +1,268 @@
;;-*-Lisp-*-
(in-package goal)
;; definition of type path-control
(deftype path-control (basic)
"The path-control is a reference a path data, which is just a list of points.
Although it contains a `curve`, the knot part is not populated, so it's just treated as
a bunch of line segments from the control points.
The child class curve-control does fill out the knot data and is a proper b-spline.
These path-controls are typically allocated on a process heap."
((flags path-control-flag)
(name symbol)
(process process-drawable)
(curve curve :inline)
(num-cverts int32 :overlay-at (-> curve num-cverts))
(cverts uint32 :overlay-at (-> curve cverts))
)
(:methods
(new (symbol type process symbol float entity symbol) _type_)
(path-control-method-9 () none)
(path-control-method-10 () none)
(path-control-method-11 () none)
(path-control-method-12 () none)
(path-control-method-13 () none)
(path-control-method-14 () none)
(path-control-method-15 () none)
(path-control-method-16 () none)
(get-num-segments (_type_) float)
(path-control-method-18 () none)
(get-num-verts (_type_) int)
(segement-duration->path-duration (_type_ float) float)
(path-duration->segment-duration (_type_ float) float)
(path-control-method-22 () none)
(path-control-method-23 () none)
(path-control-method-24 () none)
(path-control-method-25 () none)
(path-control-method-26 () none)
(path-control-method-27 () none)
(path-control-method-28 () none)
(path-control-method-29 () none)
(should-display-marks? (_type_) symbol)
(path-control-method-31 () none)
)
)
;; definition for method 3 of type path-control
(defmethod inspect ((this path-control))
(when (not this)
(set! this this)
(goto cfg-4)
)
(format #t "[~8x] ~A~%" this (-> this type))
(format #t "~1Tflags: #x~X~%" (-> this flags))
(format #t "~1Tname: ~A~%" (-> this name))
(format #t "~1Tprocess: ~A~%" (-> this process))
(format #t "~1Tcurve: #<curve @ #x~X>~%" (-> this curve))
(format #t "~1Tnum-cverts: ~D~%" (-> this curve num-cverts))
(format #t "~1Tcverts: #x~X~%" (-> this curve cverts))
(label cfg-4)
this
)
;; failed to figure out what this is:
(set! (-> path-control method-table 9) nothing)
;; definition of type curve-control
(deftype curve-control (path-control)
"A curve-control is like a path control, but it has both control points and knot points."
()
(:methods
(new (symbol type process symbol float) _type_)
)
)
;; definition for method 3 of type curve-control
(defmethod inspect ((this curve-control))
(when (not this)
(set! this this)
(goto cfg-4)
)
(format #t "[~8x] ~A~%" this (-> this type))
(format #t "~1Tflags: #x~X~%" (-> this flags))
(format #t "~1Tname: ~A~%" (-> this name))
(format #t "~1Tprocess: ~A~%" (-> this process))
(format #t "~1Tcurve: #<curve @ #x~X>~%" (-> this curve))
(format #t "~1Tnum-cverts: ~D~%" (-> this curve num-cverts))
(format #t "~1Tcverts: #x~X~%" (-> this curve cverts))
(label cfg-4)
this
)
;; definition for method 0 of type path-control
;; INFO: Used lq/sq
;; ERROR: Stack slot load at 32 mismatch: defined as size 4, got size 16
;; ERROR: Stack slot load at 32 mismatch: defined as size 4, got size 16
;; WARN: Return type mismatch object vs path-control.
(defmethod new path-control ((allocation symbol)
(type-to-make type)
(proc process)
(lump-name symbol)
(lump-time float)
(lump-actor entity)
(must-exist symbol)
)
"Allocate a new path-control, set up the curve to point to the specified lump data."
(local-vars (v0-3 object) (sv-16 res-tag) (sv-32 float))
(set! sv-32 lump-time)
(let ((s0-0 lump-actor)
(s1-0 must-exist)
)
(if (not s0-0)
(set! s0-0 (-> proc entity))
)
(when (= lump-name 'path)
(let ((v0-0 (entity-actor-lookup s0-0 'path-actor 0)))
(if v0-0
(set! s0-0 v0-0)
)
)
)
(let ((s2-0 (the-as object 0)))
(set! sv-16 (new 'static 'res-tag))
(let* ((t9-1 (method-of-type res-lump get-property-data))
(a1-2 lump-name)
(a2-2 'interp)
(t0-1 #f)
(t1-1 (the-as (pointer res-tag) (& sv-16)))
(t2-1 *res-static-buf*)
(s0-1 (t9-1 s0-0 a1-2 a2-2 sv-32 (the-as pointer t0-1) t1-1 t2-1))
)
(cond
(s0-1
(set! s2-0 (object-new allocation type-to-make (the-as int (-> type-to-make size))))
(set! v0-3 (cond
((nonzero? (the-as path-control s2-0))
(set! (-> (the-as path-control s2-0) process) (the-as process-drawable proc))
(set! (-> (the-as path-control s2-0) name) lump-name)
(set! (-> (the-as path-control s2-0) curve cverts) (the-as (inline-array vector) s0-1))
(set! v0-3 (-> sv-16 elt-count))
(set! (-> (the-as path-control s2-0) curve num-cverts) (the-as int v0-3))
v0-3
)
(else
(go process-drawable-art-error "memory")
)
)
)
)
(else
(when (not s1-0)
(set! s2-0 (object-new allocation type-to-make (the-as int (-> type-to-make size))))
(cond
((nonzero? (the-as path-control s2-0))
(logior! (-> (the-as path-control s2-0) flags) (path-control-flag not-found))
(set! (-> (the-as path-control s2-0) process) (the-as process-drawable proc))
(set! (-> (the-as path-control s2-0) name) lump-name)
(set! (-> (the-as path-control s2-0) curve cverts) (the-as (inline-array vector) #f))
(set! (-> (the-as path-control s2-0) curve num-cverts) 0)
0
)
(else
(go process-drawable-art-error "memory")
)
)
)
)
)
)
(the-as path-control s2-0)
)
)
)
;; definition for method 30 of type path-control
(defmethod should-display-marks? ((this path-control))
(and *display-path-marks* (logtest? (-> this flags) (path-control-flag display)))
)
;; definition for method 17 of type path-control
(defmethod get-num-segments ((this path-control))
(the float (+ (-> this curve num-cverts) -1))
)
;; definition for method 19 of type path-control
(defmethod get-num-verts ((this path-control))
(-> this curve num-cverts)
)
;; definition for method 20 of type path-control
(defmethod segement-duration->path-duration ((this path-control) (arg0 float))
(* arg0 (get-num-segments this))
)
;; definition for method 21 of type path-control
(defmethod path-duration->segment-duration ((this path-control) (arg0 float))
(/ arg0 (get-num-segments this))
)
;; definition for method 0 of type curve-control
(defmethod new curve-control ((allocation symbol) (type-to-make type) (proc process) (lump-name symbol) (lump-time float))
(let ((gp-0 (object-new allocation type-to-make (the-as int (-> type-to-make size)))))
(set! (-> gp-0 process) (the-as process-drawable proc))
(set! (-> gp-0 name) lump-name)
(let* ((s3-1 (-> proc entity))
(v1-2 lump-name)
(s2-0
(cond
((= v1-2 'path)
'path-k
)
((= v1-2 'flow)
'flow-k
)
((= v1-2 'intro)
'intro-k
)
((= v1-2 'pathshort)
'pathshort-k
)
((= v1-2 'patha)
'patha-k
)
((= v1-2 'pathb)
'pathb-k
)
(else
(format
0
"WARNING: curve-control is being asked to look up an unknown name '~A', it will have to do so by string.~%"
lump-name
)
(let ((s2-1 string->symbol))
(format (clear *temp-string*) "~A-k" lump-name)
(s2-1 *temp-string*)
)
)
)
)
)
(let ((v1-3 (entity-actor-lookup s3-1 'path-actor 0)))
(if v1-3
(set! s3-1 v1-3)
)
)
(when (not (get-curve-data! s3-1 (-> gp-0 curve) lump-name s2-0 lump-time))
(cond
((> (-> gp-0 curve num-cverts) 0)
(set! (-> gp-0 type) path-control)
)
(else
(logior! (-> gp-0 flags) (path-control-flag not-found))
(set! (-> gp-0 curve cverts) (the-as (inline-array vector) #f))
(set! (-> gp-0 curve num-cverts) 0)
0
)
)
)
)
gp-0
)
)
;; failed to figure out what this is:
0
@@ -0,0 +1,178 @@
;;-*-Lisp-*-
(in-package goal)
;; definition for symbol *sp-60-hz*, type symbol
(define *sp-60-hz* #t)
;; definition of type sparticle-cpuinfo
(deftype sparticle-cpuinfo (structure)
"The per-particle information. This stays on the CPU, and isn't uploaded to the VU."
((sprite sprite-vec-data-2d)
(adgif adgif-shader)
(radius float)
(omega float)
(vel-sxvel vector :inline)
(rot-syvel vector :inline)
(fade rgbaf :inline)
(acc vector :inline)
(rotvel3d quaternion :inline)
(vel vector3s :inline :overlay-at (-> vel-sxvel data 0))
(accel vector3s :inline :overlay-at (-> acc data 0))
(scalevelx float :overlay-at (-> vel-sxvel data 3))
(scalevely float :overlay-at (-> rot-syvel data 3))
(friction float)
(timer int32)
(flags sp-cpuinfo-flag)
(user-int32 int32)
(user-uint32 uint32 :overlay-at user-int32)
(user-float float :overlay-at user-int32)
(user-pntr uint32 :overlay-at user-int32)
(user-object basic :overlay-at user-int32)
(user-sprite sprite-vec-data-2d :overlay-at user-int32)
(sp-func (function sparticle-system sparticle-cpuinfo sprite-vec-data-3d uint none))
(next-time uint32)
(next-launcher basic)
(cache-alpha float)
(valid uint8)
(clock-index uint8)
(user1-int16 uint16)
(key sparticle-launch-control)
(binding sparticle-launch-state)
(data uint32 1 :overlay-at omega)
(datab int8 4 :overlay-at omega)
(dataf float 1 :overlay-at omega)
(datac uint8 1 :overlay-at omega)
)
)
;; definition for method 3 of type sparticle-cpuinfo
(defmethod inspect ((this sparticle-cpuinfo))
(when (not this)
(set! this this)
(goto cfg-4)
)
(format #t "[~8x] ~A~%" this 'sparticle-cpuinfo)
(format #t "~1Tsprite: #<sprite-vec-data-2d @ #x~X>~%" (-> this sprite))
(format #t "~1Tadgif: #<adgif-shader @ #x~X>~%" (-> this adgif))
(format #t "~1Tradius: ~f~%" (-> this radius))
(format #t "~1Tomega: ~f~%" (-> this omega))
(format #t "~1Tvel-sxvel: #<vector @ #x~X>~%" (-> this vel-sxvel))
(format #t "~1Trot-syvel: #<vector @ #x~X>~%" (-> this rot-syvel))
(format #t "~1Tfade: #<rgbaf @ #x~X>~%" (-> this fade))
(format #t "~1Tacc: #<vector @ #x~X>~%" (-> this acc))
(format #t "~1Trotvel3d: #<quaternion @ #x~X>~%" (-> this rotvel3d))
(format #t "~1Tvel: #<vector3s @ #x~X>~%" (-> this vel-sxvel))
(format #t "~1Taccel: #<vector3s @ #x~X>~%" (-> this acc))
(format #t "~1Tscalevelx: ~f~%" (-> this vel-sxvel w))
(format #t "~1Tscalevely: ~f~%" (-> this rot-syvel w))
(format #t "~1Tfriction: ~f~%" (-> this friction))
(format #t "~1Ttimer: ~D~%" (-> this timer))
(format #t "~1Tflags: ~D~%" (-> this flags))
(format #t "~1Tuser-int32: ~D~%" (-> this user-int32))
(format #t "~1Tuser-uint32: ~D~%" (-> this user-uint32))
(format #t "~1Tuser-float: ~f~%" (the-as float (-> this user-uint32)))
(format #t "~1Tuser-pntr: #x~X~%" (-> this user-uint32))
(format #t "~1Tuser-object: ~A~%" (-> this user-int32))
(format #t "~1Tuser-sprite: #<sprite-vec-data-2d @ #x~X>~%" (-> this user-uint32))
(format #t "~1Tsp-func: ~A~%" (-> this sp-func))
(format #t "~1Tnext-time: ~D~%" (-> this next-time))
(format #t "~1Tnext-launcher: ~A~%" (-> this next-launcher))
(format #t "~1Tcache-alpha: ~f~%" (-> this cache-alpha))
(format #t "~1Tvalid: ~D~%" (-> this valid))
(format #t "~1Tclock-index: ~D~%" (-> this clock-index))
(format #t "~1Tuser1-int16: ~D~%" (-> this user1-int16))
(format #t "~1Tkey: ~A~%" (-> this key))
(format #t "~1Tbinding: #<sparticle-launch-state @ #x~X>~%" (-> this binding))
(format #t "~1Tdata[1] @ #x~X~%" (&-> this omega))
(format #t "~1Tdatab[4] @ #x~X~%" (&-> this omega))
(format #t "~1Tdataf[1] @ #x~X~%" (&-> this omega))
(format #t "~1Tdatac[1] @ #x~X~%" (&-> this omega))
(label cfg-4)
this
)
;; definition of type sparticle-launchinfo
(deftype sparticle-launchinfo (structure)
"Settings for launching a particle. These are a temporary thing consumed by the assembly particle code, and modified by particle callbacks."
((launchrot vector :inline)
(conerot vector :inline)
(rotate-x float)
(rotate-y float)
(rotate-z float)
(coneradius float)
(rotate vector :inline :overlay-at rotate-x)
(scale-x float)
(scale-y float)
(scale-z float)
(dummy float)
(scale vector :inline :overlay-at scale-x)
(data uint8 1 :overlay-at (-> launchrot data 0))
)
)
;; definition for method 3 of type sparticle-launchinfo
(defmethod inspect ((this sparticle-launchinfo))
(when (not this)
(set! this this)
(goto cfg-4)
)
(format #t "[~8x] ~A~%" this 'sparticle-launchinfo)
(format #t "~1Tlaunchrot: ~`vector`P~%" (-> this launchrot))
(format #t "~1Tconerot: ~`vector`P~%" (-> this conerot))
(format #t "~1Trotate-x: ~f~%" (-> this rotate-x))
(format #t "~1Trotate-y: ~f~%" (-> this rotate-y))
(format #t "~1Trotate-z: ~f~%" (-> this rotate-z))
(format #t "~1Tconeradius: ~f~%" (-> this coneradius))
(format #t "~1Trotate: ~`vector`P~%" (&-> this rotate-x))
(format #t "~1Tscale-x: ~f~%" (-> this scale-x))
(format #t "~1Tscale-y: ~f~%" (-> this scale-y))
(format #t "~1Tscale-z: ~f~%" (-> this scale-z))
(format #t "~1Tdummy: ~f~%" (-> this dummy))
(format #t "~1Tscale: ~`vector`P~%" (&-> this scale-x))
(format #t "~1Tdata[1] @ #x~X~%" (-> this launchrot))
(label cfg-4)
this
)
;; definition of type sparticle-system
(deftype sparticle-system (basic)
"An entire particle 'system', which is a pipeline for spawning, updating, and generating sprite-renderer DMA data.
There are separate systems for different modes of sprite rendering: 2D/billboard, full 3D, and screen-space (HUD)"
((blocks int32 2)
(length int32 2)
(num-alloc int32 2)
(is-3d basic)
(flags uint32)
(alloc-table (pointer uint64))
(cpuinfo-table (inline-array sparticle-cpuinfo))
(vecdata-table pointer)
(adgifdata-table (inline-array adgif-shader))
)
)
;; definition for method 3 of type sparticle-system
(defmethod inspect ((this sparticle-system))
(when (not this)
(set! this this)
(goto cfg-4)
)
(format #t "[~8x] ~A~%" this (-> this type))
(format #t "~1Tblocks[2] @ #x~X~%" (-> this blocks))
(format #t "~1Tlength[2] @ #x~X~%" (-> this length))
(format #t "~1Tnum-alloc[2] @ #x~X~%" (-> this num-alloc))
(format #t "~1Tis-3d: ~A~%" (-> this is-3d))
(format #t "~1Tflags: ~D~%" (-> this flags))
(format #t "~1Talloc-table: #x~X~%" (-> this alloc-table))
(format #t "~1Tcpuinfo-table: #x~X~%" (-> this cpuinfo-table))
(format #t "~1Tvecdata-table: #x~X~%" (-> this vecdata-table))
(format #t "~1Tadgifdata-table: #x~X~%" (-> this adgifdata-table))
(label cfg-4)
this
)
;; failed to figure out what this is:
0
+454
View File
@@ -0,0 +1,454 @@
;;-*-Lisp-*-
(in-package goal)
;; definition of type load-dgo-msg
(deftype load-dgo-msg (structure)
"IOP RPC message for loading a dgo."
((rsvd uint16)
(result load-msg-result)
(b1 pointer)
(b2 pointer)
(bt pointer)
(name uint128)
(address uint32 :overlay-at b1)
(id uint128)
(pad uint32 7)
)
)
;; definition for method 3 of type load-dgo-msg
;; INFO: Used lq/sq
(defmethod inspect ((this load-dgo-msg))
(when (not this)
(set! this this)
(goto cfg-4)
)
(format #t "[~8x] ~A~%" this 'load-dgo-msg)
(format #t "~1Trsvd: ~D~%" (-> this rsvd))
(format #t "~1Tresult: ~D~%" (-> this result))
(format #t "~1Tb1: #x~X~%" (-> this b1))
(format #t "~1Tb2: #x~X~%" (-> this b2))
(format #t "~1Tbt: #x~X~%" (-> this bt))
(format #t "~1Tname: ~D~%" (-> this name))
(format #t "~1Taddress: ~D~%" (-> this b1))
(format #t "~1Tid: ~D~%" (-> this id))
(label cfg-4)
this
)
;; definition of type load-chunk-msg
(deftype load-chunk-msg (structure)
"IOP RPC message for loading a chunk of a chunked animation"
((rsvd uint16)
(result load-msg-result)
(address pointer)
(section uint32)
(maxlen uint32)
(dummy uint32 4)
(basename sound-stream-name :inline)
)
)
;; definition for method 3 of type load-chunk-msg
(defmethod inspect ((this load-chunk-msg))
(when (not this)
(set! this this)
(goto cfg-4)
)
(format #t "[~8x] ~A~%" this 'load-chunk-msg)
(format #t "~1Trsvd: ~D~%" (-> this rsvd))
(format #t "~1Tresult: ~D~%" (-> this result))
(format #t "~1Taddress: ~D~%" (-> this address))
(format #t "~1Tsection: ~D~%" (-> this section))
(format #t "~1Tmaxlen: ~D~%" (-> this maxlen))
(format #t "~1Tdummy[4] @ #x~X~%" (-> this dummy))
(format #t "~1Tbasename: #<sound-stream-name @ #x~X>~%" (-> this basename))
(label cfg-4)
this
)
;; definition of type play-chunk-msg
(deftype play-chunk-msg (structure)
"IOP RPC message for playing some streamed audio."
((rsvd uint16)
(result uint16)
(address pointer)
(section uint32)
(volume int32 :overlay-at section)
(maxlen uint32)
(group uint8 :overlay-at maxlen)
(id uint32 4)
(basename sound-stream-name 4 :inline)
)
)
;; definition for method 3 of type play-chunk-msg
(defmethod inspect ((this play-chunk-msg))
(when (not this)
(set! this this)
(goto cfg-4)
)
(format #t "[~8x] ~A~%" this 'play-chunk-msg)
(format #t "~1Trsvd: ~D~%" (-> this rsvd))
(format #t "~1Tresult: ~D~%" (-> this result))
(format #t "~1Taddress: ~D~%" (-> this address))
(format #t "~1Tsection: ~D~%" (-> this section))
(format #t "~1Tvolume: ~D~%" (-> this volume))
(format #t "~1Tmaxlen: ~D~%" (-> this maxlen))
(format #t "~1Tgroup: ~D~%" (-> this group))
(format #t "~1Tid[4] @ #x~X~%" (-> this id))
(format #t "~1Tbasename[4] @ #x~X~%" (-> this basename))
(label cfg-4)
this
)
;; failed to figure out what this is:
(when (zero? *load-dgo-rpc*)
(set! *load-dgo-rpc* (new 'global 'rpc-buffer-pair (the-as uint 64) (the-as uint 1) 3))
(set! *load-str-rpc* (new 'global 'rpc-buffer-pair (the-as uint 80) (the-as uint 1) 4))
(set! *play-str-rpc* (new 'global 'rpc-buffer-pair (the-as uint 256) (the-as uint 4) 5))
(set! *load-str-lock* #f)
(set! *que-str-lock* #f)
(set! *dgo-name* (new 'global 'string 64 (the-as string #f)))
)
;; definition for function str-load
(defun str-load ((name string) (chunk-idx int) (dest-addr pointer) (max-len int))
"Send a message to the IOP to start loading a chunk of a .STR file to the EE."
(if (or (check-busy *load-str-rpc*) *load-str-lock*)
(return #f)
)
(let ((s2-0 (the-as load-chunk-msg (add-element *load-str-rpc*))))
(set! (-> s2-0 result) (load-msg-result invalid))
(set! (-> s2-0 address) dest-addr)
(set! (-> s2-0 section) (the-as uint chunk-idx))
(set! (-> s2-0 maxlen) (the-as uint max-len))
(copyn-charp<-string (the-as (pointer uint8) (-> s2-0 basename)) name 48)
(call *load-str-rpc* (the-as uint 0) (the-as pointer s2-0) (the-as uint 32))
)
(set! *load-str-lock* #t)
(set! *que-str-lock* #t)
#t
)
;; definition for function str-load-status
(defun str-load-status ((maxlen-out (pointer int32)))
"Get the status of the most recent load.
Return 'busy if in progress, 'error if failed, or 'complete.
If 'complete, returns the maxlen value from the IOP."
(if (check-busy *load-str-rpc*)
(return 'busy)
)
(set! *load-str-lock* #f)
(set! *que-str-lock* #t)
(let ((v1-7 (the-as load-chunk-msg (pop-last-received *load-str-rpc*))))
(if (= (-> v1-7 result) (load-msg-result error))
(return 'error)
)
(set! (-> maxlen-out 0) (the-as int (-> v1-7 maxlen)))
)
'complete
)
;; definition for function str-load-cancel
;; WARN: Return type mismatch int vs none.
(defun str-load-cancel ()
"Cancel a streaming load. Note that this does not actually stop the transfer, so the IOP may continue writing to the buffer."
(set! *load-str-lock* #f)
(set! *que-str-lock* #t)
0
(none)
)
;; definition for function str-play-async
;; WARN: Return type mismatch int vs none.
(defun str-play-async ((name string) (id sound-id) (chunk-idx int) (group int))
"Start playing a streaming audio."
(set! *que-str-lock* #t)
(let ((s2-0 (the-as play-chunk-msg (add-element *play-str-rpc*))))
(copyn-charp<-string (the-as (pointer uint8) (-> s2-0 basename)) name 48)
(copyn-charp<-string (the-as (pointer uint8) (-> s2-0 basename 1)) "" 48)
(copyn-charp<-string (the-as (pointer uint8) (-> s2-0 basename 2)) "" 48)
(copyn-charp<-string (the-as (pointer uint8) (-> s2-0 basename 3)) "" 48)
(set! (-> s2-0 id 0) (the-as uint id))
(set! (-> s2-0 id 1) (the-as uint 0))
(set! (-> s2-0 id 2) (the-as uint 0))
(set! (-> s2-0 id 3) (the-as uint 0))
(set! (-> s2-0 section) (the-as uint chunk-idx))
(set! (-> s2-0 maxlen) (the-as uint 0))
(set! (-> s2-0 group) (the-as uint group))
(set! (-> s2-0 result) (the-as uint 0))
)
0
0
(none)
)
;; definition for function str-play-stop
;; WARN: Return type mismatch int vs none.
(defun str-play-stop ((name string) (id sound-id))
"Stop playing streaming audio."
(set! *que-str-lock* #t)
(let ((s4-0 (the-as play-chunk-msg (add-element *play-str-rpc*))))
(copyn-charp<-string (the-as (pointer uint8) (-> s4-0 basename)) name 48)
(copyn-charp<-string (the-as (pointer uint8) (-> s4-0 basename 1)) "" 48)
(copyn-charp<-string (the-as (pointer uint8) (-> s4-0 basename 2)) "" 48)
(copyn-charp<-string (the-as (pointer uint8) (-> s4-0 basename 3)) "" 48)
(set! (-> s4-0 id 0) (the-as uint id))
(set! (-> s4-0 id 1) (the-as uint 0))
(set! (-> s4-0 id 2) (the-as uint 0))
(set! (-> s4-0 id 3) (the-as uint 0))
(set! (-> s4-0 result) (the-as uint 1))
)
0
(none)
)
;; definition for function str-play-queue
;; WARN: Return type mismatch int vs none.
(defun str-play-queue ((name0 string) (name1 string) (name2 string) (name3 string) (ids (pointer uint32)) (mask pointer))
"Queue up streaming data, allowing it to start playing without delay."
(when (and (not (check-busy *play-str-rpc*)) (not *que-str-lock*))
(let ((s4-0 (the-as play-chunk-msg (add-element *play-str-rpc*))))
(if name0
(copyn-charp<-string (the-as (pointer uint8) (-> s4-0 basename)) name0 48)
(copyn-charp<-string (the-as (pointer uint8) (-> s4-0 basename)) "" 48)
)
(if name1
(copyn-charp<-string (the-as (pointer uint8) (-> s4-0 basename 1)) name1 48)
(copyn-charp<-string (the-as (pointer uint8) (-> s4-0 basename 1)) "" 48)
)
(if name2
(copyn-charp<-string (the-as (pointer uint8) (-> s4-0 basename 2)) name2 48)
(copyn-charp<-string (the-as (pointer uint8) (-> s4-0 basename 2)) "" 48)
)
(if name3
(copyn-charp<-string (the-as (pointer uint8) (-> s4-0 basename 3)) name3 48)
(copyn-charp<-string (the-as (pointer uint8) (-> s4-0 basename 3)) "" 48)
)
(dotimes (v1-14 4)
(set! (-> s4-0 id v1-14) (-> ids v1-14))
)
(set! (-> s4-0 address) mask)
(set! (-> s4-0 result) (the-as uint 2))
)
)
(set! *que-str-lock* #f)
0
(none)
)
;; definition for function str-ambient-play
;; WARN: Return type mismatch int vs none.
(defun str-ambient-play ((name string))
"Start playing ambient (unused?)."
(set! *que-str-lock* #t)
(let ((s5-0 (the-as play-chunk-msg (add-element *play-str-rpc*))))
(set! (-> s5-0 basename 0 name 0) (the-as uint 36))
(copyn-charp<-string (&-> s5-0 basename 0 name 1) name 48)
(set! (-> s5-0 result) (the-as uint 0))
)
0
0
(none)
)
;; definition for function str-ambient-stop
;; WARN: Return type mismatch int vs none.
(defun str-ambient-stop ((name string))
"Stop playing ambient (unused?)."
(set! *que-str-lock* #t)
(let ((s5-0 (the-as play-chunk-msg (add-element *play-str-rpc*))))
(set! (-> s5-0 basename 0 name 0) (the-as uint 36))
(copyn-charp<-string (&-> s5-0 basename 0 name 1) name 48)
(set! (-> s5-0 result) (the-as uint 1))
)
0
(none)
)
;; definition for function str-play-kick
;; WARN: Return type mismatch int vs none.
(defun str-play-kick ()
"Do an empty RPC on play so the IOP code runs and can update buffers."
(cond
((check-busy *play-str-rpc*)
)
(else
(call *play-str-rpc* (the-as uint 0) (the-as pointer 0) (the-as uint 0))
)
)
0
(none)
)
;; definition for symbol *dgo-time*, type time-frame
(define *dgo-time* (the-as time-frame 0))
;; definition for function dgo-load-begin
;; INFO: Used lq/sq
(defun dgo-load-begin ((name string) (buffer1 uint128) (buffer2 pointer) (buffer-top pointer) (arg4 pointer))
"Start a DGO load!"
(set! *dgo-time* (-> *display* real-clock integral-frame-counter))
(format 0 "Starting level load clock~%")
(sync *load-dgo-rpc* #t)
(let ((s1-0 (the-as load-dgo-msg (add-element *load-dgo-rpc*))))
(set! (-> s1-0 result) (load-msg-result invalid))
(set! (-> s1-0 b1) buffer2)
(set! (-> s1-0 b2) buffer-top)
(set! (-> s1-0 bt) arg4)
(set! (-> s1-0 name) (string->sound-name name))
(set! (-> s1-0 id) buffer1)
(call *load-dgo-rpc* (the-as uint 0) (the-as pointer s1-0) (the-as uint 32))
s1-0
)
)
;; definition for function dgo-load-get-next
(defun dgo-load-get-next ((done-out (pointer symbol)))
"Get the address of the most recently loaded object. #f is there is none. Returns if this is the last by arg0."
(set! (-> done-out 0) #f)
(let ((gp-0 (the-as pointer #f)))
(when (not (check-busy *load-dgo-rpc*))
(let ((v1-4 (the-as load-dgo-msg (pop-last-received *load-dgo-rpc*))))
(when v1-4
(when (or (= (-> v1-4 result) (load-msg-result done)) (= (-> v1-4 result) (load-msg-result more)))
(set! gp-0 (-> v1-4 b1))
(set! (-> done-out 0) #t)
)
(if (= (-> v1-4 result) (load-msg-result more))
(set! (-> done-out 0) #f)
)
(if (= (-> v1-4 result) (load-msg-result done))
(format
0
"Elapsed time for level = ~Fs~%"
(* 0.016666668 (the float (- (-> *display* real-clock integral-frame-counter) *dgo-time*)))
)
)
)
)
)
gp-0
)
)
;; definition for function dgo-load-continue
;; INFO: Used lq/sq
(defun dgo-load-continue ((buffer1 pointer) (buffer2 pointer) (buffer-top pointer))
"Inform the IOP that it is safe to start loading the next object."
(let ((gp-0 (the-as load-dgo-msg (add-element *load-dgo-rpc*))))
(set! (-> gp-0 result) (load-msg-result invalid))
(set! (-> gp-0 b1) buffer1)
(set! (-> gp-0 b2) buffer2)
(set! (-> gp-0 bt) buffer-top)
(set! (-> gp-0 name) (the-as uint128 0))
(call *load-dgo-rpc* (the-as uint 1) (the-as pointer gp-0) (the-as uint 32))
gp-0
)
)
;; definition for function dgo-load-cancel
;; WARN: Return type mismatch int vs none.
(defun dgo-load-cancel ((arg0 int))
"Abort a DGO load."
(let ((v1-0 (the-as sound-rpc-cancel-dgo (get-sound-buffer-entry))))
(set! (-> v1-0 command) (the-as uint 49))
(set! (-> v1-0 id) (the-as uint arg0))
)
0
(none)
)
;; definition for function find-temp-buffer
(defun find-temp-buffer ((size int))
"Unused function to find some temporary leftover space in DMA buffer.
Unused since jak 1, and checks the same buffer twice??"
(let ((gp-0 (+ (/ size 16) 2)))
(cond
((< (the-as uint gp-0)
(the-as uint (dma-buffer-free (-> *display* frames (-> *display* on-screen) global-buf)))
)
(logand -16 (&+ (-> *display* frames (-> *display* on-screen) global-buf base) 15))
)
((< (the-as uint gp-0)
(the-as uint (dma-buffer-free (-> *display* frames (-> *display* on-screen) global-buf)))
)
(logand -16 (&+ (-> *display* frames (-> *display* on-screen) global-buf base) 15))
)
)
)
)
;; definition for function dgo-load-link
(defun dgo-load-link ((object-file dgo-header) (heap kheap) (end-of-buffer uint) (print-login symbol) (loaded-from-top symbol))
"Start the async linker on a GOAL object file that was just loaded."
(let ((s4-0 (the-as object (&+ object-file 64))))
(let ((v1-0 end-of-buffer))
(cond
((>= (the-as int (+ (the-as uint s4-0) (-> object-file length))) (the-as int (-> heap top-base)))
(format
0
"ERROR: -----> dgo file header ~g #x~X has overrun heap #x~X by ~D bytes. This is very bad!~%"
(-> object-file rootname)
object-file
heap
(- (+ (the-as uint s4-0) (-> object-file length)) (the-as uint (-> heap top-base)))
)
)
((and (< (the-as int object-file) (the-as int v1-0))
(>= (the-as int (+ (the-as uint s4-0) (-> object-file length))) (the-as int v1-0))
)
(format
0
"ERROR: -----> dgo file header ~g #x~X has overrun heap #x~X by ~D bytes. This is very bad!~%"
(-> object-file rootname)
object-file
heap
(- (+ (the-as uint s4-0) (-> object-file length)) v1-0)
)
)
)
)
(if loaded-from-top
(format
0
"NOTICE: loaded ~g, ~D bytes (~f K) at top ~D at #x~X - #x~X~%"
(-> object-file rootname)
(-> object-file length)
(* 0.0009765625 (the float (-> object-file length)))
(- (+ (the-as uint s4-0) (-> object-file length)) (the-as uint (-> heap base)))
object-file
(&+ (the-as pointer s4-0) (-> object-file length))
)
)
(string<-charp (clear *dgo-name*) (-> object-file rootname))
(nonzero? (link-begin
(the-as pointer s4-0)
(-> *dgo-name* data)
(the-as int (-> object-file length))
heap
(if print-login
(link-flag output-load-msg output-load-true-msg execute-login print-login fast-link)
(link-flag output-load-msg output-load-true-msg execute-login fast-link)
)
)
)
)
)
;; definition for function destroy-mem
;; WARN: Return type mismatch int vs none.
(defun destroy-mem ((start (pointer uint32)) (end (pointer uint32)))
"Overwrite memory with #xffffffff for debugging."
(while (< (the-as int start) (the-as int end))
(set! (-> start 0) (the-as uint #xffffffff))
(set! start (&-> start 1))
)
0
(none)
)
+394
View File
@@ -0,0 +1,394 @@
;;-*-Lisp-*-
(in-package goal)
;; definition of type check-vector-collision-with-nav-spheres-info
(deftype check-vector-collision-with-nav-spheres-info (structure)
((u float)
(intersect vector :inline)
(normal vector :inline)
)
)
;; definition for method 3 of type check-vector-collision-with-nav-spheres-info
(defmethod inspect ((this check-vector-collision-with-nav-spheres-info))
(when (not this)
(set! this this)
(goto cfg-4)
)
(format #t "[~8x] ~A~%" this 'check-vector-collision-with-nav-spheres-info)
(format #t "~1Tu: ~f~%" (-> this u))
(format #t "~1Tintersect: #<vector @ #x~X>~%" (-> this intersect))
(format #t "~1Tnormal: #<vector @ #x~X>~%" (-> this normal))
(label cfg-4)
this
)
;; definition of type nav-gap-info
(deftype nav-gap-info (structure)
((dest vector :inline)
(poly nav-poly)
)
)
;; definition for method 3 of type nav-gap-info
(defmethod inspect ((this nav-gap-info))
(when (not this)
(set! this this)
(goto cfg-4)
)
(format #t "[~8x] ~A~%" this 'nav-gap-info)
(format #t "~1Tdest: ~`vector`P~%" (-> this dest))
(format #t "~1Tpoly: #<nav-poly @ #x~X>~%" (-> this poly))
(label cfg-4)
this
)
;; definition of type nav-avoid-spheres-params
(deftype nav-avoid-spheres-params (structure)
((current-pos vector :inline)
(travel vector :inline)
(pref-dir vector :inline)
(out-travel vector 2 :inline)
(closest-sphere-dist2 float)
(avoiding-sphere? symbol)
)
)
;; definition for method 3 of type nav-avoid-spheres-params
(defmethod inspect ((this nav-avoid-spheres-params))
(when (not this)
(set! this this)
(goto cfg-4)
)
(format #t "[~8x] ~A~%" this 'nav-avoid-spheres-params)
(format #t "~1Tcurrent-pos: #<vector @ #x~X>~%" (-> this current-pos))
(format #t "~1Ttravel: #<vector @ #x~X>~%" (-> this travel))
(format #t "~1Tpref-dir: #<vector @ #x~X>~%" (-> this pref-dir))
(format #t "~1Tout-travel[2] @ #x~X~%" (-> this out-travel))
(format #t "~1Tclosest-sphere-dist2: ~f~%" (-> this closest-sphere-dist2))
(format #t "~1Tavoiding-sphere?: ~A~%" (-> this avoiding-sphere?))
(label cfg-4)
this
)
;; definition of type nav-callback-info
(deftype nav-callback-info (structure)
((callback-count int32)
(callback-array (function object nav-control none) 10)
)
)
;; definition for method 3 of type nav-callback-info
(defmethod inspect ((this nav-callback-info))
(when (not this)
(set! this this)
(goto cfg-4)
)
(format #t "[~8x] ~A~%" this 'nav-callback-info)
(format #t "~1Tcallback-count: ~D~%" (-> this callback-count))
(format #t "~1Tcallback-array[10] @ #x~X~%" (-> this callback-array))
(label cfg-4)
this
)
;; definition of type nav-state
(deftype nav-state (structure)
((flags nav-state-flag)
(nav nav-control)
(user-poly nav-poly)
(mesh nav-mesh)
(current-poly nav-poly)
(virtual-current-poly nav-poly)
(next-poly nav-poly)
(target-poly nav-poly)
(rotation-rate float)
(speed meters)
(prev-speed meters)
(pad0 uint32 1)
(travel vector :inline)
(target-pos vector :inline)
(current-pos vector :inline)
(current-pos-local vector :inline)
(virtual-current-pos-local vector :inline)
(velocity vector :inline)
(heading vector :inline)
(target-dir vector :inline)
(accel vector :inline :overlay-at target-dir)
(user-position vector :inline :overlay-at virtual-current-pos-local)
)
(:methods
(nav-state-method-9 () none)
(nav-state-method-10 () none)
(nav-state-method-11 () none)
(nav-state-method-12 () none)
(nav-state-method-13 () none)
(nav-state-method-14 () none)
(nav-state-method-15 () none)
(nav-state-method-16 () none)
(nav-state-method-17 () none)
(nav-state-method-18 () none)
(nav-state-method-19 () none)
(nav-state-method-20 () none)
(nav-state-method-21 () none)
(nav-state-method-22 () none)
(nav-state-method-23 () none)
(nav-state-method-24 () none)
(nav-state-method-25 () none)
(nav-state-method-26 () none)
(nav-state-method-27 () none)
(nav-state-method-28 () none)
(nav-state-method-29 () none)
(nav-state-method-30 () none)
(nav-state-method-31 () none)
(nav-state-method-32 () none)
(nav-state-method-33 () none)
(nav-state-method-34 () none)
(nav-state-method-35 () none)
(nav-state-method-36 () none)
(nav-state-method-37 () none)
(nav-state-method-38 () none)
(nav-state-method-39 () none)
(nav-state-method-40 () none)
(nav-state-method-41 () none)
(nav-state-method-42 () none)
(nav-state-method-43 () none)
(nav-state-method-44 () none)
(nav-state-method-45 () none)
(nav-state-method-46 () none)
(nav-state-method-47 () none)
(nav-state-method-48 () none)
(nav-state-method-49 () none)
(nav-state-method-50 () none)
(nav-state-method-51 () none)
(nav-state-method-52 () none)
(nav-state-method-53 () none)
(nav-state-method-54 () none)
(nav-state-method-55 () none)
)
)
;; definition for method 3 of type nav-state
(defmethod inspect ((this nav-state))
(when (not this)
(set! this this)
(goto cfg-36)
)
(format #t "[~8x] ~A~%" this 'nav-state)
(format #t "~1Tflags: #x~X : (nav-state-flag " (-> this flags))
(let ((s5-0 (-> this flags)))
(if (= (logand s5-0 (nav-state-flag in-target-poly)) (nav-state-flag in-target-poly))
(format #t "in-target-poly ")
)
(if (= (logand s5-0 (nav-state-flag directional-mode)) (nav-state-flag directional-mode))
(format #t "directional-mode ")
)
(if (= (logand s5-0 (nav-state-flag initialized)) (nav-state-flag initialized))
(format #t "initialized ")
)
(if (= (logand s5-0 (nav-state-flag display-marks)) (nav-state-flag display-marks))
(format #t "display-marks ")
)
(if (= (logand s5-0 (nav-state-flag recovery-mode)) (nav-state-flag recovery-mode))
(format #t "recovery-mode ")
)
(if (= (logand s5-0 (nav-state-flag touching-sphere)) (nav-state-flag touching-sphere))
(format #t "touching-sphere ")
)
(if (= (logand s5-0 (nav-state-flag trapped-by-sphere)) (nav-state-flag trapped-by-sphere))
(format #t "trapped-by-sphere ")
)
(if (= (logand s5-0 (nav-state-flag blocked)) (nav-state-flag blocked))
(format #t "blocked ")
)
(if (= (logand s5-0 (nav-state-flag avoiding-sphere)) (nav-state-flag avoiding-sphere))
(format #t "avoiding-sphere ")
)
(if (= (logand s5-0 (nav-state-flag target-inside)) (nav-state-flag target-inside))
(format #t "target-inside ")
)
(if (= (logand s5-0 (nav-state-flag debug)) (nav-state-flag debug))
(format #t "debug ")
)
(if (= (logand s5-0 (nav-state-flag at-gap)) (nav-state-flag at-gap))
(format #t "at-gap ")
)
(if (= (logand s5-0 (nav-state-flag use-position)) (nav-state-flag use-position))
(format #t "user-position ")
)
(if (= (logand s5-0 (nav-state-flag in-mesh)) (nav-state-flag in-mesh))
(format #t "in-mesh ")
)
(if (= (logand s5-0 (nav-state-flag at-target)) (nav-state-flag at-target))
(format #t "at-target ")
)
(if (= (logand s5-0 (nav-state-flag target-poly-dirty)) (nav-state-flag target-poly-dirty))
(format #t "target-poly-dirty ")
)
)
(format #t ")~%")
(format #t "~1Tnav: ~A~%" (-> this nav))
(format #t "~1Tuser-poly: #<nav-poly @ #x~X>~%" (-> this user-poly))
(format #t "~1Tmesh: ~A~%" (-> this mesh))
(format #t "~1Tcurrent-poly: #<nav-poly @ #x~X>~%" (-> this current-poly))
(format #t "~1Tvirtual-current-poly: #<nav-poly @ #x~X>~%" (-> this virtual-current-poly))
(format #t "~1Tnext-poly: #<nav-poly @ #x~X>~%" (-> this next-poly))
(format #t "~1Ttarget-poly: #<nav-poly @ #x~X>~%" (-> this target-poly))
(format #t "~1Trotation-rate: ~f~%" (-> this rotation-rate))
(format #t "~1Tspeed: (meters ~m)~%" (-> this speed))
(format #t "~1Tprev-speed: (meters ~m)~%" (-> this prev-speed))
(format #t "~1Tpad0[1] @ #x~X~%" (-> this pad0))
(format #t "~1Ttravel: ~`vector`P~%" (-> this travel))
(format #t "~1Ttarget-pos: ~`vector`P~%" (-> this target-pos))
(format #t "~1Tcurrent-pos: ~`vector`P~%" (-> this current-pos))
(format #t "~1Tcurrent-pos-local: ~`vector`P~%" (-> this current-pos-local))
(format #t "~1Tvirtual-current-pos-local: ~`vector`P~%" (-> this virtual-current-pos-local))
(format #t "~1Tvelocity: ~`vector`P~%" (-> this velocity))
(format #t "~1Theading: ~`vector`P~%" (-> this heading))
(format #t "~1Ttarget-dir: ~`vector`P~%" (-> this target-dir))
(format #t "~1Taccel: #<vector @ #x~X>~%" (-> this target-dir))
(format #t "~1Tuser-position: #<vector @ #x~X>~%" (-> this virtual-current-pos-local))
(label cfg-36)
this
)
;; definition of type nav-control
(deftype nav-control (structure)
((flags nav-control-flag)
(callback-info nav-callback-info)
(process process)
(pad0 uint32)
(shape collide-shape)
(nearest-y-threshold meters)
(nav-cull-radius meters)
(sec-per-frame float)
(target-speed meters)
(acceleration meters)
(turning-acceleration meters)
(max-rotation-rate float)
(speed-scale float)
(sphere-count int32)
(sphere-array (inline-array sphere))
(root-sphere-id uint8)
(sphere-mask uint8)
(pad1 uint8 2)
(sphere-id-array uint8 16)
(extra-nav-sphere vector :inline)
(root-nav-sphere vector :inline)
(state nav-state :inline)
(mesh basic :overlay-at (-> state mesh))
)
(:methods
(nav-control-method-9 () none)
(nav-control-method-10 () none)
(nav-control-method-11 () none)
(nav-control-method-12 () none)
(nav-control-method-13 () none)
(nav-control-method-14 () none)
(nav-control-method-15 () none)
(nav-control-method-16 () none)
(nav-control-method-17 () none)
(nav-control-method-18 () none)
(nav-control-method-19 () none)
(nav-control-method-20 () none)
(nav-control-method-21 () none)
(nav-control-method-22 () none)
(nav-control-method-23 () none)
(nav-control-method-24 () none)
(nav-control-method-25 () none)
(nav-control-method-26 () none)
(nav-control-method-27 () none)
(nav-control-method-28 () none)
(nav-control-method-29 () none)
(nav-control-method-30 () none)
(nav-control-method-31 () none)
(nav-control-method-32 () none)
(nav-control-method-33 () none)
(nav-control-method-34 () none)
(nav-control-method-35 () none)
(nav-control-method-36 () none)
(nav-control-method-37 () none)
(nav-control-method-38 () none)
(nav-control-method-39 () none)
(nav-control-method-40 () none)
(nav-control-method-41 () none)
(nav-control-method-42 () none)
(nav-control-method-43 () none)
(nav-control-method-44 () none)
(nav-control-method-45 () none)
(nav-control-method-46 () none)
)
)
;; definition for method 3 of type nav-control
(defmethod inspect ((this nav-control))
(when (not this)
(set! this this)
(goto cfg-25)
)
(format #t "[~8x] ~A~%" this 'nav-control)
(format #t "~1Tflags: #x~X : (nav-control-flag " (-> this flags))
(let ((s5-0 (-> this flags)))
(if (= (logand s5-0 (nav-control-flag display-marks)) (nav-control-flag display-marks))
(format #t "display-marks ")
)
(if (= (logand s5-0 (nav-control-flag limit-rotation-rate)) (nav-control-flag limit-rotation-rate))
(format #t "limit-rotation-rate ")
)
(if (= (logand s5-0 (nav-control-flag update-heading-from-facing)) (nav-control-flag update-heading-from-facing))
(format #t "update-heading-from-facing ")
)
(if (= (logand s5-0 (nav-control-flag use-momentum)) (nav-control-flag use-momentum))
(format #t "use-momentum ")
)
(if (= (logand s5-0 (nav-control-flag output-sphere-hash)) (nav-control-flag output-sphere-hash))
(format #t "output-sphere-hash ")
)
(if (= (logand s5-0 (nav-control-flag no-redirect-in-clamp)) (nav-control-flag no-redirect-in-clamp))
(format #t "no-redirect-in-clamp ")
)
(if (= (logand s5-0 (nav-control-flag momentum-ignore-heading)) (nav-control-flag momentum-ignore-heading))
(format #t "momentum-ignore-heading ")
)
(if (= (logand s5-0 (nav-control-flag debug)) (nav-control-flag debug))
(format #t "debug ")
)
(if (= (logand s5-0 (nav-control-flag kernel-run)) (nav-control-flag kernel-run))
(format #t "kernel-run ")
)
)
(format #t ")~%")
(format #t "~1Tcallback-info: #<nav-callback-info @ #x~X>~%" (-> this callback-info))
(format #t "~1Tprocess: ~A~%" (-> this process))
(format #t "~1Tpad0: ~D~%" (-> this pad0))
(format #t "~1Tshape: ~A~%" (-> this shape))
(format #t "~1Tnearest-y-threshold: (meters ~m)~%" (-> this nearest-y-threshold))
(format #t "~1Tnav-cull-radius: (meters ~m)~%" (-> this nav-cull-radius))
(format #t "~1Tsec-per-frame: ~f~%" (-> this sec-per-frame))
(format #t "~1Ttarget-speed: (meters ~m)~%" (-> this target-speed))
(format #t "~1Tacceleration: (meters ~m)~%" (-> this acceleration))
(format #t "~1Tturning-acceleration: (meters ~m)~%" (-> this turning-acceleration))
(format #t "~1Tmax-rotation-rate: ~f~%" (-> this max-rotation-rate))
(format #t "~1Tspeed-scale: ~f~%" (-> this speed-scale))
(format #t "~1Tsphere-count: ~D~%" (-> this sphere-count))
(format #t "~1Tsphere-array: #x~X~%" (-> this sphere-array))
(format #t "~1Troot-sphere-id: ~D~%" (-> this root-sphere-id))
(format #t "~1Tsphere-mask: ~D~%" (-> this sphere-mask))
(format #t "~1Tpad1[2] @ #x~X~%" (-> this pad1))
(format #t "~1Tsphere-id-array[16] @ #x~X~%" (-> this sphere-id-array))
(dotimes (s5-1 (-> this sphere-count))
(format #t "~T [~D]~1Tsphere-id-array: ~D~%" s5-1 (-> this sphere-id-array s5-1))
)
(format #t "~1Textra-nav-sphere: ~`vector`P~%" (-> this extra-nav-sphere))
(format #t "~1Troot-nav-sphere: ~`vector`P~%" (-> this root-nav-sphere))
(format #t "~1Tstate: #<nav-state @ #x~X>~%" (-> this state))
(format #t "~1Tmesh: ~A~%" (-> this state mesh))
(label cfg-25)
this
)
;; failed to figure out what this is:
0
+805
View File
@@ -0,0 +1,805 @@
;;-*-Lisp-*-
(in-package goal)
;; definition of type nav-mesh-work-debug
(deftype nav-mesh-work-debug (structure)
"Debug outputs for the nav-mesh assembly functions"
((debug-vec1 vector :inline)
(debug-vec2 vector :inline)
(debug-vec3 vector :inline)
(debug-vec4 vector :inline)
(debug-vec5 vector :inline)
(debug-vec6 vector :inline)
(debug-vec7 vector :inline)
(debug-vec8 vector :inline)
(debug-vec9 vector :inline)
(debug-vec10 vector :inline)
(debug-vec11 vector :inline)
(debug-vec12 vector :inline)
(sphere-array sphere 16 :inline)
)
)
;; definition for method 3 of type nav-mesh-work-debug
(defmethod inspect ((this nav-mesh-work-debug))
(when (not this)
(set! this this)
(goto cfg-4)
)
(format #t "[~8x] ~A~%" this 'nav-mesh-work-debug)
(format #t "~1Tdebug-vec1: ~`vector`P~%" (-> this debug-vec1))
(format #t "~1Tdebug-vec2: ~`vector`P~%" (-> this debug-vec2))
(format #t "~1Tdebug-vec3: ~`vector`P~%" (-> this debug-vec3))
(format #t "~1Tdebug-vec4: ~`vector`P~%" (-> this debug-vec4))
(format #t "~1Tdebug-vec5: ~`vector`P~%" (-> this debug-vec5))
(format #t "~1Tdebug-vec6: ~`vector`P~%" (-> this debug-vec6))
(format #t "~1Tdebug-vec7: ~`vector`P~%" (-> this debug-vec7))
(format #t "~1Tdebug-vec8: ~`vector`P~%" (-> this debug-vec8))
(format #t "~1Tdebug-vec9: ~`vector`P~%" (-> this debug-vec9))
(format #t "~1Tdebug-vec10: ~`vector`P~%" (-> this debug-vec10))
(format #t "~1Tdebug-vec11: ~`vector`P~%" (-> this debug-vec11))
(format #t "~1Tdebug-vec12: ~`vector`P~%" (-> this debug-vec12))
(format #t "~1Tsphere-array[16] @ #x~X~%" (-> this sphere-array))
(label cfg-4)
this
)
;; definition of type nav-mesh-work
(deftype nav-mesh-work (structure)
"Workspace for nav-mesh processing functions."
((vert0-table int8 4)
(vert1-table int8 4)
(edge-mask-table uint8 3)
(pad0 uint32)
(deg-to-rad float)
(rad-to-deg float)
(nav-poly-min-dist float)
(nav-poly-epsilon float)
(sphere-array sphere 16 :inline)
(debug nav-mesh-work-debug)
(work-struct-in-scratch int8)
(mesh-struct-in-scratch int8)
(polys-in-scratch int8)
(mesh nav-mesh)
(nav basic)
(poly0 nav-poly)
(poly1 nav-poly)
(poly-id int32)
)
)
;; definition for method 3 of type nav-mesh-work
(defmethod inspect ((this nav-mesh-work))
(when (not this)
(set! this this)
(goto cfg-4)
)
(format #t "[~8x] ~A~%" this 'nav-mesh-work)
(format #t "~1Tvert0-table[4] @ #x~X~%" (-> this vert0-table))
(format #t "~1Tvert1-table[4] @ #x~X~%" (-> this vert1-table))
(format #t "~1Tedge-mask-table[3] @ #x~X~%" (-> this edge-mask-table))
(format #t "~1Tpad0: ~D~%" (-> this pad0))
(format #t "~1Tdeg-to-rad: ~f~%" (-> this deg-to-rad))
(format #t "~1Trad-to-deg: ~f~%" (-> this rad-to-deg))
(format #t "~1Tnav-poly-min-dist: ~f~%" (-> this nav-poly-min-dist))
(format #t "~1Tnav-poly-epsilon: ~f~%" (-> this nav-poly-epsilon))
(format #t "~1Tsphere-array[16] @ #x~X~%" (-> this sphere-array))
(format #t "~1Tdebug: #<nav-mesh-work-debug @ #x~X>~%" (-> this debug))
(format #t "~1Twork-struct-in-scratch: ~D~%" (-> this work-struct-in-scratch))
(format #t "~1Tmesh-struct-in-scratch: ~D~%" (-> this mesh-struct-in-scratch))
(format #t "~1Tpolys-in-scratch: ~D~%" (-> this polys-in-scratch))
(format #t "~1Tmesh: ~A~%" (-> this mesh))
(format #t "~1Tnav: ~A~%" (-> this nav))
(format #t "~1Tpoly0: ~A~%" (-> this poly0))
(format #t "~1Tpoly1: ~A~%" (-> this poly1))
(format #t "~1Tpoly-id: ~D~%" (-> this poly-id))
(label cfg-4)
this
)
;; definition of type nav-mesh-link
(deftype nav-mesh-link (structure)
"Link between two different meshes"
((id uint32)
(dest-mesh-id uint32)
(src-link-poly-id uint8)
(src-switch-poly-id uint8)
(dest-link-poly-id uint8)
(dest-switch-poly-id uint8)
(dest-mesh nav-mesh)
)
)
;; definition for method 3 of type nav-mesh-link
(defmethod inspect ((this nav-mesh-link))
(when (not this)
(set! this this)
(goto cfg-4)
)
(format #t "[~8x] ~A~%" this 'nav-mesh-link)
(format #t "~1Tid: ~D~%" (-> this id))
(format #t "~1Tdest-mesh-id: ~D~%" (-> this dest-mesh-id))
(format #t "~1Tsrc-link-poly-id: ~D~%" (-> this src-link-poly-id))
(format #t "~1Tsrc-switch-poly-id: ~D~%" (-> this src-switch-poly-id))
(format #t "~1Tdest-link-poly-id: ~D~%" (-> this dest-link-poly-id))
(format #t "~1Tdest-switch-poly-id: ~D~%" (-> this dest-switch-poly-id))
(format #t "~1Tdest-mesh: ~A~%" (-> this dest-mesh))
(label cfg-4)
this
)
;; definition of type nav-poly
(deftype nav-poly (structure)
"Polygon within a nav-mesh. Can be a tri or quad.
Based on the implementation of point-poly-intersection?, these should likely be convex."
((data uint8 64 :offset 0)
(vertex vector 4 :inline :overlay-at (-> data 0))
(vertex0 vector :inline :overlay-at (-> vertex 0))
(vertex1 vector :inline :overlay-at (-> vertex 1))
(vertex2 vector :inline :overlay-at (-> vertex 2))
(vertex3 vector :inline :overlay-at (-> vertex 3))
(id uint8 :overlay-at (-> data 12))
(pat uint8 :overlay-at (-> data 13))
(vertex-count uint8 :overlay-at (-> data 14))
(link uint8 :overlay-at (-> data 15))
(adj-poly uint8 4 :overlay-at (-> data 28))
(adj-poly0 uint8 :overlay-at (-> adj-poly 0))
(adj-poly1 uint8 :overlay-at (-> adj-poly 1))
(adj-poly2 uint8 :overlay-at (-> adj-poly 2))
(adj-poly3 uint8 :overlay-at (-> adj-poly 3))
(min-y float :overlay-at (-> data 44))
(max-y float :overlay-at (-> data 60))
)
)
;; definition for method 3 of type nav-poly
(defmethod inspect ((this nav-poly))
(when (not this)
(set! this this)
(goto cfg-4)
)
(format #t "[~8x] ~A~%" this 'nav-poly)
(format #t "~1Tdata[64] @ #x~X~%" (-> this vertex))
(format #t "~1Tvertex[4] @ #x~X~%" (-> this vertex))
(format #t "~1Tvertex0: ~`vector`P~%" (-> this vertex))
(format #t "~1Tvertex1: ~`vector`P~%" (-> this vertex1))
(format #t "~1Tvertex2: ~`vector`P~%" (-> this vertex2))
(format #t "~1Tvertex3: ~`vector`P~%" (-> this vertex3))
(format #t "~1Tid: ~D~%" (-> this id))
(format #t "~1Tpat: ~D~%" (-> this pat))
(format #t "~1Tvertex-count: ~D~%" (-> this vertex-count))
(format #t "~1Tlink: ~D~%" (-> this link))
(format #t "~1Tadj-poly[4] @ #x~X~%" (&-> this vertex1 w))
(format #t "~1Tadj-poly0: ~D~%" (-> this adj-poly0))
(format #t "~1Tadj-poly1: ~D~%" (-> this adj-poly1))
(format #t "~1Tadj-poly2: ~D~%" (-> this adj-poly2))
(format #t "~1Tadj-poly3: ~D~%" (-> this adj-poly3))
(format #t "~1Tmin-y: ~f~%" (-> this vertex2 w))
(format #t "~1Tmax-y: ~f~%" (-> this vertex3 w))
(label cfg-4)
this
)
;; definition of type nav-vertex
(deftype nav-vertex (vector)
()
)
;; definition for method 3 of type nav-vertex
;; INFO: Used lq/sq
(defmethod inspect ((this nav-vertex))
(when (not this)
(set! this this)
(goto cfg-4)
)
(format #t "[~8x] ~A~%" this 'nav-vertex)
(format #t "~1Tdata[4] @ #x~X~%" (&-> this x))
(format #t "~1Tx: ~f~%" (-> this x))
(format #t "~1Ty: ~f~%" (-> this y))
(format #t "~1Tz: ~f~%" (-> this z))
(format #t "~1Tw: ~f~%" (-> this w))
(format #t "~1Tquad: ~D~%" (-> this quad))
(label cfg-4)
this
)
;; definition of type nav-sphere
(deftype nav-sphere (structure)
((trans sphere :inline)
)
)
;; definition for method 3 of type nav-sphere
(defmethod inspect ((this nav-sphere))
(when (not this)
(set! this this)
(goto cfg-4)
)
(format #t "[~8x] ~A~%" this 'nav-sphere)
(format #t "~1Ttrans: #<sphere @ #x~X>~%" (-> this trans))
(label cfg-4)
this
)
;; definition of type nav-ray
(deftype nav-ray (structure)
((current-pos vector :inline)
(dir vector :inline)
(dest-pos vector :inline)
(current-poly nav-poly)
(next-poly nav-poly)
(len meters)
(last-edge int8)
(ignore uint8)
(terminated symbol)
(reached-dest symbol)
(hit-boundary symbol)
(hit-gap symbol)
)
)
;; definition for method 3 of type nav-ray
(defmethod inspect ((this nav-ray))
(when (not this)
(set! this this)
(goto cfg-4)
)
(format #t "[~8x] ~A~%" this 'nav-ray)
(format #t "~1Tcurrent-pos: #<vector @ #x~X>~%" (-> this current-pos))
(format #t "~1Tdir: #<vector @ #x~X>~%" (-> this dir))
(format #t "~1Tdest-pos: #<vector @ #x~X>~%" (-> this dest-pos))
(format #t "~1Tcurrent-poly: #<nav-poly @ #x~X>~%" (-> this current-poly))
(format #t "~1Tnext-poly: #<nav-poly @ #x~X>~%" (-> this next-poly))
(format #t "~1Tlen: (meters ~m)~%" (-> this len))
(format #t "~1Tlast-edge: ~D~%" (-> this last-edge))
(format #t "~1Tignore: ~D~%" (-> this ignore))
(format #t "~1Tterminated: ~A~%" (-> this terminated))
(format #t "~1Treached-dest: ~A~%" (-> this reached-dest))
(format #t "~1Thit-boundary: ~A~%" (-> this hit-boundary))
(format #t "~1Thit-gap: ~A~%" (-> this hit-gap))
(label cfg-4)
this
)
;; definition of type nav-route-portal
(deftype nav-route-portal (structure)
((vertex nav-vertex 2 :inline)
(next-poly nav-poly)
(edge-index int8)
)
)
;; definition for method 3 of type nav-route-portal
(defmethod inspect ((this nav-route-portal))
(when (not this)
(set! this this)
(goto cfg-4)
)
(format #t "[~8x] ~A~%" this 'nav-route-portal)
(format #t "~1Tvertex[2] @ #x~X~%" (-> this vertex))
(format #t "~1Tnext-poly: #<nav-poly @ #x~X>~%" (-> this next-poly))
(format #t "~1Tedge-index: ~D~%" (-> this edge-index))
(label cfg-4)
this
)
;; definition of type nav-find-poly-parms
(deftype nav-find-poly-parms (structure)
((point vector :inline)
(y-threshold float)
(ignore uint8)
(poly nav-poly)
(dist float)
(point-inside? symbol)
)
)
;; definition for method 3 of type nav-find-poly-parms
(defmethod inspect ((this nav-find-poly-parms))
(when (not this)
(set! this this)
(goto cfg-4)
)
(format #t "[~8x] ~A~%" this 'nav-find-poly-parms)
(format #t "~1Tpoint: #<vector @ #x~X>~%" (-> this point))
(format #t "~1Ty-threshold: ~f~%" (-> this y-threshold))
(format #t "~1Tignore: ~D~%" (-> this ignore))
(format #t "~1Tpoly: #<nav-poly @ #x~X>~%" (-> this poly))
(format #t "~1Tdist: ~f~%" (-> this dist))
(format #t "~1Tpoint-inside?: ~A~%" (-> this point-inside?))
(label cfg-4)
this
)
;; definition of type clamp-travel-vector-to-mesh-return-info
(deftype clamp-travel-vector-to-mesh-return-info (structure)
((found-boundary symbol)
(intersection vector :inline)
(boundary-normal vector :inline)
(prev-normal vector :inline)
(next-normal vector :inline)
(poly nav-poly)
(gap-poly nav-poly)
(edge int8)
(ignore uint8)
(vert-prev vector :inline)
(vert-0 vector :inline)
(vert-1 vector :inline)
(vert-next vector :inline)
)
)
;; definition for method 3 of type clamp-travel-vector-to-mesh-return-info
(defmethod inspect ((this clamp-travel-vector-to-mesh-return-info))
(when (not this)
(set! this this)
(goto cfg-4)
)
(format #t "[~8x] ~A~%" this 'clamp-travel-vector-to-mesh-return-info)
(format #t "~1Tfound-boundary: ~A~%" (-> this found-boundary))
(format #t "~1Tintersection: #<vector @ #x~X>~%" (-> this intersection))
(format #t "~1Tboundary-normal: #<vector @ #x~X>~%" (-> this boundary-normal))
(format #t "~1Tprev-normal: #<vector @ #x~X>~%" (-> this prev-normal))
(format #t "~1Tnext-normal: #<vector @ #x~X>~%" (-> this next-normal))
(format #t "~1Tpoly: #<nav-poly @ #x~X>~%" (-> this poly))
(format #t "~1Tgap-poly: #<nav-poly @ #x~X>~%" (-> this gap-poly))
(format #t "~1Tedge: ~D~%" (-> this edge))
(format #t "~1Tignore: ~D~%" (-> this ignore))
(format #t "~1Tvert-prev: #<vector @ #x~X>~%" (-> this vert-prev))
(format #t "~1Tvert-0: #<vector @ #x~X>~%" (-> this vert-0))
(format #t "~1Tvert-1: #<vector @ #x~X>~%" (-> this vert-1))
(format #t "~1Tvert-next: #<vector @ #x~X>~%" (-> this vert-next))
(label cfg-4)
this
)
;; definition of type nav-mesh
(deftype nav-mesh (basic)
"Mesh used for creature/enemy navigation."
((work nav-mesh-work)
(poly-array (inline-array nav-poly))
(static-sphere-count uint8)
(poly-count uint8)
(nav-control-count uint8)
(max-nav-control-count uint8)
(route (pointer uint8))
(poly-hash grid-hash)
(nav-control-array (inline-array nav-control))
(sphere-hash sphere-hash)
(static-sphere (inline-array sphere))
(user-list engine)
(next-nav-mesh surface)
(prev-nav-mesh surface)
(bounds sphere :inline)
(origin vector :inline :overlay-at (-> bounds data 0))
(entity entity)
(link-array (inline-array nav-mesh-link))
(link-count uint8)
(flags nav-mesh-flag)
(pad1 uint8 2)
(nearest-y-threshold meters)
(water-max-height meters)
(pad2 uint32 7)
)
(:methods
(nav-mesh-method-9 () none)
(nav-mesh-method-10 () none)
(nav-mesh-method-11 () none)
(nav-mesh-method-12 () none)
(nav-mesh-method-13 () none)
(nav-mesh-method-14 () none)
(nav-mesh-method-15 () none)
(nav-mesh-method-16 () none)
(nav-mesh-method-17 () none)
(advance-ray-to-nearest-poly-edge-or-dest! (_type_ nav-ray) none)
(nav-mesh-method-19 () none)
(nav-mesh-method-20 () none)
(nav-mesh-method-21 () none)
(nav-mesh-method-22 () none)
(nav-mesh-method-23 () none)
(nav-mesh-method-24 () none)
(nav-mesh-method-25 () none)
(nav-mesh-method-26 () none)
(nav-mesh-method-27 () none)
(nav-mesh-method-28 () none)
(nav-mesh-method-29 () none)
(nav-mesh-method-30 () none)
(nav-mesh-method-31 () none)
(nav-mesh-method-32 () none)
(nav-mesh-method-33 () none)
(nav-mesh-method-34 () none)
(nav-mesh-method-35 () none)
(nav-mesh-method-36 () none)
(nav-mesh-method-37 () none)
(nav-mesh-method-38 () none)
(nav-mesh-method-39 () none)
(point-in-poly? (_type_ nav-poly vector) symbol)
(nav-mesh-method-41 () none)
(closest-point-on-boundary (_type_ nav-poly vector vector) vector)
(nav-mesh-method-43 () none)
(project-point-into-poly-2d (_type_ nav-poly vector vector) vector)
(nav-mesh-method-45 () none)
(nav-mesh-method-46 () none)
(nav-mesh-method-47 () none)
(nav-mesh-method-48 () none)
(nav-mesh-method-49 () none)
)
)
;; definition for method 3 of type nav-mesh
(defmethod inspect ((this nav-mesh))
(when (not this)
(set! this this)
(goto cfg-8)
)
(format #t "[~8x] ~A~%" this (-> this type))
(format #t "~1Twork: #<nav-mesh-work @ #x~X>~%" (-> this work))
(format #t "~1Tpoly-array: #x~X~%" (-> this poly-array))
(format #t "~1Tstatic-sphere-count: ~D~%" (-> this static-sphere-count))
(format #t "~1Tpoly-count: ~D~%" (-> this poly-count))
(format #t "~1Tnav-control-count: ~D~%" (-> this nav-control-count))
(format #t "~1Tmax-nav-control-count: ~D~%" (-> this max-nav-control-count))
(format #t "~1Troute: #x~X~%" (-> this route))
(format #t "~1Tpoly-hash: ~A~%" (-> this poly-hash))
(format #t "~1Tnav-control-array: #x~X~%" (-> this nav-control-array))
(format #t "~1Tsphere-hash: ~A~%" (-> this sphere-hash))
(format #t "~1Tstatic-sphere: #x~X~%" (-> this static-sphere))
(format #t "~1Tuser-list: ~A~%" (-> this user-list))
(format #t "~1Tnext-nav-mesh: ~A~%" (-> this next-nav-mesh))
(format #t "~1Tprev-nav-mesh: ~A~%" (-> this prev-nav-mesh))
(format #t "~1Tbounds: ~`sphere`P~%" (-> this bounds))
(format #t "~1Torigin: #<vector @ #x~X>~%" (-> this bounds))
(format #t "~1Tentity: ~A~%" (-> this entity))
(format #t "~1Tlink-array: #x~X~%" (-> this link-array))
(format #t "~1Tlink-count: ~D~%" (-> this link-count))
(format #t "~1Tflags: #x~X : (nav-mesh-flag " (-> this flags))
(let ((s5-0 (-> this flags)))
(if (= (logand s5-0 (nav-mesh-flag dummy)) (nav-mesh-flag dummy))
(format #t "dummy ")
)
(if (= (logand s5-0 (nav-mesh-flag water)) (nav-mesh-flag water))
(format #t "water ")
)
)
(format #t ")~%")
(format #t "~1Tpad1[2] @ #x~X~%" (-> this pad1))
(format #t "~1Tnearest-y-threshold: (meters ~m)~%" (-> this nearest-y-threshold))
(format #t "~1Twater-max-height: (meters ~m)~%" (-> this water-max-height))
(format #t "~1Tpad2[7] @ #x~X~%" (-> this pad2))
(label cfg-8)
this
)
;; definition for function vector-normalize-unity!
(defun vector-normalize-unity! ((arg0 vector))
"Normalize a vector (xyz only) in place."
(rlet ((acc :class vf)
(Q :class vf)
(vf0 :class vf)
(vf1 :class vf)
(vf2 :class vf)
(vf3 :class vf)
)
(init-vf0-vector)
(let ((v0-0 arg0))
(let ((f0-0 1.0))
(.lvf vf1 (&-> v0-0 quad))
(.mul.vf vf2 vf1 vf1 :mask #b111)
(let ((v1-1 f0-0))
(.mov vf3 v1-1)
)
)
(.mul.x.vf acc vf0 vf2 :mask #b1000)
(.add.mul.y.vf acc vf0 vf2 acc :mask #b1000)
(.add.mul.z.vf vf2 vf0 vf2 acc :mask #b1000)
(.isqrt.vf Q vf3 vf2 :fsf #b0 :ftf #b11)
(.wait.vf)
(.mul.vf vf1 vf1 Q :mask #b111)
(.nop.vf)
(.nop.vf)
(.nop.vf)
(.svf (&-> v0-0 quad) vf1)
v0-0
)
)
)
;; definition for function vector-normalize-unity-copy!
;; INFO: Used lq/sq
(defun vector-normalize-unity-copy! ((arg0 vector) (arg1 vector))
"Normalize a vector (xyz only)"
(rlet ((acc :class vf)
(Q :class vf)
(vf0 :class vf)
(vf1 :class vf)
(vf2 :class vf)
(vf3 :class vf)
)
(init-vf0-vector)
(set! (-> arg0 quad) (-> arg1 quad))
(let ((v0-0 arg0))
(let ((f0-0 1.0))
(.lvf vf1 (&-> v0-0 quad))
(.mul.vf vf2 vf1 vf1 :mask #b111)
(let ((v1-2 f0-0))
(.mov vf3 v1-2)
)
)
(.mul.x.vf acc vf0 vf2 :mask #b1000)
(.add.mul.y.vf acc vf0 vf2 acc :mask #b1000)
(.add.mul.z.vf vf2 vf0 vf2 acc :mask #b1000)
(.isqrt.vf Q vf3 vf2 :fsf #b0 :ftf #b11)
(.wait.vf)
(.mul.vf vf1 vf1 Q :mask #b111)
(.nop.vf)
(.nop.vf)
(.nop.vf)
(.svf (&-> v0-0 quad) vf1)
v0-0
)
)
)
;; definition (debug) for function debug-validate-current-poly
(defun-debug debug-validate-current-poly ()
"Not implemented."
#f
)
;; definition for function init-ray
;; WARN: Return type mismatch int vs none.
(defun init-ray ((arg0 nav-ray))
"Set up a nav-ray. Assumes that dest-pos and current-pos are set."
(rlet ((acc :class vf)
(Q :class vf)
(vf0 :class vf)
(vf1 :class vf)
(vf2 :class vf)
(vf3 :class vf)
)
(init-vf0-vector)
(vector-! (-> arg0 dir) (-> arg0 dest-pos) (-> arg0 current-pos))
(set! (-> arg0 dir y) 0.0)
(let ((v1-1 (-> arg0 dir)))
(let ((f0-1 1.0))
(.lvf vf1 (&-> v1-1 quad))
(.mul.vf vf2 vf1 vf1 :mask #b111)
(let ((a1-2 f0-1))
(.mov vf3 a1-2)
)
)
(.mul.x.vf acc vf0 vf2 :mask #b1000)
(.add.mul.y.vf acc vf0 vf2 acc :mask #b1000)
(.add.mul.z.vf vf2 vf0 vf2 acc :mask #b1000)
(.isqrt.vf Q vf3 vf2 :fsf #b0 :ftf #b11)
(.wait.vf)
(.mul.vf vf1 vf1 Q :mask #b111)
(.nop.vf)
(.nop.vf)
(.nop.vf)
(.svf (&-> v1-1 quad) vf1)
)
(set! (-> arg0 next-poly) #f)
(set! (-> arg0 len) 0.0)
(set! (-> arg0 last-edge) -1)
(set! (-> arg0 terminated) #f)
(set! (-> arg0 reached-dest) #f)
(set! (-> arg0 hit-boundary) #f)
(set! (-> arg0 hit-gap) #f)
(set! (-> arg0 ignore) (the-as uint 3))
0
(none)
)
)
;; definition for function point-poly-intersection?
(defun point-poly-intersection? ((mesh nav-mesh) (pt vector) (num-verts int) (verts (inline-array vector)))
"Check if a point is inside a poly."
(let ((v1-1 (-> mesh work vert0-table))
(a0-2 (-> mesh work vert1-table))
)
(dotimes (t0-0 num-verts)
(let* ((t1-3 (-> verts (-> v1-1 t0-0)))
(t2-3 (-> verts (-> a0-2 t0-0)))
(f0-1 (- (-> t1-3 z) (-> t2-3 z)))
(f1-2 (- (-> t2-3 x) (-> t1-3 x)))
(f2-2 (- (-> pt x) (-> t1-3 x)))
(f3-2 (- (-> pt z) (-> t1-3 z)))
(f0-3 (+ (* f2-2 f0-1) (* f3-2 f1-2)))
)
(if (< 0.0 f0-3)
(return #f)
)
)
)
)
#t
)
;; definition for method 40 of type nav-mesh
(defmethod point-in-poly? ((this nav-mesh) (arg0 nav-poly) (arg1 vector))
"Check if a point is inside a poly of this mesh"
(let* ((a3-0 this)
(v1-0 arg1)
(a0-1 (-> arg0 vertex-count))
(a1-1 (-> arg0 vertex))
(a2-2 (-> a3-0 work vert0-table))
(a3-2 (-> a3-0 work vert1-table))
)
(dotimes (t0-0 (the-as int a0-1))
(let* ((t1-3 (-> a1-1 (-> a2-2 t0-0)))
(t2-3 (-> a1-1 (-> a3-2 t0-0)))
(f0-1 (- (-> t1-3 z) (-> t2-3 z)))
(f1-2 (- (-> t2-3 x) (-> t1-3 x)))
(f2-2 (- (-> v1-0 x) (-> t1-3 x)))
(f3-2 (- (-> v1-0 z) (-> t1-3 z)))
(f0-3 (+ (* f2-2 f0-1) (* f3-2 f1-2)))
)
(if (< 0.0 f0-3)
(return #f)
)
)
)
)
#t
)
;; definition for method 42 of type nav-mesh
;; INFO: Used lq/sq
(defmethod closest-point-on-boundary ((this nav-mesh) (arg0 nav-poly) (arg1 vector) (arg2 vector))
"Find the point on the polygon edge that is closest to the query point."
(local-vars (sv-48 vector) (sv-52 vector) (sv-56 number))
(set! sv-48 (new 'stack-no-clear 'vector))
(set! sv-52 (new 'stack-no-clear 'vector))
(set! sv-56 10000000000000000000000000000000000000.0)
(let* ((s3-0 (-> arg0 vertex-count))
(v1-3 (the-as int (+ s3-0 -1)))
)
(dotimes (s2-0 (the-as int s3-0))
(let ((f0-1 (vector-segment-distance-point! arg2 (-> arg0 vertex v1-3) (-> arg0 vertex s2-0) sv-48)))
(when (< f0-1 (the-as float sv-56))
(set! sv-56 f0-1)
(set! (-> sv-52 quad) (-> sv-48 quad))
)
)
(set! v1-3 s2-0)
)
)
(set! (-> arg1 quad) (-> sv-52 quad))
arg1
)
;; definition for method 44 of type nav-mesh
;; INFO: Used lq/sq
(defmethod project-point-into-poly-2d ((this nav-mesh) (arg0 nav-poly) (arg1 vector) (arg2 vector))
"Find the point in the polygon closest to the query point."
(local-vars (sv-48 vector) (sv-52 vector) (sv-56 number))
(cond
((point-in-poly? this arg0 arg2)
(set! (-> arg1 quad) (-> arg2 quad))
)
(else
(let ((s5-1 arg1))
(set! sv-48 (new 'stack-no-clear 'vector))
(set! sv-52 (new 'stack-no-clear 'vector))
(set! sv-56 10000000000000000000000000000000000000.0)
(let* ((s2-0 (-> arg0 vertex-count))
(v1-6 (the-as int (+ s2-0 -1)))
)
(dotimes (s1-0 (the-as int s2-0))
(let ((f0-1 (vector-segment-distance-point! arg2 (-> arg0 vertex v1-6) (-> arg0 vertex s1-0) sv-48)))
(when (< f0-1 (the-as float sv-56))
(set! sv-56 f0-1)
(set! (-> sv-52 quad) (-> sv-48 quad))
)
)
(set! v1-6 s1-0)
)
)
(set! (-> s5-1 quad) (-> sv-52 quad))
)
)
)
arg1
)
;; definition for method 18 of type nav-mesh
;; INFO: Used lq/sq
;; WARN: Return type mismatch int vs none.
(defmethod advance-ray-to-nearest-poly-edge-or-dest! ((this nav-mesh) (arg0 nav-ray))
(local-vars
(sv-16 int)
(sv-24 nav-mesh-work)
(sv-28 nav-poly)
(sv-32 uint)
(sv-36 (pointer int8))
(sv-40 (pointer int8))
(sv-44 float)
(sv-48 float)
(sv-52 vector)
(sv-56 vector)
(sv-60 float)
(sv-64 float)
(sv-68 uint)
)
(set! sv-16 -1)
(set! sv-24 (-> this work))
(set! sv-28 (-> arg0 current-poly))
(set! sv-32 (-> arg0 current-poly vertex-count))
(set! sv-36 (-> this work vert0-table))
(set! sv-40 (-> this work vert1-table))
(set! sv-44 (- (-> arg0 dest-pos x) (-> arg0 current-pos x)))
(set! sv-48 (- (-> arg0 dest-pos z) (-> arg0 current-pos z)))
(dotimes (v1-9 (the-as int sv-32))
(set! sv-52 (-> sv-28 vertex (-> sv-36 v1-9)))
(set! sv-56 (-> sv-28 vertex (-> sv-40 v1-9)))
(set! sv-60 (- (-> sv-52 z) (-> sv-56 z)))
(set! sv-64 (- (-> sv-56 x) (-> sv-52 x)))
(let ((f0-10 (+ (* sv-44 sv-60) (* sv-48 sv-64))))
(when (< 0.0 f0-10)
(let ((f1-10
(+ (* sv-60 (- (-> sv-52 x) (-> arg0 current-pos x))) (* sv-64 (- (-> sv-52 z) (-> arg0 current-pos z))))
)
)
(when (< f1-10 f0-10)
(set! sv-16 v1-9)
(let ((f0-12 (fmax 0.0 (/ f1-10 f0-10))))
(set! sv-44 (* sv-44 f0-12))
(set! sv-48 (* sv-48 f0-12))
)
)
)
)
)
)
(let ((f0-16 (+ (* sv-44 (-> arg0 dir x)) (* sv-48 (-> arg0 dir z)))))
(+! (-> arg0 len) f0-16)
)
0
(set! (-> arg0 next-poly) #f)
(cond
((= sv-16 -1)
(set! (-> arg0 current-pos quad) (-> arg0 dest-pos quad))
(set! (-> arg0 reached-dest) #t)
(set! (-> arg0 terminated) #t)
)
(else
(+! (-> arg0 current-pos x) sv-44)
(+! (-> arg0 current-pos z) sv-48)
(set! sv-68 (-> sv-28 adj-poly sv-16))
(if (!= sv-68 255)
(set! (-> arg0 next-poly) (-> this poly-array sv-68))
)
(cond
((and (-> arg0 next-poly) (not (logtest? (-> arg0 next-poly pat) (-> arg0 ignore))))
(set! (-> arg0 current-poly) (-> arg0 next-poly))
)
(else
(set! (-> arg0 last-edge) sv-16)
(if (-> arg0 next-poly)
(set! (-> arg0 hit-gap) #t)
(set! (-> arg0 hit-boundary) #t)
)
(set! (-> arg0 terminated) #t)
)
)
)
)
0
(none)
)
;; definition (debug) for function nav-sphere-from-cam
;; WARN: Return type mismatch int vs none.
(defun-debug nav-sphere-from-cam ()
"Print out a SPHEREM from the current camera position, possibly used by their level-building tool."
(let ((v1-0 (camera-pos)))
(format #t "SPHEREM(~4,,1M, ~4,,1M, ~4,,1M, 1.0)~%" (-> v1-0 x) (-> v1-0 y) (-> v1-0 z))
)
0
(none)
)
+394
View File
@@ -0,0 +1,394 @@
;;-*-Lisp-*-
(in-package goal)
;; definition of type rigid-body-info
(deftype rigid-body-info (structure)
((mass float)
(inv-mass float)
(linear-damping float)
(angular-damping float)
(bounce-factor float)
(friction-factor float)
(bounce-mult-factor float)
(cm-offset-joint vector :inline)
(inv-inertial-tensor matrix :inline)
(inertial-tensor matrix :inline)
(inertial-tensor-box meters 3)
)
(:methods
(rigid-body-info-method-9 () none)
)
)
;; definition for method 3 of type rigid-body-info
(defmethod inspect ((this rigid-body-info))
(when (not this)
(set! this this)
(goto cfg-4)
)
(format #t "[~8x] ~A~%" this 'rigid-body-info)
(format #t "~1Tmass: ~f~%" (-> this mass))
(format #t "~1Tinv-mass: ~f~%" (-> this inv-mass))
(format #t "~1Tlinear-damping: ~f~%" (-> this linear-damping))
(format #t "~1Tangular-damping: ~f~%" (-> this angular-damping))
(format #t "~1Tbounce-factor: ~f~%" (-> this bounce-factor))
(format #t "~1Tfriction-factor: ~f~%" (-> this friction-factor))
(format #t "~1Tbounce-mult-factor: ~f~%" (-> this bounce-mult-factor))
(format #t "~1Tcm-offset-joint: ~`vector`P~%" (-> this cm-offset-joint))
(format #t "~1Tinv-inertial-tensor: #<matrix @ #x~X>~%" (-> this inv-inertial-tensor))
(format #t "~1Tinertial-tensor: #<matrix @ #x~X>~%" (-> this inertial-tensor))
(format #t "~1Tinertial-tensor-box[3] @ #x~X~%" (-> this inertial-tensor-box))
(label cfg-4)
this
)
;; definition of type rigid-body-object-extra-info
(deftype rigid-body-object-extra-info (structure)
((max-time-step float)
(gravity meters)
(idle-distance meters)
(attack-force-scale float)
)
:pack-me
)
;; definition for method 3 of type rigid-body-object-extra-info
(defmethod inspect ((this rigid-body-object-extra-info))
(when (not this)
(set! this this)
(goto cfg-4)
)
(format #t "[~8x] ~A~%" this 'rigid-body-object-extra-info)
(format #t "~1Tmax-time-step: ~f~%" (-> this max-time-step))
(format #t "~1Tgravity: (meters ~m)~%" (-> this gravity))
(format #t "~1Tidle-distance: (meters ~m)~%" (-> this idle-distance))
(format #t "~1Tattack-force-scale: ~f~%" (-> this attack-force-scale))
(label cfg-4)
this
)
;; definition of type rigid-body-object-constants
(deftype rigid-body-object-constants (structure)
((info rigid-body-info :inline)
(mass float :overlay-at (-> info mass))
(inv-mass float :overlay-at (-> info inv-mass))
(cm-joint-x meters :overlay-at (-> info cm-offset-joint data 0))
(cm-joint-y meters :overlay-at (-> info cm-offset-joint data 1))
(cm-joint-z meters :overlay-at (-> info cm-offset-joint data 2))
(linear-damping float :overlay-at (-> info linear-damping))
(angular-damping float :overlay-at (-> info angular-damping))
(bounce-factor float :overlay-at (-> info bounce-factor))
(friction-factor float :overlay-at (-> info friction-factor))
(inertial-tensor-x meters :overlay-at (-> info inertial-tensor-box 0))
(inertial-tensor-y meters :overlay-at (-> info inertial-tensor-box 1))
(inertial-tensor-z meters :overlay-at (-> info inertial-tensor-box 2))
(extra rigid-body-object-extra-info :inline)
(max-time-step float :overlay-at (-> extra max-time-step))
(gravity meters :overlay-at (-> extra gravity))
(idle-distance meters :overlay-at (-> extra idle-distance))
(attack-force-scale float :overlay-at (-> extra attack-force-scale))
(name symbol)
)
)
;; definition for method 3 of type rigid-body-object-constants
(defmethod inspect ((this rigid-body-object-constants))
(when (not this)
(set! this this)
(goto cfg-4)
)
(format #t "[~8x] ~A~%" this 'rigid-body-object-constants)
(format #t "~1Tinfo: #<rigid-body-info @ #x~X>~%" (-> this info))
(format #t "~1Tmass: ~f~%" (-> this info mass))
(format #t "~1Tinv-mass: ~f~%" (-> this info inv-mass))
(format #t "~1Tcm-joint-x: (meters ~m)~%" (-> this info cm-offset-joint x))
(format #t "~1Tcm-joint-y: (meters ~m)~%" (-> this info cm-offset-joint y))
(format #t "~1Tcm-joint-z: (meters ~m)~%" (-> this info cm-offset-joint z))
(format #t "~1Tlinear-damping: ~f~%" (-> this info linear-damping))
(format #t "~1Tangular-damping: ~f~%" (-> this info angular-damping))
(format #t "~1Tbounce-factor: ~f~%" (-> this info bounce-factor))
(format #t "~1Tfriction-factor: ~f~%" (-> this info friction-factor))
(format #t "~1Tinertial-tensor-x: (meters ~m)~%" (-> this inertial-tensor-x))
(format #t "~1Tinertial-tensor-y: (meters ~m)~%" (-> this inertial-tensor-y))
(format #t "~1Tinertial-tensor-z: (meters ~m)~%" (-> this inertial-tensor-z))
(format #t "~1Textra: #<rigid-body-object-extra-info @ #x~X>~%" (-> this extra))
(format #t "~1Tmax-time-step: ~f~%" (-> this extra max-time-step))
(format #t "~1Tgravity: (meters ~m)~%" (-> this extra gravity))
(format #t "~1Tidle-distance: (meters ~m)~%" (-> this extra idle-distance))
(format #t "~1Tattack-force-scale: ~f~%" (-> this extra attack-force-scale))
(format #t "~1Tname: ~A~%" (-> this name))
(label cfg-4)
this
)
;; definition of type rigid-body-impact
(deftype rigid-body-impact (structure)
((point vector :inline)
(normal vector :inline)
(velocity vector :inline)
(impulse float)
(pat pat-surface)
(process basic)
(prim-id uint32)
)
)
;; definition for method 3 of type rigid-body-impact
(defmethod inspect ((this rigid-body-impact))
(when (not this)
(set! this this)
(goto cfg-4)
)
(format #t "[~8x] ~A~%" this 'rigid-body-impact)
(format #t "~1Tpoint: ~`vector`P~%" (-> this point))
(format #t "~1Tnormal: ~`vector`P~%" (-> this normal))
(format #t "~1Tvelocity: ~`vector`P~%" (-> this velocity))
(format #t "~1Timpulse: ~f~%" (-> this impulse))
(format #t "~1Tpat: ~D~%" (-> this pat))
(format #t "~1Tprocess: ~A~%" (-> this process))
(format #t "~1Tprim-id: ~D~%" (-> this prim-id))
(label cfg-4)
this
)
;; definition of type rigid-body-control
(deftype rigid-body-control (basic)
((flags rigid-body-flag)
(info rigid-body-info)
(force-callback basic)
(process process)
(blocked-by basic)
(time-remaining float)
(step-count int16)
(linear-damping float)
(angular-damping float)
(bounce-factor float)
(friction-factor float)
(position vector :inline)
(rot vector :inline)
(rotation quaternion :inline :overlay-at (-> rot data 0))
(lin-momentum vector :inline)
(ang-momentum vector :inline)
(force vector :inline)
(torque vector :inline)
(lin-velocity vector :inline)
(ang-velocity vector :inline)
(matrix matrix :inline)
(inv-i-world matrix :inline)
)
(:methods
(new (symbol type) _type_)
(rigid-body-control-method-9 () none)
(rigid-body-control-method-10 () none)
(rigid-body-control-method-11 () none)
(rigid-body-control-method-12 () none)
(rigid-body-control-method-13 () none)
(rigid-body-control-method-14 () none)
(rigid-body-control-method-15 () none)
(rigid-body-control-method-16 () none)
(rigid-body-control-method-17 () none)
(rigid-body-control-method-18 () none)
(rigid-body-control-method-19 () none)
(rigid-body-control-method-20 () none)
(rigid-body-control-method-21 () none)
(rigid-body-control-method-22 () none)
(rigid-body-control-method-23 () none)
(rigid-body-control-method-24 () none)
(rigid-body-control-method-25 () none)
(rigid-body-control-method-26 () none)
(rigid-body-control-method-27 () none)
(rigid-body-control-method-28 () none)
(rigid-body-control-method-29 () none)
(rigid-body-control-method-30 () none)
(rigid-body-control-method-31 () none)
(rigid-body-control-method-32 () none)
(rigid-body-control-method-33 () none)
)
)
;; definition for method 3 of type rigid-body-control
(defmethod inspect ((this rigid-body-control))
(when (not this)
(set! this this)
(goto cfg-16)
)
(format #t "[~8x] ~A~%" this (-> this type))
(format #t "~1Tflags: #x~X : (rigid-body-flag " (-> this flags))
(let ((s5-0 (-> this flags)))
(if (= (logand s5-0 (rigid-body-flag active)) (rigid-body-flag active))
(format #t "active ")
)
(if (= (logand s5-0 (rigid-body-flag blocker)) (rigid-body-flag blocker))
(format #t "blocker ")
)
(if (= (logand s5-0 (rigid-body-flag enable-physics)) (rigid-body-flag enable-physics))
(format #t "enable-physics ")
)
(if (= (logand s5-0 (rigid-body-flag display-marks)) (rigid-body-flag display-marks))
(format #t "display-marks ")
)
(if (= (logand s5-0 (rigid-body-flag enable-collision)) (rigid-body-flag enable-collision))
(format #t "enable-collision ")
)
(if (= (logand s5-0 (rigid-body-flag debug)) (rigid-body-flag debug))
(format #t "debug ")
)
)
(format #t ")~%")
(format #t "~1Tinfo: #<rigid-body-info @ #x~X>~%" (-> this info))
(format #t "~1Tforce-callback: ~A~%" (-> this force-callback))
(format #t "~1Tprocess: ~A~%" (-> this process))
(format #t "~1Tblocked-by: ~A~%" (-> this blocked-by))
(format #t "~1Ttime-remaining: ~f~%" (-> this time-remaining))
(format #t "~1Tstep-count: ~D~%" (-> this step-count))
(format #t "~1Tlinear-damping: ~f~%" (-> this linear-damping))
(format #t "~1Tangular-damping: ~f~%" (-> this angular-damping))
(format #t "~1Tbounce-factor: ~f~%" (-> this bounce-factor))
(format #t "~1Tfriction-factor: ~f~%" (-> this friction-factor))
(format #t "~1Tposition: ~`vector`P~%" (-> this position))
(format #t "~1Trot: ~`vector`P~%" (-> this rot))
(format #t "~1Trotation: #<quaternion @ #x~X>~%" (-> this rot))
(format #t "~1Tlin-momentum: ~`vector`P~%" (-> this lin-momentum))
(format #t "~1Tang-momentum: ~`vector`P~%" (-> this ang-momentum))
(format #t "~1Tforce: ~`vector`P~%" (-> this force))
(format #t "~1Ttorque: ~`vector`P~%" (-> this torque))
(format #t "~1Tlin-velocity: ~`vector`P~%" (-> this lin-velocity))
(format #t "~1Tang-velocity: ~`vector`P~%" (-> this ang-velocity))
(format #t "~1Tmatrix: #<matrix @ #x~X>~%" (-> this matrix))
(format #t "~1Tinv-i-world: #<matrix @ #x~X>~%" (-> this inv-i-world))
(label cfg-16)
this
)
;; definition of type rigid-body-object
(deftype rigid-body-object (process-focusable)
((info rigid-body-object-constants)
(flags rigid-body-object-flag)
(max-time-step float)
(incoming-attack-id uint32)
(player-touch-time time-frame)
(disturbed-time time-frame)
(player-force-position vector :inline)
(player-force vector :inline)
)
(:methods
(rigid-body-object-method-28 () none)
(rigid-body-object-method-29 () none)
(rigid-body-object-method-30 () none)
(rigid-body-object-method-31 () none)
(rigid-body-object-method-32 () none)
(rigid-body-object-method-33 () none)
(rigid-body-object-method-34 () none)
(rigid-body-object-method-35 () none)
(rigid-body-object-method-36 () none)
(rigid-body-object-method-37 () none)
(rigid-body-object-method-38 () none)
(rigid-body-object-method-39 () none)
(rigid-body-object-method-40 () none)
(rigid-body-object-method-41 () none)
(rigid-body-object-method-42 () none)
(rigid-body-object-method-43 () none)
(rigid-body-object-method-44 () none)
(rigid-body-object-method-45 () none)
(rigid-body-object-method-46 () none)
(rigid-body-object-method-47 () none)
(rigid-body-object-method-48 () none)
(rigid-body-object-method-49 () none)
(rigid-body-object-method-50 () none)
(rigid-body-object-method-51 () none)
(rigid-body-object-method-52 () none)
(rigid-body-object-method-53 () none)
(rigid-body-object-method-54 () none)
(rigid-body-object-method-55 () none)
)
)
;; definition for method 3 of type rigid-body-object
(defmethod inspect ((this rigid-body-object))
(when (not this)
(set! this this)
(goto cfg-22)
)
(let ((t9-0 (method-of-type process-focusable inspect)))
(t9-0 this)
)
(format #t "~2Tinfo: #<rigid-body-object-constants @ #x~X>~%" (-> this info))
(format #t "~2Tflags: #x~X : (rigid-body-object-flag " (-> this flags))
(let ((s5-0 (-> this flags)))
(if (= (logand s5-0 (rigid-body-object-flag dead)) (rigid-body-object-flag dead))
(format #t "dead ")
)
(if (= (logand s5-0 (rigid-body-object-flag damaged)) (rigid-body-object-flag damaged))
(format #t "damaged ")
)
(if (= (logand s5-0 (rigid-body-object-flag player-contact-force)) (rigid-body-object-flag player-contact-force))
(format #t "player-contact-force ")
)
(if (= (logand s5-0 (rigid-body-object-flag disturbed)) (rigid-body-object-flag disturbed))
(format #t "disturbed ")
)
(if (= (logand s5-0 (rigid-body-object-flag enable-collision)) (rigid-body-object-flag enable-collision))
(format #t "enable-collision ")
)
(if (= (logand s5-0 (rigid-body-object-flag player-edge-grabbing)) (rigid-body-object-flag player-edge-grabbing))
(format #t "player-edge-grabbing ")
)
(if (= (logand s5-0 (rigid-body-object-flag player-touching)) (rigid-body-object-flag player-touching))
(format #t "player-touching ")
)
(if (= (logand s5-0 (rigid-body-object-flag player-standing-on)) (rigid-body-object-flag player-standing-on))
(format #t "player-standing-on ")
)
(if (= (logand s5-0 (rigid-body-object-flag player-impulse-force)) (rigid-body-object-flag player-impulse-force))
(format #t "player-impulse-force ")
)
)
(format #t ")~%")
(format #t "~2Tmax-time-step: ~f~%" (-> this max-time-step))
(format #t "~2Tincoming-attack-id: ~D~%" (-> this incoming-attack-id))
(format #t "~2Tplayer-touch-time: ~D~%" (-> this player-touch-time))
(format #t "~2Tdisturbed-time: ~D~%" (-> this disturbed-time))
(format #t "~2Tplayer-force-position: #<vector @ #x~X>~%" (-> this player-force-position))
(format #t "~2Tplayer-force: #<vector @ #x~X>~%" (-> this player-force))
(label cfg-22)
this
)
;; definition of type rigid-body-queue
(deftype rigid-body-queue (structure)
((count int8)
(manager uint64)
(array handle 128)
)
(:methods
(rigid-body-queue-method-9 () none)
(rigid-body-queue-method-10 () none)
(rigid-body-queue-method-11 () none)
(rigid-body-queue-method-12 () none)
(rigid-body-queue-method-13 () none)
(rigid-body-queue-method-14 () none)
(rigid-body-queue-method-15 () none)
(rigid-body-queue-method-16 () none)
)
)
;; definition for method 3 of type rigid-body-queue
(defmethod inspect ((this rigid-body-queue))
(when (not this)
(set! this this)
(goto cfg-4)
)
(format #t "[~8x] ~A~%" this 'rigid-body-queue)
(format #t "~1Tcount: ~D~%" (-> this count))
(format #t "~1Tmanager: ~D~%" (-> this manager))
(format #t "~1Tarray[128] @ #x~X~%" (-> this array))
(label cfg-4)
this
)
;; failed to figure out what this is:
0
+15
View File
@@ -0,0 +1,15 @@
;;-*-Lisp-*-
(in-package goal)
;; definition for symbol *actor-list*, type (pointer collide-shape)
(define *actor-list* (the-as (pointer collide-shape) (malloc 'global 1024)))
;; definition for symbol *actor-list-length*, type int
(define *actor-list-length* 0)
;; failed to figure out what this is:
0
@@ -0,0 +1,264 @@
;;-*-Lisp-*-
(in-package goal)
;; definition of type grid-hash-word
(deftype grid-hash-word (uint8)
()
)
;; definition of type grid-hash-box
(deftype grid-hash-box (structure)
"Integer coordinate box for the spatial hash grid."
((min int8 3)
(max int8 3)
)
:pack-me
)
;; definition for method 3 of type grid-hash-box
(defmethod inspect ((this grid-hash-box))
(when (not this)
(set! this this)
(goto cfg-4)
)
(format #t "[~8x] ~A~%" this 'grid-hash-box)
(format #t "~1Tmin[3] @ #x~X~%" (-> this min))
(format #t "~1Tmax[3] @ #x~X~%" (-> this max))
(label cfg-4)
this
)
;; definition of type grid-hash
(deftype grid-hash (basic)
"The grid-hash is the basic 3D grid used in the spatial-hash, which is used for runtime
actor collision dectection by hashing actor spheres into grid cells, and avoiding the typical
O(n^2) 'check everybody against everybody' collision loop."
((work grid-hash-work)
(search-box grid-hash-box :inline)
(bucket-size int16)
(axis-scale float 3)
(dimension-array int8 3)
(vertical-cell-count int8)
(bucket-array (pointer grid-hash-word))
(box-min float 3)
(box-max float 3)
(object-count int16)
(bucket-count int16)
(min-cell-size float)
(bucket-memory-size int32)
(mem-bucket-array (pointer grid-hash-word))
(spr-bucket-array (pointer grid-hash-word))
(debug-draw symbol)
(use-scratch-ram symbol)
)
(:methods
(new (symbol type int) _type_)
(update-grid-for-objects-in-box (_type_ int vector vector) none)
(clear-bucket-array (_type_) none)
(setup-search-box (_type_ int vector vector vector) none)
(search-for-point (_type_ vector) (pointer uint8))
(search-for-sphere (_type_ vector float) (pointer uint8))
(draw (_type_ rgba) none)
(dump-grid-info (_type_) none)
(verify-bits-in-bucket (_type_ grid-hash-box grid-hash-box) none)
(box-of-everything (_type_ object grid-hash-box) none)
(grid-hash-method-18 (_type_ grid-hash-box int) none)
(grid-hash-method-19 (_type_ grid-hash-box int) none)
(do-search! (_type_ grid-hash-box (pointer uint8)) none)
(set-up-box (_type_ grid-hash-box vector vector) none)
(sphere-to-grid-box (_type_ grid-hash-box sphere) none)
(line-sphere-to-grid-box (_type_ grid-hash-box vector vector float) none)
(update-grid (_type_) none)
)
)
;; definition for method 3 of type grid-hash
(defmethod inspect ((this grid-hash))
(when (not this)
(set! this this)
(goto cfg-4)
)
(format #t "[~8x] ~A~%" this (-> this type))
(format #t "~1Twork: ~A~%" (-> this work))
(format #t "~1Tsearch-box: #<grid-hash-box @ #x~X>~%" (-> this search-box))
(format #t "~1Tbucket-size: ~D~%" (-> this bucket-size))
(format #t "~1Taxis-scale[3] @ #x~X~%" (-> this axis-scale))
(format #t "~1Tdimension-array[3] @ #x~X~%" (-> this dimension-array))
(format #t "~1Tvertical-cell-count: ~D~%" (-> this vertical-cell-count))
(format #t "~1Tbucket-array: #x~X~%" (-> this bucket-array))
(format #t "~1Tbox-min[3] @ #x~X~%" (-> this box-min))
(format #t "~1Tbox-max[3] @ #x~X~%" (-> this box-max))
(format #t "~1Tobject-count: ~D~%" (-> this object-count))
(format #t "~1Tbucket-count: ~D~%" (-> this bucket-count))
(format #t "~1Tmin-cell-size: ~f~%" (-> this min-cell-size))
(format #t "~1Tbucket-memory-size: ~D~%" (-> this bucket-memory-size))
(format #t "~1Tmem-bucket-array: #x~X~%" (-> this mem-bucket-array))
(format #t "~1Tspr-bucket-array: #x~X~%" (-> this spr-bucket-array))
(format #t "~1Tdebug-draw: ~A~%" (-> this debug-draw))
(format #t "~1Tuse-scratch-ram: ~A~%" (-> this use-scratch-ram))
(label cfg-4)
this
)
;; definition of type find-nav-sphere-ids-params
(deftype find-nav-sphere-ids-params (structure)
((bsphere sphere :inline)
(y-threshold float)
(len int16)
(max-len int16)
(mask uint8)
(array (pointer uint8))
)
)
;; definition for method 3 of type find-nav-sphere-ids-params
(defmethod inspect ((this find-nav-sphere-ids-params))
(when (not this)
(set! this this)
(goto cfg-4)
)
(format #t "[~8x] ~A~%" this 'find-nav-sphere-ids-params)
(format #t "~1Tbsphere: #<sphere @ #x~X>~%" (-> this bsphere))
(format #t "~1Ty-threshold: ~f~%" (-> this y-threshold))
(format #t "~1Tlen: ~D~%" (-> this len))
(format #t "~1Tmax-len: ~D~%" (-> this max-len))
(format #t "~1Tmask: ~D~%" (-> this mask))
(format #t "~1Tarray: #x~X~%" (-> this array))
(label cfg-4)
this
)
;; definition of type sphere-hash
(deftype sphere-hash (grid-hash)
"An extension of grid hash that holds spheres inside of the grid."
((sphere-array (inline-array sphere))
(max-object-count int16)
(pad int16)
(mem-sphere-array uint32)
(spr-sphere-array uint32)
)
(:methods
(new (symbol type int int) _type_)
(clear-objects! (_type_) none)
(add-a-sphere (_type_ vector) int)
(add-a-sphere-with-flag (_type_ vector int) int)
(update-from-spheres (_type_) none)
(sphere-hash-method-29 (_type_ find-nav-sphere-ids-params int int int) none)
(find-nav-sphere-ids (_type_ find-nav-sphere-ids-params) none)
(add-sphere-with-mask-and-id (_type_ vector int int) symbol)
(sphere-hash-method-32 (_type_ vector vector float int) symbol)
)
)
;; definition for method 3 of type sphere-hash
(defmethod inspect ((this sphere-hash))
(when (not this)
(set! this this)
(goto cfg-4)
)
(format #t "[~8x] ~A~%" this (-> this type))
(format #t "~1Twork: ~A~%" (-> this work))
(format #t "~1Tsearch-box: #<grid-hash-box @ #x~X>~%" (-> this search-box))
(format #t "~1Tbucket-size: ~D~%" (-> this bucket-size))
(format #t "~1Taxis-scale[3] @ #x~X~%" (-> this axis-scale))
(format #t "~1Tdimension-array[3] @ #x~X~%" (-> this dimension-array))
(format #t "~1Tvertical-cell-count: ~D~%" (-> this vertical-cell-count))
(format #t "~1Tbucket-array: #x~X~%" (-> this bucket-array))
(format #t "~1Tbox-min[3] @ #x~X~%" (-> this box-min))
(format #t "~1Tbox-max[3] @ #x~X~%" (-> this box-max))
(format #t "~1Tobject-count: ~D~%" (-> this object-count))
(format #t "~1Tbucket-count: ~D~%" (-> this bucket-count))
(format #t "~1Tmin-cell-size: ~f~%" (-> this min-cell-size))
(format #t "~1Tbucket-memory-size: ~D~%" (-> this bucket-memory-size))
(format #t "~1Tmem-bucket-array: #x~X~%" (-> this mem-bucket-array))
(format #t "~1Tspr-bucket-array: #x~X~%" (-> this spr-bucket-array))
(format #t "~1Tdebug-draw: ~A~%" (-> this debug-draw))
(format #t "~1Tuse-scratch-ram: ~A~%" (-> this use-scratch-ram))
(format #t "~1Tsphere-array: #x~X~%" (-> this sphere-array))
(format #t "~1Tmax-object-count: ~D~%" (-> this max-object-count))
(format #t "~1Tpad: ~D~%" (-> this pad))
(format #t "~1Tmem-sphere-array: #x~X~%" (-> this mem-sphere-array))
(format #t "~1Tspr-sphere-array: #x~X~%" (-> this spr-sphere-array))
(label cfg-4)
this
)
;; definition of type hash-object-info
(deftype hash-object-info (structure)
((object basic)
)
)
;; definition for method 3 of type hash-object-info
(defmethod inspect ((this hash-object-info))
(when (not this)
(set! this this)
(goto cfg-4)
)
(format #t "[~8x] ~A~%" this 'hash-object-info)
(format #t "~1Tobject: ~A~%" (-> this object))
(label cfg-4)
this
)
;; definition of type spatial-hash
(deftype spatial-hash (sphere-hash)
"An extension of sphere-hash that associates an object with each sphere."
((object-array (inline-array hash-object-info))
(mem-object-array (inline-array hash-object-info))
(spr-object-array (inline-array hash-object-info))
)
(:methods
(new (symbol type int int) _type_)
(spatial-hash-method-33 () none)
(add-an-object (_type_ vector hash-object-info) int)
(fill-actor-list-for-box (_type_ bounding-box (pointer collide-shape) int) int)
(fill-actor-list-for-sphere (_type_ sphere (pointer collide-shape) int) int)
(fill-actor-list-for-line-sphere (_type_ vector vector float (pointer collide-shape) int int) int)
(fill-actor-list-for-vec+r (_type_ vector (pointer collide-shape) int) int)
(spatial-hash-method-39 (_type_ object hash-object-info) int)
)
)
;; definition for method 3 of type spatial-hash
(defmethod inspect ((this spatial-hash))
(when (not this)
(set! this this)
(goto cfg-4)
)
(format #t "[~8x] ~A~%" this (-> this type))
(format #t "~1Twork: ~A~%" (-> this work))
(format #t "~1Tsearch-box: #<grid-hash-box @ #x~X>~%" (-> this search-box))
(format #t "~1Tbucket-size: ~D~%" (-> this bucket-size))
(format #t "~1Taxis-scale[3] @ #x~X~%" (-> this axis-scale))
(format #t "~1Tdimension-array[3] @ #x~X~%" (-> this dimension-array))
(format #t "~1Tvertical-cell-count: ~D~%" (-> this vertical-cell-count))
(format #t "~1Tbucket-array: #x~X~%" (-> this bucket-array))
(format #t "~1Tbox-min[3] @ #x~X~%" (-> this box-min))
(format #t "~1Tbox-max[3] @ #x~X~%" (-> this box-max))
(format #t "~1Tobject-count: ~D~%" (-> this object-count))
(format #t "~1Tbucket-count: ~D~%" (-> this bucket-count))
(format #t "~1Tmin-cell-size: ~f~%" (-> this min-cell-size))
(format #t "~1Tbucket-memory-size: ~D~%" (-> this bucket-memory-size))
(format #t "~1Tmem-bucket-array: #x~X~%" (-> this mem-bucket-array))
(format #t "~1Tspr-bucket-array: #x~X~%" (-> this spr-bucket-array))
(format #t "~1Tdebug-draw: ~A~%" (-> this debug-draw))
(format #t "~1Tuse-scratch-ram: ~A~%" (-> this use-scratch-ram))
(format #t "~1Tsphere-array: #x~X~%" (-> this sphere-array))
(format #t "~1Tmax-object-count: ~D~%" (-> this max-object-count))
(format #t "~1Tpad: ~D~%" (-> this pad))
(format #t "~1Tmem-sphere-array: #x~X~%" (-> this mem-sphere-array))
(format #t "~1Tspr-sphere-array: #x~X~%" (-> this spr-sphere-array))
(format #t "~1Tobject-array: #x~X~%" (-> this object-array))
(format #t "~1Tmem-object-array: #x~X~%" (-> this mem-object-array))
(format #t "~1Tspr-object-array: #x~X~%" (-> this spr-object-array))
(label cfg-4)
this
)
;; failed to figure out what this is:
0