[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
+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