mirror of
https://github.com/open-goal/jak-project
synced 2026-05-24 07:11:15 -04:00
637990314b
Closes #736 --------- Co-authored-by: Hat Kid <6624576+Hat-Kid@users.noreply.github.com>
940 lines
33 KiB
Common Lisp
Vendored
Generated
940 lines
33 KiB
Common Lisp
Vendored
Generated
;;-*-Lisp-*-
|
|
(in-package goal)
|
|
|
|
;; definition for method 2 of type res-tag
|
|
(defmethod print ((this res-tag))
|
|
(if (zero? (-> this inlined?))
|
|
(format
|
|
#t
|
|
"#<res-tag :name ~A :key-frame ~f :elt-type ~A :elt-count ~D>"
|
|
(-> this name)
|
|
(-> this key-frame)
|
|
(-> this elt-type)
|
|
(-> this elt-count)
|
|
)
|
|
(format
|
|
#t
|
|
"#<res-tag (i) :name ~A :key-frame ~f :elt-type ~A :elt-count ~D>"
|
|
(-> this name)
|
|
(-> this key-frame)
|
|
(-> this elt-type)
|
|
(-> this elt-count)
|
|
)
|
|
)
|
|
this
|
|
)
|
|
|
|
;; definition for method 4 of type res-tag
|
|
;; WARN: Return type mismatch uint vs int.
|
|
(defmethod length ((this res-tag))
|
|
(the-as int (if (zero? (-> this inlined?))
|
|
(* (-> this elt-count) 4)
|
|
(* (-> this elt-count) (-> this elt-type size))
|
|
)
|
|
)
|
|
)
|
|
|
|
;; definition for method 13 of type res-lump
|
|
;; INFO: Used lq/sq
|
|
(defmethod get-tag-index-data ((this res-lump) (arg0 int))
|
|
"Get the data address of the n'th tag."
|
|
(&+ (-> this data-base) (-> this tag arg0 data-offset))
|
|
)
|
|
|
|
;; definition for method 14 of type res-lump
|
|
(defmethod get-tag-data ((this res-lump) (arg0 res-tag))
|
|
"Get the data address of the specified tag."
|
|
(&+ (-> this data-base) (-> arg0 data-offset))
|
|
)
|
|
|
|
;; definition for method 0 of type res-lump
|
|
(defmethod new res-lump ((allocation symbol) (type-to-make type) (arg0 int) (arg1 int))
|
|
(let ((v0-0 (object-new allocation type-to-make (the-as int (+ (-> type-to-make size) (* (+ arg0 -1) 16) arg1)))))
|
|
(set! (-> v0-0 allocated-length) arg0)
|
|
(set! (-> v0-0 data-size) arg1)
|
|
(set! (-> v0-0 length) 0)
|
|
(set! (-> v0-0 data-base) (&-> v0-0 tag arg0))
|
|
(set! (-> v0-0 data-top) (&-> v0-0 tag arg0))
|
|
v0-0
|
|
)
|
|
)
|
|
|
|
;; definition for method 4 of type res-lump
|
|
(defmethod length ((this res-lump))
|
|
(-> this length)
|
|
)
|
|
|
|
;; definition for method 5 of type res-lump
|
|
;; WARN: Return type mismatch uint vs int.
|
|
(defmethod asize-of ((this res-lump))
|
|
(the-as int (+ (-> this type psize) (* (-> this allocated-length) 16) (-> this data-size)))
|
|
)
|
|
|
|
;; definition for method 3 of type res-lump
|
|
;; INFO: Used lq/sq
|
|
(defmethod inspect ((this res-lump))
|
|
(format #t "[~8x] ~A~%" this (-> this type))
|
|
(format #t "~Textra: ~A~%" (-> this extra))
|
|
(format #t "~Tallocated-length: ~D~%" (-> this allocated-length))
|
|
(format #t "~Tlength: ~D~%" (-> this length))
|
|
(format #t "~Tdata-base: #x~X~%" (-> this data-base))
|
|
(format #t "~Tdata-top: #x~X~%" (-> this data-top))
|
|
(format #t "~Tdata-size: #x~X~%" (-> this data-size))
|
|
(format #t "~Ttag[~D]: @ #x~X~%" (-> this allocated-length) (-> this tag))
|
|
(dotimes (s5-0 (-> this length))
|
|
(format #t "~T [~D] " s5-0)
|
|
(print (-> this tag s5-0))
|
|
(let ((t9-10 format)
|
|
(a0-12 #t)
|
|
(a1-9 " @ #x~X")
|
|
(a3-2 this)
|
|
(a2-9 s5-0)
|
|
)
|
|
(t9-10 a0-12 a1-9 (&+ (-> a3-2 data-base) (-> a3-2 tag a2-9 data-offset)))
|
|
)
|
|
(cond
|
|
((zero? (-> this tag s5-0 inlined?))
|
|
(let ((t9-11 format)
|
|
(a0-14 #t)
|
|
(a1-10 " = ~A~%")
|
|
(a3-4 this)
|
|
(a2-17 s5-0)
|
|
)
|
|
(t9-11 a0-14 a1-10 (-> (the-as (pointer uint32) (&+ (-> a3-4 data-base) (-> a3-4 tag a2-17 data-offset)))))
|
|
)
|
|
)
|
|
(else
|
|
(format #t "~%")
|
|
)
|
|
)
|
|
)
|
|
this
|
|
)
|
|
|
|
;; definition for method 19 of type res-lump
|
|
;; INFO: Used lq/sq
|
|
;; WARN: Return type mismatch int vs res-tag-pair.
|
|
(defmethod lookup-tag-idx ((this res-lump) (arg0 symbol) (arg1 symbol) (arg2 float))
|
|
"Look up the index of the tag containing with the given name and timestamp.
|
|
Correct lookups return a res-tag-pair, which contains one tag index in the lower 32 bits and one in the upper 32 bits.
|
|
Depending on the mode, they may be the same, or they may be two tags that you should interpolate
|
|
between, if the exact time was not found.
|
|
|
|
@param name-sym should be the name of the thing you want.
|
|
@param time is for the timestamp you want.
|
|
If mode = 'base, then both the indices are the same and the timestamp is ignored.
|
|
If mode = 'interp, then it tries to get closest below/closest above (or both the same, if exact match found).
|
|
If mode = 'exact, then it requires an exact timestamp match and both indices are the same.
|
|
If things go wrong, returns a negative number."
|
|
(local-vars (t4-1 int))
|
|
(when (or (= arg0 'id)
|
|
(= arg0 'aid)
|
|
(= arg0 'trans)
|
|
(= arg0 'rot)
|
|
(= arg0 'nav-mesh)
|
|
(= arg0 'process-type)
|
|
(= arg0 'task)
|
|
)
|
|
(crash!)
|
|
0
|
|
)
|
|
(if (or (not this) (zero? this) (<= (-> this length) 0))
|
|
(return (new 'static 'res-tag-pair :lo #xffffffff :hi #xffffffff))
|
|
)
|
|
(let ((v1-14 -1)
|
|
(t0-6 -1)
|
|
)
|
|
(let ((t1-0 -1)
|
|
(t2-4 (-> (the-as (pointer uint64) (-> (symbol->string arg0) data)) 0))
|
|
)
|
|
(let ((t3-1 (+ (-> this length) -1))
|
|
(t4-0 0)
|
|
)
|
|
(while (>= t3-1 t4-0)
|
|
(let* ((t5-2 (+ t4-0 (/ (- t3-1 t4-0) 2)))
|
|
(t6-5 (- t2-4 (-> (the-as (pointer uint64) (-> (symbol->string (-> this tag t5-2 name)) data)) 0)))
|
|
)
|
|
(cond
|
|
((zero? t6-5)
|
|
(set! t4-1 t5-2)
|
|
(goto cfg-32)
|
|
)
|
|
((< (the-as int t6-5) 0)
|
|
(set! t3-1 (+ t5-2 -1))
|
|
)
|
|
(else
|
|
(set! t4-0 (+ t5-2 1))
|
|
)
|
|
)
|
|
)
|
|
)
|
|
)
|
|
(set! t4-1 -1)
|
|
(label cfg-32)
|
|
(if (< t4-1 0)
|
|
(return (the-as res-tag-pair t4-1))
|
|
)
|
|
(while (and (> t4-1 0)
|
|
(= t2-4 (-> (the-as (pointer uint64) (-> (symbol->string (-> this tag (+ t4-1 -1) name)) data)) 0))
|
|
)
|
|
(+! t4-1 -1)
|
|
)
|
|
(when (= arg1 'base)
|
|
(set! t0-6 t4-1)
|
|
(set! v1-14 t4-1)
|
|
(goto cfg-73)
|
|
)
|
|
(let ((t3-13 t4-1)
|
|
(t4-4 (&-> this tag t4-1))
|
|
)
|
|
(while (not (or (>= t3-13 (-> this length))
|
|
(< t2-4 (-> (&+ (the-as (pointer uint64) (symbol->string (-> t4-4 0 name))) 4) 0))
|
|
)
|
|
)
|
|
(cond
|
|
((!= arg0 (-> t4-4 0 name))
|
|
)
|
|
((= (-> t4-4 0 key-frame) arg2)
|
|
(set! t0-6 t3-13)
|
|
(set! v1-14 t3-13)
|
|
(goto cfg-73)
|
|
)
|
|
((and (>= arg2 (-> t4-4 0 key-frame)) (!= arg1 'exact))
|
|
(set! t0-6 t3-13)
|
|
(set! v1-14 t3-13)
|
|
(if (= (-> t4-4 0 key-frame) -1000000000.0)
|
|
(set! t1-0 t3-13)
|
|
)
|
|
)
|
|
((< arg2 (-> t4-4 0 key-frame))
|
|
(if (and (!= t0-6 t1-0) (= arg1 'interp))
|
|
(set! v1-14 t3-13)
|
|
)
|
|
(goto cfg-73)
|
|
)
|
|
)
|
|
(+! t3-13 1)
|
|
(set! t4-4 (&-> t4-4 1))
|
|
)
|
|
)
|
|
)
|
|
(label cfg-73)
|
|
(the-as res-tag-pair (logior (logand (the-as uint #xffffffff) t0-6) (shl v1-14 32)))
|
|
)
|
|
)
|
|
|
|
;; definition for method 20 of type res-lump
|
|
;; INFO: Used lq/sq
|
|
(defmethod make-property-data ((this res-lump) (arg1 float) (tag-pair res-tag-pair) (arg3 pointer))
|
|
"Returns (a pointer to) the value data of a property with the tag-pair.
|
|
If tag-pair does not represent an exact point in the timeline, then the data is interpolated based on time
|
|
with the result written into buf. buf must have enough space to copy all of the data.
|
|
Otherwise, simply returns an address to the resource binary."
|
|
(rlet ((vf1 :class vf)
|
|
(vf2 :class vf)
|
|
(vf3 :class vf)
|
|
(vf4 :class vf)
|
|
)
|
|
(let* ((t0-2 (-> this tag (-> tag-pair lo)))
|
|
(t1-2 (-> this tag (-> tag-pair hi)))
|
|
(v1-6 (-> t0-2 elt-count))
|
|
)
|
|
(cond
|
|
((zero? (-> t0-2 inlined?))
|
|
(&+ (-> this data-base) (-> t0-2 data-offset))
|
|
)
|
|
((or (not arg3)
|
|
(= (-> tag-pair lo) (-> tag-pair hi))
|
|
(!= v1-6 (-> t1-2 elt-count))
|
|
(!= (-> t0-2 elt-type) (-> t1-2 elt-type))
|
|
)
|
|
(let ((a0-4 t0-2))
|
|
(&+ (-> this data-base) (-> a0-4 data-offset))
|
|
)
|
|
)
|
|
(else
|
|
(let* ((f0-2 (/ (- arg1 (-> t0-2 key-frame)) (- (-> t1-2 key-frame) (-> t0-2 key-frame))))
|
|
(a1-4 this)
|
|
(a2-7 t0-2)
|
|
(a1-6 (&+ (-> a1-4 data-base) (-> a2-7 data-offset)))
|
|
(a2-13 (&+ (-> this data-base) (-> t1-2 data-offset)))
|
|
)
|
|
(case (-> t0-2 elt-type symbol)
|
|
(('float)
|
|
(dotimes (a0-8 (the-as int v1-6))
|
|
(set! (-> (the-as (pointer float) (&+ arg3 (* a0-8 4))))
|
|
(+ (* (-> (the-as (pointer float) (&+ a1-6 (* a0-8 4)))) (- 1.0 f0-2))
|
|
(* (-> (the-as (pointer float) (&+ a2-13 (* a0-8 4)))) f0-2)
|
|
)
|
|
)
|
|
)
|
|
arg3
|
|
)
|
|
(('integer 'sinteger 'uinteger 'int64 'uint64)
|
|
(let ((a0-10 (the int (* 4096.0 f0-2))))
|
|
(dotimes (t0-10 (the-as int v1-6))
|
|
(set! (-> (the-as (pointer int64) (&+ arg3 (* t0-10 8))))
|
|
(sar
|
|
(+ (* (the-as int (-> (the-as (pointer uint64) (&+ a1-6 (* t0-10 8))))) (- 4096 a0-10))
|
|
(* (the-as int (-> (the-as (pointer uint64) (&+ a2-13 (* t0-10 8))))) a0-10)
|
|
)
|
|
12
|
|
)
|
|
)
|
|
)
|
|
)
|
|
arg3
|
|
)
|
|
(('int8)
|
|
(let ((a0-12 (the int (* 4096.0 f0-2))))
|
|
(dotimes (t0-11 (the-as int v1-6))
|
|
(set! (-> (the-as (pointer int8) (&+ arg3 t0-11)))
|
|
(sar
|
|
(+ (* (-> (the-as (pointer int8) (&+ a1-6 t0-11))) (- 4096 a0-12))
|
|
(* (-> (the-as (pointer int8) (&+ a2-13 t0-11))) a0-12)
|
|
)
|
|
12
|
|
)
|
|
)
|
|
)
|
|
)
|
|
arg3
|
|
)
|
|
(('uint8)
|
|
(let ((a0-14 (the int (* 4096.0 f0-2))))
|
|
(dotimes (t0-12 (the-as int v1-6))
|
|
(set! (-> (the-as (pointer uint8) (&+ arg3 t0-12)))
|
|
(shr
|
|
(+ (* (-> (the-as (pointer uint8) (&+ a1-6 t0-12))) (the-as uint (- 4096 a0-14)))
|
|
(* (-> (the-as (pointer uint8) (&+ a2-13 t0-12))) (the-as uint a0-14))
|
|
)
|
|
12
|
|
)
|
|
)
|
|
)
|
|
)
|
|
arg3
|
|
)
|
|
(('int16)
|
|
(let ((a0-16 (the int (* 4096.0 f0-2))))
|
|
(dotimes (t0-13 (the-as int v1-6))
|
|
(set! (-> (the-as (pointer int16) (&+ arg3 (* t0-13 2))))
|
|
(sar
|
|
(+ (* (-> (the-as (pointer int16) (&+ a1-6 (* t0-13 2)))) (- 4096 a0-16))
|
|
(* (-> (the-as (pointer int16) (&+ a2-13 (* t0-13 2)))) a0-16)
|
|
)
|
|
12
|
|
)
|
|
)
|
|
)
|
|
)
|
|
arg3
|
|
)
|
|
(('uint16)
|
|
(let ((a0-18 (the int (* 4096.0 f0-2))))
|
|
(dotimes (t0-14 (the-as int v1-6))
|
|
(set! (-> (the-as (pointer uint16) (&+ arg3 (* t0-14 2))))
|
|
(shr
|
|
(+ (* (-> (the-as (pointer uint16) (&+ a1-6 (* t0-14 2)))) (the-as uint (- 4096 a0-18)))
|
|
(* (-> (the-as (pointer uint16) (&+ a2-13 (* t0-14 2)))) (the-as uint a0-18))
|
|
)
|
|
12
|
|
)
|
|
)
|
|
)
|
|
)
|
|
arg3
|
|
)
|
|
(('int32)
|
|
(let ((a0-20 (the int (* 4096.0 f0-2))))
|
|
(dotimes (t0-15 (the-as int v1-6))
|
|
(set! (-> (the-as (pointer int32) (&+ arg3 (* t0-15 4))))
|
|
(sar
|
|
(+ (* (-> (the-as (pointer int32) (&+ a1-6 (* t0-15 4)))) (- 4096 a0-20))
|
|
(* (-> (the-as (pointer int32) (&+ a2-13 (* t0-15 4)))) a0-20)
|
|
)
|
|
12
|
|
)
|
|
)
|
|
)
|
|
)
|
|
arg3
|
|
)
|
|
(('uint32)
|
|
(let ((a0-22 (the int (* 4096.0 f0-2))))
|
|
(dotimes (t0-16 (the-as int v1-6))
|
|
(set! (-> (the-as (pointer uint32) (&+ arg3 (* t0-16 4))))
|
|
(shr
|
|
(+ (* (-> (the-as (pointer uint32) (&+ a1-6 (* t0-16 4)))) (the-as uint (- 4096 a0-22)))
|
|
(* (-> (the-as (pointer uint32) (&+ a2-13 (* t0-16 4)))) (the-as uint a0-22))
|
|
)
|
|
12
|
|
)
|
|
)
|
|
)
|
|
)
|
|
arg3
|
|
)
|
|
(('vector)
|
|
(let ((a0-23 f0-2))
|
|
(.mov vf3 a0-23)
|
|
)
|
|
(let ((a0-25 (- 1.0 f0-2)))
|
|
(.mov vf4 a0-25)
|
|
)
|
|
(dotimes (a0-26 (the-as int v1-6))
|
|
(let ((t0-18 (+ (* a0-26 16) (the-as int a1-6))))
|
|
(.lvf vf1 (&-> (the-as (pointer int128) t0-18)))
|
|
)
|
|
(let ((t0-20 (+ (* a0-26 16) (the-as int a2-13))))
|
|
(.lvf vf2 (&-> (the-as (pointer int128) t0-20)))
|
|
)
|
|
(.mul.x.vf vf1 vf1 vf4)
|
|
(.mul.x.vf vf2 vf2 vf3)
|
|
(.add.vf vf1 vf1 vf2)
|
|
(.svf (&-> (the-as (pointer uint128) (+ (* a0-26 16) (the-as int arg3))) 0) vf1)
|
|
)
|
|
arg3
|
|
)
|
|
(else
|
|
(let ((a0-27 t0-2))
|
|
(&+ (-> this data-base) (-> a0-27 data-offset))
|
|
)
|
|
)
|
|
)
|
|
)
|
|
)
|
|
)
|
|
)
|
|
)
|
|
)
|
|
|
|
;; definition for method 9 of type res-lump
|
|
;; INFO: Used lq/sq
|
|
(defmethod get-property-data ((this res-lump)
|
|
(arg0 symbol)
|
|
(arg1 symbol)
|
|
(arg2 float)
|
|
(arg3 pointer)
|
|
(arg4 (pointer res-tag))
|
|
(arg5 pointer)
|
|
)
|
|
"Returns an address to a given property's data at a specific time stamp, or default on error.
|
|
@param name is the name of the property you want, mode is its lookup mode ('interp 'base 'exact), time is the timestamp.
|
|
@param default is the default result returned in the case of an error.
|
|
@param tag-addr is an address to a res-tag. The current base tag is written to this. Ignored if tag-addr is #f
|
|
@param buf-addr is an address to the data buffer used to write interpolated data to. It must have enough space! Only necessary for 'interp mode."
|
|
(let ((s3-0 (lookup-tag-idx this arg0 arg1 arg2)))
|
|
(cond
|
|
((< (the-as int s3-0) 0)
|
|
(empty)
|
|
)
|
|
(else
|
|
(set! arg3 (make-property-data this arg2 s3-0 arg5))
|
|
(if arg4
|
|
(set! (-> arg4 0) (-> this tag (-> s3-0 lo)))
|
|
)
|
|
)
|
|
)
|
|
)
|
|
arg3
|
|
)
|
|
|
|
;; definition for method 10 of type res-lump
|
|
;; INFO: Used lq/sq
|
|
;; WARN: Return type mismatch object vs structure.
|
|
(defmethod get-property-struct ((this res-lump)
|
|
(arg0 symbol)
|
|
(arg1 symbol)
|
|
(arg2 float)
|
|
(arg3 structure)
|
|
(arg4 (pointer res-tag))
|
|
(arg5 pointer)
|
|
)
|
|
"Returns a given struct property's value at a specific time stamp, or default on error.
|
|
@param name is the name of the property you want, `mode` is its lookup mode ('interp 'base 'exact), `time` is the timestamp.
|
|
@param default is the default result returned in the case of an error.
|
|
@param tag-addr is an address to a [[res-tag]]. The current base tag is written to this. Ignored if tag-addr is #f.
|
|
@param buf-addr is an address to the data buffer used to write interpolated data to.
|
|
It must have enough space! Only necessary for 'interp mode."
|
|
(let ((s3-0 (lookup-tag-idx this arg0 arg1 arg2)))
|
|
(cond
|
|
((< (the-as int s3-0) 0)
|
|
(empty)
|
|
)
|
|
(else
|
|
(set! arg3 (the-as structure (make-property-data this arg2 s3-0 arg5)))
|
|
(let ((v1-4 (-> this tag (-> s3-0 lo))))
|
|
(if arg4
|
|
(set! (-> arg4 0) v1-4)
|
|
)
|
|
(if (zero? (-> v1-4 inlined?))
|
|
(set! arg3 (the-as structure (-> (the-as (pointer uint32) arg3))))
|
|
(empty)
|
|
)
|
|
)
|
|
)
|
|
)
|
|
)
|
|
(the-as structure arg3)
|
|
)
|
|
|
|
;; definition for method 11 of type res-lump
|
|
;; INFO: Used lq/sq
|
|
;; WARN: Return type mismatch int vs uint128.
|
|
(defmethod get-property-value ((this res-lump)
|
|
(arg0 symbol)
|
|
(arg1 symbol)
|
|
(arg2 float)
|
|
(arg3 uint128)
|
|
(arg4 (pointer res-tag))
|
|
(arg5 pointer)
|
|
)
|
|
"Returns a given value property's value at a specific time stamp, or default on error.
|
|
@param name is the name of the property you want, `mode` is its lookup mode ('interp 'base 'exact), `time` is the timestamp.
|
|
@param default is the default result returned in the case of an error.
|
|
@param tag-addr is an address to a res-tag. The current base tag is written to this. Ignored if `tag-addr` is #f.
|
|
@param buf-addr is an address to the data buffer used to write interpolated data to.
|
|
It must have enough space! Only necessary for 'interp mode."
|
|
(let ((a2-1 (lookup-tag-idx this arg0 arg1 arg2)))
|
|
(cond
|
|
((< (the-as int a2-1) 0)
|
|
(empty)
|
|
)
|
|
(else
|
|
(let* ((a0-2 (-> a2-1 lo))
|
|
(s1-0 (-> this tag a0-2))
|
|
(s0-0 (-> s1-0 elt-type))
|
|
(gp-1 (make-property-data this arg2 a2-1 arg5))
|
|
)
|
|
(if arg4
|
|
(set! (-> arg4 0) s1-0)
|
|
)
|
|
(cond
|
|
((type-type? (the-as type s0-0) uinteger)
|
|
(case (-> s1-0 elt-type size)
|
|
((1)
|
|
(set! arg3 (the-as uint128 (-> (the-as (pointer uint8) gp-1))))
|
|
)
|
|
((2)
|
|
(set! arg3 (the-as uint128 (-> (the-as (pointer uint16) gp-1))))
|
|
)
|
|
((4)
|
|
(set! arg3 (the-as uint128 (-> (the-as (pointer uint32) gp-1))))
|
|
)
|
|
((16)
|
|
(set! arg3 (-> (the-as (pointer uint128) gp-1)))
|
|
)
|
|
(else
|
|
(set! arg3 (the-as uint128 (-> (the-as (pointer uint64) gp-1))))
|
|
)
|
|
)
|
|
)
|
|
((type-type? (the-as type s0-0) integer)
|
|
(case (-> s1-0 elt-type size)
|
|
((1)
|
|
(set! arg3 (the-as uint128 (-> (the-as (pointer int8) gp-1))))
|
|
)
|
|
((2)
|
|
(set! arg3 (the-as uint128 (-> (the-as (pointer int16) gp-1))))
|
|
)
|
|
((4)
|
|
(set! arg3 (the-as uint128 (-> (the-as (pointer int32) gp-1))))
|
|
)
|
|
((16)
|
|
(set! arg3 (-> (the-as (pointer uint128) gp-1)))
|
|
)
|
|
(else
|
|
(set! arg3 (the-as uint128 (-> (the-as (pointer uint64) gp-1))))
|
|
)
|
|
)
|
|
)
|
|
((type-type? (the-as type s0-0) float)
|
|
(set! arg3 (the-as uint128 (the int (-> (the-as (pointer float) gp-1)))))
|
|
)
|
|
(else
|
|
(empty)
|
|
)
|
|
)
|
|
)
|
|
)
|
|
)
|
|
)
|
|
(the-as uint128 arg3)
|
|
)
|
|
|
|
;; definition for method 12 of type res-lump
|
|
;; INFO: Used lq/sq
|
|
(defmethod get-property-value-float ((this res-lump)
|
|
(arg0 symbol)
|
|
(arg1 symbol)
|
|
(arg2 float)
|
|
(arg3 float)
|
|
(arg4 (pointer res-tag))
|
|
(arg5 pointer)
|
|
)
|
|
(local-vars (v1-8 uint) (v1-11 int))
|
|
(let ((a2-1 (lookup-tag-idx this arg0 arg1 arg2)))
|
|
(cond
|
|
((< (the-as int a2-1) 0)
|
|
(empty)
|
|
)
|
|
(else
|
|
(let* ((a0-2 (-> a2-1 lo))
|
|
(s1-0 (-> this tag a0-2))
|
|
(s0-0 (-> s1-0 elt-type))
|
|
(gp-1 (make-property-data this arg2 a2-1 arg5))
|
|
)
|
|
(if arg4
|
|
(set! (-> arg4 0) s1-0)
|
|
)
|
|
(cond
|
|
((type-type? (the-as type s0-0) float)
|
|
(set! arg3 (-> (the-as (pointer float) gp-1)))
|
|
)
|
|
((type-type? (the-as type s0-0) uinteger)
|
|
(case (-> s1-0 elt-type size)
|
|
((1)
|
|
(set! v1-8 (-> (the-as (pointer uint8) gp-1)))
|
|
)
|
|
((2)
|
|
(set! v1-8 (-> (the-as (pointer uint16) gp-1)))
|
|
)
|
|
((4)
|
|
(set! v1-8 (-> (the-as (pointer uint32) gp-1)))
|
|
)
|
|
((16)
|
|
(set! v1-8 (the-as uint (-> (the-as (pointer uint128) gp-1))))
|
|
)
|
|
(else
|
|
(set! v1-8 (-> (the-as (pointer uint64) gp-1)))
|
|
)
|
|
)
|
|
(set! arg3 (the float v1-8))
|
|
)
|
|
((type-type? (the-as type s0-0) integer)
|
|
(case (-> s1-0 elt-type size)
|
|
((1)
|
|
(set! v1-11 (-> (the-as (pointer int8) gp-1)))
|
|
)
|
|
((2)
|
|
(set! v1-11 (-> (the-as (pointer int16) gp-1)))
|
|
)
|
|
((4)
|
|
(set! v1-11 (-> (the-as (pointer int32) gp-1)))
|
|
)
|
|
((16)
|
|
(set! v1-11 (the-as int (-> (the-as (pointer uint128) gp-1))))
|
|
)
|
|
(else
|
|
(set! v1-11 (the-as int (-> (the-as (pointer uint64) gp-1))))
|
|
)
|
|
)
|
|
(set! arg3 (the float v1-11))
|
|
)
|
|
(else
|
|
(empty)
|
|
)
|
|
)
|
|
)
|
|
)
|
|
)
|
|
)
|
|
arg3
|
|
)
|
|
|
|
;; definition for method 16 of type res-lump
|
|
;; INFO: Used lq/sq
|
|
(defmethod sort! ((this res-lump))
|
|
"Sort all tags based on name, then key-frame."
|
|
(let ((v1-0 -1))
|
|
(while (nonzero? v1-0)
|
|
(set! v1-0 0)
|
|
(let ((a1-0 0)
|
|
(a2-1 (+ (-> this length) -2))
|
|
)
|
|
(while (>= a2-1 a1-0)
|
|
(let* ((a3-2 (-> this tag a1-0))
|
|
(t0-3 (-> this tag (+ a1-0 1)))
|
|
(t1-6 (-> (the-as (pointer uint64) (-> (symbol->string (-> a3-2 name)) data)) 0))
|
|
(t2-6 (-> (the-as (pointer uint64) (-> (symbol->string (-> t0-3 name)) data)) 0))
|
|
)
|
|
(when (or (< t2-6 t1-6) (and (= t1-6 t2-6) (< (-> t0-3 key-frame) (-> a3-2 key-frame))))
|
|
(+! v1-0 1)
|
|
(set! (-> this tag a1-0) t0-3)
|
|
(set! (-> this tag (+ a1-0 1)) a3-2)
|
|
)
|
|
)
|
|
(+! a1-0 1)
|
|
)
|
|
)
|
|
)
|
|
)
|
|
this
|
|
)
|
|
|
|
;; definition for method 15 of type res-lump
|
|
;; INFO: Used lq/sq
|
|
(defmethod allocate-data-memory-for-tag! ((this res-lump) (arg0 res-tag))
|
|
"Find space for the data described by arg0 in this.
|
|
Returns a tag with data-offset set correctly for this res-lump.
|
|
If the lump already contains memory for the given tag, and it is big enough,
|
|
it will be reused. Alignment will be at least 8 bytes.
|
|
If the input tag has elt-count = 0, it will return a tag for elt-count = 1."
|
|
(local-vars (resource-mem pointer))
|
|
(let* ((tag-pair (lookup-tag-idx this (-> arg0 name) 'exact (-> arg0 key-frame)))
|
|
(existing-tag (-> this tag (-> tag-pair lo)))
|
|
)
|
|
0
|
|
(if (and (>= (the-as int tag-pair) 0) (!= (-> arg0 key-frame) (-> arg0 key-frame)))
|
|
(set! tag-pair (new 'static 'res-tag-pair :lo #xffffffff :hi #xffffffff))
|
|
)
|
|
(if (zero? (-> arg0 elt-count))
|
|
(set! arg0 (copy-and-set-field arg0 elt-count 1))
|
|
)
|
|
(let ((data-size (length arg0)))
|
|
(cond
|
|
((and (>= (the-as int tag-pair) 0) (>= (length existing-tag) data-size))
|
|
(set! resource-mem (&+ (-> this data-base) (-> existing-tag data-offset)))
|
|
(when (logtest? (the-as int resource-mem) 7)
|
|
(set! resource-mem (logand -16 (&+ (-> this data-top) 15)))
|
|
(set! (-> this data-top) (&+ resource-mem data-size))
|
|
)
|
|
)
|
|
(else
|
|
(set! resource-mem (logand -16 (&+ (-> this data-top) 15)))
|
|
(set! (-> this data-top) (&+ resource-mem data-size))
|
|
)
|
|
)
|
|
(let* ((a0-22 arg0)
|
|
(s4-1 (copy-and-set-field a0-22 data-offset (&- resource-mem (the-as uint (-> this data-base)))))
|
|
)
|
|
(when (>= (the-as int (&+ resource-mem data-size)) (the-as int (&+ (-> this data-base) (-> this data-size))))
|
|
(format
|
|
0
|
|
"ERROR: attempting to a new tag ~`res-tag`P data of #x~X bytes to ~A, but data memory is full.~%"
|
|
s4-1
|
|
data-size
|
|
this
|
|
)
|
|
(return (the-as res-tag #f))
|
|
)
|
|
(cond
|
|
((< (the-as int tag-pair) 0)
|
|
(cond
|
|
((>= (-> this length) (-> this allocated-length))
|
|
(format 0 "ERROR: attempting to a new tag ~`res-tag`P to ~A, but tag memory is full.~%" s4-1 this)
|
|
(return (the-as res-tag #f))
|
|
)
|
|
(else
|
|
(set! (-> this tag (-> this length)) s4-1)
|
|
(+! (-> this length) 1)
|
|
(sort! this)
|
|
)
|
|
)
|
|
)
|
|
(else
|
|
(set! (-> this tag (-> tag-pair lo)) s4-1)
|
|
)
|
|
)
|
|
s4-1
|
|
)
|
|
)
|
|
)
|
|
)
|
|
|
|
;; definition for method 17 of type res-lump
|
|
(defmethod add-data! ((this res-lump) (tag res-tag) (arg2 pointer))
|
|
"Given a tag and a pointer to its data, copy it to this res-lump.
|
|
This doesn't seem to do the right thing if the given tag is a non-inline tag
|
|
with > 1 element."
|
|
(let ((a0-2 (allocate-data-memory-for-tag! this tag)))
|
|
(when a0-2
|
|
(let* ((v1-2 this)
|
|
(a1-1 a0-2)
|
|
(s4-0 (&+ (-> v1-2 data-base) (-> a1-1 data-offset)))
|
|
)
|
|
(cond
|
|
((zero? (-> a0-2 inlined?))
|
|
(length a0-2)
|
|
(set! (-> (the-as (pointer pointer) s4-0) 0) arg2)
|
|
)
|
|
(else
|
|
(let ((a2-1 (length a0-2)))
|
|
(mem-copy! s4-0 arg2 a2-1)
|
|
)
|
|
)
|
|
)
|
|
)
|
|
)
|
|
)
|
|
this
|
|
)
|
|
|
|
;; definition for method 18 of type res-lump
|
|
(defmethod add-32bit-data! ((this res-lump) (arg0 res-tag) (arg1 object))
|
|
"Add a single 32-bit value using [[add-data!]]."
|
|
(let* ((sv-16 arg1)
|
|
(v1-0 arg0)
|
|
(a1-4 (copy-and-set-field v1-0 inlined? 1))
|
|
)
|
|
(add-data! this a1-4 (& sv-16))
|
|
)
|
|
)
|
|
|
|
;; definition for method 21 of type res-lump
|
|
;; INFO: Used lq/sq
|
|
(defmethod get-curve-data! ((this res-lump) (arg0 curve) (arg1 symbol) (arg2 symbol) (arg3 float))
|
|
"Read curve data and write it to curve-target. Return #t if both
|
|
control points and knots data was succesfully read, #f otherwise."
|
|
(let ((s5-0 #f))
|
|
(let* ((sv-16 (new 'static 'res-tag))
|
|
(a0-2 ((method-of-object this get-property-data)
|
|
this
|
|
arg1
|
|
'exact
|
|
arg3
|
|
(the-as pointer #f)
|
|
(& sv-16)
|
|
*res-static-buf*
|
|
)
|
|
)
|
|
)
|
|
(when a0-2
|
|
(set! (-> arg0 cverts) (the-as (inline-array vector) a0-2))
|
|
(set! (-> arg0 num-cverts) (the-as int (-> sv-16 elt-count)))
|
|
(when (< 256 (-> arg0 num-cverts))
|
|
(format
|
|
0
|
|
"ERROR<GMJ>: curve has ~D control points--only ~D are allowed. Increase MAX-CURVE-CONTROL-POINTS or shorten the curve.~%"
|
|
(-> arg0 num-cverts)
|
|
256
|
|
)
|
|
(set! (-> arg0 num-cverts) 256)
|
|
)
|
|
(let* ((sv-32 (new 'static 'res-tag))
|
|
(a0-6 ((method-of-object this get-property-data)
|
|
this
|
|
arg2
|
|
'exact
|
|
arg3
|
|
(the-as pointer #f)
|
|
(& sv-32)
|
|
*res-static-buf*
|
|
)
|
|
)
|
|
)
|
|
(when a0-6
|
|
(set! (-> arg0 knots) (the-as (pointer float) a0-6))
|
|
(set! (-> arg0 num-knots) (the-as int (-> sv-32 elt-count)))
|
|
(set! s5-0 #t)
|
|
)
|
|
)
|
|
)
|
|
)
|
|
s5-0
|
|
)
|
|
)
|
|
|
|
;; definition for method 8 of type res-lump
|
|
;; INFO: Used lq/sq
|
|
;; WARN: Return type mismatch int vs res-lump.
|
|
;; WARN: Using new Jak 2 rtype-of
|
|
;; WARN: Using new Jak 2 rtype-of
|
|
;; WARN: Using new Jak 2 rtype-of
|
|
;; WARN: Using new Jak 2 rtype-of
|
|
;; WARN: Using new Jak 2 rtype-of
|
|
;; WARN: Using new Jak 2 rtype-of
|
|
(defmethod mem-usage ((this res-lump) (usage memory-usage-block) (flags int))
|
|
(let ((s3-0 48)
|
|
(s2-0 "res")
|
|
)
|
|
(cond
|
|
((logtest? flags 256)
|
|
(set! s3-0 44)
|
|
(set! s2-0 "camera")
|
|
)
|
|
((logtest? flags 64)
|
|
(set! s3-0 43)
|
|
(set! s2-0 "entity")
|
|
)
|
|
((logtest? flags 512)
|
|
(set! s3-0 76)
|
|
(set! s2-0 "art-joint-geo")
|
|
)
|
|
)
|
|
(set! (-> usage length) (max (-> usage length) (+ s3-0 1)))
|
|
(set! (-> usage data s3-0 name) s2-0)
|
|
(+! (-> usage data s3-0 count) 1)
|
|
(let ((v1-19 (asize-of this)))
|
|
(+! (-> usage data s3-0 used) v1-19)
|
|
(+! (-> usage data s3-0 total) (logand -16 (+ v1-19 15)))
|
|
)
|
|
(dotimes (s1-0 (-> this length))
|
|
(when (zero? (-> this tag s1-0 inlined?))
|
|
(let* ((a1-4 this)
|
|
(a0-15 s1-0)
|
|
(s0-0 (the-as object (-> (the-as (pointer int32) (&+ (-> a1-4 data-base) (-> a1-4 tag a0-15 data-offset))))))
|
|
)
|
|
(when (not (part-group-pointer? (the-as pointer s0-0)))
|
|
(let ((v1-34 (rtype-of (the-as int s0-0))))
|
|
(cond
|
|
((or (= v1-34 symbol) (or (= v1-34 type) (= v1-34 pair)))
|
|
)
|
|
((= v1-34 string)
|
|
(set! (-> usage length) (max (-> usage length) (+ s3-0 1)))
|
|
(set! (-> usage data s3-0 name) s2-0)
|
|
(+! (-> usage data s3-0 count) 1)
|
|
(let ((v1-48 ((method-of-type (rtype-of (the-as int s0-0)) asize-of) (the-as int s0-0))))
|
|
(+! (-> usage data s3-0 used) v1-48)
|
|
(+! (-> usage data s3-0 total) (logand -16 (+ v1-48 15)))
|
|
)
|
|
)
|
|
((or (= v1-34 nav-mesh) (= v1-34 collide-mesh))
|
|
(let ((a0-48 (the-as (array object) s0-0)))
|
|
((method-of-type (rtype-of a0-48) mem-usage) a0-48 usage flags)
|
|
)
|
|
)
|
|
((= v1-34 array)
|
|
(set! (-> usage length) (max (-> usage length) (+ s3-0 1)))
|
|
(set! (-> usage data s3-0 name) s2-0)
|
|
(+! (-> usage data s3-0 count) 1)
|
|
(let* ((a0-53 (the-as (array object) s0-0))
|
|
(v1-68 ((method-of-type (rtype-of a0-53) asize-of) a0-53))
|
|
)
|
|
(+! (-> usage data s3-0 used) v1-68)
|
|
(+! (-> usage data s3-0 total) (logand -16 (+ v1-68 15)))
|
|
)
|
|
(let ((sv-16 0))
|
|
(while (< sv-16 (-> (the-as array s0-0) length))
|
|
(let ((a0-63 (-> (the-as (array object) s0-0) sv-16)))
|
|
((method-of-type (rtype-of a0-63) mem-usage) a0-63 usage flags)
|
|
)
|
|
(+! sv-16 1)
|
|
)
|
|
)
|
|
)
|
|
(else
|
|
(set! (-> usage length) (max (-> usage length) (+ s3-0 1)))
|
|
(set! (-> usage data s3-0 name) s2-0)
|
|
(+! (-> usage data s3-0 count) 1)
|
|
(let* ((a0-68 (the-as int s0-0))
|
|
(v1-96 ((method-of-type (rtype-of a0-68) asize-of) a0-68))
|
|
)
|
|
(+! (-> usage data s3-0 used) v1-96)
|
|
(+! (-> usage data s3-0 total) (logand -16 (+ v1-96 15)))
|
|
)
|
|
)
|
|
)
|
|
)
|
|
)
|
|
)
|
|
)
|
|
)
|
|
)
|
|
(the-as res-lump 0)
|
|
)
|
|
|
|
;; definition for symbol *res-static-buf*, type pointer
|
|
(define *res-static-buf* (malloc 'global 128))
|