more temp stuff

This commit is contained in:
water
2022-07-10 18:55:34 -04:00
parent 1c390a68a3
commit b0801ab009
53 changed files with 16173 additions and 1356 deletions
+11
View File
@@ -651,6 +651,17 @@ TP_Type SimpleExpression::get_type_int2(const TypeState& input,
}
}
if (env.version == GameVersion::Jak2 && tc(dts, TypeSpec("symbol"), arg1_type) &&
!m_args[0].is_int() && is_int_or_uint(dts, arg0_type)) {
if (arg0_type.is_integer_constant(jak2::SYM_TO_STRING_OFFSET)) {
// symbol -> GOAL String
// NOTE - the offset doesn't fit in a s16, so it's loaded into a register first.
// so we expect the arg to be a variable, and the type propagation will figure out the
// integer constant.
return TP_Type::make_from_ts(dts.ts.make_pointer_typespec("string"));
}
}
if (tc(dts, TypeSpec("structure"), arg1_type) && !m_args[0].is_int() &&
is_int_or_uint(dts, arg0_type)) {
if (arg1_type.typespec() == TypeSpec("symbol") &&
+57 -15
View File
@@ -101,7 +101,8 @@ Form* try_cast_simplify(Form* in,
if (new_type == TypeSpec("float")) {
auto ic = get_goal_integer_constant(in, env);
if (ic) {
ASSERT(*ic <= UINT32_MAX);
// ASSERT(*ic <= UINT32_MAX);
ASSERT((s64)*ic == (s64)(s32)*ic);
float f;
memcpy(&f, &ic.value(), sizeof(float));
return pool.form<ConstantFloatElement>(f);
@@ -983,7 +984,18 @@ void SimpleExpressionElement::update_from_stack_add_i(const Env& env,
// try to find symbol to string stuff
auto arg0_int = get_goal_integer_constant(args.at(0), env);
if (arg0_int && (*arg0_int == DECOMP_SYM_INFO_OFFSET + 4) &&
u64 symbol_to_string_offset = -1;
switch(env.version) {
case GameVersion::Jak1:
symbol_to_string_offset = DECOMP_SYM_INFO_OFFSET + 4;
break;
case GameVersion::Jak2:
symbol_to_string_offset = jak2::SYM_TO_STRING_OFFSET;
break;
default:
ASSERT(false);
}
if (arg0_int && (*arg0_int == symbol_to_string_offset) &&
arg1_type.typespec() == TypeSpec("symbol")) {
result->push_back(pool.alloc_element<GetSymbolStringPointer>(args.at(1)));
return;
@@ -2655,23 +2667,53 @@ bool try_to_rewrite_matrix_inline_ctor(const Env& env, FormPool& pool, FormStack
// zeroing the rows:
std::vector<RegisterAccess> write_vars;
for (int i = 0; i < 4; i++) {
auto elt = matrix_entries->at(i + 1).elt;
if (env.version == GameVersion::Jak1) {
for (int i = 0; i < 4; i++) {
auto elt = matrix_entries->at(i + 1).elt;
auto matcher = Matcher::set(
Matcher::deref(Matcher::any_reg(0), false,
{DerefTokenMatcher::string("vector"), DerefTokenMatcher::integer(i),
DerefTokenMatcher::string("quad")}),
Matcher::cast("uint128", Matcher::integer(0)));
auto matcher = Matcher::set(
Matcher::deref(Matcher::any_reg(0), false,
{DerefTokenMatcher::string("vector"), DerefTokenMatcher::integer(i),
DerefTokenMatcher::string("quad")}),
Matcher::cast("uint128", Matcher::integer(0)));
auto mr = match(matcher, elt);
if (mr.matched) {
if (var_name != env.get_variable_name(*mr.maps.regs.at(0))) {
auto mr = match(matcher, elt);
if (mr.matched) {
if (var_name != env.get_variable_name(*mr.maps.regs.at(0))) {
return false;
}
write_vars.push_back(*mr.maps.regs.at(0));
} else {
return false;
}
}
} else {
for (int i = 0; i < 4; i++) {
auto elt = matrix_entries->at(i + 1).elt;
Matcher matcher;
if (i == 3) {
matcher = Matcher::set(Matcher::deref(Matcher::any_reg(0), false,
{DerefTokenMatcher::string("trans"),
DerefTokenMatcher::string("quad")}),
Matcher::cast("uint128", Matcher::integer(0)));
} else {
matcher = Matcher::set(
Matcher::deref(Matcher::any_reg(0), false,
{DerefTokenMatcher::string("quad"), DerefTokenMatcher::integer(i)}),
Matcher::cast("uint128", Matcher::integer(0)));
}
auto mr = match(matcher, elt);
if (mr.matched) {
if (var_name != env.get_variable_name(*mr.maps.regs.at(0))) {
return false;
}
write_vars.push_back(*mr.maps.regs.at(0));
} else {
return false;
}
write_vars.push_back(*mr.maps.regs.at(0));
} else {
return false;
}
}
+8
View File
@@ -980,6 +980,14 @@ bool is_128bit(const TP_Type& type, const DecompilerTypeSystem& dts) {
return false;
}
bool is_float(const TP_Type& type, const DecompilerTypeSystem& dts) {
if (dts.ts.tc(TypeSpec("float"), type.typespec())) {
return true;
}
return false;
}
void promote_register_class(const Function& func,
VariableNames* result,
const DecompilerTypeSystem& dts) {
File diff suppressed because it is too large Load Diff
@@ -6,5 +6,11 @@
[26, "(function process symbol)"],
[23, "(function process symbol)"],
[17, "(function process symbol)"]
],
"level": [
[5, "(function none)"]
],
"main": [
[3, "(function none :behavior process)"]
]
}
+8
View File
@@ -95,7 +95,15 @@
},
"blocks_ending_in_asm_branch": {
"closest-pt-in-triangle": [17],
// this one is all asm branches
"circle-circle-xz-intersect": [
1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14
],
"find-knot-span": [0, 1, 2, 3, 5, 6, 7, 8, 9],
"curve-evaluate!": [0, 2, 5, 6, 7, 8, 9]
},
// Sometimes the game might use format strings that are fetched dynamically,
+39
View File
@@ -24,5 +24,44 @@
],
"quaternion-h": [
["L1", "quaternion"]
],
"quaternion": [
["L85", "vector"],
["L84", "vector"],
["L83", "vector"],
["L82", "vector"],
["L81", "vector"],
["L80", "vector"],
["L79", "vector"],
["L78", "vector"]
],
"trigonometry": [
["L93", "vector"],
["L92", "vector"],
["L91", "vector"]
],
"video-h": [
["L1", "video-params"]
],
"geometry": [
["L132", "vector"]
],
"texture-h": [
["L10", "texture-base"],
["L9", "texture-base"],
["L8", "texture-base"],
["L7", "texture-base"],
["L6", "texture-base"],
["L5", "texture-base"]
],
"texture-anim-h": [
["L1", "(pointer uint32)", 64]
],
"main-h": [
["L3", "frame-stats"]
],
"font-h": [
["L20", "matrix"],
["L19", "font-work"]
]
}
@@ -59,5 +59,208 @@
[80, "matrix"]
],
"matrix-with-scale->quaternion": [[16, "matrix"]],
"quaternion-exp!": [[16, "vector"]],
"quaternion-slerp!": [[16, "vector"]],
"quaternion-zxy!": [
[16, "vector"],
[32, "vector"],
[48, "vector"]
],
"vector-x-quaternion!": [[16, "matrix"]],
"vector-y-quaternion!": [[16, "matrix"]],
"vector-z-quaternion!": [[16, "matrix"]],
"quaternion-x-angle": [[16, "vector"]],
"quaternion-y-angle": [[16, "vector"]],
"quaternion-z-angle": [[16, "vector"]],
"quaternion-rotate-local-x!": [[16, "quaternion"]],
"quaternion-rotate-local-y!": [[16, "quaternion"]],
"quaternion-rotate-local-z!": [[16, "quaternion"]],
"quaternion-rotate-y!": [[16, "quaternion"]],
"quaternion-rotate-x!": [
[16, "quaternion"],
[32, "vector"]
],
"quaternion-rotate-z!": [
[16, "quaternion"],
[32, "vector"]
],
"quaternion-delta-y": [
[16, "vector"],
[32, "vector"]
],
"quaternion-rotate-y-to-vector!": [
[16, "quaternion"],
[32, "vector"],
[48, "quaternion"]
],
"quaternion-xz-angle": [
[16, "matrix"],
[80, "vector"]
],
"vector-rotate-x!": [
[16, "quaternion"],
[32, "matrix"]
],
"vector-rotate-y!": [
[16, "quaternion"],
[32, "matrix"]
],
"vector-rotate-z!": [
[16, "quaternion"],
[32, "matrix"]
],
"quaternion-axis-angle!": [
[16, "vector"]
],
"quaternion-vector-angle!": [
[16, "vector"]
],
"quaternion-look-at!": [
[16, "matrix"]
],
"quaternion-pseudo-seek": [
[16, "quaternion"],
[32, "quaternion"]
],
"quaternion-smooth-seek!": [
[16, ["inline-array", "quaternion", 2]]
],
"eul->matrix": [[16, "vector"]],
"eul->quat": [[16, "matrix"]],
"quat->eul": [[16, "matrix"]],
"vector-sincos!": [[16, "vector"]],
"vector-reflect-flat-gravity!": [[16, "vector"], [32, "vector"]],
"vector-line-distance": [
[16, "vector"],
[32, "vector"],
[48, "vector"],
[64, "vector"]
],
"vector-line-distance-point!": [
[16, "vector"],
[32, "vector"],
[48, "vector"],
[64, "vector"]
],
"forward-up-nopitch->inv-matrix": [[16, "vector"]],
"forward-up-nopitch->quaternion": [[16, "matrix"]],
"forward-up->quaternion": [
[16, "matrix"],
[80, "vector"]
],
"quaternion-from-two-vectors!": [[16, "vector"]],
"quaternion-from-two-vectors-max-angle!": [[16, "vector"]],
"matrix-from-two-vectors!": [[16, "vector"]],
"matrix-from-two-vectors-max-angle!": [[16, "vector"]],
"matrix-from-two-vectors-max-angle-partial!": [[16, "vector"]],
"matrix-from-two-vectors-partial-linear!": [[16, "vector"]],
"matrix-remove-z-rot": [
[16, "vector"],
[32, "matrix"]
],
"matrix-rot-diff!": [
[16, "quaternion"],
[32, "quaternion"],
[48, "quaternion"]
],
"quaternion-seek": [
[16, "matrix"],
[80, "matrix"],
[144, "quaternion"]
],
"vector-segment-overlap": [
[16, "vector"],
[32, "vector"],
[48, "vector"],
[64, "vector"]
],
"line-sphere-intersection?": [
[16, "vector"],
[32, "vector"],
[48, "vector"]
],
"forward-up->inv-matrix": [
[16, "vector"]
],
"quaternion-from-two-vectors-partial!": [
[16, "vector"]
],
"quaternion-from-two-vectors-max-angle-partial!": [
[16, "vector"]
],
"matrix-from-two-vectors-smooth!": [
[16, "vector"]
],
"matrix-from-two-vectors-the-long-way-smooth!": [
[16, "vector"]
],
"quaternion-from-two-vectors-smooth!": [
[16, "matrix"]
],
"vector-deg-seek": [[16, "matrix"]],
"vector-deg-slerp": [
[16, "matrix"],
[80, "vector"],
[96, "vector"]
],
"circle-test": [
[16, "sphere"],
[32, "sphere"],
[48, "vector"],
[64, "vector"]
],
"vector-vector-deg-slerp!": [
[16, "vector"],
[32, "vector"],
[48, "quaternion"],
[64, "quaternion"],
[80, "quaternion"],
[96, "vector"]
],
"vector-circle-tangent-new": [
[16, "sphere"],
[32, "vector"],
[48, "vector"]
],
"vector-circle-tangent": [
[16, "sphere"],
[32, "vector"],
[48, "vector"],
[64, "vector"]
],
"curve-length": [
[16, "vector"],
[32, "vector"]
],
"curve-closest-point": [
[16, "vector"],
[32, "vector"]
],
"closest-pt-in-triangle": [
[16, "vector"],
[32, "vector"],
[48, "vector"]
],
"vector-plane-distance": [[16, "vector"]],
"vector-smooth-seek!": [[16, "vector"]],
"vector-vector-angle-safe": [[16, "vector"], [32, "vector"]],
"move-target-from-pad": [
[16, "vector"],
[32, "vector"],
[48, "matrix"]
],
"reverse-transform-point!": [
[16, "vector"],
[32, "vector"],
[48, "vector"]
],
"init-for-transform": [
[16, "matrix"],
[80, "matrix"],
[144, "vector4s-3"],
[192, "vector"],
[208, "vector4s-3"]
],
"placeholder-do-not-add-below!": []
}
+89 -1
View File
@@ -86,8 +86,96 @@
[[0,33], "f0", "float"],
[[0,33], "f1", "float"],
[[0,33], "f2", "float"]
],
"vector-x-quaternion!": [[10, "v1", "(pointer uint128)"]],
"vector-y-quaternion!": [[10, "v1", "(pointer uint128)"]],
"vector-z-quaternion!": [[10, "v1", "(pointer uint128)"]],
"dma-buffer-add-vu-function": [[[9, 33], "t2", "dma-packet"]],
"dma-buffer-add-buckets": [
[[1, 4], "v1", "dma-bucket"],
[5, "v1", "pointer"],
[[9, 11], "v1", "dma-bucket"],
[11, "v1", "pointer"]
],
"dma-buffer-patch-buckets": [
[[6,8], "a0", "(inline-array dma-bucket)"],
[8, "a3", "pointer"],
[14, "a0", "(inline-array dma-bucket)"],
[3, "a0", "(inline-array dma-bucket)"],
[36, "a0", "(inline-array dma-bucket)"],
[10, "a0", "(inline-array dma-bucket)"],
[18, "a0", "(inline-array dma-bucket)"],
[[29,33], "a0", "dma-packet"],
[34, "a0", "(inline-array dma-bucket)"]
],
"dma-bucket-insert-tag": [
[[2, 6], "v1", "dma-bucket"],
[3, "a0", "dma-bucket"]
],
"disasm-vif-details": [
[[62, 94], "s3", "(pointer uint32)"],
[[98, 130], "s3", "(pointer uint16)"],
[[134, 164], "s3", "(pointer uint32)"],
[[168, 198], "s3", "(pointer uint16)"],
[[202, 225], "s3", "(pointer uint16)"]
],
"disasm-vif-tag": [
[[81, 85], "t1", "vif-stcycl-imm"],
[242, "a0", "vif-unpack-imm"]
],
"disasm-dma-list": [
[25, "v1", "dma-tag"],
[153, "v1", "dma-packet"],
[189, "v1", "dma-packet"],
[229, "v1", "dma-packet"],
[258, "v1", "dma-packet"],
[302, "v1", "dma-packet"],
[308, "v1", "dma-packet"],
[152, "v1", "(pointer uint64)"],
[167, "v1", "(pointer uint64)"],
[176, "v1", "(pointer uint64)"],
[198, "v1", "(pointer uint64)"],
[207, "v1", "(pointer uint64)"],
[238, "v1", "(pointer uint64)"],
[247, "v1", "(pointer uint64)"],
[282, "v1", "(pointer uint64)"],
[291, "v1", "(pointer uint64)"],
[324, "v1", "(pointer uint64)"],
[334, "v1", "(pointer uint64)"]
],
"calculate-basis-functions-vector!": [
[[8, 20], "v1", "(pointer float)"],
[[0, 60], "f1", "float"]
],
"curve-evaluate!": [[62, "s5", "pointer"]],
"vector4-array-add!": [
[11, "s5", "(inline-array vector4)"],
[12, "s4", "(inline-array vector4)"],
[13, "gp", "(inline-array vector4)"]],
"vector4-array-sub!": [
[11, "s5", "(inline-array vector4)"],
[12, "s4", "(inline-array vector4)"],
[13, "gp", "(inline-array vector4)"]],
"vector4-array-mul!": [
[11, "s5", "(inline-array vector4)"],
[12, "s4", "(inline-array vector4)"],
[13, "gp", "(inline-array vector4)"]],
"vector4-array-scale!": [
[11, "s5", "(inline-array vector4)"],
[12, "gp", "(inline-array vector4)"]],
"vector4-array-madd!": [
[13, "s5", "(inline-array vector4)"],
[14, "s4", "(inline-array vector4)"],
[15, "gp", "(inline-array vector4)"]],
"vector4-array-msub!": [
[13, "s5", "(inline-array vector4)"],
[14, "s4", "(inline-array vector4)"],
[15, "gp", "(inline-array vector4)"]],
"vector4-array-lerp!": [
[13, "s5", "(inline-array vector4)"],
[14, "s4", "(inline-array vector4)"],
[15, "gp", "(inline-array vector4)"]],
"placeholder-do-not-add-below": []
}
+1 -1
View File
@@ -924,7 +924,7 @@ goos::Object decompile_structure(const TypeSpec& type,
}
// first, let's see if it's a value or reference
auto field_type_info = ts.lookup_type(field.type());
auto field_type_info = ts.lookup_type_allow_partial_def(field.type());
if (!field_type_info->is_reference()) {
// value type. need to get bytes.
ASSERT(!field.is_inline());
+56
View File
@@ -5,3 +5,59 @@
;; name in dgo: dma-bucket
;; dgos: ENGINE, GAME
(define-extern *display-profile* symbol)
(define-extern *stats-profile-bars* symbol)
(defun dma-buffer-add-buckets ((arg0 dma-buffer) (arg1 int))
(let ((v0-0 (-> arg0 base)))
(let ((v1-0 (the-as object v0-0)))
(dotimes (a2-0 arg1)
(set! (-> (the-as dma-bucket v1-0) tag)
(new 'static 'dma-tag :id (dma-tag-id next) :addr (the-as int (&+ (the-as pointer v1-0) 16)))
)
(set! (-> (the-as dma-bucket v1-0) last) (the-as (pointer dma-tag) v1-0))
(set! v1-0 (&+ (the-as pointer v1-0) 16))
)
(set! (-> arg0 base) (the-as pointer v1-0))
)
(the-as (inline-array dma-bucket) v0-0)
)
)
(defun dma-buffer-patch-buckets ((arg0 (inline-array dma-bucket)) (arg1 int))
(when (nonzero? arg0)
(dotimes (v1-1 arg1)
(cond
((= (the-as object arg0) (-> arg0 0 last))
(set! (-> arg0 0 tag) (new 'static 'dma-tag :id (dma-tag-id cnt)))
(set! (-> arg0 0 clear) (the-as uint 0))
0
)
(else
(set! (-> arg0 0 last 0 addr) (the-as int (-> arg0 1)))
(cond
((or *display-profile* *stats-profile-bars*)
(set! (-> (the-as dma-packet arg0) vif0) (new 'static 'vif-tag :cmd (vif-cmd mark) :imm v1-1))
(set! (-> (the-as dma-packet arg0) vif1) (new 'static 'vif-tag :irq #x1))
)
(else
(set! (-> arg0 0 clear) (the-as uint 0))
0
)
)
)
)
(set! arg0 (the-as (inline-array dma-bucket) (-> arg0 1)))
)
)
(the-as (inline-array dma-bucket) arg0)
)
(defun dma-bucket-insert-tag ((arg0 (inline-array dma-bucket)) (arg1 bucket-id) (arg2 pointer) (arg3 (pointer dma-tag)))
(let ((v1-1 (-> arg0 arg1)))
(set! (-> (the-as dma-bucket (-> v1-1 last)) next) (the-as uint arg2))
(set! (-> v1-1 last) arg3)
)
arg2
)
+130
View File
@@ -5,3 +5,133 @@
;; name in dgo: dma-buffer
;; dgos: ENGINE, GAME
(deftype dma-packet (structure)
((dma dma-tag :offset-assert 0)
(vif0 vif-tag :offset-assert 8)
(vif1 vif-tag :offset-assert 12)
(quad uint128 :offset 0)
)
:method-count-assert 9
:size-assert #x10
:flag-assert #x900000010
)
(deftype dma-packet-array (inline-array-class)
((data dma-packet :inline :dynamic :offset-assert 16)
)
:method-count-assert 9
:size-assert #x10
:flag-assert #x900000010
)
(set! (-> dma-packet-array heap-base) (the-as uint 16))
(deftype dma-gif (structure)
((gif uint64 2 :offset-assert 0)
(quad uint128 :offset 0)
)
:method-count-assert 9
:size-assert #x10
:flag-assert #x900000010
)
(deftype dma-gif-packet (structure)
((dma-vif dma-packet :inline :offset-assert 0)
(gif uint64 2 :offset-assert 16)
(quad uint128 2 :offset 0)
)
:method-count-assert 9
:size-assert #x20
:flag-assert #x900000020
)
(deftype dma-buffer (basic)
((allocated-length int32 :offset-assert 4)
(base pointer :offset-assert 8)
(end pointer :offset-assert 12)
(data uint64 1 :offset-assert 16)
)
:method-count-assert 9
:size-assert #x18
:flag-assert #x900000018
(:methods
(new (symbol type int) _type_ 0)
)
)
(defmethod new dma-buffer ((allocation symbol) (type-to-make type) (arg0 int))
(let ((v0-0 (object-new allocation type-to-make (+ arg0 -4 (-> type-to-make size)))))
(set! (-> v0-0 base) (-> v0-0 data))
(set! (-> v0-0 allocated-length) arg0)
v0-0
)
)
(defun dma-buffer-inplace-new ((arg0 dma-buffer) (arg1 int))
(set! (-> arg0 base) (-> arg0 data))
(set! (-> arg0 allocated-length) arg1)
arg0
)
(defmethod length dma-buffer ((obj dma-buffer))
(-> obj allocated-length)
)
(defmethod asize-of dma-buffer ((obj dma-buffer))
(+ (-> obj allocated-length) -4 (-> dma-buffer size))
)
(defun dma-buffer-length ((arg0 dma-buffer))
(the-as int (shr (+ (&- (-> arg0 base) (the-as uint (-> arg0 data))) 15) 4))
)
(defun dma-buffer-free ((arg0 dma-buffer))
(the-as int (shr (+ (&- (-> arg0 end) (the-as uint (-> arg0 base))) 15) 4))
)
(defun dma-buffer-add-vu-function ((arg0 dma-buffer) (arg1 vu-function) (arg2 int))
(let ((v1-0 (&-> arg1 data 4))
(a3-0 (-> arg1 qlength))
(a1-1 (-> arg1 origin))
)
(while (> a3-0 0)
(let ((t0-1 (min 127 a3-0)))
(let* ((t1-1 arg0)
(t2-0 (the-as object (-> t1-1 base)))
)
(set! (-> (the-as dma-packet t2-0) dma)
(new 'static 'dma-tag :id (dma-tag-id ref) :addr (the-as int v1-0) :qwc t0-1)
)
(set! (-> (the-as dma-packet t2-0) vif0) (new 'static 'vif-tag :cmd (if (zero? arg2) 16 19)))
(set! (-> (the-as dma-packet t2-0) vif1) (new 'static 'vif-tag :cmd (vif-cmd mpg) :num (* t0-1 2) :imm a1-1))
(set! (-> t1-1 base) (&+ (the-as pointer t2-0) 16))
)
(&+! v1-0 (* t0-1 16))
(set! a3-0 (- a3-0 t0-1))
(+! a1-1 (* t0-1 2))
)
)
)
#f
)
(defun dma-buffer-send ((arg0 dma-bank) (arg1 dma-buffer))
(when (< (-> arg1 allocated-length) (&- (-> arg1 base) (the-as uint (-> arg1 data))))
(crash!)
0
)
(dma-send arg0 (the-as uint (-> arg1 data)) (the-as uint (dma-buffer-length arg1)))
(none)
)
(defun dma-buffer-send-chain ((arg0 dma-bank-source) (arg1 dma-buffer))
(when (< (-> arg1 allocated-length) (&- (-> arg1 base) (the-as uint (-> arg1 data))))
(crash!)
0
)
(dma-send-chain arg0 (the-as uint (-> arg1 data)))
(none)
)
+577
View File
@@ -5,3 +5,580 @@
;; name in dgo: dma-disasm
;; dgos: ENGINE, GAME
(declare-file (debug))
(when *debug-segment*
(deftype vif-disasm-element (structure)
((mask uint32 :offset-assert 0)
(tag vif-cmd-32 :offset-assert 4)
(val uint32 :offset-assert 8)
(print uint32 :offset-assert 12)
(string1 string :offset-assert 16)
(string2 string :offset-assert 20)
)
:method-count-assert 9
:size-assert #x18
:flag-assert #x900000018
)
(define *vif-disasm-table*
(the-as (array vif-disasm-element)
(new 'static 'boxed-array :type vif-disasm-element
(new 'static 'vif-disasm-element :mask #x7f :string1 "nop")
(new 'static 'vif-disasm-element :mask #x7f :tag (vif-cmd-32 stcycl) :print #x2 :string1 "stcycl")
(new 'static 'vif-disasm-element :mask #x7f :tag (vif-cmd-32 offset) :print #x1 :string1 "offset":string2 "offset")
(new 'static 'vif-disasm-element :mask #x7f :tag (vif-cmd-32 base) :print #x1 :string1 "base" :string2 "base")
(new 'static 'vif-disasm-element :mask #x7f :tag (vif-cmd-32 itop) :print #x1 :string1 "itop" :string2 "addr")
(new 'static 'vif-disasm-element :mask #x7f :tag (vif-cmd-32 stmod) :print #x1 :string1 "stmod" :string2 "mode")
(new 'static 'vif-disasm-element :mask #x7f :tag (vif-cmd-32 mskpath3) :print #x1 :string1 "mskpath3" :string2 "mask")
(new 'static 'vif-disasm-element :mask #x7f :tag (vif-cmd-32 mark) :print #x1 :string1 "mark" :string2 "mark")
(new 'static 'vif-disasm-element :mask #x7f :tag (vif-cmd-32 flushe) :string1 "flushe")
(new 'static 'vif-disasm-element :mask #x7f :tag (vif-cmd-32 flush) :string1 "flush")
(new 'static 'vif-disasm-element :mask #x7f :tag (vif-cmd-32 flusha) :string1 "flusha")
(new 'static 'vif-disasm-element :mask #x7f :tag (vif-cmd-32 mscal) :print #x1 :string1 "mscal" :string2 "addr")
(new 'static 'vif-disasm-element :mask #x7f :tag (vif-cmd-32 mscnt) :string1 "mscnt")
(new 'static 'vif-disasm-element :mask #x7f :tag (vif-cmd-32 mscalf) :print #x1 :string1 "mscalf" :string2 "addr")
(new 'static 'vif-disasm-element :mask #x7f :tag (vif-cmd-32 stmask) :print #x3 :string1 "stmask" :string2 "mask")
(new 'static 'vif-disasm-element :mask #x7f :tag (vif-cmd-32 strow) :print #x4 :string1 "strow" :string2 "row")
(new 'static 'vif-disasm-element :mask #x7f :tag (vif-cmd-32 stcol) :print #x4 :string1 "stcol" :string2 "col")
(new 'static 'vif-disasm-element :mask #x7f :tag (vif-cmd-32 mpg) :print #x5 :string1 "mpg")
(new 'static 'vif-disasm-element :mask #x7f :tag (vif-cmd-32 direct) :print #x6 :string1 "direct")
(new 'static 'vif-disasm-element :mask #x7f :tag (vif-cmd-32 directhl) :print #x6 :string1 "directhl")
(new 'static 'vif-disasm-element :mask #x6f :tag (vif-cmd-32 unpack-s-32) :val #x10 :print #x7 :string1 "unpack-s-32")
(new 'static 'vif-disasm-element :mask #x6f :tag (vif-cmd-32 unpack-s-16) :val #x8 :print #x7 :string1 "unpack-s-16")
(new 'static 'vif-disasm-element :mask #x6f :tag (vif-cmd-32 unpack-s-8) :val #x4 :print #x7 :string1 "unpack-s-8")
(new 'static 'vif-disasm-element :mask #x6f :tag (vif-cmd-32 unpack-v2-32) :val #x8 :print #x7 :string1 "unpack-v2-32")
(new 'static 'vif-disasm-element :mask #x6f :tag (vif-cmd-32 unpack-v2-16) :val #x4 :print #x7 :string1 "unpack-v2-16")
(new 'static 'vif-disasm-element :mask #x6f :tag (vif-cmd-32 unpack-v2-8) :val #x2 :print #x7 :string1 "unpack-v2-8")
(new 'static 'vif-disasm-element :mask #x6f :tag (vif-cmd-32 unpack-v3-32) :val #xc :print #x7 :string1 "unpack-v3-32")
(new 'static 'vif-disasm-element :mask #x6f :tag (vif-cmd-32 unpack-v3-16) :val #x6 :print #x7 :string1 "unpack-v3-16")
(new 'static 'vif-disasm-element :mask #x6f :tag (vif-cmd-32 unpack-v3-8) :val #x3 :print #x7 :string1 "unpack-v3-8")
(new 'static 'vif-disasm-element :mask #x6f :tag (vif-cmd-32 unpack-v4-32) :val #x10 :print #x7 :string1 "unpack-v4-32")
(new 'static 'vif-disasm-element :mask #x6f :tag (vif-cmd-32 unpack-v4-16) :val #x8 :print #x7 :string1 "unpack-v4-16")
(new 'static 'vif-disasm-element :mask #x6f :tag (vif-cmd-32 unpack-v4-8) :val #x4 :print #x7 :string1 "unpack-v4-8")
(new 'static 'vif-disasm-element :mask #x6f :tag (vif-cmd-32 unpack-v4-5) :val #x2 :print #x7 :string1 "unpack-v4-5")
(new 'static 'vif-disasm-element :print #x8)
)
)
)
(defun disasm-vif-details ((arg0 symbol) (arg1 (pointer uint8)) (arg2 vif-cmd) (arg3 int))
(let ((s4-0 arg3))
(cond
((= arg2 (vif-cmd unpack-v4-8))
(let ((s3-0 (&-> arg1 4)))
(dotimes (s2-0 s4-0)
(format
arg0
" #x~X: #x~2X #x~2X #x~2X #x~2X~%"
(+ (+ (* s2-0 4) 4) (the-as int arg1))
(-> s3-0 (* s2-0 4))
(-> s3-0 (+ (* s2-0 4) 1))
(-> s3-0 (+ (* s2-0 4) 2))
(-> s3-0 (+ (* s2-0 4) 3))
)
)
)
)
((= arg2 (vif-cmd unpack-s-8))
(let ((s3-1 (&-> arg1 4)))
(dotimes (s2-1 s4-0)
(format arg0 " #x~X: #x~2x~%" (+ (+ s2-1 4) (the-as int arg1)) arg3)
(-> s3-1 (* 3 s2-1))
(-> s3-1 (+ (* 3 s2-1) 1))
)
)
)
((= arg2 (vif-cmd unpack-v4-32))
(let ((s3-2 (the-as (pointer uint32) (&-> arg1 4))))
(dotimes (s2-2 s4-0)
(format
arg0
" #x~X: #x~8x #x~8x #x~8x #x~8x~%"
(+ (+ (* s2-2 16) 4) (the-as int arg1))
(-> s3-2 (* s2-2 4))
(-> s3-2 (+ (* s2-2 4) 1))
(-> s3-2 (+ (* s2-2 4) 2))
(-> s3-2 (+ (* s2-2 4) 3))
)
)
)
)
((= arg2 (vif-cmd unpack-v4-16))
(let ((s3-3 (the-as (pointer uint16) (&-> arg1 4))))
(dotimes (s2-3 s4-0)
(format
arg0
" #x~X: #x~4x #x~4x #x~4x #x~4x~%"
(+ (+ (* s2-3 8) 4) (the-as int arg1))
(-> s3-3 (* s2-3 4))
(-> s3-3 (+ (* s2-3 4) 1))
(-> s3-3 (+ (* s2-3 4) 2))
(-> s3-3 (+ (* s2-3 4) 3))
)
)
)
)
((= arg2 (vif-cmd unpack-v3-32))
(let ((s3-4 (the-as (pointer uint32) (&-> arg1 4))))
(dotimes (s2-4 s4-0)
(format
arg0
" #x~X: #x~8x #x~8x #x~8x~%"
(+ (+ (* 12 s2-4) 4) (the-as int arg1))
(-> (&+ s3-4 (* 12 s2-4)) 0)
(-> s3-4 (+ (* 3 s2-4) 1))
(-> s3-4 (+ (* 3 s2-4) 2))
)
)
)
)
((= arg2 (vif-cmd unpack-v3-16))
(let ((s3-5 (the-as (pointer uint16) (&-> arg1 4))))
(dotimes (s2-5 s4-0)
(format
arg0
" #x~X: #x~4x #x~4x #x~4x~%"
(+ (+ (* 6 s2-5) 4) (the-as int arg1))
(-> (&+ s3-5 (* 6 s2-5)) 0)
(-> s3-5 (+ (* 3 s2-5) 1))
(-> s3-5 (+ (* 3 s2-5) 2))
)
)
)
)
((= arg2 (vif-cmd unpack-v2-16))
(let ((s3-6 (the-as (pointer uint16) (&-> arg1 4))))
(dotimes (s2-6 s4-0)
(format
arg0
" #x~X: #x~4x #x~4x~%"
(+ (+ (* s2-6 4) 4) (the-as int arg1))
(-> (&+ s3-6 (* 6 s2-6)) 0)
(-> s3-6 (+ (* 3 s2-6) 1))
)
)
)
)
(else
(format arg0 " #x~X: Data format #b~b not yet supported, add it for yourself!~%" (&-> arg1 4) arg2)
)
)
)
#f
)
(defun disasm-vif-tag ((arg0 (pointer vif-tag)) (arg1 int) (arg2 symbol) (arg3 symbol))
(local-vars (sv-16 vif-cmd) (sv-32 (pointer vif-tag)) (sv-48 int) (sv-64 vif-unpack-imm))
(let ((gp-0 0))
(while (< gp-0 (* arg1 4))
(let ((s0-0 4))
(let ((s1-0 (-> arg0 0)))
(format arg2 " #x~X:" arg0)
(dotimes (v1-0 (-> *vif-disasm-table* length))
(set! sv-16 (-> s1-0 cmd))
(when (= (logand sv-16 (-> *vif-disasm-table* v1-0 mask)) (-> *vif-disasm-table* v1-0 tag))
(let ((a0-12 (-> *vif-disasm-table* v1-0 print)))
(cond
((zero? a0-12)
(format arg2 " (~s :irq ~D)~%" (-> *vif-disasm-table* v1-0 string1) (-> s1-0 irq))
)
((= a0-12 1)
(format
arg2
" (~s :irq ~D :~s #x~X)~%"
(-> *vif-disasm-table* v1-0 string1)
(-> s1-0 irq)
(-> *vif-disasm-table* v1-0 string2)
(-> s1-0 imm)
)
)
((= a0-12 2)
(let ((t1-1 (-> s1-0 imm)))
(format
arg2
" (~s :irq ~D :wl ~D :cl ~D)~%"
(-> *vif-disasm-table* v1-0 string1)
(-> s1-0 irq)
(shr (shl (the-as int t1-1) 48) 56)
(shr (shl (the-as int t1-1) 56) 56)
)
)
)
((= a0-12 3)
(set! s0-0 8)
(format
arg2
" (~s :irq ~D :~s #x~X)~%"
(-> *vif-disasm-table* v1-0 string1)
(-> s1-0 irq)
(-> *vif-disasm-table* v1-0 string2)
(-> arg0 1)
)
)
((= a0-12 4)
(set! s0-0 20)
(format
arg2
" (~s :irq ~D :~s "
(-> *vif-disasm-table* v1-0 string1)
(-> s1-0 irq)
(-> *vif-disasm-table* v1-0 string2)
)
(format arg2 "#x~X #x~X #x~X #x~X)~%" (-> arg0 1) (-> arg0 2) (-> arg0 3) (-> arg0 4))
)
((= a0-12 5)
(format
arg2
" (~s :irq ~D :instructions #x~D :addr #x~X)~%"
(-> *vif-disasm-table* v1-0 string1)
(-> s1-0 irq)
(-> s1-0 num)
(-> s1-0 imm)
)
)
((= a0-12 6)
(if (-> s1-0 imm)
(set! s0-0 #x100000)
(set! s0-0 (the-as int (* (-> s1-0 imm) 16)))
)
(format arg2 " (~s :irq ~D :qwc #x~D)~%" (-> *vif-disasm-table* v1-0 string1) (-> s1-0 irq) (-> s1-0 imm))
(set! sv-32 (&-> arg0 1))
(set! sv-48 0)
(while (< sv-48 (the-as int (-> s1-0 imm)))
(format
arg2
" #x~X: #x~8x #x~8x #x~8x #x~8x~%"
(+ (+ (* sv-48 16) 4) (the-as int arg0))
(-> sv-32 (* sv-48 4))
(-> sv-32 (+ (* sv-48 4) 1))
(-> sv-32 (+ (* sv-48 4) 2))
(-> sv-32 (+ (* sv-48 4) 3))
)
(set! sv-48 (+ sv-48 1))
)
#f
)
((= a0-12 7)
(set! s0-0 (the-as int (+ (logand -4 (+ (* (-> *vif-disasm-table* v1-0 val) (-> s1-0 num)) 3)) 4)))
(set! sv-64 (the-as vif-unpack-imm (-> s1-0 imm)))
(format
arg2
" (~s :irq ~D :num ~D :addr #x~X "
(-> *vif-disasm-table* v1-0 string1)
(-> s1-0 irq)
(-> s1-0 num)
(-> sv-64 addr)
)
(format
arg2
":msk ~D :flg ~D :usn ~D [skip ~d])~%"
(-> s1-0 msk)
(-> sv-64 flg)
(-> sv-64 usn)
(the-as uint s0-0)
)
(if arg3
(disasm-vif-details
arg2
(the-as (pointer uint8) arg0)
(logand sv-16 (vif-cmd cmd-mask))
(the-as int (-> s1-0 num))
)
)
)
((= a0-12 8)
(format arg2 " (*unknown* vif-tag #x~X)~%" (-> s1-0 cmd))
)
)
)
(set! v1-0 (-> *vif-disasm-table* length))
)
)
)
(+! gp-0 s0-0)
(&+! arg0 s0-0)
)
)
(- gp-0 (* arg1 4))
)
)
(defun disasm-dma-tag ((arg0 dma-tag) (arg1 symbol))
(format arg1 "(dma-tag ")
(let ((t9-1 format)
(a0-2 arg1)
(a1-2 "~s")
(v1-1 (-> arg0 id))
)
(t9-1 a0-2 a1-2 (cond
((= v1-1 (dma-tag-id refe))
"refe"
)
((= v1-1 (dma-tag-id refs))
"refs"
)
((= v1-1 (dma-tag-id ret))
"ret"
)
((= v1-1 (dma-tag-id cnt))
"cnt"
)
((= v1-1 (dma-tag-id next))
"next"
)
((= v1-1 (dma-tag-id call))
"call"
)
((= v1-1 (dma-tag-id ref))
"ref"
)
((= v1-1 (dma-tag-id end))
"end"
)
(else
"*unknown*"
)
)
)
)
(if (> (-> arg0 addr) 0)
(format arg1 " :addr #x~8x" (-> arg0 addr))
)
(if (> (-> arg0 qwc) 0)
(format arg1 " :qwc ~d" (-> arg0 qwc))
)
(if (> (-> arg0 spr) 0)
(format arg1 " :spr ~d" (-> arg0 spr))
)
(if (> (-> arg0 irq) 0)
(format arg1 " :irq ~d" (-> arg0 irq))
)
(if (> (-> arg0 pce) 0)
(format arg1 " :pce ~d" (-> arg0 pce))
)
(format arg1 ")~%")
(none)
)
(define *dma-disasm* #t)
(defun disasm-dma-list ((arg0 dma-packet) (arg1 symbol) (arg2 symbol) (arg3 symbol) (arg4 int))
(local-vars
(sv-16 object)
(sv-32 dma-packet)
(sv-48 int)
(sv-64 object)
(sv-80 object)
(sv-96 int)
(sv-112 dma-tag)
)
(set! sv-32 arg0)
(let ((s2-0 arg1)
(s3-0 arg2)
(gp-0 arg3)
(s1-0 arg4)
)
(if s3-0
(format gp-0 "~%--- ~X -----------------------------~%" sv-32)
)
(let ((s0-0 #f))
(let ((s4-0 0)
(s5-0 0)
)
(set! sv-16 0)
(set! sv-48 0)
(set! sv-64 0)
(set! sv-80 1)
(set! sv-96 -1)
(set! sv-112 (new 'static 'dma-tag))
(while (not s0-0)
(let ((t9-1 valid?)
(a0-2 sv-32)
(a1-2 #f)
(a2-2 "dma-list tag pointer")
)
(cond
((not (t9-1 a0-2 (the-as type a1-2) (the-as symbol a2-2) #t gp-0))
(format gp-0 "ERROR: dma-list tag pointer invalid~%")
(set! s0-0 'error)
)
(else
(set! sv-112 (-> sv-32 dma))
(when (not (or (zero? s5-0) (let ((t9-3 valid?)
(a0-4 sv-16)
(a1-4 #f)
)
(set! a2-2 "dma-list data pointer")
(t9-3 a0-4 (the-as type a1-4) (the-as symbol a2-2) #t gp-0)
)
)
)
(format gp-0 "ERROR: dma-list data pointer invalid~%")
(set! s0-0 'error)
)
(when (logtest? (the-as dma-tag #x3ff0000) sv-112)
(format gp-0 "ERROR: dma tag has data in reserved bits ~X~%" (the-as none a2-2))
(set! s0-0 'error)
)
)
)
)
(when (or s3-0 (= s0-0 'error))
(format gp-0 "#x~8x: " sv-32)
(cond
((zero? sv-96)
(format gp-0 " ")
)
((= sv-96 1)
(format gp-0 " ")
)
)
(disasm-dma-tag sv-112 gp-0)
)
(cond
(s0-0
)
((or (= (-> sv-112 id) (dma-tag-id ref)) (= (-> sv-112 id) (dma-tag-id refs)) (zero? (-> sv-112 id)))
(set! sv-16 (-> sv-112 addr))
(set! sv-48 (the-as int (-> sv-112 qwc)))
(when s2-0
(let ((v0-10 (disasm-vif-tag (&-> sv-32 vif0) 2 gp-0 (= s2-0 'details))))
(disasm-vif-tag
(the-as (pointer vif-tag) (+ (the-as int sv-16) v0-10))
(the-as int (- (* sv-48 4) (the-as uint (/ v0-10 4))))
gp-0
(= s2-0 'details)
)
)
)
(set! sv-32 (the-as dma-packet (&-> (the-as (pointer uint64) sv-32) 2)))
(if (= (-> sv-112 id) (dma-tag-id refe))
(set! s0-0 #t)
)
)
((= (-> sv-112 id) (dma-tag-id cnt))
(set! sv-16 (&-> (the-as (pointer uint64) sv-32) 2))
(set! sv-48 (the-as int (-> sv-112 qwc)))
(if s2-0
(disasm-vif-tag
(the-as (pointer vif-tag) (&-> (the-as (pointer uint64) sv-32) 1))
(the-as int (+ (* sv-48 4) 2))
gp-0
(= s2-0 'details)
)
)
(set! sv-32 (the-as dma-packet (+ (the-as uint sv-32) (* (+ sv-48 1) 16))))
sv-32
)
((= (-> sv-112 id) (dma-tag-id next))
(set! sv-16 (&-> (the-as (pointer uint64) sv-32) 2))
(set! sv-48 (the-as int (-> sv-112 qwc)))
(if s2-0
(disasm-vif-tag
(the-as (pointer vif-tag) (&-> (the-as (pointer uint64) sv-32) 1))
(the-as int (+ (* sv-48 4) 2))
gp-0
(= s2-0 'details)
)
)
(when (= sv-32 (-> sv-112 addr))
(format gp-0 "ERROR: next tag creates infinite loop.~%")
(set! s0-0 'error)
)
(set! sv-32 (the-as dma-packet (-> sv-112 addr)))
sv-32
)
((= (-> sv-112 id) (dma-tag-id call))
(set! sv-16 (&-> (the-as (pointer uint64) sv-32) 2))
(set! sv-48 (the-as int (-> sv-112 qwc)))
(if s2-0
(disasm-vif-tag
(the-as (pointer vif-tag) (&-> (the-as (pointer uint64) sv-32) 1))
(the-as int (+ (* sv-48 4) 2))
gp-0
(= s2-0 'details)
)
)
(set! sv-32 (the-as dma-packet (-> sv-112 addr)))
(set! sv-96 (+ sv-96 1))
(cond
((zero? sv-96)
(set! sv-64 (&+ (the pointer sv-16) sv-48))
(the-as (pointer uint64) sv-64)
)
(else
(set! sv-80 (&+ (the pointer sv-16) sv-48))
(the-as (pointer uint64) sv-80)
)
)
)
((= (-> sv-112 id) (dma-tag-id ret))
(set! sv-16 (&-> (the-as (pointer uint64) sv-32) 2))
(set! sv-48 (the-as int (-> sv-112 qwc)))
(if s2-0
(disasm-vif-tag
(the-as (pointer vif-tag) (&-> (the-as (pointer uint64) sv-32) 1))
(the-as int (+ (* sv-48 4) 2))
gp-0
(= s2-0 'details)
)
)
(let ((v1-123 sv-96))
(cond
((zero? v1-123)
(set! sv-32 (the-as dma-packet sv-64))
sv-32
)
((= v1-123 1)
(set! sv-32 (the-as dma-packet sv-80))
sv-32
)
(else
(set! s0-0 #t)
)
)
)
(set! sv-96 (+ sv-96 -1))
sv-96
)
((= (-> sv-112 id) (dma-tag-id end))
(set! sv-16 (&-> (the-as (pointer uint64) sv-32) 2))
(set! sv-48 (the-as int (-> sv-112 qwc)))
(set! s0-0 #t)
(if s2-0
(disasm-vif-tag
(the-as (pointer vif-tag) (&-> (the-as (pointer uint64) sv-32) 1))
(the-as int (+ (* sv-48 4) 2))
gp-0
(= s2-0 'details)
)
)
)
(else
(format gp-0 "ERROR: Unknown DMA TAG command.~%")
(set! s0-0 'error)
)
)
(+! s4-0 sv-48)
(+! s5-0 1)
(if (and (>= s1-0 0) (>= s5-0 s1-0))
(set! s0-0 #t)
)
)
(when (or s3-0 (= s0-0 'error))
(format gp-0 "NOTICE: Total tags: ~d~%" s5-0)
(format gp-0 "NOTICE: Total QWC: ~d~%" s4-0)
(format gp-0 "--------------------------------~%~%")
)
)
(!= s0-0 'error)
)
)
)
)
+264
View File
@@ -5,3 +5,267 @@
;; name in dgo: dma-h
;; dgos: ENGINE, GAME
(deftype dma-chcr (uint32)
((dir uint8 :offset 0 :size 1)
(mod uint8 :offset 2 :size 2)
(asp uint8 :offset 4 :size 2)
(tte uint8 :offset 6 :size 1)
(tie uint8 :offset 7 :size 1)
(str uint8 :offset 8 :size 1)
(tag uint16 :offset 16 :size 16)
)
:method-count-assert 9
:size-assert #x4
:flag-assert #x900000004
)
(deftype dma-bank (structure)
((chcr dma-chcr :offset 0)
(madr uint32 :offset 16)
(qwc uint32 :offset 32)
)
:method-count-assert 9
:size-assert #x24
:flag-assert #x900000024
)
(deftype dma-bank-source (dma-bank)
((tadr uint32 :offset 48)
)
:method-count-assert 9
:size-assert #x34
:flag-assert #x900000034
)
(deftype dma-bank-vif (dma-bank-source)
((as0 uint32 :offset 64)
(as1 uint32 :offset 80)
)
:method-count-assert 9
:size-assert #x54
:flag-assert #x900000054
)
(deftype dma-bank-spr (dma-bank-source)
((sadr uint32 :offset 128)
)
:method-count-assert 9
:size-assert #x84
:flag-assert #x900000084
)
(deftype dma-ctrl (uint32)
((dmae uint8 :offset 0 :size 1)
(rele uint8 :offset 1 :size 1)
(mfd uint8 :offset 2 :size 2)
(sts uint8 :offset 4 :size 2)
(std uint8 :offset 6 :size 2)
(rcyc uint8 :offset 8 :size 3)
)
:method-count-assert 9
:size-assert #x4
:flag-assert #x900000004
)
(deftype dma-enable (uint32)
((cpnd uint8 :offset 16 :size 1)
)
:method-count-assert 9
:size-assert #x4
:flag-assert #x900000004
)
(deftype dma-sqwc (uint32)
((sqwc uint8 :offset 0 :size 8)
(tqwc uint8 :offset 16 :size 8)
)
:method-count-assert 9
:size-assert #x4
:flag-assert #x900000004
)
(deftype dma-bank-control (structure)
((ctrl dma-ctrl :offset 0)
(stat uint32 :offset 16)
(pcr uint32 :offset 32)
(sqwc dma-sqwc :offset 48)
(rbsr uint32 :offset 64)
(rbor uint32 :offset 80)
(stadr uint32 :offset 96)
(enabler uint32 :offset 5408)
(enablew uint32 :offset 5520)
)
:method-count-assert 9
:size-assert #x1594
:flag-assert #x900001594
)
(deftype vu-code-block (basic)
((name basic :offset-assert 4)
(code uint32 :offset-assert 8)
(size int32 :offset-assert 12)
(dest-address uint32 :offset-assert 16)
)
:method-count-assert 9
:size-assert #x14
:flag-assert #x900000014
)
(deftype vu-stat (uint64)
()
:method-count-assert 9
:size-assert #x8
:flag-assert #x900000008
)
(defenum dma-tag-id
:bitfield #f
:type uint8
(refe 0) ;; addr=ADDR, ends after this transfer
(cnt 1) ;; addr=after tag, next-tag=after data
(next 2) ;; addr=after tag, next-tag=ADDR
(ref 3) ;; addr=ADDR, next-tag=after tag
(refs 4) ;; ref, but stall controled
(call 5) ;;
(ret 6) ;;
(end 7) ;; next, but ends.
)
(deftype dma-tag (uint64)
((qwc uint16 :offset 0 :size 16)
(pce uint8 :offset 26 :size 2)
(id dma-tag-id :offset 28 :size 3)
(irq uint8 :offset 31 :size 1)
(addr uint32 :offset 32 :size 31)
(spr uint8 :offset 63 :size 1)
)
:method-count-assert 9
:size-assert #x8
:flag-assert #x900000008
)
(deftype dma-bucket (structure)
((tag dma-tag :offset-assert 0)
(last (pointer dma-tag) :offset-assert 8)
(dummy uint32 :offset-assert 12)
(next uint32 :offset 4)
(clear uint64 :offset 8)
(vif0 uint32 :offset 8)
(vif1 uint32 :offset 12)
)
:method-count-assert 9
:size-assert #x10
:flag-assert #x900000010
)
(deftype vif-mask (uint32)
((m0 uint8 :offset 0 :size 2)
(m1 uint8 :offset 2 :size 2)
(m2 uint8 :offset 4 :size 2)
(m3 uint8 :offset 6 :size 2)
(m4 uint8 :offset 8 :size 2)
(m5 uint8 :offset 10 :size 2)
(m6 uint8 :offset 12 :size 2)
(m7 uint8 :offset 14 :size 2)
(m8 uint8 :offset 16 :size 2)
(m9 uint8 :offset 18 :size 2)
(m10 uint8 :offset 20 :size 2)
(m11 uint8 :offset 22 :size 2)
(m12 uint8 :offset 24 :size 2)
(m13 uint8 :offset 26 :size 2)
(m14 uint8 :offset 28 :size 2)
(m15 uint8 :offset 30 :size 2)
)
:method-count-assert 9
:size-assert #x4
:flag-assert #x900000004
)
(deftype vif-stcycl-imm (uint16)
((cl uint8 :offset 0 :size 8)
(wl uint8 :offset 8 :size 8)
)
:method-count-assert 9
:size-assert #x2
:flag-assert #x900000002
)
(deftype vif-unpack-imm (uint16)
((addr uint16 :offset 0 :size 10)
(usn uint8 :offset 14 :size 1)
(flg uint8 :offset 15 :size 1)
)
:method-count-assert 9
:size-assert #x2
:flag-assert #x900000002
)
;; all these have mask (only applies to unpacks) and interrupt not set.
(defenum vif-cmd
:bitfield #f
:type uint8
(nop 0) ;; no-op, can still have irq set.
(stcycl 1) ;; set write recycle register
(offset 2) ;; set offset register
(base 3) ;; set base register
(itop 4) ;; set data pointer register (itops)
(stmod 5) ;; set mode register
(mskpath3 6) ;; set path 3 mask
(mark 7) ;; set mark register
(pc-port 8) ;; special tag for PC Port data.
(flushe 16) ;; wait for end of microprogram
(flush 17) ;; wait for end of microprogram and transfer (path1/path2)
(flusha 19) ;; wait for end of microprogram and transfer (path1/path2/path3)
(mscal 20) ;; activate microprogram (call)
(mscalf 21) ;; flushe and activate (call)
(mscnt 23) ;; activate microprogram (continue)
(stmask 32) ;; set MASK register.
(strow 48) ;; set filling data
(stcol 49) ;; set filling data
(mpg 74) ;; transfer microprogram
(direct 80) ;; straight to GIF.
(directhl 81)
(unpack-s-32 96)
(unpack-s-16 97)
(unpack-s-8 98)
;; 99 is invllid
(unpack-v2-32 100)
(unpack-v2-16 101)
(unpack-v2-8 102)
;; 103 is invalid
(unpack-v3-32 104)
(unpack-v3-16 105)
(unpack-v3-8 106)
;; 107 is invalid
(unpack-v4-32 108)
(unpack-v4-16 109)
(unpack-v4-8 110)
(unpack-v4-5 111)
(cmd-mask 239) ;; not sure what this is.
)
;; this makes a copy of the above type, but uses a uint32.
(defenum vif-cmd-32
:bitfield #f
:type uint32
:copy-entries vif-cmd
)
(deftype vif-tag (uint32)
((imm uint16 :offset 0 :size 16)
(num uint8 :offset 16 :size 8)
(cmd vif-cmd :offset 24 :size 7)
(irq uint8 :offset 31 :size 1)
(msk uint8 :offset 28 :size 1)
)
:method-count-assert 9
:size-assert #x4
:flag-assert #x900000004
)
;; dma-sync-fast
;; dma-send-no-scratch
;; dma-sync-with-count
;; dma-count-until-done
+14
View File
@@ -5,3 +5,17 @@
;; name in dgo: dma
;; dgos: ENGINE, GAME
(defun ultimate-memcpy ((dst pointer) (src pointer) (size-bytes uint))
;; on PC Port, just call C mem-move, it's the fastest.
(__mem-move dst src size-bytes)
)
(defun dma-send ((arg0 dma-bank) (madr uint) (qwc uint))
(format 0 "dma-send~%")
(break!)
)
(defun dma-send-chain ((arg0 dma-bank-source) (tadr uint))
(format 0 "dma-send-chain~%")
(break!)
)
+191 -2
View File
@@ -1,7 +1,196 @@
;;-*-Lisp-*-
(in-package goal)
;; name: main-h.gc
;; name in dgo: main-h
;; dgos: ENGINE, GAME
(declare-type debug-menu-context basic)
(define *stats-poly* #f)
(define *stats-memory* #f)
(define *stats-memory-short* #f)
(define *stats-memory-level-index* 0)
(define *stats-collide* #f)
(define *stats-bsp* #f)
(define *stats-buffer* #f)
(define *stats-target* #f)
(define *stats-profile-bars* #f)
(define *stats-perf* #f)
(define *artist-all-visible* #f)
(define *artist-flip-visible* #f)
(define *artist-fix-visible* #f)
(define *artist-fix-frustum* #f)
(define *artist-error-spheres* #f)
(define *artist-use-menu-subdiv* #f)
(define *display-profile* #t)
(define *display-sidekick-stats* #f)
(define *display-quad-stats* #f)
(define *display-tri-stats* #f)
(define *display-ground-stats* #f)
(define *display-collision-marks* #f)
(define *display-collide-cache* #f)
(define *display-render-collision* #f)
(define *display-hipri-collision-marks* #f)
(define *display-edge-collision-marks* #f)
(define *display-geo-marks* #f)
(define *display-target-marks* #f)
(define *target-rc-board-controls* #f)
(define *display-collide-history* 0)
(define *display-xyz-axes* #f)
(define *display-cam-collide-history* #f)
(define *record-cam-collide-history* #f)
(define *display-cam-master-marks* #f)
(define *display-cam-other* #f)
(define *display-camera-marks* #f)
(define *camera-no-mip-correction* #f)
(define *display-cam-los-info* #f)
(define *display-cam-los-debug* #f)
(define *display-cam-los-marks* #f)
(define *display-cam-coll-marks* #f)
(define *display-camera-info* #f)
(define *display-camera-old-stats* #f)
(define *display-camera-last-attacker* #f)
(define *display-file-info* #f)
(define *display-actor-marks* #f)
(define *display-sprite-info* #f)
(define *display-sprite-marks* #f)
(define *display-sprite-spheres* #f)
(define *display-entity-errors* #t)
(define *display-instance-info* #f)
(define *display-deci-count* #f)
(define *sync-dma* #f)
(define *display-strip-lines* 0)
(define *display-battle-marks* #f)
(define *display-joint-axes* #f)
(define *display-nav-marks* #f)
(define *display-nav-network* #f)
(define *display-path-marks* #f)
(define *display-vol-marks* #f)
(define *display-water-marks* #f)
(define *display-nav-mesh* #f)
(define *display-actor-pointer* #f)
(define *display-actor-vis* #f)
(define *display-actor-graph* #f)
(define *display-traffic-height-map* #f)
(define *display-trail-graph* #f)
(define *display-color-bars* #f)
(define *display-bug-report* #f)
(define *display-level-border* #f)
(define *display-memcard-info* #f)
(define *display-split-boxes* #f)
(define *display-split-box-info* #f)
(define *display-texture-distances* #f)
(define *display-texture-download* #f)
(define *display-art-control* #f)
(define *display-gui-control* #f)
(define *display-level-spheres* #f)
(define *time-of-day-fast* #f)
(define *display-iop-info* #f)
(define *ambient-sound-class* #t)
(define *slow-frame-rate* #f)
(define *display-region-marks* #f)
(define *execute-regions* #t)
(define *debug-pause* #f)
(define *debug-view-anims* #f)
(define *debug-unkillable* #f)
(define *debug-actor* (the-as object #f))
(define *gun-marks* #f)
(define *bug-report-output-mode* (if *debug-segment*
'file-stream
'*stdcon*
)
)
(define *display-scene-control* 0)
(define *display-bot-marks* 0)
(define *display-race-marks* 0)
(define *race-record-path* #f)
(define *select-race* 0)
(define *select-race-path* 0)
(define *bot-record-path* -1)
(define *subdivide-draw-mode* 0)
(define *subdivide-scissor-draw-mode* 0)
(define *subdivide-foreground-draw-mode* 0)
(define *subdivide-ocean-draw-mode* 0)
(define *ocean-height-hack* 0)
(define-perm *dproc* process #f)
(define *run* #f)
(define *teleport* #f)
(define *teleport-count* 0)
(define *draw-hook* (the-as (function none) nothing))
(define *debug-hook* '())
(define *menu-hook* (the-as (function debug-menu-context) nothing))
(define *progress-hook* nothing)
(define *dma-timeout-hook* nothing)
(deftype frame-stats (structure)
((field-time time-frame 2 :offset-assert 0)
(field int32 :offset-assert 16)
)
:method-count-assert 9
:size-assert #x14
:flag-assert #x900000014
)
(define *frame-stats* (new 'static 'frame-stats))
(deftype screen-filter (basic)
((draw? basic :offset-assert 4)
(bucket int32 :offset-assert 8)
(color vector :inline :offset-assert 16)
(color-src vector :inline :offset-assert 32)
(color-dest vector :inline :offset-assert 48)
(extra vector :inline :offset-assert 64)
(speed float :offset 64)
(current-interp float :offset 68)
)
:method-count-assert 12
:size-assert #x50
:flag-assert #xc00000050
(:methods
(dummy-9 () none 9)
(dummy-10 () none 10)
(dummy-11 () none 11)
)
)
(deftype col-rend (basic)
((draw? symbol :offset-assert 4)
(outline? symbol :offset-assert 8)
(show-back-faces? symbol :offset-assert 12)
(show-normals? symbol :offset-assert 16)
(ghost-hidden? symbol :offset-assert 20)
(show-only uint32 :offset-assert 24)
(cspec uint32 :offset-assert 28)
(track uint8 :offset-assert 32)
(bbox-radius float :offset-assert 36)
(bbox-center vector :inline :offset-assert 48)
(camera-to-bbox-dist float :offset-assert 64)
)
:method-count-assert 10
:size-assert #x44
:flag-assert #xa00000044
(:methods
(dummy-9 () none 9)
)
)
(define *col-rend* (new 'static 'col-rend
:draw? #f
:outline? #t
:show-back-faces? #t
:show-normals? #f
:ghost-hidden? #t
:cspec #x38
:track #x1
:bbox-radius 24576.0
:camera-to-bbox-dist 65536.0
)
)
(defun-debug debug-actor? ((arg0 object))
(= arg0 *debug-actor*)
)
0
@@ -32,3 +32,5 @@
(point-past-plane? (_type_ vector) symbol 10)
)
)
(define-extern quaternion-from-two-vectors-max-angle! (function quaternion vector vector float quaternion))
File diff suppressed because it is too large Load Diff
+102
View File
@@ -5,3 +5,105 @@
;; name in dgo: display-h
;; dgos: ENGINE, GAME
(declare-type display basic)
(define-extern set-display (function display int int int int int display))
(deftype display-frame (basic)
((buffer dma-buffer 11 :offset-assert 4)
(calc-buf dma-buffer :offset 8)
(vu1-buf dma-buffer :offset 8)
(debug-buf dma-buffer :offset 36)
(global-buf dma-buffer :offset 40)
(bucket-group dma-bucket :offset 44)
(profile-array profile-array :inline :offset-assert 48)
(start-time uint64 :offset-assert 56)
(run-time uint64 :offset-assert 64)
)
(:methods
(new (symbol type) _type_ 0)
)
:method-count-assert 9
:size-assert #x48
:flag-assert #x900000048
)
(defmethod new display-frame ((allocation symbol) (type-to-make type))
(let ((gp-0 (object-new allocation type-to-make (the-as int (-> type-to-make size)))))
(set! (-> gp-0 calc-buf) (the-as dma-buffer 0))
(set! (-> gp-0 global-buf) (the-as dma-buffer 0))
(set! (-> gp-0 debug-buf) (the-as dma-buffer 0))
(when *debug-segment*
(set! (-> gp-0 profile-array data 0) (new 'debug 'profile-segment-array))
(set! (-> gp-0 profile-array data 1) (new 'debug 'profile-segment-array))
)
gp-0
)
)
(deftype display (basic)
((on-screen int32 :offset-assert 4)
(last-screen int32 :offset-assert 8)
(frames display-frame 2 :offset-assert 12)
(bgcolor uint64 :offset-assert 24)
(pmode gs-pmode :offset-assert 32)
(clock clock 13 :offset-assert 40)
(session-clock clock :offset 40)
(game-clock clock :offset 44)
(base-clock clock :offset 48)
(real-clock clock :offset 52)
(frame-clock clock :offset 56)
(real-frame-clock clock :offset 60)
(target-clock clock :offset 64)
(entity-clock clock :offset 68)
(part-clock clock :offset 72)
(bg-clock clock :offset 76)
(camera-clock clock :offset 80)
(user0-clock clock :offset 84)
(total-game-clock clock :offset 88)
(time-factor float :offset-assert 92)
(dog-ratio float :offset-assert 96)
(vblank-start-time uint64 2 :offset-assert 104)
(total-run-time uint64 :offset-assert 120)
(run-half-speed basic :offset-assert 128)
(dog-count float :offset-assert 132)
(vu1-enable-user vu1-renderer-mask :offset-assert 136)
(vu1-enable-user-menu vu1-renderer-mask :offset-assert 144)
(force-sync uint32 :offset-assert 152)
)
:method-count-assert 10
:size-assert #x9c
:flag-assert #xa0000009c
(:methods
(new (symbol type int int int int int) _type_ 0)
(dummy-9 () none 9)
)
)
(defmethod new display ((allocation symbol) (type-to-make type) (arg0 int) (arg1 int) (arg2 int) (arg3 int) (arg4 int))
(let ((gp-0 (object-new allocation type-to-make (the-as int (-> type-to-make size)))))
(set-display gp-0 arg0 arg1 arg2 arg3 arg4)
(set! (-> gp-0 frames 0) (new 'global 'display-frame))
(set! (-> gp-0 frames 1) (new 'global 'display-frame))
(set! (-> gp-0 pmode) (new 'static 'gs-pmode :en1 #x1 :crtmd #x1 :mmod #x1 :slbg #x1))
(set! (-> gp-0 run-half-speed) #f)
(set! (-> gp-0 vu1-enable-user-menu)
(vu1-renderer-mask rn3 rn4 rn5 rn6 rn7 rn8 rn9 rn10 rn11 rn12 rn13 rn14 rn15
rn16 rn17 rn18 rn19 rn20 rn21 rn22 rn23 rn24 rn25 rn26 rn27 rn28
rn29 rn30 rn31 rn32 rn34
)
)
(set! (-> gp-0 vu1-enable-user)
(vu1-renderer-mask rn3 rn4 rn5 rn6 rn7 rn8 rn9 rn10 rn11 rn12 rn13 rn14 rn15
rn16 rn17 rn18 rn19 rn20 rn21 rn22 rn23 rn24 rn25 rn26 rn27 rn28
rn29 rn30 rn31 rn32 rn34
)
)
gp-0
)
)
(define *pre-draw-hook* (the-as (function object none) nothing))
(define *post-draw-hook* (the-as (function dma-buffer none) nothing))
(define-extern *display* display)
+972
View File
@@ -5,3 +5,975 @@
;; name in dgo: gs
;; dgos: ENGINE, GAME
(defenum gs-psm
:bitfield #f
:type uint8
(ct32 0)
(ct24 1)
(ct16 2)
(ct16s 10)
(mt8 19)
(mt4 20)
(mt8h 27)
(mt4hl 36)
(mt4hh 44)
(mz32 48)
(mz24 49)
(mz16 50)
(mz16s 58)
)
(defenum gs-reg
:type uint8
(prim 0)
(rgbaq 1)
(st 2)
(uv 3)
(xyzf2 4)
(xyz2 5)
(tex0-1 6)
(tex0-2 7)
(clamp-1 8)
(clamp-2 9)
(fog 10)
(xyzf3 12)
(xyz3 13)
(tex1-1 20)
(tex1-2 21)
(tex2-1 22)
(tex2-2 23)
(xyoffset-1 24)
(xyoffset-2 25)
(prmodecont 26)
(prmode 27)
(texclut 28)
(scanmsk 34)
(miptbp1-1 52)
(miptbp1-2 53)
(miptbp2-1 54)
(miptbp2-2 55)
(texa 59)
(fogcol 61)
(texflush 63)
(scissor-1 64)
(scissor-2 65)
(alpha-1 66)
(alpha-2 67)
(dimx 68)
(dthe 69)
(colclamp 70)
(test-1 71)
(test-2 72)
(pabe 73)
(fba-1 74)
(fba-2 75)
(frame-1 76)
(frame-2 77)
(zbuf-1 78)
(zbuf-2 79)
(bitbltbuf 80)
(trxpos 81)
(trxreg 82)
(trxdir 83)
(hwreg 84)
(signal 96)
(finish 97)
(label 98)
)
(defenum gs-atest
:type uint8
(never 0)
(always 1)
(less 2)
(less-equal 3)
(equal 4)
(greater-equal 5)
(greater 6)
(not-equal 7)
)
(defenum gs-ztest
:type uint8
(never 0)
(always 1)
(greater-equal 2)
(greater 3)
)
(defenum gs-reg64
:type uint64
:copy-entries gs-reg
)
(defenum gs-prim-type
:type uint8
(point 0)
(line 1)
(line-strip 2)
(tri 3)
(tri-strip 4)
(tri-fan 5)
(sprite 6)
)
(defenum gs-tex-wrap-mode
:type uint8
(repeat 0)
(clamp 1)
(region-clamp 2)
(region-repeat 3)
)
(defenum gif-flag
:type uint8
(packed 0)
(reg-list 1)
(image 2)
(disable 3)
)
(defenum gif-reg-id
:type uint8
(prim 0)
(rgbaq 1)
(st 2)
(uv 3)
(xyzf2 4)
(xyz2 5)
(tex0-1 6)
(tex0-2 7)
(clamp-1 8)
(clamp-2 9)
(fog 10)
(xyzf3 12)
(xyz3 13)
(a+d 14)
(nop 15)
)
(deftype gs-pmode (uint64)
((en1 uint8 :offset 0 :size 1)
(en2 uint8 :offset 1 :size 1)
(crtmd uint8 :offset 2 :size 3)
(mmod uint8 :offset 5 :size 1)
(amod uint8 :offset 6 :size 1)
(slbg uint8 :offset 7 :size 1)
(alp uint8 :offset 8 :size 8)
)
:method-count-assert 9
:size-assert #x8
:flag-assert #x900000008
)
(deftype gs-smode2 (uint64)
((int uint8 :offset 0 :size 1)
(ffmd uint8 :offset 1 :size 1)
(dpms uint8 :offset 2 :size 2)
)
:method-count-assert 9
:size-assert #x8
:flag-assert #x900000008
)
(defun psm-size ((arg0 gs-psm))
(cond
((= arg0 (gs-psm mt8))
64
)
((= arg0 (gs-psm mt4))
32
)
((or (= arg0 (gs-psm ct16)) (= arg0 (gs-psm ct16s)) (= arg0 (gs-psm mz16)) (= arg0 (gs-psm mz16s)))
128
)
(else
256
)
)
)
(defun psm-page-height ((arg0 gs-psm))
(cond
((= arg0 (gs-psm mt8))
64
)
((= arg0 (gs-psm mt4))
128
)
((or (= arg0 (gs-psm ct16)) (= arg0 (gs-psm ct16s)) (= arg0 (gs-psm mz16)) (= arg0 (gs-psm mz16s)))
64
)
(else
32
)
)
)
(defun psm->string ((arg0 gs-psm))
(case arg0
(((gs-psm ct24))
"ct24"
)
(((gs-psm mt4))
"mt4"
)
(((gs-psm ct32))
"ct32"
)
(((gs-psm mz16s))
"mz16s"
)
(((gs-psm ct16s))
"ct16s"
)
(((gs-psm mt8))
"mt8"
)
(((gs-psm mt8h))
"mt8h"
)
(((gs-psm mz16))
"mz16"
)
(((gs-psm mz24))
"mz24"
)
(((gs-psm mt4hh))
"mt4hh"
)
(((gs-psm ct16))
"ct16"
)
(((gs-psm mt4hl))
"mt4hl"
)
(((gs-psm mz32))
"mz32"
)
(else
"*unknown*"
)
)
)
(deftype gs-display-fb (uint64)
((fbp uint16 :offset 0 :size 9)
(fbw uint8 :offset 9 :size 6)
(psm gs-psm :offset 15 :size 5)
(dbx uint16 :offset 32 :size 11)
(dby uint16 :offset 43 :size 11)
)
:method-count-assert 9
:size-assert #x8
:flag-assert #x900000008
)
(deftype gs-display (uint64)
((dx uint16 :offset 0 :size 12)
(dy uint16 :offset 12 :size 11)
(magh uint8 :offset 23 :size 4)
(magv uint8 :offset 27 :size 2)
(dw uint16 :offset 32 :size 12)
(dh uint16 :offset 44 :size 11)
)
:method-count-assert 9
:size-assert #x8
:flag-assert #x900000008
)
(deftype gs-bgcolor (uint64)
((r uint8 :offset 0 :size 8)
(g uint8 :offset 8 :size 8)
(b uint8 :offset 16 :size 8)
)
:method-count-assert 9
:size-assert #x8
:flag-assert #x900000008
)
(deftype gs-csr (uint64)
((signal uint8 :offset 0 :size 1)
(finish uint8 :offset 1 :size 1)
(hsint uint8 :offset 2 :size 1)
(vsint uint8 :offset 3 :size 1)
(edwint uint8 :offset 4 :size 1)
(flush uint8 :offset 8 :size 1)
(reset uint8 :offset 9 :size 1)
(nfield uint8 :offset 12 :size 1)
(field uint8 :offset 13 :size 1)
(fifo uint8 :offset 14 :size 2)
(rev uint8 :offset 16 :size 8)
(id uint8 :offset 24 :size 8)
)
:method-count-assert 9
:size-assert #x8
:flag-assert #x900000008
)
(deftype gs-bank (structure)
((pmode gs-pmode :offset-assert 0)
(smode2 gs-smode2 :offset 32)
(dspfb1 gs-display-fb :offset 112)
(display1 gs-display :offset 128)
(dspfb2 gs-display-fb :offset 144)
(display2 gs-display :offset 160)
(extbuf uint64 :offset 176)
(extdata uint64 :offset 192)
(extwrite uint64 :offset 208)
(bgcolor gs-bgcolor :offset 224)
(csr gs-csr :offset 4096)
(imr uint64 :offset 4112)
(busdir uint64 :offset 4160)
)
:method-count-assert 9
:size-assert #x1048
:flag-assert #x900001048
)
(deftype gs-frame (uint64)
((fbp uint16 :offset 0 :size 9)
(fbw uint8 :offset 16 :size 6)
(psm gs-psm :offset 24 :size 6)
(fbmsk uint32 :offset 32 :size 32)
)
:method-count-assert 9
:size-assert #x8
:flag-assert #x900000008
)
(deftype gs-zbuf (uint64)
((zbp uint16 :offset 0 :size 9)
(psm gs-psm :offset 24 :size 4)
(zmsk uint8 :offset 32 :size 1)
)
:method-count-assert 9
:size-assert #x8
:flag-assert #x900000008
)
(deftype gs-xy-offset (uint64)
((ofx uint16 :offset 0 :size 16)
(ofy uint16 :offset 32 :size 16)
)
:method-count-assert 9
:size-assert #x8
:flag-assert #x900000008
)
(deftype gs-scissor (uint64)
((scax0 uint16 :offset 0 :size 11)
(scax1 uint16 :offset 16 :size 11)
(scay0 uint16 :offset 32 :size 11)
(scay1 uint16 :offset 48 :size 11)
)
:method-count-assert 9
:size-assert #x8
:flag-assert #x900000008
)
(deftype gs-prmode-cont (uint64)
((ac uint8 :offset 0 :size 1)
)
:method-count-assert 9
:size-assert #x8
:flag-assert #x900000008
)
(deftype gs-color-clamp (uint64)
((clamp uint8 :offset 0 :size 1)
)
:method-count-assert 9
:size-assert #x8
:flag-assert #x900000008
)
(deftype gs-dthe (uint64)
((dthe uint8 :offset 0 :size 1)
)
:method-count-assert 9
:size-assert #x8
:flag-assert #x900000008
)
(deftype gs-test (uint64)
((ate uint8 :offset 0 :size 1)
(atst gs-atest :offset 1 :size 3)
(aref uint8 :offset 4 :size 8)
(afail uint8 :offset 12 :size 2)
(date uint8 :offset 14 :size 1)
(datm uint8 :offset 15 :size 1)
(zte uint8 :offset 16 :size 1)
(ztst gs-ztest :offset 17 :size 2)
)
:method-count-assert 9
:size-assert #x8
:flag-assert #x900000008
)
(deftype gs-prim (uint64)
((prim gs-prim-type :offset 0 :size 3)
(iip uint8 :offset 3 :size 1)
(tme uint8 :offset 4 :size 1)
(fge uint8 :offset 5 :size 1)
(abe uint8 :offset 6 :size 1)
(aa1 uint8 :offset 7 :size 1)
(fst uint8 :offset 8 :size 1)
(ctxt uint8 :offset 9 :size 1)
(fix uint8 :offset 10 :size 1)
)
:method-count-assert 9
:size-assert #x8
:flag-assert #x900000008
)
(deftype gs-rgbaq (uint64)
((r uint8 :offset 0 :size 8)
(g uint8 :offset 8 :size 8)
(b uint8 :offset 16 :size 8)
(a uint8 :offset 24 :size 8)
(q float :offset 32 :size 32)
)
:method-count-assert 9
:size-assert #x8
:flag-assert #x900000008
)
(deftype gs-xyz (uint64)
((x uint16 :offset 0 :size 16)
(y uint16 :offset 16 :size 16)
(z uint32 :offset 32 :size 32)
)
:method-count-assert 9
:size-assert #x8
:flag-assert #x900000008
)
(deftype gs-uv (uint64)
((u uint16 :offset 0 :size 14)
(v uint16 :offset 16 :size 14)
)
:method-count-assert 9
:size-assert #x8
:flag-assert #x900000008
)
(deftype gs-st (uint64)
((s float :offset 0 :size 32)
(t float :offset 32 :size 32)
)
:method-count-assert 9
:size-assert #x8
:flag-assert #x900000008
)
(deftype gs-xyzf (uint64)
((x uint16 :offset 0 :size 16)
(y uint16 :offset 16 :size 16)
(z uint32 :offset 32 :size 24)
(f uint8 :offset 56 :size 8)
)
:method-count-assert 9
:size-assert #x8
:flag-assert #x900000008
)
(deftype gs-adcmd (structure)
((word uint32 4 :offset-assert 0)
(quad uint128 :offset 0)
(data uint64 :offset 0)
(cmds uint64 :offset 8)
(cmd uint8 :offset 8)
(x uint32 :offset 0)
(y uint32 :offset 4)
(z uint32 :offset 8)
(w uint32 :offset 12)
)
:method-count-assert 9
:size-assert #x10
:flag-assert #x900000010
)
(deftype gs-trxpos (uint64)
((ssax uint16 :offset 0 :size 11)
(ssay uint16 :offset 16 :size 11)
(dsax uint16 :offset 32 :size 11)
(dsay uint16 :offset 48 :size 11)
(dir uint8 :offset 59 :size 2)
)
:method-count-assert 9
:size-assert #x8
:flag-assert #x900000008
)
(deftype gs-trxreg (uint64)
((rrw uint16 :offset 0 :size 12)
(rrh uint16 :offset 32 :size 12)
)
:method-count-assert 9
:size-assert #x8
:flag-assert #x900000008
)
(deftype gs-trxdir (uint64)
((xdir uint8 :offset 0 :size 2)
)
:method-count-assert 9
:size-assert #x8
:flag-assert #x900000008
)
(deftype gs-bitbltbuf (uint64)
((sbp uint16 :offset 0 :size 14)
(sbw uint8 :offset 16 :size 6)
(spsm uint8 :offset 24 :size 6)
(dbp uint16 :offset 32 :size 14)
(dbw uint8 :offset 48 :size 6)
(dpsm uint8 :offset 56 :size 6)
)
:method-count-assert 9
:size-assert #x8
:flag-assert #x900000008
)
(deftype gs-tex0 (uint64)
((tbp0 uint16 :offset 0 :size 14)
(tbw uint8 :offset 14 :size 6)
(psm uint8 :offset 20 :size 6)
(tw uint8 :offset 26 :size 4)
(th uint8 :offset 30 :size 4)
(tcc uint8 :offset 34 :size 1)
(tfx uint8 :offset 35 :size 2)
(cbp uint16 :offset 37 :size 14)
(cpsm uint8 :offset 51 :size 4)
(csm uint8 :offset 55 :size 1)
(csa uint8 :offset 56 :size 5)
(cld uint8 :offset 61 :size 3)
)
:method-count-assert 9
:size-assert #x8
:flag-assert #x900000008
)
(deftype gs-tex1 (uint64)
((lcm uint8 :offset 0 :size 1)
(mxl uint8 :offset 2 :size 3)
(mmag uint8 :offset 5 :size 1)
(mmin uint8 :offset 6 :size 3)
(mtba uint8 :offset 9 :size 1)
(l uint8 :offset 19 :size 2)
(k int16 :offset 32 :size 12)
)
:method-count-assert 9
:size-assert #x8
:flag-assert #x900000008
)
(deftype gs-texa (uint64)
((ta0 uint8 :offset 0 :size 8)
(aem uint8 :offset 15 :size 1)
(ta1 uint8 :offset 32 :size 8)
)
:method-count-assert 9
:size-assert #x8
:flag-assert #x900000008
)
(deftype gs-texclut (uint64)
((cbw uint8 :offset 0 :size 6)
(cou uint8 :offset 6 :size 6)
(cov uint16 :offset 12 :size 10)
)
:method-count-assert 9
:size-assert #x8
:flag-assert #x900000008
)
(deftype gs-miptbp (uint64)
((tbp1 uint16 :offset 0 :size 14)
(tbw1 uint8 :offset 14 :size 6)
(tbp2 uint16 :offset 20 :size 14)
(tbw2 uint8 :offset 34 :size 6)
(tbp3 uint16 :offset 40 :size 14)
(tbw3 uint8 :offset 54 :size 6)
)
:method-count-assert 9
:size-assert #x8
:flag-assert #x900000008
)
(deftype gs-alpha (uint64)
((a uint8 :offset 0 :size 2)
(b uint8 :offset 2 :size 2)
(c uint8 :offset 4 :size 2)
(d uint8 :offset 6 :size 2)
(fix uint8 :offset 32 :size 8)
)
:method-count-assert 9
:size-assert #x8
:flag-assert #x900000008
)
(deftype gs-clamp (uint64)
((wms gs-tex-wrap-mode :offset 0 :size 2)
(wmt gs-tex-wrap-mode :offset 2 :size 2)
(minu uint16 :offset 4 :size 10)
(maxu uint16 :offset 14 :size 10)
(minv uint16 :offset 24 :size 10)
(maxv uint16 :offset 34 :size 10)
)
:method-count-assert 9
:size-assert #x8
:flag-assert #x900000008
)
(deftype gs-fog (uint64)
((f uint8 :offset 56 :size 8)
)
:method-count-assert 9
:size-assert #x8
:flag-assert #x900000008
)
(deftype gs-fogcol (uint64)
((fcr uint8 :offset 0 :size 8)
(fcg uint8 :offset 8 :size 8)
(fcb uint8 :offset 16 :size 8)
)
:method-count-assert 9
:size-assert #x8
:flag-assert #x900000008
)
(deftype gif-ctrl (uint32)
((rst uint8 :offset 0 :size 1)
(pse uint8 :offset 3 :size 1)
)
:method-count-assert 9
:size-assert #x4
:flag-assert #x900000004
)
(deftype gif-mode (uint32)
((m3r uint8 :offset 0 :size 1)
(imt uint8 :offset 2 :size 1)
)
:method-count-assert 9
:size-assert #x4
:flag-assert #x900000004
)
(deftype gif-stat (uint32)
((m3r uint8 :offset 0 :size 1)
(m3p uint8 :offset 1 :size 1)
(imt uint8 :offset 2 :size 1)
(pse uint8 :offset 3 :size 1)
(ip3 uint8 :offset 5 :size 1)
(p3q uint8 :offset 6 :size 1)
(p2q uint8 :offset 7 :size 1)
(p1q uint8 :offset 8 :size 1)
(oph uint8 :offset 9 :size 1)
(apath uint8 :offset 10 :size 2)
(dir uint8 :offset 12 :size 1)
(fqc uint8 :offset 24 :size 5)
)
:method-count-assert 9
:size-assert #x4
:flag-assert #x900000004
)
(deftype gif-cnt (uint32)
((loopcnt uint16 :offset 0 :size 15)
(regcnt uint8 :offset 16 :size 4)
(vuaddr uint16 :offset 20 :size 10)
)
:method-count-assert 9
:size-assert #x4
:flag-assert #x900000004
)
(deftype gif-p3cnt (uint32)
((p3cnt uint16 :offset 0 :size 15)
)
:method-count-assert 9
:size-assert #x4
:flag-assert #x900000004
)
(deftype gif-p3tag (uint32)
((loopcnt uint16 :offset 0 :size 15)
(eop uint8 :offset 15 :size 1)
)
:method-count-assert 9
:size-assert #x4
:flag-assert #x900000004
)
(deftype gif-bank (structure)
((ctrl gif-ctrl :offset 0)
(mode gif-mode :offset 16)
(stat gif-stat :offset 32)
(tag0 uint32 :offset 64)
(tag1 uint32 :offset 80)
(tag2 uint32 :offset 96)
(tag3 uint32 :offset 112)
(cnt gif-cnt :offset 128)
(p3cnt gif-p3cnt :offset 144)
(p3tag gif-p3tag :offset 160)
)
:method-count-assert 9
:size-assert #xa4
:flag-assert #x9000000a4
)
(deftype gif-tag-prim (uint32)
()
:method-count-assert 9
:size-assert #x4
:flag-assert #x900000004
)
(deftype gif-tag-count (uint32)
()
:method-count-assert 9
:size-assert #x4
:flag-assert #x900000004
)
(deftype gif-tag64 (uint64)
((nloop uint16 :offset 0 :size 15)
(eop uint8 :offset 15 :size 1)
(id uint16 :offset 32 :size 14)
(pre uint8 :offset 46 :size 1)
(prim gs-prim :offset 47 :size 11)
(flg gif-flag :offset 58 :size 2)
(nreg uint8 :offset 60 :size 4)
)
:method-count-assert 9
:size-assert #x8
:flag-assert #x900000008
)
(deftype gif-tag (uint128)
((nloop uint16 :offset 0 :size 15)
(eop uint8 :offset 15 :size 1)
(id uint16 :offset 32 :size 14)
(pre uint8 :offset 46 :size 1)
(prim uint16 :offset 47 :size 11)
(flg gif-flag :offset 58 :size 2)
(nreg uint8 :offset 60 :size 4)
(regs0 gif-reg-id :offset 64 :size 4)
(regs1 gif-reg-id :offset 68 :size 4)
(regs2 gif-reg-id :offset 72 :size 4)
(regs3 gif-reg-id :offset 76 :size 4)
(regs4 gif-reg-id :offset 80 :size 4)
(regs5 gif-reg-id :offset 84 :size 4)
(regs6 gif-reg-id :offset 88 :size 4)
(regs7 gif-reg-id :offset 92 :size 4)
(regs8 gif-reg-id :offset 96 :size 4)
(regs9 gif-reg-id :offset 100 :size 4)
(regs10 gif-reg-id :offset 104 :size 4)
(regs11 gif-reg-id :offset 108 :size 4)
(regs12 gif-reg-id :offset 112 :size 4)
(regs13 gif-reg-id :offset 116 :size 4)
(regs14 gif-reg-id :offset 120 :size 4)
(regs15 gif-reg-id :offset 124 :size 4)
)
:method-count-assert 9
:size-assert #x10
:flag-assert #x900000010
)
(deftype gif-tag-regs (uint64)
((regs0 gif-reg-id :offset 0 :size 4)
(regs1 gif-reg-id :offset 4 :size 4)
(regs2 gif-reg-id :offset 8 :size 4)
(regs3 gif-reg-id :offset 12 :size 4)
(regs4 gif-reg-id :offset 16 :size 4)
(regs5 gif-reg-id :offset 20 :size 4)
(regs6 gif-reg-id :offset 24 :size 4)
(regs7 gif-reg-id :offset 28 :size 4)
(regs8 gif-reg-id :offset 32 :size 4)
(regs9 gif-reg-id :offset 36 :size 4)
(regs10 gif-reg-id :offset 40 :size 4)
(regs11 gif-reg-id :offset 44 :size 4)
(regs12 gif-reg-id :offset 48 :size 4)
(regs13 gif-reg-id :offset 52 :size 4)
(regs14 gif-reg-id :offset 56 :size 4)
(regs15 gif-reg-id :offset 60 :size 4)
)
)
(deftype gs-gif-tag (structure)
((qword uint128 :offset-assert 0)
(tag gif-tag64 :offset 0)
(regs gif-tag-regs :offset 8)
(dword uint64 2 :offset 0)
(word uint32 4 :offset 0)
)
:method-count-assert 9
:size-assert #x10
:flag-assert #x900000010
)
(defmethod inspect gif-tag ((obj gif-tag))
(format #t "[~8x] gif-tag~%" obj)
(format #t "~Tnloop: ~4d~%" (-> obj nloop))
(format #t "~Teop : ~4d~%" (-> obj eop))
(format #t "~Tid : ~4d~%" (-> obj id))
(format #t "~Tpre : ~4d~%" (-> obj pre))
(format #t "~Tprim : ~4d~%" (-> obj prim))
(format #t "~Tflg : ~4d~%" (-> obj flg))
(format #t "~Tnreg : ~4d~%" (-> obj nreg))
(format #t "~Tregs0 : ~4d~%" (-> obj regs0))
(format #t "~Tregs1 : ~4d~%" (-> obj regs1))
(format #t "~Tregs2 : ~4d~%" (-> obj regs2))
(format #t "~Tregs3 : ~4d~%" (-> obj regs3))
(format #t "~Tregs4 : ~4d~%" (-> obj regs4))
(format #t "~Tregs5 : ~4d~%" (-> obj regs5))
(format #t "~Tregs6 : ~4d~%" (-> obj regs6))
(format #t "~Tregs7 : ~4d~%" (-> obj regs7))
(format #t "~Tregs8 : ~4d~%" (-> obj regs8))
(format #t "~Tregs9 : ~4d~%" (-> obj regs9))
(format #t "~Tregs10: ~4d~%" (-> obj regs10))
(format #t "~Tregs11: ~4d~%" (-> obj regs11))
(format #t "~Tregs12: ~4d~%" (-> obj regs12))
(format #t "~Tregs13: ~4d~%" (-> obj regs13))
(format #t "~Tregs14: ~4d~%" (-> obj regs14))
(the-as gif-tag (format #t "~Tregs15: ~4d~%" (-> obj regs15)))
)
(define *fog-color* (new 'static 'rgba :r #x80))
(deftype gif-packet (basic)
((reg-count int32 :offset-assert 4)
(gif-tag gs-gif-tag :inline :offset-assert 16)
(gif-tag0 uint128 :offset 16)
(args uint64 1 :offset-assert 32)
)
:method-count-assert 9
:size-assert #x28
:flag-assert #x900000028
(:methods
(new (symbol type int) _type_ 0)
)
)
(defmethod new gif-packet ((allocation symbol) (type-to-make type) (arg0 int))
(object-new allocation type-to-make (the-as int (+ (-> type-to-make size) (* (+ arg0 -1) 8))))
)
(defun open-gif-packet ((arg0 gif-packet))
(set! (-> arg0 reg-count) 0)
(set! (-> arg0 gif-tag regs) (new 'static 'gif-tag-regs))
arg0
)
(defun add-reg-gif-packet ((arg0 gif-packet) (arg1 int) (arg2 int))
(let ((v1-0 (-> arg0 gif-tag)))
(logior! (-> v1-0 regs) (ash arg1 (* (-> arg0 reg-count) 4)))
)
(set! (-> (&-> arg0 args (-> arg0 reg-count)) 0) (the-as uint arg2))
(+! (-> arg0 reg-count) 1)
(none)
)
(defun close-gif-packet ((arg0 gif-packet) (arg1 int))
(set! (-> arg0 gif-tag tag)
(new 'static 'gif-tag64 :nloop #x1 :flg (gif-flag reg-list) :eop arg1 :nreg (-> arg0 reg-count))
)
arg0
)
;; definition of type draw-context
(deftype draw-context (basic)
((orgx int32 :offset-assert 4)
(orgy int32 :offset-assert 8)
(orgz int32 :offset-assert 12)
(width int32 :offset-assert 16)
(height int32 :offset-assert 20)
(color rgba 4 :offset-assert 24) ;; weird.. only first is used?
)
:method-count-assert 9
:size-assert #x28
:flag-assert #x900000028
(:methods
(new (symbol type int int int int rgba) _type_ 0)
)
)
(defmethod new draw-context ((allocation symbol) (type-to-make type) (arg0 int) (arg1 int) (arg2 int) (arg3 int) (arg4 rgba))
(let ((v0-0 (object-new allocation type-to-make (the-as int (-> type-to-make size)))))
(set! (-> v0-0 orgx) arg0)
(set! (-> v0-0 orgy) arg1)
(set! (-> v0-0 orgz) #xffffff)
(set! (-> v0-0 width) arg2)
(set! (-> v0-0 height) arg3)
(set! (-> v0-0 color 0) arg4)
v0-0
)
)
(defun draw-context-set-xy ((arg0 draw-context) (arg1 int) (arg2 int))
(set! (-> arg0 orgx) arg1)
(set! (-> arg0 orgy) arg2)
(none)
)
(deftype gs-packed-rgba (vector4w)
((r int32 :offset 0)
(g int32 :offset 4)
(b int32 :offset 8)
(a int32 :offset 12)
)
:method-count-assert 9
:size-assert #x10
:flag-assert #x900000010
)
(deftype gs-packed-xyzw (vector)
((ix int32 :offset 0)
(iy int32 :offset 4)
(iz int32 :offset 8)
(iw int32 :offset 12)
)
:method-count-assert 9
:size-assert #x10
:flag-assert #x900000010
)
(deftype gs-packed-stq (vector)
((tex-s float :offset 0)
(tex-t float :offset 4)
(tex-q float :offset 8)
)
:method-count-assert 9
:size-assert #x10
:flag-assert #x900000010
)
(deftype gs-packed-uv (vector)
((u int16 :offset 0)
(v int16 :offset 4)
)
:method-count-assert 9
:size-assert #x10
:flag-assert #x900000010
)
(deftype gs-packed-gt (structure)
((stq gs-packed-stq :inline :offset 0)
(rgba gs-packed-rgba :inline :offset 16)
(xyzw gs-packed-xyzw :inline :offset 32)
)
:method-count-assert 9
:size-assert #x30
:flag-assert #x900000030
)
(deftype gs-packed-gt4 (structure)
((data gs-packed-gt 4 :inline :offset-assert 0)
)
:method-count-assert 9
:size-assert #xc0
:flag-assert #x9000000c0
)
+29
View File
@@ -5,3 +5,32 @@
;; name in dgo: video-h
;; dgos: ENGINE, GAME
(deftype video-params (structure)
((set-video-mode basic :offset-assert 0)
(reset-video-mode basic :offset-assert 4)
(display-fbp int32 :offset-assert 8)
(relative-x-scale float :offset 16)
(display-dx int32 :offset-assert 20)
(display-dy int32 :offset-assert 24)
(display-sy int32 :offset-assert 28)
(relative-x-scale-reciprical float :offset-assert 32)
(screen-pages-high int32 :offset-assert 36)
)
:method-count-assert 9
:size-assert #x28
:flag-assert #x900000028
)
(define *video-params* (new 'static 'video-params
:set-video-mode #f
:reset-video-mode #f
:display-fbp #xa4
:relative-x-scale 1.0
:display-dy 8
:display-sy #xe0
:relative-x-scale-reciprical 1.0
:screen-pages-high 13
)
)
+102
View File
@@ -5,3 +5,105 @@
;; name in dgo: lights-h
;; dgos: ENGINE, GAME
(deftype vu-lights (structure)
((direction vector 3 :inline :offset-assert 0)
(color vector 3 :inline :offset-assert 48)
(ambient vector :inline :offset-assert 96)
)
:method-count-assert 9
:size-assert #x70
:flag-assert #x900000070
)
(deftype light (structure)
((direction vector :inline :offset-assert 0)
(color rgbaf :inline :offset-assert 16)
(extra vector :inline :offset-assert 32)
(level float :offset 32)
(luminance float :offset 40)
(priority float :offset 44)
(bytes uint8 4 :offset 36)
(mask uint16 :offset 36)
(palette-index int8 :offset 39)
)
:method-count-assert 9
:size-assert #x30
:flag-assert #x900000030
)
(deftype light-sphere (structure)
((name basic :offset-assert 0)
(bsphere vector :inline :offset-assert 16)
(direction vector :inline :offset-assert 32)
(color vector :inline :offset-assert 48)
(decay-start float :offset 4)
(ambient-point-ratio float :offset 8)
(brightness float :offset 12)
(bytes uint8 4 :offset 60)
(mask uint16 :offset 60)
(palette-index int8 :offset 63)
)
:method-count-assert 9
:size-assert #x40
:flag-assert #x900000040
)
(deftype light-hash-bucket (structure)
((index uint16 :offset-assert 0)
(count uint16 :offset-assert 2)
)
:method-count-assert 9
:size-assert #x4
:flag-assert #x900000004
)
(deftype light-hash (basic)
((num-lights uint16 :offset-assert 4)
(num-indices uint16 :offset-assert 6)
(num-buckets uint16 :offset-assert 8)
(bucket-step uint16 2 :offset-assert 10)
(base-trans vector :inline :offset-assert 16)
(axis-scale vector :inline :offset-assert 32)
(dimension-array vector4w :inline :offset-assert 48)
(bucket-array uint32 :offset-assert 64)
(index-array uint32 :offset-assert 68)
(light-sphere-array uint32 :offset-assert 72)
)
:method-count-assert 9
:size-assert #x4c
:flag-assert #x90000004c
)
(deftype light-hash-work (structure)
((ones vector4w :inline :offset-assert 0)
)
:method-count-assert 9
:size-assert #x10
:flag-assert #x900000010
)
(define *light-hash* (the-as light-hash-work #f))
(defmethod print light ((obj light))
(format
#t
"#<light [~F] ~F ~F ~F "
(-> obj extra x)
(-> obj direction x)
(-> obj direction y)
(-> obj direction z)
)
(format #t "~F ~F ~F @ #x~X>" (-> obj color x) (-> obj color y) (-> obj color z) obj)
obj
)
(deftype light-group (structure)
((dir0 light :inline :offset-assert 0)
(dir1 light :inline :offset-assert 48)
(dir2 light :inline :offset-assert 96)
(ambi light :inline :offset-assert 144)
)
:method-count-assert 9
:size-assert #xc0
:flag-assert #x9000000c0
)
+105
View File
@@ -5,3 +5,108 @@
;; name in dgo: math-camera-h
;; dgos: ENGINE, GAME
(deftype vis-gif-tag (structure)
((fog0 uint32 :offset-assert 0)
(strip uint32 :offset-assert 4)
(regs uint32 :offset-assert 8)
(fan uint32 :offset-assert 12)
)
:method-count-assert 9
:size-assert #x10
:flag-assert #x900000010
)
(deftype cull-info (structure)
((x-fact float :offset-assert 0)
(y-fact float :offset-assert 4)
(z-fact float :offset-assert 8)
(cam-radius float :offset-assert 12)
(cam-x float :offset-assert 16)
(cam-y float :offset-assert 20)
(xz-dir-ax float :offset-assert 24)
(xz-dir-az float :offset-assert 28)
(xz-dir-bx float :offset-assert 32)
(xz-dir-bz float :offset-assert 36)
(xz-cross-ab float :offset-assert 40)
(yz-dir-ay float :offset-assert 44)
(yz-dir-az float :offset-assert 48)
(yz-dir-by float :offset-assert 52)
(yz-dir-bz float :offset-assert 56)
(yz-cross-ab float :offset-assert 60)
)
:allow-misaligned
:method-count-assert 9
:size-assert #x40
:flag-assert #x900000040
)
(deftype math-camera (basic)
((d meters :offset-assert 4)
(f meters :offset-assert 8)
(fov degrees :offset-assert 12)
(x-ratio float :offset-assert 16)
(y-ratio float :offset-assert 20)
(x-pix float :offset-assert 24)
(x-clip float :offset-assert 28)
(x-clip-ratio-in float :offset-assert 32)
(x-clip-ratio-over float :offset-assert 36)
(y-pix float :offset-assert 40)
(y-clip float :offset-assert 44)
(y-clip-ratio-in float :offset-assert 48)
(y-clip-ratio-over float :offset-assert 52)
(cull-info cull-info :inline :offset-assert 56)
(fog-start meters :offset-assert 120)
(fog-end meters :offset-assert 124)
(fog-max float :offset-assert 128)
(fog-min float :offset-assert 132)
(reset int32 :offset-assert 136)
(smooth-step float :offset-assert 140)
(smooth-t float :offset-assert 144)
(perspective matrix :inline :offset-assert 160)
(isometric matrix :inline :offset-assert 224)
(sprite-2d matrix :inline :offset-assert 288)
(sprite-2d-hvdf vector :inline :offset-assert 352)
(camera-rot matrix :inline :offset-assert 368)
(inv-camera-rot matrix :inline :offset-assert 432)
(inv-camera-rot-smooth matrix :inline :offset-assert 496)
(inv-camera-rot-smooth-from quaternion :inline :offset-assert 560)
(camera-temp matrix :inline :offset-assert 576)
(prev-camera-temp matrix :inline :offset-assert 640)
(prev-inv-camera-rot matrix :inline :offset-assert 704)
(prev-trans vector :inline :offset-assert 768)
(hmge-scale vector :inline :offset-assert 784)
(inv-hmge-scale vector :inline :offset-assert 800)
(hvdf-off vector :inline :offset-assert 816)
(guard vector :inline :offset-assert 832)
(vis-gifs vis-gif-tag 4 :inline :offset-assert 848)
(giftex uint128 :offset 848)
(gifgr uint128 :offset 864)
(giftex-trans uint128 :offset 880)
(gifgr-trans uint128 :offset 896)
(pfog0 float :offset-assert 912)
(pfog1 float :offset-assert 916)
(trans vector :inline :offset-assert 928)
(plane plane 4 :inline :offset-assert 944)
(guard-plane plane 4 :inline :offset-assert 1008)
(shrub-mat matrix :inline :offset-assert 1072)
(quat-other quaternion :inline :offset-assert 1136)
(trans-other vector :inline :offset-assert 1152)
(shrub-mat-other matrix :inline :offset-assert 1168)
(camera-temp-other matrix :inline :offset-assert 1232)
(camera-rot-other matrix :inline :offset-assert 1296)
(inv-camera-rot-other matrix :inline :offset-assert 1360)
(plane-other plane 4 :inline :offset-assert 1424)
(guard-plane-other plane 4 :inline :offset-assert 1488)
(mirror-trans vector :inline :offset-assert 1552)
(mirror-normal vector :inline :offset-assert 1568)
(fov-correction-factor float :offset-assert 1584)
)
:method-count-assert 9
:size-assert #x634
:flag-assert #x900000634
)
+630
View File
@@ -5,3 +5,633 @@
;; name in dgo: math-camera
;; dgos: ENGINE, GAME
(deftype fog-corrector (structure)
((fog-end float :offset-assert 0)
(fog-start float :offset-assert 4)
)
:method-count-assert 9
:size-assert #x8
:flag-assert #x900000008
)
(defun fog-corrector-setup ((arg0 fog-corrector) (arg1 math-camera))
(set! (-> arg0 fog-end) (* (-> arg1 fog-end) (-> arg1 fov-correction-factor)))
(set! (-> arg0 fog-start) (* (-> arg1 fog-start) (-> arg1 fov-correction-factor)))
(none)
)
(define *math-camera-fog-correction* (new 'global 'fog-corrector))
(define-extern sprite-distorter-generate-tables (function none))
(defun update-math-camera ((arg0 math-camera) (arg1 symbol) (arg2 symbol) (arg3 float))
(local-vars (sv-16 float))
(set! (-> arg0 x-ratio) (tan (* 0.5 arg3)))
(if (= arg2 'aspect4x3)
(set! (-> arg0 y-ratio) (* 0.75 (-> arg0 x-ratio)))
(set! (-> arg0 y-ratio) (* 0.5625 (-> arg0 x-ratio)))
)
(let ((f1-3 (-> arg0 x-ratio))
(f0-7 (-> arg0 y-ratio))
(v1-6 (-> arg0 cull-info))
)
(/ (+ 1.0 (* 4.0 f1-3 f1-3)) (+ 1.0 (* f1-3 f1-3)))
(let ((f2-5 (/ (+ 1.0 (* 4.0 f0-7 f0-7)) (+ 1.0 (* f0-7 f0-7)))))
(set! (-> v1-6 x-fact) (/ (+ 1.0 (* 4.0 f1-3 f1-3)) (* f1-3 (sqrtf (+ 1.0 (* 16.0 f1-3 f1-3))))))
(set! (-> v1-6 y-fact) (/ (+ 1.0 (* 4.0 f0-7 f0-7)) (* f0-7 (sqrtf (+ 1.0 (* 16.0 f0-7 f0-7))))))
(set! (-> v1-6 z-fact) (sqrtf (+ (* (+ -4.0 f2-5) (+ -4.0 f2-5) f0-7 f0-7) (* (+ -1.0 f2-5) (+ -1.0 f2-5)))))
)
(let* ((f2-11 (* f1-3 (-> arg0 d)))
(f1-5 (* f0-7 (-> arg0 d)))
(f0-10 (+ (* f2-11 f2-11) (* f1-5 f1-5)))
(f1-8 (-> arg0 d))
)
(set! (-> v1-6 cam-radius) (sqrtf (+ f0-10 (* f1-8 f1-8))))
)
(let* ((f1-12 (* (-> arg0 d) (-> arg0 x-ratio)))
(f0-14 (-> arg0 d))
(f2-13 (* 4.0 f1-12))
(f3-21 (-> arg0 d))
)
(let ((f4-21 (/ 1.0 (sqrtf (+ (* f1-12 f1-12) (* f0-14 f0-14)))))
(f5-11 (/ 1.0 (sqrtf (+ (* f2-13 f2-13) (* f3-21 f3-21)))))
)
(set! (-> v1-6 xz-dir-ax) (* f1-12 f4-21))
(set! (-> v1-6 xz-dir-az) (* f0-14 f4-21))
(set! (-> v1-6 xz-dir-bx) (* f2-13 f5-11))
(set! (-> v1-6 xz-dir-bz) (* f3-21 f5-11))
)
(set! (-> v1-6 xz-cross-ab) (- (* f1-12 f3-21) (* f0-14 f2-13)))
)
(let* ((f1-15 (* (-> arg0 d) (-> arg0 y-ratio)))
(f0-18 (-> arg0 d))
(f2-15 (* 4.0 f1-15))
(f3-22 (-> arg0 d))
)
(let ((f4-26 (/ 1.0 (sqrtf (+ (* f1-15 f1-15) (* f0-18 f0-18)))))
(f5-16 (/ 1.0 (sqrtf (+ (* f2-15 f2-15) (* f3-22 f3-22)))))
)
(set! (-> v1-6 yz-dir-ay) (* f1-15 f4-26))
(set! (-> v1-6 yz-dir-az) (* f0-18 f4-26))
(set! (-> v1-6 yz-dir-by) (* f2-15 f5-16))
(set! (-> v1-6 yz-dir-bz) (* f3-22 f5-16))
)
(set! (-> v1-6 yz-cross-ab) (- (* f1-15 f3-22) (* f0-18 f2-15)))
)
)
(fog-corrector-setup *math-camera-fog-correction* arg0)
(matrix-identity! (-> arg0 camera-rot))
(let ((f0-21 100.0)
(f2-16 16760631.0)
)
16777115.0
(let ((f30-0 (/ (* (-> arg0 d) (- (-> arg0 fog-min) (-> arg0 fog-max)))
(- (-> *math-camera-fog-correction* fog-end) (-> *math-camera-fog-correction* fog-start))
)
)
(f1-21 (* -0.5 (- f2-16 f0-21)))
)
(let ((f4-34 (/ f1-21 (* (-> arg0 d) (- (-> arg0 f) (-> arg0 d)))))
(f3-30 (-> arg0 fov-correction-factor))
)
(set! (-> arg0 perspective data 0) (* f3-30 (- (/ (-> arg0 x-pix) (* (-> arg0 x-ratio) (-> arg0 d))))))
(set! (-> arg0 perspective data 5) (* f3-30 (- (/ (-> arg0 y-pix) (* (-> arg0 y-ratio) (-> arg0 d))))))
(set! (-> arg0 perspective data 10) (* f3-30 (+ (-> arg0 f) (-> arg0 d)) f4-34))
(set! (-> arg0 perspective data 11) (* (/ f3-30 (-> arg0 d)) f30-0))
(set! (-> arg0 perspective trans z) (* -2.0 f4-34 (-> arg0 f) (-> arg0 d) f3-30))
)
(let ((f24-0 2048.0)
(f26-0 2048.0)
(f28-0 (/ (- (* (-> *math-camera-fog-correction* fog-end) (-> arg0 fog-max))
(* (-> *math-camera-fog-correction* fog-start) (-> arg0 fog-min))
)
(- (-> *math-camera-fog-correction* fog-end) (-> *math-camera-fog-correction* fog-start))
)
)
)
(let ((f22-0 (* 0.5 (+ f2-16 f0-21))))
(set! (-> arg0 hmge-scale x) (/ 1.0 (-> arg0 x-clip)))
(set! (-> arg0 hmge-scale y) (/ 1.0 (-> arg0 y-clip)))
(set! (-> arg0 hmge-scale z) (/ 1.0 f1-21))
(set! (-> arg0 hmge-scale w) (/ 1.0 f30-0))
(set! (-> arg0 inv-hmge-scale x) (-> arg0 x-clip))
(set! (-> arg0 inv-hmge-scale y) (-> arg0 y-clip))
(set! (-> arg0 inv-hmge-scale z) f1-21)
(set! (-> arg0 inv-hmge-scale w) f30-0)
(cond
((or (zero? *screen-shot-work*) (= (-> *screen-shot-work* count) -1))
(set! (-> arg0 hvdf-off x) f24-0)
(set! (-> arg0 hvdf-off y) f26-0)
)
(else
(let* ((v1-32 (-> *screen-shot-work* count))
(a0-36 (-> *screen-shot-work* size))
(f0-34 (the float a0-36))
(f20-0 (/ (the float (mod v1-32 a0-36)) f0-34))
)
(set! sv-16 (/ (the float (/ v1-32 a0-36)) f0-34))
(format 0 "~f ~f~%" f20-0 sv-16)
(set! (-> arg0 hvdf-off x) (- f24-0 f20-0))
)
(set! (-> arg0 hvdf-off y) (- f26-0 sv-16))
)
)
(set! (-> arg0 hvdf-off z) f22-0)
(set! (-> arg0 hvdf-off w) f28-0)
(set! (-> arg0 guard x) (/ (-> arg0 x-clip) (-> arg0 x-pix)))
(set! (-> arg0 guard y) (/ (-> arg0 y-clip) (-> arg0 y-pix)))
(set! (-> arg0 guard z) 1.0)
(set! (-> arg0 guard w) 1.0)
(set! (-> arg0 isometric trans z) (- 16777215.0 f22-0))
;; PC HACK!
;; for whatever reason, the font render ends up computing a depth #x1000000 instead of
;; #xffffffff, which overflows the 24-bit z buffer.
;; cheating this by 1 bit seems to fix it.
(#when PC_PORT
;; #x4b002032 -> #x4b002031
(set! (-> arg0 isometric vector 3 z) (the-as float (- (the-as int (-> arg0 isometric vector 3 z)) 1)))
)
)
(set! (-> arg0 isometric trans w) f30-0)
(let ((f1-28 (-> arg0 perspective data 0))
(f2-19 (-> arg0 perspective data 5))
(f0-48 (* -1.9996 (-> arg0 perspective data 0)))
)
(let ((v1-39 (-> arg0 sprite-2d)))
(set! (-> v1-39 data 0) f0-48)
(set! (-> v1-39 data 1) 0.0)
(set! (-> v1-39 data 2) 0.0)
(set! (-> v1-39 data 3) 0.0)
)
(let ((v1-40 (&-> arg0 sprite-2d data 4)))
(set! (-> v1-40 0) 0.0)
(set! (-> v1-40 1) (- (* (/ f2-19 f1-28) f0-48)))
(set! (-> v1-40 2) 0.0)
(set! (-> v1-40 3) 0.0)
)
(let ((v1-41 (&-> arg0 sprite-2d data 8)))
(set! (-> v1-41 0) 0.0)
(set! (-> v1-41 1) 0.0)
(set! (-> v1-41 2) (- f0-48))
(set! (-> v1-41 3) 0.0)
)
(set-vector! (-> arg0 sprite-2d trans) 0.0 0.0 (* 500000000.0 f0-48) (* 60.0 f0-48 (-> arg0 pfog0)))
)
(set! (-> arg0 sprite-2d-hvdf quad) (-> arg0 hvdf-off quad))
(set! (-> arg0 sprite-2d-hvdf x) 2048.0)
(set! (-> arg0 sprite-2d-hvdf y) 2048.0)
(set! (-> arg0 sprite-2d-hvdf z) (-> arg0 hvdf-off z))
(set! (-> arg0 pfog0) f30-0)
(set! (-> arg0 pfog1) f28-0)
)
)
)
0
#|
(make-u128 0 (shl #x301ec000 32))
(make-u128 0 (shl #x303ec000 32))
(let ((v1-54 (-> arg0 pfog0)))
(let ((a0-42 (-> arg0 vis-gifs)))
(set! (-> a0-42 0 fog0) (the-as uint v1-54))
(set! (-> a0-42 0 strip) (the-as uint #x301e4000))
(set! (-> a0-42 0 regs) (the-as uint 1042))
(set! (-> a0-42 0 fan) (the-as uint #x301ec000))
)
(let ((a0-43 (&-> arg0 gifgr)))
(s.w! a0-43 v1-54)
(let ((a1-9 (make-u128 0 (shl #x20164000 32))))
(s.w! (+ a0-43 4) a1-9)
)
(let ((a1-10 65))
(s.w! (+ a0-43 8) a1-10)
)
(let ((a1-11 #x301ec000))
(s.w! (+ a0-43 12) a1-11)
)
)
(let ((a0-44 (-> arg0 vis-gifs)))
(set! (-> a0-44 0 fog0) (the-as uint v1-54))
(set! (-> a0-44 0 strip) (the-as uint #x303e4000))
(set! (-> a0-44 0 regs) (the-as uint 1042))
(set! (-> a0-44 0 fan) (the-as uint #x303ec000))
)
(let ((a0-45 (-> arg0 vis-gifs)))
(set! (-> a0-45 0 fog0) (the-as uint v1-54))
(set! (-> a0-45 0 strip) (the-as uint #x303e4000))
(set! (-> a0-45 0 regs) (the-as uint 1042))
(set! (-> a0-45 0 fan) (the-as uint #x303ec000))
)
)
|#
(if (nonzero? sprite-distorter-generate-tables)
(sprite-distorter-generate-tables)
)
arg0
)
(defmethod new math-camera ((allocation symbol) (type-to-make type))
(let ((gp-0 (object-new allocation type-to-make (the-as int (-> type-to-make size)))))
(set! (-> gp-0 d) 1024.0)
(set! (-> gp-0 f) 40960000.0)
(set! (-> gp-0 fov) 11650.845)
(set! (-> gp-0 x-pix) 256.0)
(set! (-> gp-0 x-clip) 1024.0)
(set! (-> gp-0 y-pix) 112.0)
(set! (-> gp-0 y-clip) 448.0)
(set! (-> gp-0 fog-start) 40960.0)
(set! (-> gp-0 fog-end) 819200.0)
(set! (-> gp-0 fog-max) 255.0)
(set! (-> gp-0 fog-min) 150.0)
(matrix-identity! (-> gp-0 inv-camera-rot))
(matrix-identity! (-> gp-0 camera-rot))
(vector-reset! (-> gp-0 trans))
(quaternion-identity! (-> gp-0 quat-other))
(set-vector! (-> gp-0 trans-other) 0.0 0.0 0.0 1.0)
(matrix-identity! (-> gp-0 inv-camera-rot-other))
(matrix-identity! (-> gp-0 camera-rot-other))
(matrix-identity! (-> gp-0 camera-temp-other))
(set! (-> gp-0 isometric data 0) 1.0)
(set! (-> gp-0 isometric data 5) 0.5)
(set! (-> gp-0 isometric data 10) -1.0)
(set! (-> gp-0 reset) 1)
(set! (-> gp-0 smooth-step) 0.0)
(set! (-> gp-0 smooth-t) 0.0)
(update-math-camera gp-0 'ntsc 'aspect4x3 (-> gp-0 fov))
)
)
(define *math-camera* (new 'global 'math-camera))
(defun math-cam-start-smoothing ((arg0 float) (arg1 float))
(set! (-> *math-camera* smooth-step) (/ 1.0 arg0))
(set! (-> *math-camera* smooth-t) arg1)
(matrix->quaternion (-> *math-camera* inv-camera-rot-smooth-from) (-> *math-camera* inv-camera-rot-smooth))
)
#|
(defun move-target-from-pad ((arg0 transform) (arg1 int))
(let ((s4-0 (new-stack-vector0)))
(set! (-> s4-0 x) (the-as float (gpr->fpr (cond
((cpad-hold? arg1 circle)
-1029701632
)
((cpad-hold? arg1 square)
#x42a00000
)
(else
0
)
)
)
)
)
(set! (-> s4-0 y) 0.0)
(set! (-> s4-0 z) (the-as float (gpr->fpr (cond
((cpad-hold? arg1 down)
-1029701632
)
((cpad-hold? arg1 up)
#x42a00000
)
(else
0
)
)
)
)
)
(set! (-> s4-0 w) 1.0)
(let ((a0-5 (new-stack-vector0))
(s3-0 (new-stack-matrix0))
)
(vector-negate! a0-5 (-> arg0 rot))
(matrix-rotate-zyx! s3-0 (-> arg0 rot))
(vector-matrix*! s4-0 s4-0 s3-0)
)
(vector+! (-> arg0 trans) (-> arg0 trans) s4-0)
)
(set! (-> arg0 trans w) 1.0)
(if (cpad-hold? arg1 r1)
(set! (-> arg0 trans y) (+ 80.0 (-> arg0 trans y)))
)
(if (cpad-hold? arg1 r2)
(set! (-> arg0 trans y) (+ -80.0 (-> arg0 trans y)))
)
(if (cpad-hold? arg1 x)
(set! (-> arg0 rot x) (+ 546.13336 (-> arg0 rot x)))
)
(if (cpad-hold? arg1 triangle)
(set! (-> arg0 rot x) (+ -546.13336 (-> arg0 rot x)))
)
(if (cpad-hold? arg1 left)
(set! (-> arg0 rot y) (+ 546.13336 (-> arg0 rot y)))
)
(if (cpad-hold? arg1 right)
(set! (-> arg0 rot y) (+ -546.13336 (-> arg0 rot y)))
)
arg0
)
|#
(defun transform-point-vector! ((arg0 vector) (arg1 vector))
"Apply camera transformation to a point. Return true if it is visible or not.
This returns the point in GS coords, but as float instead of int, so it's
not really useful. See transform-point-qword! for more details"
(rlet ((acc :class vf)
(Q :class vf)
(vf0 :class vf)
(vf23 :class vf)
(vf24 :class vf)
(vf25 :class vf)
(vf26 :class vf)
(vf27 :class vf)
(vf28 :class vf)
(vf29 :class vf)
(vf30 :class vf)
(vf31 :class vf)
)
(init-vf0-vector)
(let ((v1-0 0))
)
(.lvf vf24 (&-> *math-camera* camera-temp vector 0 quad))
(.lvf vf25 (&-> *math-camera* camera-temp vector 1 quad))
(.lvf vf26 (&-> *math-camera* camera-temp vector 2 quad))
(.lvf vf27 (&-> *math-camera* camera-temp vector 3 quad))
(.lvf vf29 (&-> *math-camera* hmge-scale quad))
(.lvf vf30 (&-> *math-camera* hvdf-off quad))
(.lvf vf28 (&-> arg1 quad))
(.mul.x.vf acc vf24 vf28)
(.add.mul.y.vf acc vf25 vf28 acc)
(.add.mul.z.vf acc vf26 vf28 acc)
(.add.mul.w.vf vf28 vf27 vf0 acc)
(.add.w.vf vf23 vf0 vf0)
(.mul.vf vf31 vf28 vf29)
;;(TODO.VCLIP vf31 vf31)
(let ((clip (vu-clip vf31 0)))
(.div.vf Q vf0 vf31 :fsf #b11 :ftf #b11)
(.wait.vf)
;;(.cfc2.i v1-7 Clipping)
(.mul.vf vf28 vf28 Q :mask #b111)
(.mul.vf vf23 vf23 Q)
(.add.vf vf28 vf28 vf30)
(.max.x.vf vf28 vf28 vf0 :mask #b1000)
(.svf (&-> arg0 quad) vf28)
(zero? (logand clip 63))
)
)
)
(defun transform-point-qword! ((arg0 vector4w) (arg1 vector))
"Apply camera transformation to point, returning fixed point 28.4 position
that can be given to the GS directly."
(rlet ((acc :class vf)
(Q :class vf)
(vf0 :class vf)
(vf23 :class vf)
(vf24 :class vf)
(vf25 :class vf)
(vf26 :class vf)
(vf27 :class vf)
(vf28 :class vf)
(vf29 :class vf)
(vf30 :class vf)
(vf31 :class vf)
)
(init-vf0-vector)
(let ((v1-0 0))
)
;; this camera matrix has both the projection and camera translation/rotation
(.lvf vf24 (&-> *math-camera* camera-temp vector 0 quad))
(.lvf vf25 (&-> *math-camera* camera-temp vector 1 quad))
(.lvf vf26 (&-> *math-camera* camera-temp vector 2 quad))
(.lvf vf27 (&-> *math-camera* camera-temp vector 3 quad))
;; scaling
(.lvf vf29 (&-> *math-camera* hmge-scale quad))
;; offset
(.lvf vf30 (&-> *math-camera* hvdf-off quad))
;; input point
(.lvf vf28 (&-> arg1 quad))
;; matrix multiply, result in vf28
(.mul.x.vf acc vf24 vf28)
(.add.mul.y.vf acc vf25 vf28 acc)
(.add.mul.z.vf acc vf26 vf28 acc)
(.add.mul.w.vf vf28 vf27 vf0 acc)
(.add.w.vf vf23 vf0 vf0) ;; set w = 1.0
;; apply hmge scaling. the result of this multiply sets clipping flags appropriately
(.mul.vf vf31 vf28 vf29) ;; scale.
;;(TODO.VCLIP vf31 vf31)
(let ((clip (vu-clip vf31 0))) ;; clip!
;; perspective divide
(.div.vf Q vf0 vf31 :fsf #b11 :ftf #b11)
(.wait.vf)
;;(.cfc2.i v1-7 Clipping)
;; perspective
(.mul.vf vf28 vf28 Q :mask #b111)
;; compute scale factor (w was 1.0)
(.mul.vf vf23 vf23 Q)
;; apply hvdf offsets
(.add.vf vf28 vf28 vf30)
;; saturate fog
(.max.x.vf vf28 vf28 vf0 :mask #b1000)
;; convert to GS fixed point
(vftoi4.xyzw vf28 vf28)
;; store result!
(.svf (&-> arg0 quad) vf28)
;; return result of clipping.
(zero? (logand clip 63))
)
)
)
(defun transform-point-vector-scale! ((arg0 vector) (arg1 vector))
"Similar to transform-point-qword! but returns the scale factor instead."
(local-vars (v0-0 float))
(rlet ((acc :class vf)
(Q :class vf)
(vf0 :class vf)
(vf23 :class vf)
(vf24 :class vf)
(vf25 :class vf)
(vf26 :class vf)
(vf27 :class vf)
(vf28 :class vf)
(vf29 :class vf)
(vf30 :class vf)
(vf31 :class vf)
)
(init-vf0-vector)
(let ((v1-0 0))
)
(.lvf vf24 (&-> *math-camera* camera-temp vector 0 quad))
(.lvf vf25 (&-> *math-camera* camera-temp vector 1 quad))
(.lvf vf26 (&-> *math-camera* camera-temp vector 2 quad))
(.lvf vf27 (&-> *math-camera* camera-temp vector 3 quad))
(.lvf vf29 (&-> *math-camera* hmge-scale quad))
(.lvf vf30 (&-> *math-camera* hvdf-off quad))
(.lvf vf28 (&-> arg1 quad))
(.mul.x.vf acc vf24 vf28)
(.add.mul.y.vf acc vf25 vf28 acc)
(.add.mul.z.vf acc vf26 vf28 acc)
(.add.mul.w.vf vf28 vf27 vf0 acc)
(.add.w.vf vf23 vf0 vf0)
(.mul.vf vf31 vf28 vf29)
;;(TODO.VCLIP vf31 vf31) clip result was unused
(.div.vf Q vf0 vf31 :fsf #b11 :ftf #b11)
(.wait.vf)
;;(.cfc2.i v1-7 Clipping)
(.mul.vf vf28 vf28 Q :mask #b111)
(.mul.vf vf23 vf23 Q)
(.add.vf vf28 vf28 vf30)
(.max.x.vf vf28 vf28 vf0 :mask #b1000)
(.svf (&-> arg0 quad) vf28)
;;(let ((a0-2 (zero? (logand v1-7 63))))
;; )
(.mov v0-0 vf23)
v0-0
)
)
(defun reverse-transform-point! ((arg0 vector) (arg1 vector) (arg2 vector) (arg3 vector))
(let* ((v1-1 (-> *math-camera* perspective))
(s2-0 (-> *math-camera* camera-rot))
(f30-0 (* (/ (-> v1-1 data 11) (-> v1-1 data 0)) (-> *math-camera* hmge-scale w)))
(f28-0 (* (/ (-> v1-1 data 11) (-> v1-1 data 5)) (-> *math-camera* hmge-scale w)))
(s4-0 (vector-rotate*! (new 'stack-no-clear 'vector) arg2 s2-0))
(v1-3 (vector-matrix*! (new 'stack-no-clear 'vector) arg1 s2-0))
(f0-8 (/ (+ (* (-> s4-0 x) (-> v1-3 x)) (* (-> s4-0 y) (-> v1-3 y)) (* (-> s4-0 z) (-> v1-3 z)))
(+ (* (-> s4-0 x) (-> arg3 x) f30-0) (* (-> s4-0 y) (-> arg3 y) f28-0) (-> s4-0 z))
)
)
(f1-16 (* (-> arg3 x) f0-8 f30-0))
(f2-9 (* (-> arg3 y) f0-8 f28-0))
(t9-2 vector-matrix*!)
(a0-5 arg0)
(a1-3 (new 'stack-no-clear 'vector))
)
(set! (-> a1-3 x) f1-16)
(set! (-> a1-3 y) f2-9)
(set! (-> a1-3 z) f0-8)
(set! (-> a1-3 w) 1.0)
(t9-2 a0-5 a1-3 (-> *math-camera* inv-camera-rot))
)
(none)
)
(defun init-for-transform ((arg0 matrix))
"Sets up VU0 registers with camera info.
This is probably a very old function and it's only used by jungle mirrors.
It stashes some data in vector float registers that must be there before calling transform-float-point."
(rlet ((vf1 :class vf)
(vf17 :class vf)
(vf18 :class vf)
(vf19 :class vf)
(vf2 :class vf)
(vf23 :class vf)
(vf24 :class vf)
(vf25 :class vf)
(vf26 :class vf)
(vf27 :class vf)
(vf28 :class vf)
(vf29 :class vf)
(vf3 :class vf)
(vf4 :class vf)
(vf6 :class vf)
(vf7 :class vf)
(vf8 :class vf)
(vf9 :class vf)
)
(let ((gp-0 (new-stack-matrix0))
(s5-0 (new-stack-matrix0))
(s4-0 (new 'stack 'vector4s-3))
(s3-0 (new-stack-vector0))
(s2-0 (new 'stack 'vector4s-3))
)
(matrix*! s5-0 arg0 (-> *math-camera* camera-temp))
(matrix-3x3-inverse-transpose! gp-0 arg0)
(let ((v1-3 s3-0))
(set! (-> v1-3 x) 0.4)
(set! (-> v1-3 y) 0.4)
(set! (-> v1-3 z) 0.4)
(set! (-> v1-3 w) 1.0)
)
(let ((v1-4 (-> s4-0 data)))
(set! (-> v1-4 0) 1.0)
(set! (-> v1-4 1) 1.0)
(set! (-> v1-4 2) 1.0)
(set! (-> v1-4 3) 1.0)
)
(let ((v1-5 (&-> s4-0 data 4)))
(set! (-> v1-5 0) 0.0)
(set! (-> v1-5 1) 0.0)
(set! (-> v1-5 2) 0.0)
(set! (-> v1-5 3) 1.0)
)
(let ((v1-6 (&-> s4-0 data 8)))
(set! (-> v1-6 0) 0.0)
(set! (-> v1-6 1) 0.0)
(set! (-> v1-6 2) 0.0)
(set! (-> v1-6 3) 1.0)
)
(let ((v1-7 (-> s2-0 data)))
(set! (-> v1-7 0) 1.0)
(set! (-> v1-7 1) 0.0)
(set! (-> v1-7 2) 0.0)
(set! (-> v1-7 3) 1.0)
)
(let ((v1-8 (&-> s2-0 data 4)))
(set! (-> v1-8 0) 0.0)
(set! (-> v1-8 1) 1.0)
(set! (-> v1-8 2) 0.0)
(set! (-> v1-8 3) 1.0)
)
(let ((v1-9 (&-> s2-0 data 8)))
(set! (-> v1-9 0) 0.0)
(set! (-> v1-9 1) 0.0)
(set! (-> v1-9 2) 1.0)
(set! (-> v1-9 3) 1.0)
)
(.lvf vf7 (&-> *math-camera* hmge-scale quad))
(.lvf vf8 (&-> *math-camera* hvdf-off quad))
(.lvf vf9 (&-> *math-camera* giftex))
(let ((v1-13 255))
(.mov vf6 v1-13)
)
;;(.mov v1-14 vf6)
(.itof.vf vf6 vf6)
(.svf (&-> *transform-regs* vf7) vf7)
(.svf (&-> *transform-regs* vf8) vf8)
(.svf (&-> *transform-regs* vf9) vf9)
(.svf (&-> *transform-regs* vf6) vf6)
(set! (-> *transform-regs* vf1) (-> s5-0 vector 0 quad))
(set! (-> *transform-regs* vf2) (-> s5-0 vector 1 quad))
(set! (-> *transform-regs* vf3) (-> s5-0 vector 2 quad))
(set! (-> *transform-regs* vf4) (-> s5-0 vector 3 quad))
(set! (-> *transform-regs* vf17) (-> gp-0 vector 0 quad))
(set! (-> *transform-regs* vf18) (-> gp-0 vector 1 quad))
(set! (-> *transform-regs* vf19) (-> gp-0 vector 2 quad))
(set! (-> *transform-regs* vf23) (-> s2-0 quad 0))
(set! (-> *transform-regs* vf24) (-> s2-0 quad 1))
(set! (-> *transform-regs* vf25) (-> s2-0 quad 2))
(set! (-> *transform-regs* vf27) (-> s4-0 quad 0))
(set! (-> *transform-regs* vf28) (-> s4-0 quad 1))
(set! (-> *transform-regs* vf29) (-> s4-0 quad 2))
(set! (-> *transform-regs* vf26) (-> s3-0 quad))
)
(none)
)
)
+239
View File
@@ -5,3 +5,242 @@
;; name in dgo: mood-h
;; dgos: ENGINE, GAME
(deftype mood-channel (structure)
((data float 24 :offset-assert 0)
(vecs vector4 6 :inline :offset 0)
)
:method-count-assert 9
:size-assert #x60
:flag-assert #x900000060
)
(deftype mood-channel-group (structure)
((data mood-channel 4 :inline :offset-assert 0)
)
:method-count-assert 9
:size-assert #x180
:flag-assert #x900000180
)
(deftype mood-fog (structure)
((fog-color vector :inline :offset-assert 0)
(fog-dists vector :inline :offset-assert 16)
(fog-start meters :offset 16)
(fog-end meters :offset 20)
(fog-max float :offset 24)
(fog-min float :offset 28)
(erase-color vector :inline :offset-assert 32)
)
:method-count-assert 9
:size-assert #x30
:flag-assert #x900000030
)
(deftype mood-fog-table (structure)
((data mood-fog 8 :inline :offset-assert 0)
)
:method-count-assert 9
:size-assert #x180
:flag-assert #x900000180
)
(deftype mood-color (structure)
((lgt-color vector :inline :offset-assert 0)
(amb-color vector :inline :offset-assert 16)
)
:method-count-assert 9
:size-assert #x20
:flag-assert #x900000020
)
(deftype mood-direction-table (structure)
((data vector 4 :inline :offset-assert 0)
)
:method-count-assert 9
:size-assert #x40
:flag-assert #x900000040
)
(deftype mood-color-table (structure)
((data mood-color 8 :inline :offset-assert 0)
)
:method-count-assert 9
:size-assert #x100
:flag-assert #x900000100
)
(deftype mood-sky-table (structure)
((data vector 8 :inline :offset-assert 0)
)
:method-count-assert 9
:size-assert #x80
:flag-assert #x900000080
)
(deftype mood-clouds (structure)
((cloud-min float :offset-assert 0)
(cloud-max float :offset-assert 4)
)
:method-count-assert 9
:size-assert #x8
:flag-assert #x900000008
)
(deftype mood-weather (structure)
((data float 2 :offset-assert 0)
(cloud float :offset 0)
(fog float :offset 4)
)
:pack-me
:allow-misaligned
:method-count-assert 9
:size-assert #x8
:flag-assert #x900000008
)
(deftype mood-iweather (structure)
((data int32 2 :offset-assert 0)
(cloud int32 :offset 0)
(fog int32 :offset 4)
)
:allow-misaligned
:method-count-assert 9
:size-assert #x8
:flag-assert #x900000008
)
(deftype mood-range (structure)
((data float 4 :offset-assert 0)
(min-cloud float :offset 0)
(max-cloud float :offset 4)
(min-fog float :offset 8)
(max-fog float :offset 12)
(quad uint128 :offset 0)
)
:method-count-assert 9
:size-assert #x10
:flag-assert #x900000010
)
(deftype mood-filters-table (structure)
((data vector 8 :inline :offset-assert 0)
)
:method-count-assert 9
:size-assert #x80
:flag-assert #x900000080
)
(deftype mood-table (basic)
((mood-fog-table mood-fog-table :offset-assert 4)
(mood-color-table mood-color-table :offset-assert 8)
(mood-channel-group mood-channel-group :offset-assert 12)
(mood-direction-table mood-direction-table :offset-assert 16)
(mood-sky-table mood-sky-table :offset-assert 20)
(mood-interp-table basic :offset-assert 24)
)
:method-count-assert 9
:size-assert #x1c
:flag-assert #x90000001c
)
(deftype mood-context-core (structure)
((current-fog mood-fog :inline :offset-assert 0)
(current-sky-color vector :inline :offset-assert 48)
(current-env-color vector :inline :offset-assert 64)
(current-prt-color vector :inline :offset-assert 80)
(current-shadow-color vector :inline :offset-assert 96)
)
:method-count-assert 9
:size-assert #x70
:flag-assert #x900000070
)
(deftype mood-context-core2 (mood-context-core)
((light-group light-group 8 :inline :offset-assert 112)
)
:method-count-assert 9
:size-assert #x670
:flag-assert #x900000670
)
(deftype mood-context-core3 (mood-context-core2)
((times vector 8 :inline :offset-assert 1648)
)
:method-count-assert 9
:size-assert #x6f0
:flag-assert #x9000006f0
)
(deftype mood-context (mood-context-core3)
((itimes vector4w 4 :inline :offset-assert 1776)
(state uint32 32 :offset-assert 1840)
)
:method-count-assert 9
:size-assert #x7b0
:flag-assert #x9000007b0
)
(deftype mood-control-work (structure)
((weather mood-weather :inline :offset-assert 0)
(iweather mood-iweather :inline :offset-assert 8)
(interp mood-weather :inline :offset-assert 16)
(index int32 4 :offset-assert 24)
(color-interp float :offset-assert 40)
(color-index int32 2 :offset-assert 44)
(channel-interp float :offset-assert 52)
(channel-index int32 2 :offset-assert 56)
(cloud-interp float :offset-assert 64)
(cloud-index int32 2 :offset-assert 68)
)
:method-count-assert 9
:size-assert #x4c
:flag-assert #x90000004c
)
(deftype mood-control (mood-table)
((mood-clouds mood-clouds :offset-assert 28)
(current-interp mood-weather :inline :offset-assert 32)
(target-interp mood-weather :inline :offset-assert 40)
(speed-interp mood-weather :inline :offset-assert 48)
(range mood-range :inline :offset-assert 64)
(time-until-random mood-weather :inline :offset-assert 80)
(time-until-random-min mood-weather :inline :offset-assert 88)
(time-until-random-max mood-weather :inline :offset-assert 96)
(display-flag basic :offset-assert 104)
(overide-weather-flag basic :offset-assert 108)
(overide mood-weather :inline :offset-assert 112)
(lightning-index int32 :offset-assert 120)
(lightning-val int32 :offset-assert 124)
(lightning-time int32 :offset-assert 128)
(lightning-time2 float :offset-assert 132)
(lightning-flash float :offset-assert 136)
(lightning-id uint32 :offset-assert 140)
(lightning-count0 uint32 :offset-assert 144)
(lightning-count1 uint32 :offset-assert 148)
(lightning-count2 uint32 :offset-assert 152)
(rain-id uint32 :offset-assert 156)
(sound-pitch float :offset-assert 160)
(fogs mood-fog 9 :offset-assert 164)
(colors mood-color 3 :offset-assert 200)
(channels mood-channel 3 :offset-assert 212)
(clouds mood-clouds 9 :offset-assert 224)
)
:method-count-assert 19
:size-assert #x104
:flag-assert #x1300000104
(:methods
(dummy-9 () none 9)
(dummy-10 () none 10)
(dummy-11 () none 11)
(dummy-12 () none 12)
(dummy-13 () none 13)
(dummy-14 () none 14)
(dummy-15 () none 15)
(dummy-16 () none 16)
(dummy-17 () none 17)
(dummy-18 () none 18)
)
)
@@ -5,3 +5,186 @@
;; name in dgo: texture-anim-h
;; dgos: ENGINE, GAME
(deftype texture-anim-layer (structure)
((extra vector :inline :offset 240)
(func basic :offset 256)
(func-id basic :offset 256)
(init-func basic :offset 260)
(init-func-id basic :offset 260)
(tex basic :offset 264)
(start-time float :offset 268)
(end-time float :offset 272)
(tex-name basic :offset 276)
(test uint64 :offset 280)
(alpha uint64 :offset 288)
(clamp uint64 :offset 296)
(start-color vector :inline :offset 80)
(start-scale vector2 :inline :offset 96)
(start-offset vector2 :inline :offset 104)
(start-st-scale vector2 :inline :offset 112)
(start-st-offset vector2 :inline :offset 120)
(start-qs vector :inline :offset 128)
(start-rot degrees :offset 144)
(start-st-rot degrees :offset 148)
(end-color vector :inline :offset 160)
(end-scale vector2 :inline :offset 176)
(end-offset vector2 :inline :offset 184)
(end-st-scale vector2 :inline :offset 192)
(end-st-offset vector2 :inline :offset 200)
(end-qs vector :inline :offset 208)
(end-rot degrees :offset 224)
(end-st-rot degrees :offset 228)
)
:method-count-assert 11
:size-assert #x130
:flag-assert #xb00000130
(:methods
(dummy-9 () none 9)
(dummy-10 () none 10)
)
)
(deftype texture-anim (structure)
((num-layers uint32 :offset-assert 0)
(func basic :offset-assert 4)
(func-id basic :offset 4)
(init-func basic :offset-assert 8)
(init-func-id basic :offset 8)
(tex basic :offset-assert 12)
(tex-name basic :offset-assert 16)
(extra vector :inline :offset-assert 32)
(color uint32 :offset-assert 48)
(frame-time float :offset-assert 52)
(frame-delta float :offset-assert 56)
(frame-mod float :offset-assert 60)
(test uint64 :offset-assert 64)
(alpha uint64 :offset-assert 72)
(clamp uint64 :offset-assert 80)
(data uint8 :dynamic :offset-assert 88)
)
:method-count-assert 11
:size-assert #x58
:flag-assert #xb00000058
(:methods
(dummy-9 () none 9)
(dummy-10 () none 10)
)
)
(deftype texture-anim-array (array)
()
:method-count-assert 11
:size-assert #x10
:flag-assert #xb00000010
(:methods
(dummy-9 () none 9)
(dummy-10 () none 10)
)
)
(deftype texture-anim-work (structure)
((erase-tmpl dma-gif-packet :inline :offset-assert 0)
(draw-tmpl dma-gif-packet :inline :offset-assert 32)
(draw2-tmpl dma-gif-packet :inline :offset-assert 64)
(fill-tmpl dma-gif-packet :inline :offset-assert 96)
(adgif-tmpl dma-gif-packet :inline :offset-assert 128)
(corner0 vector :inline :offset-assert 160)
(corner1 vector :inline :offset-assert 176)
(corner2 vector :inline :offset-assert 192)
(corner3 vector :inline :offset-assert 208)
(const vector :inline :offset-assert 224)
(random vector 8 :inline :offset-assert 240)
(random-index uint8 :offset-assert 368)
)
:method-count-assert 9
:size-assert #x171
:flag-assert #x900000171
)
(deftype clut16x16 (structure)
((clut rgba 256 :offset-assert 0)
)
:method-count-assert 9
:size-assert #x400
:flag-assert #x900000400
)
(deftype noise8x8 (structure)
((image uint8 64 :offset-assert 0)
)
:method-count-assert 9
:size-assert #x40
:flag-assert #x900000040
)
(deftype noise16x16 (structure)
((image uint8 256 :offset-assert 0)
)
:method-count-assert 9
:size-assert #x100
:flag-assert #x900000100
)
(deftype noise32x32 (structure)
((image uint8 1024 :offset-assert 0)
)
:method-count-assert 9
:size-assert #x400
:flag-assert #x900000400
)
(deftype noise64x64 (structure)
((image uint8 4096 :offset-assert 0)
)
:method-count-assert 9
:size-assert #x1000
:flag-assert #x900001000
)
(deftype noise128x128 (structure)
((image uint8 16384 :offset-assert 0)
)
:method-count-assert 9
:size-assert #x4000
:flag-assert #x900004000
)
(deftype fog8x256 (structure)
((image uint8 256 :offset-assert 0)
)
:method-count-assert 9
:size-assert #x100
:flag-assert #x900000100
)
(deftype fog-texture-work (structure)
((corner vector 4 :inline :offset-assert 0)
(const vector :inline :offset-assert 64)
(min-corner vector :inline :offset-assert 80)
(max-corner vector :inline :offset-assert 96)
(fog-near float :offset-assert 112)
(fog-far float :offset-assert 116)
(fog-delta float :offset-assert 120)
(alpha-near float :offset-assert 124)
(alpha-far float :offset-assert 128)
(alpha-delta float :offset-assert 132)
(color uint32 :offset-assert 136)
)
:method-count-assert 9
:size-assert #x8c
:flag-assert #x90000008c
)
(define *clut-translate*
(new 'static 'array uint32 64
#x3020100 #x7060504 #x13121110 #x17161514 #xb0a0908 #xf0e0d0c #x1b1a1918 #x1f1e1d1c
#x23222120 #x27262524 #x33323130 #x37363534 #x2b2a2928 #x2f2e2d2c #x3b3a3938 #x3f3e3d3c #x43424140
#x47464544 #x53525150 #x57565554 #x4b4a4948 #x4f4e4d4c #x5b5a5958 #x5f5e5d5c #x63626160 #x67666564
#x73727170 #x77767574 #x6b6a6968 #x6f6e6d6c #x7b7a7978 #x7f7e7d7c #x83828180 #x87868584 #x93929190
#x97969594 #x8b8a8988 #x8f8e8d8c #x9b9a9998 #x9f9e9d9c #xa3a2a1a0 #xa7a6a5a4 #xb3b2b1b0 #xb7b6b5b4
#xabaaa9a8 #xafaeadac #xbbbab9b8 #xbfbebdbc #xc3c2c1c0 #xc7c6c5c4 #xd3d2d1d0 #xd7d6d5d4 #xcbcac9c8
#xcfcecdcc #xdbdad9d8 #xdfdedddc #xe3e2e1e0 #xe7e6e5e4 #xf3f2f1f0 #xf7f6f5f4 #xebeae9e8 #xefeeedec
#xfbfaf9f8 #xfffefdfc
)
)
@@ -5,3 +5,680 @@
;; name in dgo: texture-h
;; dgos: ENGINE, GAME
(declare-type texture-page basic)
(defenum link-test-flags
:type uint32
:bitfield #t
; (needs-log-in 8)
; (bit-9 9)
)
(deftype texture-id (uint32)
((index uint16 :offset 8 :size 12)
(page uint16 :offset 20 :size 12)
)
:method-count-assert 9
:size-assert #x4
:flag-assert #x900000004
)
(deftype texture-pool-segment (structure)
((dest uint32 :offset-assert 0)
(size uint32 :offset-assert 4)
)
:pack-me
:allow-misaligned
:method-count-assert 9
:size-assert #x8
:flag-assert #x900000008
)
(deftype texture-pool (basic)
((top int32 :offset-assert 4)
(cur int32 :offset-assert 8)
(allocate-func (function texture-pool texture-page kheap int texture-page) :offset-assert 12)
(font-palette int32 :offset-assert 16)
(segment texture-pool-segment 4 :inline :offset-assert 20)
(segment-near texture-pool-segment :inline :offset 20)
(segment-common texture-pool-segment :inline :offset 28)
(common-page texture-page 32 :offset-assert 52)
(common-page-mask int32 :offset-assert 180)
(update-sprites-flag basic :offset-assert 184)
(update-flag basic :offset-assert 188)
(texture-enable-user uint64 :offset-assert 192)
(texture-enable-user-menu uint64 :offset-assert 200)
(ids uint32 128 :offset-assert 208)
)
:method-count-assert 26
:size-assert #x2d0
:flag-assert #x1a000002d0
(:methods
(dummy-9 () none 9)
(dummy-10 () none 10)
(dummy-11 () none 11)
(dummy-12 () none 12)
(dummy-13 () none 13)
(dummy-14 () none 14)
(dummy-15 () none 15)
(dummy-16 () none 16)
(dummy-17 () none 17)
(dummy-18 () none 18)
(dummy-19 () none 19)
(dummy-20 () none 20)
(dummy-21 () none 21)
(dummy-22 () none 22)
(dummy-23 () none 23)
(dummy-24 () none 24)
(dummy-25 () none 25)
)
)
(deftype texture-mask (structure)
((mask vector4w :inline :offset-assert 0)
(dist float :offset 12)
(long uint64 2 :offset 0)
(quad uint128 :offset 0)
)
:method-count-assert 9
:size-assert #x10
:flag-assert #x900000010
)
(deftype texture-masks (structure)
((data texture-mask 3 :inline :offset-assert 0)
)
:method-count-assert 9
:size-assert #x30
:flag-assert #x900000030
)
(deftype texture-masks-array (inline-array-class)
((data texture-masks :inline :dynamic :offset-assert 16)
)
:method-count-assert 9
:size-assert #x10
:flag-assert #x900000010
)
(set! (-> texture-masks-array heap-base) (the-as uint 48))
(define *texture-masks* (the-as texture-masks #f))
(define *texture-masks-array* (the-as texture-masks-array #f))
(deftype texture (basic)
((w int16 :offset-assert 4)
(h int16 :offset-assert 6)
(num-mips uint8 :offset-assert 8)
(tex1-control uint8 :offset-assert 9)
(psm gs-psm :offset-assert 10)
(mip-shift uint8 :offset-assert 11)
(clutpsm uint16 :offset-assert 12)
(dest uint16 7 :offset-assert 14)
(clutdest uint16 :offset-assert 28)
(width uint8 7 :offset-assert 30)
(name string :offset-assert 40)
(size uint32 :offset-assert 44)
(uv-dist float :offset-assert 48)
(pad uint32 3 :offset-assert 52)
(masks texture-masks :inline :offset-assert 64)
)
:method-count-assert 9
:size-assert #x70
:flag-assert #x900000070
)
(deftype texture-page-segment (structure)
((block-data pointer :offset-assert 0)
(size uint32 :offset-assert 4)
(dest uint32 :offset-assert 8)
)
:pack-me
:allow-misaligned
:method-count-assert 9
:size-assert #xc
:flag-assert #x90000000c
)
(defun texture-mip->segment ((arg0 int) (arg1 int))
(if (>= 2 arg1)
(+ (- -1 arg0) arg1)
(max 0 (- 2 arg0))
)
)
(deftype texture-page (basic)
((info file-info :offset-assert 4)
(name basic :offset-assert 8)
(id uint32 :offset-assert 12)
(length int32 :offset-assert 16)
(mip0-size uint32 :offset-assert 20)
(size uint32 :offset-assert 24)
(segment texture-page-segment 3 :inline :offset-assert 28)
(dram-size uint32 :offset-assert 64)
(pad uint32 15 :offset-assert 68)
(data texture :dynamic :offset-assert 128)
)
:method-count-assert 14
:size-assert #x80
:flag-assert #xe00000080
(:methods
(dummy-9 () none 9)
(dummy-10 () none 10)
(dummy-11 () none 11)
(dummy-12 () none 12)
(dummy-13 () none 13)
)
)
(deftype shader-ptr (uint32)
((shader uint32 :offset 8 :size 24)
)
:method-count-assert 9
:size-assert #x4
:flag-assert #x900000004
)
(deftype texture-link (structure)
((next shader-ptr :offset-assert 0)
)
:method-count-assert 9
:size-assert #x4
:flag-assert #x900000004
)
(deftype texture-page-dir-entry (structure)
((length int16 :offset-assert 0)
(status uint16 :offset-assert 2)
(page texture-page :offset-assert 4)
(link texture-link :offset-assert 8)
)
:pack-me
:allow-misaligned
:method-count-assert 9
:size-assert #xc
:flag-assert #x90000000c
)
(deftype texture-page-dir (basic)
((length int32 :offset-assert 4)
(entries texture-page-dir-entry 1 :inline :offset-assert 8)
)
:method-count-assert 10
:size-assert #x14
:flag-assert #xa00000014
(:methods
(relocate (_type_ kheap (pointer uint8)) none :replace 7)
(unlink-textures-in-heap! (_type_ kheap) int 9)
)
)
(deftype texture-relocate-later (basic)
((memcpy symbol :offset-assert 4)
(dest uint32 :offset-assert 8)
(source uint32 :offset-assert 12)
(move uint32 :offset-assert 16)
(entry texture-page-dir-entry :offset-assert 20)
(page texture-page :offset-assert 24)
)
:method-count-assert 9
:size-assert #x1c
:flag-assert #x90000001c
)
(define *texture-relocate-later* (new 'global 'texture-relocate-later))
(set! (-> *texture-relocate-later* memcpy) #f)
(define *texture-page-dir* (the-as texture-page-dir #f))
(deftype adgif-shader (structure)
((quad qword 5 :offset-assert 0)
(prims gs-reg64 10 :offset 0)
(reg-0 uint8 :offset 8)
(reg-1 uint8 :offset 24)
(reg-2 uint8 :offset 40)
(reg-3 uint8 :offset 56)
(reg-4 uint8 :offset 72)
(tex0 gs-tex0 :offset 0)
(tex1 gs-tex1 :offset 16)
(miptbp1 gs-miptbp :offset 32)
(clamp gs-clamp :offset 48)
(clamp-reg gs-reg64 :offset 56)
(alpha gs-alpha :offset 64)
(link-test link-test-flags :offset 8)
(texture-id texture-id :offset 24)
(next shader-ptr :offset 40)
)
:method-count-assert 9
:size-assert #x50
:flag-assert #x900000050
)
(deftype adgif-shader-array (inline-array-class)
((data adgif-shader :inline :dynamic :offset-assert 16)
)
:method-count-assert 9
:size-assert #x10
:flag-assert #x900000010
)
(set! (-> adgif-shader-array heap-base) (the-as uint 80))
(deftype texture-base (structure)
((vram-page uint32 :offset-assert 0)
(vram-block uint32 :offset-assert 4)
(vram-word uint32 :offset-assert 8)
)
:method-count-assert 9
:size-assert #xc
:flag-assert #x90000000c
)
(define ct32-24-block-table
(new 'static 'boxed-array :type int32
0 1 4 5 16 17 20 21 2 3 6 7 18 19 22 23 8 9 12 13
24 25 28 29 10 11 14 15 26 27 30 31
)
)
(define mz32-24-block-table
(new 'static 'boxed-array :type int32
16 17 20 21 0 1 4 5 18 19 22 23 2 3 6 7 24
25 28 29 8 9 12 13 26 27 30 31 10 11 14 15
)
)
(define ct16-block-table
(new 'static 'boxed-array :type int32
0 2 8 10 1 3 9 11 4 6 12 14 5 7 13 15 16
18 24 26 17 19 25 27 20 22 28 30 21 23 29 31
)
)
(define ct16s-block-table
(new 'static 'boxed-array :type int32
0 2 16 18 1 3 17 19 8 10 24 26 9 11 25 27 4
6 20 22 5 7 21 23 12 14 28 30 13 15 29 31
)
)
(define mz16-block-table
(new 'static 'boxed-array :type int32
16 18 24 26 17 19 25 27 20 22 28 30 21 23
29 31 0 2 8 10 1 3 9 11 4 6 12 14 5 7 13 15
)
)
(define mz16s-block-table
(new 'static 'boxed-array :type int32
16 18 0 2 17 19 1 3 24 26 8 10 25 27 9
11 20 22 4 6 21 23 5 7 28 30 12 14 29 31 13 15
)
)
(define mt8-block-table
(new 'static 'boxed-array :type int32
0 1 4 5 16 17 20 21 2 3 6 7 18 19 22 23 8 9 12 13
24 25 28 29 10 11 14 15 26 27 30 31
)
)
(define mt4-block-table
(new 'static 'boxed-array :type int32
0 2 8 10 1 3 9 11 4 6 12 14 5 7 13 15
16 18 24 26 17 19 25 27 20 22 28 30 21 23 29 31
)
)
(deftype texture-page-translate-item (structure)
((bucket bucket-id :offset-assert 0)
(level-index uint32 :offset-assert 4)
(level-texture-page uint32 :offset-assert 8)
(texture-user uint32 :offset-assert 12)
)
:method-count-assert 9
:size-assert #x10
:flag-assert #x900000010
)
(define *texture-page-translate*
(new 'static 'boxed-array :type texture-page-translate-item
(new 'static 'texture-page-translate-item
:bucket (bucket-id bucket-4)
:level-index #x6
:level-texture-page #x9
:texture-user #x100
)
(new 'static 'texture-page-translate-item :bucket (bucket-id bucket-7) :texture-user #x1)
(new 'static 'texture-page-translate-item :bucket (bucket-id bucket-18) :level-index #x1 :texture-user #x1)
(new 'static 'texture-page-translate-item :bucket (bucket-id bucket-29) :level-index #x2 :texture-user #x1)
(new 'static 'texture-page-translate-item :bucket (bucket-id bucket-40) :level-index #x3 :texture-user #x1)
(new 'static 'texture-page-translate-item :bucket (bucket-id bucket-51) :level-index #x4 :texture-user #x1)
(new 'static 'texture-page-translate-item :bucket (bucket-id bucket-62) :level-index #x5 :texture-user #x1)
(new 'static 'texture-page-translate-item :bucket (bucket-id bucket-73) :level-texture-page #x2 :texture-user #x4)
(new 'static 'texture-page-translate-item :bucket (bucket-id bucket-82) :level-index #x1 :level-texture-page #x2 :texture-user #x4)
(new 'static 'texture-page-translate-item :bucket (bucket-id bucket-91) :level-index #x2 :level-texture-page #x2 :texture-user #x4)
(new 'static 'texture-page-translate-item :bucket (bucket-id bucket-100) :level-index #x3 :level-texture-page #x2 :texture-user #x4)
(new 'static 'texture-page-translate-item
:bucket (bucket-id bucket-109)
:level-index #x4
:level-texture-page #x2
:texture-user #x4
)
(new 'static 'texture-page-translate-item
:bucket (bucket-id bucket-118)
:level-index #x5
:level-texture-page #x2
:texture-user #x4
)
(new 'static 'texture-page-translate-item
:bucket (bucket-id bucket-127)
:level-texture-page #x3
:texture-user #x8
)
(new 'static 'texture-page-translate-item
:bucket (bucket-id bucket-137)
:level-index #x1
:level-texture-page #x3
:texture-user #x8
)
(new 'static 'texture-page-translate-item
:bucket (bucket-id bucket-147)
:level-index #x2
:level-texture-page #x3
:texture-user #x8
)
(new 'static 'texture-page-translate-item
:bucket (bucket-id bucket-157)
:level-index #x3
:level-texture-page #x3
:texture-user #x8
)
(new 'static 'texture-page-translate-item
:bucket (bucket-id bucket-167)
:level-index #x4
:level-texture-page #x3
:texture-user #x8
)
(new 'static 'texture-page-translate-item
:bucket (bucket-id bucket-177)
:level-index #x5
:level-texture-page #x3
:texture-user #x8
)
(new 'static 'texture-page-translate-item :bucket (bucket-id bucket-187) :level-index #x6 :texture-user #x1)
(new 'static 'texture-page-translate-item
:bucket (bucket-id bucket-191)
:level-index #x6
:level-texture-page #x2
:texture-user #x4
)
(new 'static 'texture-page-translate-item
:bucket (bucket-id bucket-196)
:level-texture-page #x1
:texture-user #x2
)
(new 'static 'texture-page-translate-item
:bucket (bucket-id bucket-200)
:level-index #x1
:level-texture-page #x1
:texture-user #x2
)
(new 'static 'texture-page-translate-item
:bucket (bucket-id bucket-204)
:level-index #x2
:level-texture-page #x1
:texture-user #x2
)
(new 'static 'texture-page-translate-item
:bucket (bucket-id bucket-208)
:level-index #x3
:level-texture-page #x1
:texture-user #x2
)
(new 'static 'texture-page-translate-item
:bucket (bucket-id bucket-212)
:level-index #x4
:level-texture-page #x1
:texture-user #x2
)
(new 'static 'texture-page-translate-item
:bucket (bucket-id bucket-216)
:level-index #x5
:level-texture-page #x1
:texture-user #x2
)
(new 'static 'texture-page-translate-item
:bucket (bucket-id bucket-220)
:level-index #x6
:level-texture-page #x1
:texture-user #x2
)
(new 'static 'texture-page-translate-item
:bucket (bucket-id bucket-224)
:level-texture-page #x6
:texture-user #x2
)
(new 'static 'texture-page-translate-item
:bucket (bucket-id bucket-228)
:level-index #x1
:level-texture-page #x6
:texture-user #x2
)
(new 'static 'texture-page-translate-item
:bucket (bucket-id bucket-232)
:level-index #x2
:level-texture-page #x6
:texture-user #x2
)
(new 'static 'texture-page-translate-item
:bucket (bucket-id bucket-236)
:level-index #x3
:level-texture-page #x6
:texture-user #x2
)
(new 'static 'texture-page-translate-item
:bucket (bucket-id bucket-240)
:level-index #x4
:level-texture-page #x6
:texture-user #x2
)
(new 'static 'texture-page-translate-item
:bucket (bucket-id bucket-244)
:level-index #x5
:level-texture-page #x6
:texture-user #x2
)
(new 'static 'texture-page-translate-item
:bucket (bucket-id bucket-248)
:level-index #x6
:level-texture-page #x6
:texture-user #x2
)
(new 'static 'texture-page-translate-item
:bucket (bucket-id bucket-252)
:level-texture-page #x4
:texture-user #x10
)
(new 'static 'texture-page-translate-item
:bucket (bucket-id bucket-261)
:level-index #x1
:level-texture-page #x4
:texture-user #x10
)
(new 'static 'texture-page-translate-item
:bucket (bucket-id bucket-270)
:level-index #x2
:level-texture-page #x4
:texture-user #x10
)
(new 'static 'texture-page-translate-item
:bucket (bucket-id bucket-279)
:level-index #x3
:level-texture-page #x4
:texture-user #x10
)
(new 'static 'texture-page-translate-item
:bucket (bucket-id bucket-288)
:level-index #x4
:level-texture-page #x4
:texture-user #x10
)
(new 'static 'texture-page-translate-item
:bucket (bucket-id bucket-297)
:level-index #x5
:level-texture-page #x4
:texture-user #x10
)
(new 'static 'texture-page-translate-item
:bucket (bucket-id bucket-306)
:level-index #x6
:level-texture-page #x4
:texture-user #x10
)
(new 'static 'texture-page-translate-item
:bucket (bucket-id bucket-309)
:level-index #x6
:level-texture-page #x9
:texture-user #x100
)
(new 'static 'texture-page-translate-item
:bucket (bucket-id bucket-312)
:level-texture-page #x7
:texture-user #x40
)
(new 'static 'texture-page-translate-item
:bucket (bucket-id bucket-312)
:level-index #x1
:level-texture-page #x7
:texture-user #x40
)
(new 'static 'texture-page-translate-item
:bucket (bucket-id bucket-312)
:level-index #x2
:level-texture-page #x7
:texture-user #x40
)
(new 'static 'texture-page-translate-item
:bucket (bucket-id bucket-312)
:level-index #x3
:level-texture-page #x7
:texture-user #x40
)
(new 'static 'texture-page-translate-item
:bucket (bucket-id bucket-312)
:level-index #x4
:level-texture-page #x7
:texture-user #x40
)
(new 'static 'texture-page-translate-item
:bucket (bucket-id bucket-312)
:level-index #x5
:level-texture-page #x7
:texture-user #x40
)
(new 'static 'texture-page-translate-item
:bucket (bucket-id bucket-312)
:level-index #x6
:level-texture-page #x7
:texture-user #x40
)
(new 'static 'texture-page-translate-item
:bucket (bucket-id bucket-316)
:level-texture-page #x5
:texture-user #x20
)
(new 'static 'texture-page-translate-item
:bucket (bucket-id bucket-316)
:level-index #x1
:level-texture-page #x5
:texture-user #x20
)
(new 'static 'texture-page-translate-item
:bucket (bucket-id bucket-316)
:level-index #x2
:level-texture-page #x5
:texture-user #x20
)
(new 'static 'texture-page-translate-item
:bucket (bucket-id bucket-316)
:level-index #x3
:level-texture-page #x5
:texture-user #x20
)
(new 'static 'texture-page-translate-item
:bucket (bucket-id bucket-316)
:level-index #x4
:level-texture-page #x5
:texture-user #x20
)
(new 'static 'texture-page-translate-item
:bucket (bucket-id bucket-316)
:level-index #x5
:level-texture-page #x5
:texture-user #x20
)
(new 'static 'texture-page-translate-item
:bucket (bucket-id bucket-316)
:level-index #x6
:level-texture-page #x5
:texture-user #x20
)
(new 'static 'texture-page-translate-item
:bucket (bucket-id bucket-319)
:level-texture-page #x8
:texture-user #x80
)
(new 'static 'texture-page-translate-item
:bucket (bucket-id bucket-319)
:level-index #x1
:level-texture-page #x8
:texture-user #x80
)
(new 'static 'texture-page-translate-item
:bucket (bucket-id bucket-319)
:level-index #x2
:level-texture-page #x8
:texture-user #x80
)
(new 'static 'texture-page-translate-item
:bucket (bucket-id bucket-319)
:level-index #x3
:level-texture-page #x8
:texture-user #x80
)
(new 'static 'texture-page-translate-item
:bucket (bucket-id bucket-319)
:level-index #x4
:level-texture-page #x8
:texture-user #x80
)
(new 'static 'texture-page-translate-item
:bucket (bucket-id bucket-319)
:level-index #x5
:level-texture-page #x8
:texture-user #x80
)
(new 'static 'texture-page-translate-item
:bucket (bucket-id bucket-319)
:level-index #x6
:level-texture-page #x8
:texture-user #x80
)
(new 'static 'texture-page-translate-item
:bucket (bucket-id bucket-319)
:level-index #x6
:level-texture-page #x3
:texture-user #x80
)
)
)
(define *eyes-texture-base* (new 'static 'texture-base))
(define *skull-gem-texture-base* (new 'static 'texture-base))
(define *ocean-texture-base* (new 'static 'texture-base))
(define *ocean-envmap-texture-base* (new 'static 'texture-base))
(define *grey-scale-base* (new 'static 'texture-base))
(define *map-texture-base* (new 'static 'texture-base))
+400
View File
@@ -5,3 +5,403 @@
;; name in dgo: vu1-user-h
;; dgos: ENGINE, GAME
(defenum bucket-id
:type int32
:bitfield #f
(bucket-0 0)
(bucket-1 1)
(bucket-2 2)
(bucket-3 3)
(bucket-4 4)
(bucket-5 5)
(bucket-6 6)
(bucket-7 7) ;; level 0 tex
(bucket-8 8)
(bucket-9 9)
(bucket-10 10)
(bucket-11 11)
(bucket-12 12)
(bucket-13 13)
(bucket-14 14)
(bucket-15 15)
(bucket-16 16)
(bucket-17 17)
(bucket-18 18)
(bucket-19 19)
(bucket-20 20)
(bucket-21 21)
(bucket-22 22)
(bucket-23 23)
(bucket-24 24)
(bucket-25 25)
(bucket-26 26)
(bucket-27 27)
(bucket-28 28)
(bucket-29 29)
(bucket-30 30)
(bucket-31 31)
(bucket-32 32)
(bucket-33 33)
(bucket-34 34)
(bucket-35 35)
(bucket-36 36)
(bucket-37 37)
(bucket-38 38)
(bucket-39 39)
(bucket-40 40)
(bucket-41 41)
(bucket-42 42)
(bucket-43 43)
(bucket-44 44)
(bucket-45 45)
(bucket-46 46)
(bucket-47 47)
(bucket-48 48)
(bucket-49 49)
(bucket-50 50)
(bucket-51 51)
(bucket-52 52)
(bucket-53 53)
(bucket-54 54)
(bucket-55 55)
(bucket-56 56)
(bucket-57 57)
(bucket-58 58)
(bucket-59 59)
(bucket-60 60)
(bucket-61 61)
(bucket-62 62)
(bucket-63 63)
(bucket-64 64)
(bucket-65 65)
(bucket-66 66)
(bucket-67 67)
(bucket-68 68)
(bucket-69 69)
(bucket-70 70)
(bucket-71 71)
(bucket-72 72)
(bucket-73 73)
(bucket-74 74)
(bucket-75 75)
(bucket-76 76)
(bucket-77 77)
(bucket-78 78)
(bucket-79 79)
(bucket-80 80)
(bucket-81 81)
(bucket-82 82)
(bucket-83 83)
(bucket-84 84)
(bucket-85 85)
(bucket-86 86)
(bucket-87 87)
(bucket-88 88)
(bucket-89 89)
(bucket-90 90)
(bucket-91 91)
(bucket-92 92)
(bucket-93 93)
(bucket-94 94)
(bucket-95 95)
(bucket-96 96)
(bucket-97 97)
(bucket-98 98)
(bucket-99 99)
(bucket-100 100)
(bucket-101 101)
(bucket-102 102)
(bucket-103 103)
(bucket-104 104)
(bucket-105 105)
(bucket-106 106)
(bucket-107 107)
(bucket-108 108)
(bucket-109 109)
(bucket-110 110)
(bucket-111 111)
(bucket-112 112)
(bucket-113 113)
(bucket-114 114)
(bucket-115 115)
(bucket-116 116)
(bucket-117 117)
(bucket-118 118)
(bucket-119 119)
(bucket-120 120)
(bucket-121 121)
(bucket-122 122)
(bucket-123 123)
(bucket-124 124)
(bucket-125 125)
(bucket-126 126)
(bucket-127 127)
(bucket-128 128)
(bucket-129 129)
(bucket-130 130)
(bucket-131 131)
(bucket-132 132)
(bucket-133 133)
(bucket-134 134)
(bucket-135 135)
(bucket-136 136)
(bucket-137 137)
(bucket-138 138)
(bucket-139 139)
(bucket-140 140)
(bucket-141 141)
(bucket-142 142)
(bucket-143 143)
(bucket-144 144)
(bucket-145 145)
(bucket-146 146)
(bucket-147 147)
(bucket-148 148)
(bucket-149 149)
(bucket-150 150)
(bucket-151 151)
(bucket-152 152)
(bucket-153 153)
(bucket-154 154)
(bucket-155 155)
(bucket-156 156)
(bucket-157 157)
(bucket-158 158)
(bucket-159 159)
(bucket-160 160)
(bucket-161 161)
(bucket-162 162)
(bucket-163 163)
(bucket-164 164)
(bucket-165 165)
(bucket-166 166)
(bucket-167 167)
(bucket-168 168)
(bucket-169 169)
(bucket-170 170)
(bucket-171 171)
(bucket-172 172)
(bucket-173 173)
(bucket-174 174)
(bucket-175 175)
(bucket-176 176)
(bucket-177 177)
(bucket-178 178)
(bucket-179 179)
(bucket-180 180)
(bucket-181 181)
(bucket-182 182)
(bucket-183 183)
(bucket-184 184)
(bucket-185 185)
(bucket-186 186)
(bucket-187 187)
(bucket-188 188)
(bucket-189 189)
(bucket-190 190)
(bucket-191 191)
(bucket-192 192)
(bucket-193 193)
(bucket-194 194)
(bucket-195 195)
(bucket-196 196)
(bucket-197 197)
(bucket-198 198)
(bucket-199 199)
(bucket-200 200)
(bucket-201 201)
(bucket-202 202)
(bucket-203 203)
(bucket-204 204)
(bucket-205 205)
(bucket-206 206)
(bucket-207 207)
(bucket-208 208)
(bucket-209 209)
(bucket-210 210)
(bucket-211 211)
(bucket-212 212)
(bucket-213 213)
(bucket-214 214)
(bucket-215 215)
(bucket-216 216)
(bucket-217 217)
(bucket-218 218)
(bucket-219 219)
(bucket-220 220)
(bucket-221 221)
(bucket-222 222)
(bucket-223 223)
(bucket-224 224)
(bucket-225 225)
(bucket-226 226)
(bucket-227 227)
(bucket-228 228)
(bucket-229 229)
(bucket-230 230)
(bucket-231 231)
(bucket-232 232)
(bucket-233 233)
(bucket-234 234)
(bucket-235 235)
(bucket-236 236)
(bucket-237 237)
(bucket-238 238)
(bucket-239 239)
(bucket-240 240)
(bucket-241 241)
(bucket-242 242)
(bucket-243 243)
(bucket-244 244)
(bucket-245 245)
(bucket-246 246)
(bucket-247 247)
(bucket-248 248)
(bucket-249 249)
(bucket-250 250)
(bucket-251 251)
(bucket-252 252)
(bucket-253 253)
(bucket-254 254)
(bucket-255 255)
(bucket-256 256)
(bucket-257 257)
(bucket-258 258)
(bucket-259 259)
(bucket-260 260)
(bucket-261 261)
(bucket-262 262)
(bucket-263 263)
(bucket-264 264)
(bucket-265 265)
(bucket-266 266)
(bucket-267 267)
(bucket-268 268)
(bucket-269 269)
(bucket-270 270)
(bucket-271 271)
(bucket-272 272)
(bucket-273 273)
(bucket-274 274)
(bucket-275 275)
(bucket-276 276)
(bucket-277 277)
(bucket-278 278)
(bucket-279 279)
(bucket-280 280)
(bucket-281 281)
(bucket-282 282)
(bucket-283 283)
(bucket-284 284)
(bucket-285 285)
(bucket-286 286)
(bucket-287 287)
(bucket-288 288)
(bucket-289 289)
(bucket-290 290)
(bucket-291 291)
(bucket-292 292)
(bucket-293 293)
(bucket-294 294)
(bucket-295 295)
(bucket-296 296)
(bucket-297 297)
(bucket-298 298)
(bucket-299 299)
(bucket-300 300)
(bucket-301 301)
(bucket-302 302)
(bucket-303 303)
(bucket-304 304)
(bucket-305 305)
(bucket-306 306)
(bucket-307 307)
(bucket-308 308)
(bucket-309 309)
(bucket-310 310)
(bucket-311 311)
(bucket-312 312)
(bucket-313 313)
(bucket-314 314)
(bucket-315 315)
(bucket-316 316)
(bucket-317 317)
(bucket-318 318)
(bucket-319 319)
(bucket-320 320)
(bucket-321 321)
(bucket-322 322)
(bucket-323 323)
(bucket-324 324)
(debug 325)
)
(defenum vu1-renderer-mask
:type uint64
:bitfield #t
(rn0)
(rn1)
(rn2)
(rn3)
(rn4)
(rn5)
(rn6)
(rn7)
(rn8)
(rn9)
(rn10)
(rn11)
(rn12)
(rn13)
(rn14)
(rn15)
(rn16)
(rn17)
(rn18)
(rn19)
(rn20)
(rn21)
(rn22)
(rn23)
(rn24)
(rn25)
(rn26)
(rn27)
(rn28)
(rn29)
(rn30)
(rn31)
(rn32)
(rn33)
(rn34)
)
(deftype dma-foreground-sink (basic)
((bucket bucket-id :offset-assert 4)
(foreground-texture-page int8 :offset-assert 8)
(foreground-texture-level int8 :offset-assert 9)
(foreground-output-bucket int8 :offset-assert 10)
)
:method-count-assert 9
:size-assert #xb
:flag-assert #x90000000b
)
(deftype generic-bucket-state (structure)
((gifbuf-adr uint32 :offset-assert 0)
(inbuf-adr uint32 :offset-assert 4)
)
:allow-misaligned
:method-count-assert 9
:size-assert #x8
:flag-assert #x900000008
)
(deftype generic-dma-foreground-sink (dma-foreground-sink)
((state generic-bucket-state :inline :offset-assert 12)
)
:method-count-assert 9
:size-assert #x14
:flag-assert #x900000014
)
+487
View File
@@ -5,3 +5,490 @@
;; name in dgo: level-h
;; dgos: ENGINE, GAME
(declare-type bsp-header basic)
(declare-type drawable basic)
(declare-type entity-links structure)
(defenum vis-info-flag
:type uint32
:bitfield #t
(dummy0 0)
(dummy1 1)
(dummy2 2)
(dummy3 3)
(dummy4 4)
(dummy5 5)
(dummy6 6)
(dummy7 7)
(dummy8 8)
(dummy9 9)
(dummy10 10)
(dummy11 11)
(dummy12 12)
(dummy13 13)
(dummy14 14)
(dummy15 15)
(dummy16 16)
(dummy17 17)
(dummy18 18)
(dummy19 19)
(dummy20 20)
(dummy21 21)
(dummy22 22)
(dummy23 23)
(dummy24 24)
(dummy25 25)
(dummy26 26)
(dummy27 27)
(dummy28 28)
(in-iop 29)
(loading 30)
(vis-valid 31)
)
(defenum task-mask
:type uint32
:bitfield #t
(task0 0) ;; 0x1
(task1 1) ;; 0x2
(task2 2) ;; 0x4
(task3 3) ;; 0x8
(task4 4) ;; 0x10
(task5 5) ;; 0x20
(task6 6) ;; 0x40
(task7 7) ;; 0x80
(done 8) ;; 0x100
(dummy0 9) ;; 0x200
(dummy1 10) ;; 0x400
(dummy2 11) ;; 0x800
(special 12) ;; 0x1000
(primary0 13) ;; 0x2000
(ctywide 14) ;; 0x4000
(never 15) ;; 0x8000
(movie0 16) ;; 0x10000
(movie1 17) ;; 0x20000
(movie2 18) ;; 0x40000
)
(deftype level-vis-info (basic)
((level level :offset-assert 4)
(from-level level :offset-assert 8)
(from-bsp bsp-header :offset-assert 12)
(flags vis-info-flag :offset-assert 16)
(length uint32 :offset-assert 20)
(allocated-length uint32 :offset-assert 24)
(dictionary-length uint32 :offset-assert 28)
(dictionary uint32 :offset-assert 32)
(string-block uint32 :offset-assert 36)
(ramdisk uint32 :offset-assert 40)
(vis-bits uint32 :offset-assert 44)
(current-vis-string uint32 :offset-assert 48)
(vis-string uint32 :dynamic :offset-assert 52)
)
:method-count-assert 9
:size-assert #x34
:flag-assert #x900000034
)
(defmethod asize-of level-vis-info ((obj level-vis-info))
(the-as int (+ (-> level-vis-info size) (-> obj dictionary-length)))
)
(deftype level-load-info (basic)
((name-list string 6 :offset-assert 4)
(index int16 :offset-assert 28)
(task-level uint8 :offset-assert 30)
(name string :offset 4)
(visname string :offset 8)
(nickname string :offset 12)
(dbname string :offset 16)
(taskname string :offset 20)
(packages pair :offset-assert 32)
(memory-mode uint32 :offset-assert 36)
(music-bank basic :offset-assert 40)
(ambient-sounds basic :offset-assert 44)
(sound-reverb float :offset-assert 48)
(mood-func basic :offset-assert 52)
(mood-init basic :offset-assert 56)
(ocean basic :offset-assert 60)
(sky basic :offset-assert 64)
(use-camera-other basic :offset-assert 68)
(part-engine-max int32 :offset-assert 72)
(city-map-bits uint64 :offset-assert 80)
(continues basic :offset-assert 88)
(tasks basic :offset-assert 92)
(priority int32 :offset-assert 96)
(load-commands basic :offset-assert 100)
(alt-load-commands basic :offset-assert 104)
(bsp-mask uint64 :offset-assert 112)
(buzzer int32 :offset-assert 120)
(buttom-height meters :offset-assert 124)
(run-packages basic :offset-assert 128)
(prev-level basic :offset-assert 132)
(next-level basic :offset-assert 136)
(wait-for-load symbol :offset-assert 140)
(login-func basic :offset-assert 144)
(activate-func basic :offset-assert 148)
(deactivate-func basic :offset-assert 152)
(kill-func basic :offset-assert 156)
(borrow-size uint16 2 :offset-assert 160)
(borrow-level symbol 2 :offset-assert 164)
(borrow-display? basic 2 :offset-assert 172)
(base-task-mask task-mask :offset-assert 180)
(texture-anim basic 10 :offset-assert 184)
(texture-anim-tfrag basic :offset 184)
(texture-anim-pris basic :offset 188)
(texture-anim-shrub basic :offset 192)
(texture-anim-alpha basic :offset 196)
(texture-anim-water basic :offset 200)
(texture-anim-twarp basic :offset 204)
(texture-anim-pris2 basic :offset 208)
(texture-anim-sprite basic :offset 212)
(texture-anim-map basic :offset 216)
(texture-anim-sky basic :offset 220)
(draw-priority float :offset-assert 224)
(level-flags uint32 :offset-assert 228)
(fog-height float :offset-assert 232)
(bigmap-id uint32 :offset-assert 236)
(ocean-near-translucent? symbol :offset-assert 240)
(ocean-far? symbol :offset-assert 244)
(mood-range mood-range :inline :offset-assert 256)
(max-rain float :offset-assert 272)
(fog-mult float :offset-assert 276)
(ocean-alpha float :offset-assert 280)
(extra-sound-bank basic :offset-assert 284)
)
:method-count-assert 9
:size-assert #x120
:flag-assert #x900000120
)
(deftype login-state (basic)
((state int32 :offset-assert 4)
(pos uint32 :offset-assert 8)
(elts uint32 :offset-assert 12)
(elt drawable 16 :offset-assert 16)
)
:method-count-assert 9
:size-assert #x50
:flag-assert #x900000050
)
(deftype level (basic)
((name symbol :offset-assert 4)
(load-name basic :offset-assert 8)
(nickname basic :offset-assert 12)
(index int32 :offset-assert 16)
(status symbol :offset-assert 20)
(borrow-level basic 2 :offset-assert 24)
(borrow-from-level basic :offset-assert 32)
(heap kheap :inline :offset-assert 48)
(borrow-heap kheap 2 :inline :offset-assert 64)
(bsp bsp-header :offset-assert 96)
(art-group basic :offset-assert 100)
(info basic :offset-assert 104)
(texture-page texture-page 18 :offset-assert 108)
(loaded-texture-page texture-page 16 :offset-assert 180)
(loaded-texture-page-count int32 :offset-assert 244)
(entity basic :offset-assert 248)
(closest-object float :offset-assert 252)
(upload-size int32 18 :offset 324)
(inside-boxes symbol :offset-assert 396)
(display? symbol :offset-assert 400)
(render? symbol :offset-assert 404)
(meta-inside? symbol :offset-assert 408)
(force-inside? symbol :offset-assert 412)
(mood-context mood-context :inline :offset-assert 416)
(mood-func basic :offset-assert 2384)
(mood-init basic :offset-assert 2388)
(vis-bits pointer :offset-assert 2392)
(all-visible? symbol :offset-assert 2396)
(force-all-visible? symbol :offset-assert 2400)
(linking basic :offset-assert 2404)
(vis-info level-vis-info 8 :offset-assert 2408)
(vis-self-index int32 :offset-assert 2440)
(vis-adj-index int32 :offset-assert 2444)
(vis-buffer uint8 2048 :offset-assert 2448)
(mem-usage-block basic :offset-assert 4496)
(mem-usage int32 :offset-assert 4500)
(code-memory-start pointer :offset-assert 4504)
(code-memory-end pointer :offset-assert 4508)
(load-start-time time-frame :offset-assert 4512)
(load-stop-time time-frame :offset-assert 4520)
(load-buffer basic 2 :offset-assert 4528)
(load-buffer-size uint32 :offset-assert 4536)
(load-buffer-last uint32 :offset-assert 4540)
(load-buffer-mode uint32 :offset-assert 4544)
(display-start-time time-frame :offset-assert 4552)
(memory-mask uint32 :offset-assert 4560)
(task-mask task-mask :offset-assert 4564)
(tfrag-gs-test uint64 :offset-assert 4568)
(texture-dirty-masks texture-mask 10 :inline :offset-assert 4576)
(texture-mask texture-mask 18 :inline :offset-assert 4736)
(sky-mask texture-mask :inline :offset-assert 5024)
(tfrag-masks basic :offset-assert 5040)
(tfrag-dists pointer :offset-assert 5044)
(shrub-masks basic :offset-assert 5048)
(shrub-dists pointer :offset-assert 5052)
(alpha-masks basic :offset-assert 5056)
(alpha-dists pointer :offset-assert 5060)
(water-masks basic :offset-assert 5064)
(water-dists pointer :offset-assert 5068)
(tfrag-last-calls int32 6 :offset-assert 5072)
(texture-anim-array texture-anim-array 10 :offset-assert 5096)
(light-hash basic :offset-assert 5136)
(draw-priority float :offset-assert 5140)
(draw-index int32 :offset-assert 5144)
(part-engine basic :offset-assert 5148)
(user-object basic 4 :offset-assert 5152)
(loaded-text-info-count int32 :offset-assert 5168)
(loaded-text-info object 8 :offset-assert 5172)
(level-type basic :offset-assert 5204)
(load-order int64 :offset-assert 5208)
(pad int8 12 :offset-assert 5216)
)
:method-count-assert 30
:size-assert #x146c
:flag-assert #x1e0000146c
(:methods
(dummy-9 () none 9)
(dummy-10 () none 10)
(dummy-11 () none 11)
(dummy-12 () none 12)
(dummy-13 () none 13)
(dummy-14 () none 14)
(dummy-15 () none 15)
(dummy-16 () none 16)
(dummy-17 () none 17)
(dummy-18 () none 18)
(dummy-19 () none 19)
(dummy-20 () none 20)
(dummy-21 () none 21)
(dummy-22 () none 22)
(dummy-23 () none 23)
(dummy-24 () none 24)
(dummy-25 () none 25)
(dummy-26 () none 26)
(dummy-27 () none 27)
(dummy-28 () none 28)
(dummy-29 () none 29)
)
)
(deftype level-group (basic)
((length int32 :offset-assert 4)
(log-in-level-bsp bsp-header :offset-assert 8)
(loading-level level :offset-assert 12)
(entity-link entity-links :offset 16)
(border? symbol :offset-assert 20)
(vis? symbol :offset-assert 24)
(want-level basic :offset-assert 28)
(receiving-level basic :offset-assert 32)
(load-commands basic :offset-assert 36)
(play? symbol :offset-assert 40)
(target-pos vector 2 :inline :offset-assert 48)
(camera-pos vector 2 :inline :offset-assert 80)
(heap kheap :inline :offset-assert 112)
(sound-bank basic 4 :offset-assert 128)
(disk-load-timing? symbol :offset-assert 144)
(load-level basic :offset-assert 148)
(load-size uint32 :offset-assert 152)
(load-time float :offset-assert 156)
(load-login-time float :offset-assert 160)
(draw-level-count int32 :offset-assert 164)
(draw-level basic 7 :offset-assert 168)
(draw-index-map uint8 7 :offset-assert 196)
(load-order uint64 :offset-assert 208)
(pad uint8 30 :offset-assert 216)
(level level 7 :inline :offset-assert 256)
(level0 level :inline :offset 256)
(level1 level :inline :offset 5488)
(level2 level :inline :offset 10720)
(level3 level :inline :offset 15952)
(level4 level :inline :offset 21184)
(level5 level :inline :offset 26416)
(default-level level :inline :offset 31648)
(pad2 uint8 4 :offset-assert 36880)
)
:method-count-assert 31
:size-assert #x9014
:flag-assert #x1f00009014
(:methods
(dummy-9 () none 9)
(dummy-10 () none 10)
(dummy-11 () none 11)
(dummy-12 () none 12)
(dummy-13 () none 13)
(dummy-14 () none 14)
(dummy-15 () none 15)
(dummy-16 () none 16)
(dummy-17 () none 17)
(dummy-18 () none 18)
(dummy-19 () none 19)
(dummy-20 () none 20)
(dummy-21 () none 21)
(dummy-22 () none 22)
(dummy-23 () none 23)
(dummy-24 () none 24)
(dummy-25 () none 25)
(dummy-26 () none 26)
(dummy-27 () none 27)
(dummy-28 () none 28)
(dummy-29 () none 29)
(dummy-30 () none 30)
)
)
(defmethod inspect level-group ((obj level-group))
(when (not obj)
(set! obj obj)
(goto cfg-13)
)
(format #t "[~8x] ~A~%" obj (-> obj type))
(format #t "~1Tlength: ~D~%" (-> obj length))
(format #t "~1Tentity-link: ~`entity-links`P~%" (-> obj entity-link))
(format #t "~1Tborder?: ~A~%" (-> obj border?))
(format #t "~1Tvis?: ~A~%" (-> obj vis?))
(format #t "~1Twant-level: ~A~%" (-> obj want-level))
(format #t "~1Treceiving-level: ~A~%" (-> obj receiving-level))
(format #t "~1Tload-commands: ~A~%" (-> obj load-commands))
(format #t "~1Tplay?: ~A~%" (-> obj play?))
(format #t "~1Ttarget-pos[2] @ #x~X~%" (-> obj target-pos))
(dotimes (s5-0 2)
(format #t "~T [~D]~1Ttarget-pos: ~`vector`P~%" s5-0 (-> obj target-pos s5-0))
)
(format #t "~1Tcamera-pos[2] @ #x~X~%" (-> obj camera-pos))
(dotimes (s5-1 2)
(format #t "~T [~D]~1Tcamera-pos: ~`vector`P~%" s5-1 (-> obj camera-pos s5-1))
)
(format #t "~1Theap: #<kheap @ #x~X>~%" (-> obj heap))
(format #t "~1Tsound-bank[4] @ #x~X~%" (-> obj sound-bank))
(format #t "~1Tdisk-load-timing?: ~A~%" (-> obj disk-load-timing?))
(format #t "~1Tload-level: ~A~%" (-> obj load-level))
(format #t "~1Tload-size: ~D~%" (-> obj load-size))
(format #t "~1Tload-time: ~f~%" (-> obj load-time))
(format #t "~1Tload-login-time: ~f~%" (-> obj load-login-time))
(format #t "~1Tdraw-level-count: ~D~%" (-> obj draw-level-count))
(format #t "~1Tdraw-level[7] @ #x~X~%" (-> obj draw-level))
(dotimes (s5-2 (-> obj draw-level-count))
(format #t "~T [~D]~1Tdraw-level: ~`object`P~%" s5-2 (-> obj draw-level s5-2))
)
(format #t "~1Tdraw-index-map[7] @ #x~X~%" (-> obj draw-index-map))
(format #t "~1Tload-order: ~D~%" (-> obj load-order))
(format #t "~1Tlevel[7] @ #x~X~%" (-> obj level))
(format #t "~1Tdata[7] @ #x~X~%" (-> obj level))
(format #t "~1Tlevel0: ~`level`P~%" (-> obj level))
(format #t "~1Tlevel1: ~`level`P~%" (-> obj level1))
(format #t "~1Tlevel2: ~`level`P~%" (-> obj level2))
(format #t "~1Tlevel3: ~`level`P~%" (-> obj level3))
(format #t "~1Tlevel4: ~`level`P~%" (-> obj level4))
(format #t "~1Tlevel5: ~`level`P~%" (-> obj level5))
(format #t "~1Tlevel-default: ~`level`P~%" (-> obj default-level))
(label cfg-13)
obj
)
(define-extern *level* level-group)
(when (zero? *level*)
(define *level* (new 'static 'level-group
:length 6
:log-in-level-bsp #f
:loading-level #f
:entity-link #f
:border? #f
:vis? #f
:want-level #f
:load-commands '()
:play? #f
:sound-bank (new 'static 'array basic 4 #f #f #f #f)
:disk-load-timing? #f
:level (new 'static 'inline-array level 7
(new 'static 'level
:name #f
:status 'inactive
:borrow-level (new 'static 'array basic 2 #f #f)
:borrow-from-level #f
:inside-boxes #f
:force-inside? #f
:linking #f
:level-type #f
)
(new 'static 'level
:name #f
:index 1
:status 'inactive
:borrow-level (new 'static 'array basic 2 #f #f)
:borrow-from-level #f
:inside-boxes #f
:force-inside? #f
:linking #f
:level-type #f
)
(new 'static 'level
:name #f
:index 2
:status 'inactive
:borrow-level (new 'static 'array basic 2 #f #f)
:borrow-from-level #f
:inside-boxes #f
:force-inside? #f
:linking #f
:level-type #f
)
(new 'static 'level
:name #f
:index 3
:status 'inactive
:borrow-level (new 'static 'array basic 2 #f #f)
:borrow-from-level #f
:inside-boxes #f
:force-inside? #f
:linking #f
:level-type #f
)
(new 'static 'level
:name #f
:index 4
:status 'inactive
:borrow-level (new 'static 'array basic 2 #f #f)
:borrow-from-level #f
:inside-boxes #f
:force-inside? #f
:linking #f
:level-type #f
)
(new 'static 'level
:name #f
:index 5
:status 'inactive
:borrow-level (new 'static 'array basic 2 #f #f)
:borrow-from-level #f
:inside-boxes #f
:force-inside? #f
:linking #f
:level-type #f
)
(new 'static 'level
:name 'default
:index 6
:status 'reserved
:borrow-level (new 'static 'array basic 2 #f #f)
:borrow-from-level #f
:bsp #f
:inside-boxes #f
:display? #f
:force-inside? #f
:linking #f
:level-type #f
)
)
)
)
0
)
(define *draw-index* 0)
(define *level-index* 0)
+184
View File
@@ -5,3 +5,187 @@
;; name in dgo: file-io
;; dgos: ENGINE, GAME
(defenum file-kind
:bitfield #f
(level-bt 0) ;; aka bsp-header.
(art-group 1)
(tpage 2)
(dir-tpage 3)
(level-vs 4)
(tx 5)
(vis 6)
(map 7)
)
(deftype file-stream (basic)
((flags uint32 :offset-assert 4)
(mode symbol :offset-assert 8)
(name string :offset-assert 12)
(file uint32 :offset-assert 16)
)
:method-count-assert 9
:size-assert #x14
:flag-assert #x900000014
(:methods
(new (symbol type string symbol) _type_ 0)
)
)
(defmethod new file-stream ((allocation symbol) (type-to-make type) (arg0 string) (arg1 symbol))
(let ((a0-1 (object-new allocation type-to-make (the-as int (-> type-to-make size)))))
(file-stream-open a0-1 arg0 arg1)
)
)
(set! (-> file-stream method-table 4) file-stream-length)
(defun file-stream-read-string ((arg0 file-stream) (arg1 string))
(clear arg1)
(file-stream-read arg0 (-> arg1 data) (length arg0))
arg1
)
(deftype file-info (basic)
((file-type (pointer string) :offset-assert 4) ;; something funny here...
(file-name basic :offset-assert 8)
(major-version uint32 :offset-assert 12)
(minor-version uint32 :offset-assert 16)
(maya-file-name basic :offset-assert 20)
(tool-debug basic :offset-assert 24)
(mdb-file-name basic :offset-assert 28)
)
:method-count-assert 9
:size-assert #x20
:flag-assert #x900000020
)
(defmethod print file-info ((obj file-info))
(format
#t
"#<~A ~A :version ~D.~D @ #x~X>"
(-> obj type)
(-> obj file-name)
(-> obj major-version)
(-> obj minor-version)
obj
)
obj
)
(define *file-temp-string* (new 'global 'string 128 (the-as string #f)))
(defun make-file-name ((arg0 file-kind) (arg1 string) (arg2 int) (arg3 symbol))
(clear *file-temp-string*)
(cond
((= arg0 (file-kind dir-tpage))
(format *file-temp-string* "texture-page~D/dir-tpages" 8)
)
((= arg0 (file-kind tpage))
(format *file-temp-string* "texture-page~D/tpage-~S" 8 arg1)
)
((= arg0 (file-kind level-bt))
(format *file-temp-string* "level~D/~S-bt" 36 arg1)
)
((= arg0 (file-kind tx))
(format *file-temp-string* "res~D/~S-tx" 1 arg1)
)
((= arg0 (file-kind level-vs))
(format *file-temp-string* "level~D/~S-vs" 36 arg1)
)
((= arg0 (file-kind vis))
(format *file-temp-string* "~S.VIS" arg1)
)
((= arg0 (file-kind map))
(format *file-temp-string* "map~D/~S-mp" 1 arg1)
)
((= arg0 (file-kind art-group))
(format
*file-temp-string*
"art-group~D/~S-ag"
(cond
((> arg2 0)
arg2
)
(else
7
)
)
arg1
)
)
)
*file-temp-string*
)
(defun make-vfile-name ((arg0 file-kind) (arg1 string))
(clear *file-temp-string*)
(cond
((= arg0 (file-kind level-bt))
(format *file-temp-string* "$LEVEL/~S" arg1)
)
((= arg0 (file-kind art-group))
(format *file-temp-string* "$ART_GROUP/~S" arg1)
)
)
*file-temp-string*
)
(defun file-info-correct-version? ((arg0 file-info) (arg1 file-kind) (arg2 int))
(let* ((s5-0 (cond
((zero? arg2)
(case arg1
(((file-kind tpage) (file-kind dir-tpage))
8
)
(((file-kind level-bt))
36
)
(((file-kind art-group))
7
)
)
)
(else
arg2
)
)
)
(v1-1 arg1)
(s4-0 (cond
((= v1-1 (file-kind tpage))
"texture-page"
)
((= v1-1 (file-kind level-bt))
"bsp-header"
)
((= v1-1 (file-kind art-group))
"art-group"
)
)
)
)
(cond
((not (name= (-> arg0 file-type 0) s4-0))
(format 0 "ERROR: file ~A is of type ~S but needs to be ~S.~%" (-> arg0 file-name) (-> arg0 file-type) s4-0)
#f
)
((!= s5-0 (-> arg0 major-version))
(format
0
"ERROR: file ~A is version ~D.~D, but needs to be ~D.x~%"
(-> arg0 file-name)
(-> arg0 major-version)
(-> arg0 minor-version)
s5-0
)
#f
)
(else
#t
)
)
)
)
+213
View File
@@ -5,3 +5,216 @@
;; name in dgo: loader-h
;; dgos: ENGINE, GAME
(declare-type art-group basic)
(define-extern art-group type)
(define-extern external-art-buffer-init function)
(deftype load-dir (basic)
((lev level :offset-assert 4)
(string-array (array string) :offset-assert 8)
(data-array (array basic) :offset-assert 12)
)
:method-count-assert 11
:size-assert #x10
:flag-assert #xb00000010
(:methods
(new (symbol type int level) _type_ 0)
(dummy-9 () none 9)
(dummy-10 () none 10)
)
)
(deftype load-dir-art-group (load-dir)
((art-group-array (array art-group) :offset 12)
)
:method-count-assert 11
:size-assert #x10
:flag-assert #xb00000010
(:methods
(new (symbol type int level) _type_ 0)
)
)
(defmethod new load-dir ((allocation symbol) (type-to-make type) (arg0 int) (arg1 level))
(let ((s4-0 (object-new allocation type-to-make (the-as int (-> type-to-make size)))))
(set! (-> s4-0 lev) arg1)
(set! (-> s4-0 string-array)
(the-as (array string) ((method-of-type array new) allocation array string arg0))
)
(set! (-> s4-0 string-array length) 0)
(set! (-> s4-0 data-array) (the-as (array basic) ((method-of-type array new) allocation array basic arg0)))
(set! (-> s4-0 data-array length) 0)
s4-0
)
)
(defmethod new load-dir-art-group ((allocation symbol) (type-to-make type) (arg0 int) (arg1 level))
(let ((v0-0 ((method-of-type load-dir new) allocation type-to-make arg0 arg1)))
(set! (-> v0-0 data-array content-type) art-group)
(the-as load-dir-art-group v0-0)
)
)
(deftype external-art-buffer (basic)
((index int32 :offset-assert 4)
(other external-art-buffer :offset-assert 8)
(status symbol :offset-assert 12)
(locked? symbol :offset-assert 16)
(login? symbol :offset-assert 20)
(frame-lock symbol :offset-assert 24)
(init-heap function :offset-assert 28)
(heap kheap :inline :offset-assert 32)
(pending-load-file string :offset-assert 48)
(pending-load-file-part int32 :offset-assert 52)
(pending-load-file-owner handle :offset-assert 56)
(pending-load-file-priority float :offset-assert 64)
(load-file string :offset-assert 68)
(load-file-part int32 :offset-assert 72)
(load-file-owner handle :offset-assert 80)
(load-file-priority float :offset-assert 88)
(buf pointer :offset-assert 92)
(len int32 :offset-assert 96)
(art-group art-group :offset-assert 100)
(art-data uint32 :offset 100)
)
:method-count-assert 16
:size-assert #x68
:flag-assert #x1000000068
(:methods
(new (symbol type int function symbol) _type_ 0)
(dummy-9 () none 9)
(dummy-10 () none 10)
(dummy-11 () none 11)
(dummy-12 () none 12)
(dummy-13 () none 13)
(dummy-14 () none 14)
(dummy-15 () none 15)
)
)
(defmethod new external-art-buffer ((allocation symbol) (type-to-make type) (arg0 int) (arg1 function) (arg2 symbol))
(let ((v0-0 (object-new allocation type-to-make (the-as int (-> type-to-make size)))))
(set! (-> v0-0 index) arg0)
(set! (-> v0-0 init-heap) arg1)
(set! (-> v0-0 login?) arg2)
(set! (-> v0-0 load-file) #f)
(set! (-> v0-0 load-file-part) -1)
(set! (-> v0-0 load-file-owner) (the-as handle #f))
(set! (-> v0-0 load-file-priority) 100000000.0)
(set! (-> v0-0 pending-load-file) #f)
(set! (-> v0-0 pending-load-file-part) -1)
(set! (-> v0-0 pending-load-file-owner) (the-as handle #f))
(set! (-> v0-0 pending-load-file-priority) 100000000.0)
(set! (-> v0-0 art-group) #f)
(set! (-> v0-0 status) 'initialize)
(set! (-> v0-0 locked?) #f)
(set! (-> v0-0 other) #f)
v0-0
)
)
(deftype spool-anim (basic)
((name string :offset 16)
(anim-name basic :offset-assert 20)
(parts int32 :offset-assert 24)
(hint-id int32 :offset 24)
(priority float :offset-assert 28)
(owner uint64 :offset-assert 32)
(command-list pair :offset-assert 40)
)
:method-count-assert 9
:size-assert #x2c
:flag-assert #x90000002c
)
(deftype external-art-control (basic)
((buffer external-art-buffer 2 :offset-assert 4)
(rec spool-anim 3 :inline :offset-assert 16)
(spool-lock handle :offset-assert 160)
(reserve-buffer external-art-buffer :offset-assert 168)
(reserve-buffer-count int16 :offset-assert 172)
(dma-reserve-buffer-count int16 :offset-assert 174)
(active-stream string :offset-assert 176)
(queue-stream (array spool-anim) :offset-assert 180)
(frame-mask uint32 :offset-assert 184)
(dma-reserve-heap kheap :inline :offset-assert 192)
)
:method-count-assert 16
:size-assert #xd0
:flag-assert #x10000000d0
(:methods
(dummy-9 () none 9)
(dummy-10 () none 10)
(dummy-11 () none 11)
(dummy-12 () none 12)
(dummy-13 () none 13)
(dummy-14 () none 14)
(dummy-15 () none 15)
)
)
(defmethod new external-art-control ((allocation symbol) (type-to-make type))
(let ((gp-0 (object-new allocation type-to-make (the-as int (-> type-to-make size)))))
(dotimes (s4-0 2)
(set! (-> gp-0 buffer s4-0)
((method-of-type external-art-buffer new) allocation external-art-buffer s4-0 external-art-buffer-init #t)
)
)
(set! (-> gp-0 buffer 0 other) (-> gp-0 buffer 1))
(set! (-> gp-0 buffer 1 other) (-> gp-0 buffer 0))
(dotimes (v1-9 3)
(set! (-> gp-0 rec v1-9 name) #f)
(set! (-> gp-0 rec v1-9 priority) 100000000.0)
(set! (-> gp-0 rec v1-9 owner) (the-as uint #f))
)
(set! (-> gp-0 spool-lock) (the-as handle #f))
(set! (-> gp-0 reserve-buffer) #f)
(set! (-> gp-0 active-stream) #f)
(set! (-> gp-0 queue-stream) (the-as (array spool-anim) (new 'global 'boxed-array spool-anim 4)))
(dotimes (s5-1 (-> gp-0 queue-stream allocated-length))
(set! (-> gp-0 queue-stream s5-1) (new 'global 'spool-anim))
)
(set! (-> gp-0 queue-stream length) 0)
gp-0
)
)
(deftype subtitle-range (basic)
((start-frame float :offset-assert 4)
(end-frame float :offset-assert 8)
(message object 8 :offset-assert 12)
)
:method-count-assert 9
:size-assert #x2c
:flag-assert #x90000002c
)
(defmethod inspect subtitle-range ((obj subtitle-range))
(when (not obj)
(return obj)
)
(format #t "[~8x] ~A~%" obj (-> obj type))
(format #t "~1Tstart-frame: ~f~%" (-> obj start-frame))
(format #t "~1Tend-frame: ~f~%" (-> obj end-frame))
(format #t "~1Tmessage[8] @ #x~X~%" (-> obj message))
(dotimes (s5-0 8)
(format #t "~T [~D]~1Tmessage: ~`object`P~%" s5-0 (-> obj message s5-0))
)
obj
)
(deftype subtitle-image (basic)
((width uint16 :offset-assert 4)
(height uint16 :offset-assert 6)
(palette rgba 16 :offset 16)
(data uint8 :dynamic :offset-assert 80)
)
:method-count-assert 9
:size-assert #x50
:flag-assert #x900000050
)
+204
View File
@@ -5,3 +5,207 @@
;; name in dgo: euler
;; dgos: ENGINE, GAME
(defun set-eul! ((arg0 euler-angles) (arg1 float) (arg2 float) (arg3 float) (arg4 int))
(set! (-> arg0 x) arg1)
(set! (-> arg0 y) arg2)
(set! (-> arg0 z) arg3)
(set! (-> arg0 w) (the float arg4))
arg0
)
(defun eul->matrix ((arg0 matrix) (arg1 euler-angles))
(matrix-identity! arg0)
(let ((s5-0 (new 'stack-no-clear 'vector)))
(set! (-> s5-0 quad) (-> arg1 quad))
(when (= (logand (the int (-> s5-0 w)) 1) 1)
(let ((f0-2 (-> s5-0 x)))
(set! (-> s5-0 x) (-> s5-0 z))
(set! (-> s5-0 z) f0-2)
)
)
(when (= (logand (/ (the int (-> s5-0 w)) 4) 1) 1)
(set! (-> s5-0 x) (- (-> s5-0 x)))
(set! (-> s5-0 y) (- (-> s5-0 y)))
(set! (-> s5-0 z) (- (-> s5-0 z)))
)
(let* ((f26-0 (cos (-> s5-0 x)))
(f30-0 (cos (-> s5-0 y)))
(f22-0 (cos (-> s5-0 z)))
(f24-0 (sin (-> s5-0 x)))
(f28-0 (sin (-> s5-0 y)))
(f4-0 (sin (-> s5-0 z)))
(f0-17 (* f26-0 f22-0))
(f1-1 (* f26-0 f4-0))
(f2-0 (* f24-0 f22-0))
(f3-0 (* f24-0 f4-0))
)
0
0
0
(let* ((v1-12 (logand (/ (the int (-> s5-0 w)) 4) 1))
(a1-2 (-> EulSafe (logand (/ (the int (-> s5-0 w)) 8) 3)))
(a0-21 (-> EulNext (+ a1-2 v1-12)))
(v1-17 (-> EulNext (+ (- 1 v1-12) a1-2)))
)
(cond
((= (logand (/ (the int (-> s5-0 w)) 2) 1) 1)
(set! (-> (the-as (pointer float) (+ (+ (* a1-2 16) (* a1-2 4)) (the-as int arg0)))) f30-0)
(set! (-> (the-as (pointer float) (+ (+ (* a1-2 16) (* a0-21 4)) (the-as int arg0)))) (* f28-0 f24-0))
(set! (-> (the-as (pointer float) (+ (+ (* a1-2 16) (* v1-17 4)) (the-as int arg0)))) (* f28-0 f26-0))
(set! (-> (the-as (pointer float) (+ (+ (* a0-21 16) (* a1-2 4)) (the-as int arg0)))) (* f28-0 f4-0))
(set! (-> (the-as (pointer float) (+ (+ (* a0-21 16) (* a0-21 4)) (the-as int arg0))))
(- f0-17 (* f30-0 f3-0))
)
(set! (-> (the-as (pointer float) (+ (+ (* a0-21 16) (* v1-17 4)) (the-as int arg0))))
(- (- f2-0) (* f30-0 f1-1))
)
(set! (-> (the-as (pointer float) (+ (+ (* v1-17 16) (* a1-2 4)) (the-as int arg0)))) (- (* f28-0 f22-0)))
(set! (-> (the-as (pointer float) (+ (+ (* v1-17 16) (* a0-21 4)) (the-as int arg0))))
(+ f1-1 (* f30-0 f2-0))
)
(set! (-> (the-as (pointer float) (+ (+ (* v1-17 16) (* v1-17 4)) (the-as int arg0))))
(+ (- f3-0) (* f30-0 f0-17))
)
)
(else
(set! (-> (the-as (pointer float) (+ (+ (* a1-2 16) (* a1-2 4)) (the-as int arg0)))) (* f30-0 f22-0))
(set! (-> (the-as (pointer float) (+ (+ (* a1-2 16) (* a0-21 4)) (the-as int arg0))))
(+ (- f1-1) (* f28-0 f2-0))
)
(set! (-> (the-as (pointer float) (+ (+ (* a1-2 16) (* v1-17 4)) (the-as int arg0))))
(+ f3-0 (* f28-0 f0-17))
)
(set! (-> (the-as (pointer float) (+ (+ (* a0-21 16) (* a1-2 4)) (the-as int arg0)))) (* f30-0 f4-0))
(set! (-> (the-as (pointer float) (+ (+ (* a0-21 16) (* a0-21 4)) (the-as int arg0))))
(+ f0-17 (* f28-0 f3-0))
)
(set! (-> (the-as (pointer float) (+ (+ (* a0-21 16) (* v1-17 4)) (the-as int arg0))))
(+ (- f2-0) (* f28-0 f1-1))
)
(set! (-> (the-as (pointer float) (+ (+ (* v1-17 16) (* a1-2 4)) (the-as int arg0)))) (- f28-0))
(set! (-> (the-as (pointer float) (+ (+ (* v1-17 16) (* a0-21 4)) (the-as int arg0)))) (* f30-0 f24-0))
(set! (-> (the-as (pointer float) (+ (+ (* v1-17 16) (* v1-17 4)) (the-as int arg0)))) (* f30-0 f26-0))
)
)
)
)
)
arg0
)
(defun matrix->eul ((arg0 euler-angles) (arg1 matrix) (arg2 int))
0
0
0
(let* ((v1-4 (logand (/ arg2 4) 1))
(s3-0 (-> EulSafe (logand (/ arg2 8) 3)))
(s2-0 (-> EulNext (+ s3-0 v1-4)))
(s1-0 (-> EulNext (+ (- 1 v1-4) s3-0)))
)
(cond
((= (logand (/ arg2 2) 1) 1)
(let* ((f0-0 (-> (the-as (pointer float) (+ (+ (* s2-0 4) (* s3-0 16)) (the-as int arg1)))))
(f0-2 (* f0-0 f0-0))
(f1-0 (-> (the-as (pointer float) (+ (+ (* s1-0 4) (* s3-0 16)) (the-as int arg1)))))
(f30-0 (sqrtf (+ f0-2 (* f1-0 f1-0))))
)
(cond
((< 0.00000000001 f30-0)
(set! (-> arg0 x) (atan
(-> (the-as (pointer float) (+ (+ (* s2-0 4) (* s3-0 16)) (the-as int arg1))))
(-> (the-as (pointer float) (+ (+ (* s1-0 4) (* s3-0 16)) (the-as int arg1))))
)
)
(set! (-> arg0 y) (atan f30-0 (-> (the-as (pointer float) (+ (+ (* s3-0 4) (* s3-0 16)) (the-as int arg1))))))
(set! (-> arg0 z) (atan
(-> (the-as (pointer float) (+ (+ (* s3-0 4) (* s2-0 16)) (the-as int arg1))))
(- (-> (the-as (pointer float) (+ (+ (* s3-0 4) (* s1-0 16)) (the-as int arg1)))))
)
)
)
(else
(set! (-> arg0 x) (atan
(- (-> (the-as (pointer float) (+ (+ (* s1-0 4) (* s2-0 16)) (the-as int arg1)))))
(-> (the-as (pointer float) (+ (+ (* s2-0 4) (* s2-0 16)) (the-as int arg1))))
)
)
(set! (-> arg0 y) (atan f30-0 (-> (the-as (pointer float) (+ (+ (* s3-0 4) (* s3-0 16)) (the-as int arg1))))))
(set! (-> arg0 z) 0.0)
)
)
)
)
(else
(let* ((f0-21 (-> (the-as (pointer float) (+ (+ (* s3-0 4) (* s3-0 16)) (the-as int arg1)))))
(f0-23 (* f0-21 f0-21))
(f1-3 (-> (the-as (pointer float) (+ (+ (* s3-0 4) (* s2-0 16)) (the-as int arg1)))))
(f30-1 (sqrtf (+ f0-23 (* f1-3 f1-3))))
)
(cond
((< 0.00000000001 f30-1)
(set! (-> arg0 x)
(atan
(-> (the-as (pointer float) (+ (+ (* s2-0 4) (* s1-0 16)) (the-as int arg1))))
(-> (the-as (pointer float) (+ (+ (* s1-0 4) (* s1-0 16)) (the-as int arg1))))
)
)
(set! (-> arg0 y)
(atan (- (-> (the-as (pointer float) (+ (+ (* s3-0 4) (* s1-0 16)) (the-as int arg1))))) f30-1)
)
(set! (-> arg0 z) (atan
(-> (the-as (pointer float) (+ (+ (* s3-0 4) (* s2-0 16)) (the-as int arg1))))
(-> (the-as (pointer float) (+ (+ (* s3-0 4) (* s3-0 16)) (the-as int arg1))))
)
)
)
(else
(set! (-> arg0 x)
(atan
(- (-> (the-as (pointer float) (+ (+ (* s1-0 4) (* s2-0 16)) (the-as int arg1)))))
(-> (the-as (pointer float) (+ (+ (* s2-0 4) (* s2-0 16)) (the-as int arg1))))
)
)
(set! (-> arg0 y)
(atan (- (-> (the-as (pointer float) (+ (+ (* s3-0 4) (* s1-0 16)) (the-as int arg1))))) f30-1)
)
(set! (-> arg0 z) 0.0)
)
)
)
)
)
)
(when (= (logand (/ arg2 4) 1) 1)
(set! (-> arg0 x) (- (-> arg0 x)))
(set! (-> arg0 y) (- (-> arg0 y)))
(set! (-> arg0 z) (- (-> arg0 z)))
)
(when (= (logand arg2 1) 1)
(let ((f0-49 (-> arg0 x)))
(set! (-> arg0 x) (-> arg0 z))
(set! (-> arg0 z) f0-49)
)
)
(set! (-> arg0 w) (the float arg2))
arg0
)
(defun eul->quat ((arg0 quaternion) (arg1 euler-angles))
(let ((s5-0 (new 'stack-no-clear 'matrix)))
(eul->matrix s5-0 arg1)
(matrix->quaternion arg0 s5-0)
)
arg0
)
(defun quat->eul ((arg0 euler-angles) (arg1 quaternion) (arg2 int))
(let ((s5-0 (new 'stack-no-clear 'matrix)))
(quaternion->matrix s5-0 arg1)
(matrix->eul arg0 s5-0 arg2)
)
arg0
)
+11
View File
@@ -52,3 +52,14 @@
)
arg0
)
(defmacro new-stack-matrix0 ()
"Get a new matrix on the stack that's set to zero."
`(let ((mat (new 'stack-no-clear 'matrix)))
(set! (-> mat quad 0) (the-as uint128 0))
(set! (-> mat quad 1) (the-as uint128 0))
(set! (-> mat quad 2) (the-as uint128 0))
(set! (-> mat quad 3) (the-as uint128 0))
mat
)
)
+11
View File
@@ -21,6 +21,17 @@
(define *unity-quaternion* (new 'static 'quaternion :data (new 'static 'array float 4 0.0 0.0 0.0 1.0)))
(define-extern quaternion-normalize! (function quaternion quaternion))
(define-extern quaternion->matrix (function matrix quaternion matrix))
(define-extern matrix->quaternion (function quaternion matrix quaternion))
(define-extern vector-y-angle (function vector float))
(defmacro new-stack-quaternion0 ()
"Get a stack quaternion that's set to 0.
This is more efficient than (new 'stack 'quaternion) because
this doesn't call the constructor."
`(let ((q (new 'stack-no-clear 'quaternion)))
(set! (-> q quad) (the-as uint128 0))
q
)
)
+987
View File
@@ -5,3 +5,990 @@
;; name in dgo: quaternion
;; dgos: ENGINE, GAME
(defmethod inspect quaternion ((obj quaternion))
(format #t "[~8x] quaternion~%" obj)
(format #t "~T[~F] [~F] [~F] [~F]~%" (-> obj x) (-> obj y) (-> obj z) (-> obj w))
(let ((f0-5 (/ 1.0 (sqrtf (+ (* (-> obj x) (-> obj x)) (* (-> obj y) (-> obj y)) (* (-> obj z) (-> obj z)))))))
(format #t "~Taxis: ~F ~F ~F" (* f0-5 (-> obj x)) (* f0-5 (-> obj y)) (* f0-5 (-> obj z)))
)
(let ((f0-9 (* 2.0 (acos (-> obj w)))))
(format #t "~T~Tangle: (deg ~R)~%" f0-9)
)
obj
)
(defun quaternion-axis-angle! ((arg0 quaternion) (arg1 float) (arg2 float) (arg3 float) (arg4 float))
(let ((s5-0 (new 'stack-no-clear 'vector)))
(sincos! (the-as (pointer float) s5-0) (* 0.5 arg4))
(let ((f0-2 (-> s5-0 x)))
(set! (-> arg0 x) (* arg1 f0-2))
(set! (-> arg0 y) (* arg2 f0-2))
(set! (-> arg0 z) (* arg3 f0-2))
)
(set! (-> arg0 w) (-> s5-0 y))
)
arg0
)
(defun quaternion-vector-angle! ((arg0 quaternion) (arg1 vector) (arg2 float))
(let ((s5-0 (new 'stack-no-clear 'vector)))
(sincos! (the-as (pointer float) s5-0) (* 0.5 arg2))
(let ((f0-2 (-> s5-0 x)))
(set! (-> arg0 x) (* (-> arg1 x) f0-2))
(set! (-> arg0 y) (* (-> arg1 y) f0-2))
(set! (-> arg0 z) (* (-> arg1 z) f0-2))
)
(set! (-> arg0 w) (-> s5-0 y))
)
arg0
)
(defun vector-angle<-quaternion! ((arg0 vector) (arg1 quaternion))
(let* ((f0-0 1.0)
(f1-0 1.0)
(f2-0 (-> arg1 w))
(f30-0 (/ f0-0 (sqrtf (- f1-0 (* f2-0 f2-0)))))
(f0-3 (* 2.0 (acos-rad (-> arg1 w))))
)
(set! (-> arg0 x) (* (-> arg1 x) f30-0))
(set! (-> arg0 y) (* (-> arg1 y) f30-0))
(set! (-> arg0 z) (* (-> arg1 z) f30-0))
(set! (-> arg0 w) f0-3)
)
arg0
)
(defun quaternion-look-at! ((arg0 vector) (arg1 vector) (arg2 vector))
(let ((s5-0 (new 'stack-no-clear 'matrix)))
(vector-cross! (the-as vector (-> s5-0 data)) arg2 arg1)
(vector-cross! (the-as vector (&-> s5-0 data 4)) arg1 (the-as vector (-> s5-0 data)))
(set! (-> s5-0 vector 2 quad) (-> arg1 quad))
(quaternion-normalize! (matrix->quaternion (the-as quaternion arg0) s5-0))
)
)
(defun quaternion-zero! ((arg0 quaternion))
(set! (-> arg0 vec quad) (the-as uint128 0))
arg0
)
(defun quaternion-identity! ((arg0 quaternion))
(set! (-> arg0 vec quad) (the-as uint128 0))
(set! (-> arg0 w) 1.0)
arg0
)
(defun quaternion-i! ((arg0 quaternion))
(set! (-> arg0 vec quad) (the-as uint128 0))
(set! (-> arg0 x) 1.0)
arg0
)
(defun quaternion-j! ((arg0 quaternion))
(set! (-> arg0 vec quad) (the-as uint128 0))
(set! (-> arg0 y) 1.0)
arg0
)
(defun quaternion-k! ((arg0 quaternion))
(set! (-> arg0 vec quad) (the-as uint128 0))
(set! (-> arg0 z) 1.0)
arg0
)
(defun quaternion-copy! ((arg0 quaternion) (arg1 quaternion))
(set! (-> arg0 vec quad) (-> arg1 vec quad))
arg0
)
(defun quaternion-set! ((arg0 quaternion) (arg1 float) (arg2 float) (arg3 float) (arg4 float))
(set! (-> arg0 x) arg1)
(set! (-> arg0 y) arg2)
(set! (-> arg0 z) arg3)
(set! (-> arg0 w) arg4)
arg0
)
(defun quaternion+! ((arg0 quaternion) (arg1 quaternion) (arg2 quaternion))
(rlet ((vf1 :class vf)
(vf2 :class vf)
)
(.lvf vf1 (&-> arg1 vec quad))
(.lvf vf2 (&-> arg2 vec quad))
(.add.vf vf1 vf1 vf2)
(.svf (&-> arg0 vec quad) vf1)
arg0
)
)
(defun quaternion-! ((arg0 quaternion) (arg1 quaternion) (arg2 quaternion))
(rlet ((vf1 :class vf)
(vf2 :class vf)
)
(.lvf vf1 (&-> arg1 vec quad))
(.lvf vf2 (&-> arg2 vec quad))
(.sub.vf vf1 vf1 vf2)
(.svf (&-> arg0 vec quad) vf1)
arg0
)
)
(defun quaternion-negate! ((arg0 quaternion) (arg1 quaternion))
(rlet ((vf1 :class vf)
(vf2 :class vf)
)
(.lvf vf1 (&-> arg1 vec quad))
;;(.sub.vf vf2 vf2 vf2)
(.xor.vf vf2 vf2 vf2)
(.sub.vf vf1 vf2 vf1)
(.svf (&-> arg0 vec quad) vf1)
arg0
)
)
(defun quaternion-conjugate! ((arg0 quaternion) (arg1 quaternion))
(rlet ((vf1 :class vf)
(vf2 :class vf)
)
(.lvf vf1 (&-> arg1 vec quad))
;;(.sub.vf vf2 vf2 vf2)
(.xor.vf vf2 vf2 vf2)
(.sub.vf vf2 vf2 vf1 :mask #b111)
(.add.vf vf2 vf2 vf1 :mask #b1000)
(.svf (&-> arg0 vec quad) vf2)
arg0
)
)
(defun quaternion-float*! ((arg0 quaternion) (arg1 quaternion) (arg2 float))
(rlet ((vf1 :class vf)
(vf2 :class vf)
)
(.lvf vf1 (&-> arg1 vec quad))
(.mov vf2 arg2)
(.mul.x.vf vf1 vf1 vf2)
(.svf (&-> arg0 vec quad) vf1)
arg0
)
)
(defun quaternion-float/! ((arg0 quaternion) (arg1 quaternion) (arg2 float))
(let ((f0-1 (/ 1.0 arg2)))
(quaternion-float*! arg0 arg1 f0-1)
)
arg0
)
(defun quaternion-norm2 ((arg0 quaternion))
(local-vars (v0-0 float))
(rlet ((acc :class vf)
(vf0 :class vf)
(vf1 :class vf)
)
(init-vf0-vector)
(.lvf vf1 (&-> arg0 vec quad))
(.mul.vf vf1 vf1 vf1)
(.add.z.vf acc vf1 vf1 :mask #b1000)
(.add.mul.y.vf acc vf0 vf1 acc :mask #b1000)
(.add.mul.x.vf vf1 vf0 vf1 acc :mask #b1000)
(.add.w.vf vf1 vf0 vf1)
(.mov v0-0 vf1)
v0-0
)
)
(defun quaternion-norm ((arg0 quaternion))
(local-vars (v1-1 float))
(rlet ((acc :class vf)
(vf0 :class vf)
(vf1 :class vf)
)
(init-vf0-vector)
(.lvf vf1 (&-> arg0 vec quad))
(.mul.vf vf1 vf1 vf1)
(.add.z.vf acc vf1 vf1 :mask #b1000)
(.add.mul.y.vf acc vf0 vf1 acc :mask #b1000)
(.add.mul.x.vf vf1 vf0 vf1 acc :mask #b1000)
(.add.w.vf vf1 vf0 vf1)
(.mov v1-1 vf1)
(sqrtf v1-1)
)
)
(defun quaternion-normalize! ((arg0 quaternion))
(rlet ((acc :class vf)
(Q :class vf)
(vf0 :class vf)
(vf1 :class vf)
(vf2 :class vf)
)
(init-vf0-vector)
(.lvf vf1 (&-> arg0 vec quad))
(.mul.vf vf2 vf1 vf1)
(.add.z.vf acc vf2 vf2 :mask #b1000)
(.add.mul.y.vf acc vf0 vf2 acc :mask #b1000)
(.add.mul.x.vf vf2 vf0 vf2 acc :mask #b1000)
(.isqrt.vf Q vf0 vf2 :fsf #b11 :ftf #b11)
(.wait.vf)
(.mul.vf vf2 vf1 Q)
(.nop.vf)
(.nop.vf)
(.svf (&-> arg0 vec quad) vf2)
arg0
)
)
(defun quaternion-inverse! ((arg0 quaternion) (arg1 quaternion))
(rlet ((acc :class vf)
(Q :class vf)
(vf0 :class vf)
(vf1 :class vf)
(vf2 :class vf)
(vf3 :class vf)
)
(init-vf0-vector)
(.lvf vf1 (&-> arg1 vec quad))
(.mul.vf vf2 vf1 vf1)
(.xor.vf vf3 vf3 vf3)
;;(.sub.vf vf3 vf3 vf3)
(.add.z.vf acc vf2 vf2 :mask #b1000)
(.add.mul.y.vf acc vf0 vf2 acc :mask #b1000)
(.add.mul.x.vf vf2 vf0 vf2 acc :mask #b1000)
(.sub.vf vf3 vf3 vf1 :mask #b111)
(.div.vf Q vf0 vf2 :fsf #b11 :ftf #b11)
(.add.vf vf3 vf3 vf1 :mask #b1000)
(.wait.vf)
(.mul.vf vf3 vf3 Q)
(.nop.vf)
(.nop.vf)
(.svf (&-> arg0 vec quad) vf3)
arg0
)
)
(defun quaternion-dot ((arg0 quaternion) (arg1 quaternion))
(local-vars (v0-0 float))
(rlet ((acc :class vf)
(vf0 :class vf)
(vf1 :class vf)
(vf2 :class vf)
)
(init-vf0-vector)
(.lvf vf1 (&-> arg0 vec quad))
(.lvf vf2 (&-> arg1 vec quad))
(.mul.vf vf1 vf1 vf2)
(.add.z.vf acc vf1 vf1 :mask #b1000)
(.add.mul.y.vf acc vf0 vf1 acc :mask #b1000)
(.add.mul.x.vf vf1 vf0 vf1 acc :mask #b1000)
(.add.w.vf vf1 vf0 vf1)
(.mov v0-0 vf1)
v0-0
)
)
;; definition for function quaternion*!
(defun quaternion*! ((arg0 quaternion) (arg1 quaternion) (arg2 quaternion))
(rlet ((acc :class vf)
(vf0 :class vf)
(vf1 :class vf)
(vf2 :class vf)
(vf3 :class vf)
(vf4 :class vf)
)
(init-vf0-vector)
(.lvf vf1 (&-> arg1 vec quad))
(.lvf vf2 (&-> arg2 vec quad))
(.sub.vf vf4 vf0 vf0 :mask #b1000)
(.mul.vf vf3 vf1 vf2)
(.outer.product.a.vf acc vf1 vf2)
(.outer.product.b.vf vf4 vf2 vf1 acc)
(.mul.w.vf acc vf1 vf2)
(.add.mul.w.vf acc vf2 vf1 acc)
(.sub.mul.w.vf acc vf0 vf3 acc :mask #b1000)
(.sub.mul.z.vf acc vf0 vf3 acc :mask #b1000)
(.sub.mul.y.vf acc vf0 vf3 acc :mask #b1000)
(.sub.mul.x.vf acc vf0 vf3 acc :mask #b1000)
(.add.mul.w.vf vf1 vf4 vf0 acc)
(.svf (&-> arg0 vec quad) vf1)
arg0
)
)
(defun quaternion-right-mult-matrix! ((arg0 matrix) (arg1 quaternion))
(let ((f3-0 (-> arg1 x))
(f2-0 (-> arg1 y))
(f1-0 (-> arg1 z))
(f0-0 (-> arg1 w))
)
(set! (-> arg0 data 0) f0-0)
(set! (-> arg0 data 1) f1-0)
(set! (-> arg0 data 2) (- f2-0))
(set! (-> arg0 data 3) f3-0)
(set! (-> arg0 data 4) (- f1-0))
(set! (-> arg0 data 5) f0-0)
(set! (-> arg0 data 6) f3-0)
(set! (-> arg0 data 7) f2-0)
(set! (-> arg0 data 8) f2-0)
(set! (-> arg0 data 9) (- f3-0))
(set! (-> arg0 data 10) f0-0)
(set! (-> arg0 data 11) f1-0)
(set! (-> arg0 trans x) (- f3-0))
(set! (-> arg0 trans y) (- f2-0))
(set! (-> arg0 trans z) (- f1-0))
(set! (-> arg0 trans w) f0-0)
)
arg0
)
(defun quaternion-left-mult-matrix! ((arg0 matrix) (arg1 quaternion))
(let ((f2-0 (-> arg1 x))
(f1-0 (-> arg1 y))
(f0-0 (-> arg1 z))
)
(let ((f3-0 (-> arg1 w)))
(set! (-> arg0 data 0) f2-0)
(set! (-> arg0 data 1) f3-0)
(set! (-> arg0 data 2) (- f0-0))
(set! (-> arg0 data 3) f1-0)
(set! (-> arg0 data 4) f1-0)
(set! (-> arg0 data 5) f0-0)
(set! (-> arg0 data 6) f3-0)
(set! (-> arg0 data 7) (- f3-0))
(set! (-> arg0 data 8) f0-0)
(set! (-> arg0 data 9) (- f1-0))
(set! (-> arg0 data 10) f2-0)
(set! (-> arg0 data 11) f3-0)
(set! (-> arg0 trans x) f3-0)
)
(set! (-> arg0 trans y) (- f2-0))
(set! (-> arg0 trans z) (- f1-0))
(set! (-> arg0 trans w) (- f0-0))
)
arg0
)
(defun quaternion->matrix ((arg0 matrix) (arg1 quaternion))
(rlet ((acc :class vf)
(vf0 :class vf)
(vf1 :class vf)
(vf2 :class vf)
(vf3 :class vf)
(vf4 :class vf)
(vf5 :class vf)
)
(init-vf0-vector)
(.lvf vf1 (&-> arg1 vec quad))
(.add.vf vf5 vf1 vf1)
(.add.w.vf vf2 vf0 vf1 :mask #b1)
(.add.z.vf vf2 vf0 vf1 :mask #b10)
(.sub.y.vf vf2 vf0 vf1 :mask #b100)
(.sub.w.vf vf2 vf0 vf0 :mask #b1000)
(.sub.z.vf vf3 vf0 vf1 :mask #b1)
(.add.w.vf vf3 vf0 vf1 :mask #b10)
(.add.x.vf vf3 vf0 vf1 :mask #b100)
(.sub.w.vf vf3 vf0 vf0 :mask #b1000)
(.add.y.vf vf4 vf0 vf1 :mask #b1)
(.sub.x.vf vf4 vf0 vf1 :mask #b10)
(.add.w.vf vf4 vf0 vf1 :mask #b100)
(.sub.w.vf vf4 vf0 vf0 :mask #b1000)
(.outer.product.a.vf acc vf5 vf2)
(.outer.product.b.vf vf2 vf2 vf5 acc)
(.outer.product.a.vf acc vf5 vf3)
(.outer.product.b.vf vf3 vf3 vf5 acc)
(.outer.product.a.vf acc vf5 vf4)
(.outer.product.b.vf vf4 vf4 vf5 acc)
(.add.w.vf vf2 vf2 vf0 :mask #b1)
(.add.w.vf vf3 vf3 vf0 :mask #b10)
(.add.w.vf vf4 vf4 vf0 :mask #b100)
(.svf (&-> arg0 trans quad) vf0)
(.svf (&-> arg0 quad 0) vf2)
(.svf (&-> arg0 quad 1) vf3)
(.svf (&-> arg0 quad 2) vf4)
arg0
)
)
#|
;; definition for function quaternion->matrix-2
;; WARN: Unsupported inline assembly instruction kind - [pexew a1, v1]
;; WARN: Unsupported inline assembly instruction kind - [prot3w a2, a1]
;; Used lq/sq
(defun quaternion->matrix-2 ((arg0 matrix) (arg1 quaternion))
(local-vars (v1-1 uint128) (a1-1 uint128) (a1-2 uint128) (a2-0 uint128) (a3-0 uint128))
(rlet ((acc :class vf)
(vf0 :class vf)
(vf1 :class vf)
(vf2 :class vf)
(vf3 :class vf)
(vf4 :class vf)
(vf5 :class vf)
(vf6 :class vf)
(vf7 :class vf)
(vf8 :class vf)
)
(init-vf0-vector)
(let ((v1-0 (-> arg1 vec quad)))
(.pexew a1-1 v1-0)
(.mov vf1 v1-0)
(.prot3w a2-0 a1-1)
(.pcpyud a1-2 v1-0 a1-1)
(.mov vf4 a2-0)
(let ((a2-1 #x3f800000))
(.add.vf vf5 vf1 vf1)
(.sub.y.vf vf4 vf0 vf4 :mask #b10)
(.pextlw a3-0 v1-0 a1-2)
(.mov vf3 a1-2)
(.pextuw v1-1 v1-0 a3-0)
(.mov vf2 v1-1)
(set! (-> arg0 trans quad) (the-as uint128 0))
(.sub.x.vf vf3 vf0 vf3 :mask #b1)
(set! (-> arg0 trans w) (the-as float a2-1))
(.sub.z.vf vf2 vf0 vf2 :mask #b100)
(.outer.product.a.vf acc vf5 vf4)
(.outer.product.b.vf vf8 vf4 vf5 acc)
(.outer.product.a.vf acc vf5 vf3)
(.outer.product.b.vf vf7 vf3 vf5 acc)
(.outer.product.a.vf acc vf5 vf2)
(.outer.product.b.vf vf6 vf2 vf5 acc)
(.add.w.vf vf8 vf8 vf0 :mask #b100)
(.add.w.vf vf7 vf7 vf0 :mask #b10)
(.add.w.vf vf6 vf6 vf0 :mask #b1)
(.svf (&-> arg0 quad 2) vf8)
(set! (-> arg0 data 11) (the-as float a2-1))
(.svf (&-> arg0 quad 1) vf7)
(set! (-> arg0 data 7) (the-as float a2-1))
(.svf (&-> arg0 quad 0) vf6)
(set! (-> arg0 data 3) (the-as float a2-1))
)
)
arg0
)
)
|#
(defun matrix->quaternion ((arg0 quaternion) (arg1 matrix))
(let ((f0-2 (+ (-> arg1 data 0) (-> arg1 data 5) (-> arg1 data 10))))
(cond
((< 0.0 f0-2)
(let ((f0-4 (sqrtf (+ 1.0 f0-2))))
(set! (-> arg0 w) (* 0.5 f0-4))
(let ((f0-5 (/ 0.5 f0-4)))
(set! (-> arg0 x) (* f0-5 (- (-> arg1 data 6) (-> arg1 data 9))))
(set! (-> arg0 y) (* f0-5 (- (-> arg1 data 8) (-> arg1 data 2))))
(set! (-> arg0 z) (* f0-5 (- (-> arg1 data 1) (-> arg1 data 4))))
)
)
)
(else
(let ((a2-0 0)
(a3-0 1)
(v1-4 2)
)
(when (< (-> arg1 data 0) (-> arg1 data 5))
(set! a2-0 1)
(set! a3-0 2)
(set! v1-4 0)
)
(when (< (-> (the-as (pointer float) (+ (+ (* a2-0 4) (* a2-0 16)) (the-as int arg1)))) (-> arg1 data 10))
(set! a2-0 2)
(set! a3-0 0)
(set! v1-4 1)
)
(let ((f0-12
(sqrtf
(+ (- 1.0
(+ (-> (the-as (pointer float) (+ (+ (* a3-0 4) (* a3-0 16)) (the-as int arg1))))
(-> (the-as (pointer float) (+ (+ (* v1-4 4) (* v1-4 16)) (the-as int arg1))))
)
)
(-> (the-as (pointer float) (+ (+ (* a2-0 4) (* a2-0 16)) (the-as int arg1))))
)
)
)
)
(set! (-> arg0 data a2-0) (* 0.5 f0-12))
(if (!= f0-12 0.0)
(set! f0-12 (/ 0.5 f0-12))
)
(set! (-> arg0 w)
(* (- (-> (the-as (pointer float) (+ (+ (* v1-4 4) (* a3-0 16)) (the-as int arg1))))
(-> (the-as (pointer float) (+ (+ (* a3-0 4) (* v1-4 16)) (the-as int arg1))))
)
f0-12
)
)
(set! (-> arg0 data a3-0)
(* (+ (-> (the-as (pointer float) (+ (+ (* a3-0 4) (* a2-0 16)) (the-as int arg1))))
(-> (the-as (pointer float) (+ (+ (* a2-0 4) (* a3-0 16)) (the-as int arg1))))
)
f0-12
)
)
(set! (-> arg0 data v1-4)
(* (+ (-> (the-as (pointer float) (+ (+ (* v1-4 4) (* a2-0 16)) (the-as int arg1))))
(-> (the-as (pointer float) (+ (+ (* a2-0 4) (* v1-4 16)) (the-as int arg1))))
)
f0-12
)
)
)
)
)
)
)
arg0
)
(defun matrix-with-scale->quaternion ((arg0 quaternion) (arg1 matrix))
(local-vars (a1-4 float))
(rlet ((vf1 :class vf)
(vf2 :class vf)
(vf3 :class vf)
(vf4 :class vf)
(vf5 :class vf)
(vf6 :class vf)
(vf7 :class vf)
)
(let ((v1-0 (new-stack-matrix0)))
(let* ((f0-1 (vector-dot (the-as vector (-> arg1 data)) (the-as vector (-> arg1 data))))
(f1-1 (vector-dot (the-as vector (&-> arg1 data 4)) (the-as vector (&-> arg1 data 4))))
(f2-1 (vector-dot (the-as vector (&-> arg1 data 8)) (the-as vector (&-> arg1 data 8))))
(f0-3 (/ 1.0 (sqrtf f0-1)))
(f1-3 (/ 1.0 (sqrtf f1-1)))
(f2-3 (/ 1.0 (sqrtf f2-1)))
)
(.lvf vf1 (&-> arg1 quad 0))
(.lvf vf2 (&-> arg1 quad 1))
(.lvf vf3 (&-> arg1 quad 2))
(.lvf vf4 (&-> arg1 trans quad))
(let ((a1-1 f0-3))
(.mov vf5 a1-1)
)
(let ((a1-2 f1-3))
(.mov vf6 a1-2)
)
(let ((a1-3 f2-3))
(.mov vf7 a1-3)
)
)
(.mul.x.vf vf1 vf1 vf5)
(.mul.x.vf vf2 vf2 vf6)
(.mul.x.vf vf3 vf3 vf7)
(.svf (&-> v1-0 quad 0) vf1)
(.svf (&-> v1-0 quad 1) vf2)
(.svf (&-> v1-0 quad 2) vf3)
(.svf (&-> v1-0 trans quad) vf4)
(.mov a1-4 vf4)
(matrix->quaternion arg0 v1-0)
)
)
)
(defun quaternion-vector-len ((arg0 quaternion))
(let ((f0-0 1.0)
(f1-0 (-> arg0 w))
)
(sqrtf (- f0-0 (* f1-0 f1-0)))
)
)
(defun quaternion-log! ((arg0 quaternion) (arg1 quaternion))
(cond
((= (-> arg1 w) 0.0)
(set! (-> arg0 x) (* 1.5707963 (-> arg1 x)))
(set! (-> arg0 y) (* 1.5707963 (-> arg1 y)))
(set! (-> arg0 z) (* 1.5707963 (-> arg1 z)))
)
(else
(let* ((f30-0 (quaternion-vector-len arg1))
(f0-9 (/ (atan2-rad (-> arg1 w) f30-0) f30-0))
)
(set! (-> arg0 x) (* (-> arg1 x) f0-9))
(set! (-> arg0 y) (* (-> arg1 y) f0-9))
(set! (-> arg0 z) (* (-> arg1 z) f0-9))
)
)
)
arg0
)
(defun quaternion-exp! ((arg0 quaternion) (arg1 quaternion))
(let ((f30-0 (vector-length (the-as vector arg1))))
(cond
((= f30-0 0.0)
(set! (-> arg0 x) 0.0)
(set! (-> arg0 y) 0.0)
(set! (-> arg0 z) 0.0)
(set! (-> arg0 w) 1.0)
)
(else
(let ((s5-0 (new 'stack-no-clear 'vector)))
(sincos-rad! (the-as (pointer float) s5-0) f30-0)
(let ((f0-6 (/ (-> s5-0 x) f30-0)))
(set! (-> arg0 x) (* (-> arg1 x) f0-6))
(set! (-> arg0 y) (* (-> arg1 y) f0-6))
(set! (-> arg0 z) (* (-> arg1 z) f0-6))
)
(set! (-> arg0 w) (-> s5-0 y))
)
)
)
)
arg0
)
(defun quaternion-slerp! ((arg0 quaternion) (arg1 quaternion) (arg2 quaternion) (arg3 float))
(local-vars (v1-15 float))
(rlet ((acc :class vf)
(vf1 :class vf)
(vf2 :class vf)
(vf3 :class vf)
(vf4 :class vf)
)
(let ((f0-0 (quaternion-dot arg1 arg2))
(f30-0 1.0)
)
(when (< f0-0 0.0)
(set! f0-0 (- f0-0))
(set! f30-0 -1.0)
)
(cond
((< (- 1.0 f0-0) 0.0001)
(let ((v1-7 (- 1.0 arg3)))
(.mov vf1 v1-7)
)
(let ((v1-8 (* arg3 f30-0)))
(.mov vf2 v1-8)
)
(.lvf vf3 (&-> arg1 vec quad))
(.lvf vf4 (&-> arg2 vec quad))
(.mul.x.vf acc vf3 vf1)
(.add.mul.x.vf vf3 vf4 vf2 acc)
(.svf (&-> arg0 vec quad) vf3)
(quaternion-normalize! arg0)
)
(else
(let* ((f1-4 1.0)
(f2-1 f0-0)
(f1-6 (sqrtf (- f1-4 (* f2-1 f2-1))))
(f0-6 (/ (- f1-6 f0-0) (+ f1-6 f0-0)))
(f28-0 (/ 1.0 f1-6))
)
(let ((f0-7 (atan-series-rad f0-6))
(s2-0 (new 'stack-no-clear 'vector))
)
(set! (-> s2-0 x) (* (- 1.0 arg3) f0-7))
(set! (-> s2-0 y) (* arg3 f0-7 f30-0))
(vector-sin-rad! s2-0 s2-0)
(.lvf vf1 (&-> s2-0 quad))
)
(let ((v1-14 f28-0))
(.mov vf2 v1-14)
)
)
(.mul.x.vf vf1 vf1 vf2)
(.lvf vf3 (&-> arg1 vec quad))
(.lvf vf4 (&-> arg2 vec quad))
(.mul.x.vf acc vf3 vf1)
(.add.mul.y.vf vf3 vf4 vf1 acc)
(.svf (&-> arg0 vec quad) vf3)
(.mov v1-15 vf3)
)
)
)
arg0
)
)
(defun quaternion-pseudo-slerp! ((arg0 quaternion) (arg1 quaternion) (arg2 quaternion) (arg3 float))
(rlet ((acc :class vf)
(vf1 :class vf)
(vf2 :class vf)
(vf3 :class vf)
(vf4 :class vf)
)
(let ((f1-0 (quaternion-dot arg1 arg2))
(f0-0 1.0)
)
(when (< f1-0 0.0)
(- f1-0)
(set! f0-0 -1.0)
)
(let ((v1-5 (- 1.0 arg3)))
(.mov vf1 v1-5)
)
(let ((v1-6 (* arg3 f0-0)))
(.mov vf2 v1-6)
)
)
(.lvf vf3 (&-> arg1 vec quad))
(.lvf vf4 (&-> arg2 vec quad))
(.mul.x.vf acc vf3 vf1)
(.add.mul.x.vf vf3 vf4 vf2 acc)
(.svf (&-> arg0 vec quad) vf3)
(quaternion-normalize! arg0)
arg0
)
)
(defun quaternion-pseudo-seek ((arg0 quaternion) (arg1 quaternion) (arg2 quaternion) (arg3 float))
(let ((s3-0 (new 'stack-no-clear 'quaternion)))
(let ((s5-0 (new 'stack-no-clear 'quaternion)))
(quaternion-copy! s3-0 arg2)
(if (< (quaternion-dot s3-0 arg1) 0.0)
(quaternion-negate! s3-0 s3-0)
)
(quaternion-! s5-0 s3-0 arg1)
(let ((f0-1 (quaternion-norm2 s5-0))
(f1-1 arg3)
)
(if (< (* f1-1 f1-1) f0-1)
(quaternion-float*! s5-0 s5-0 (/ arg3 (sqrtf f0-1)))
)
)
(quaternion+! s3-0 arg1 s5-0)
)
(quaternion-normalize! s3-0)
(quaternion-copy! arg0 s3-0)
)
)
(defun quaternion-smooth-seek! ((arg0 quaternion) (arg1 quaternion) (arg2 quaternion) (arg3 float))
(let ((gp-0 (new 'stack-no-clear 'inline-array 'quaternion 2)))
(quaternion-copy! (-> gp-0 0) arg2)
(if (< (quaternion-dot (-> gp-0 0) arg1) 0.0)
(quaternion-negate! (-> gp-0 0) (-> gp-0 0))
)
(quaternion-! (-> gp-0 1) (-> gp-0 0) arg1)
(quaternion-float*! (-> gp-0 1) (-> gp-0 1) (fmin 1.0 arg3))
(quaternion+! (-> gp-0 0) arg1 (-> gp-0 1))
(quaternion-normalize! (-> gp-0 0))
(quaternion-copy! arg0 (-> gp-0 0))
)
)
(defun quaternion-zxy! ((arg0 quaternion) (arg1 vector))
(rlet ((acc :class vf)
(vf0 :class vf)
(vf1 :class vf)
(vf2 :class vf)
(vf3 :class vf)
(vf4 :class vf)
(vf5 :class vf)
(vf6 :class vf)
(vf7 :class vf)
)
(init-vf0-vector)
(let ((s4-0 (new 'stack-no-clear 'vector))
(gp-0 (new 'stack-no-clear 'vector))
(s5-0 (new 'stack-no-clear 'vector))
)
(vector-rad<-vector-deg/2! s4-0 arg1)
(vector-sincos-rad! gp-0 s5-0 s4-0)
(.lvf vf1 (&-> gp-0 quad))
(.lvf vf2 (&-> s5-0 quad))
)
(.mul.x.vf vf4 vf0 vf1 :mask #b1000)
(.add.vf vf4 vf0 vf2 :mask #b111)
(.sub.vf vf4 vf0 vf4 :mask #b110)
(.add.vf vf3 vf0 vf1 :mask #b111)
(.mul.x.vf vf3 vf0 vf2 :mask #b1000)
(.outer.product.a.vf acc vf1 vf1)
(.outer.product.b.vf vf6 vf0 vf0 acc)
(.outer.product.a.vf acc vf2 vf2)
(.outer.product.b.vf vf5 vf0 vf0 acc)
(.mul.x.vf vf6 vf0 vf6 :mask #b1000)
(.mul.x.vf vf5 vf0 vf5 :mask #b1000)
(.mul.vf acc vf6 vf4)
(.add.mul.vf vf7 vf5 vf3 acc)
(.svf (&-> arg0 vec quad) vf7)
arg0
)
)
(defun vector-x-quaternion! ((arg0 vector) (arg1 quaternion))
(let ((s5-0 (new-stack-matrix0)))
(quaternion->matrix s5-0 arg1)
(set! (-> arg0 quad) (-> (the-as (pointer uint128) (-> s5-0 data)) 0))
)
arg0
)
(defun vector-y-quaternion! ((arg0 vector) (arg1 quaternion))
(let ((s5-0 (new-stack-matrix0)))
(quaternion->matrix s5-0 arg1)
(set! (-> arg0 quad) (-> (the-as (pointer uint128) (&-> s5-0 data 4)) 0))
)
arg0
)
(defun vector-z-quaternion! ((arg0 vector) (arg1 quaternion))
(let ((s5-0 (new-stack-matrix0)))
(quaternion->matrix s5-0 arg1)
(set! (-> arg0 quad) (-> (the-as (pointer uint128) (&-> s5-0 data 8)) 0))
)
arg0
)
(defun quaternion-x-angle ((arg0 quaternion))
(let ((v1-1 (vector-y-quaternion! (new 'stack-no-clear 'vector) arg0)))
(atan (-> v1-1 z) (-> v1-1 y))
)
)
(defun quaternion-y-angle ((arg0 quaternion))
(let ((v1-1 (vector-z-quaternion! (new 'stack-no-clear 'vector) arg0)))
(atan (-> v1-1 x) (-> v1-1 z))
)
)
(defun quaternion-z-angle ((arg0 quaternion))
(let ((v1-1 (vector-y-quaternion! (new 'stack-no-clear 'vector) arg0)))
(atan (-> v1-1 x) (-> v1-1 y))
)
)
(defun quaternion-vector-y-angle ((arg0 quaternion) (arg1 vector))
(let ((f30-0 (quaternion-y-angle arg0))
(f0-2 (atan (-> arg1 x) (-> arg1 z)))
)
(deg-diff f30-0 f0-2)
)
)
(defun quaternion-rotate-local-x! ((arg0 quaternion) (arg1 quaternion) (arg2 float))
(let ((a2-1 (quaternion-vector-angle! (new-stack-quaternion0) (new 'static 'vector :x 1.0 :w 1.0) arg2)))
(quaternion-normalize! (quaternion*! arg0 arg1 a2-1))
)
)
(defun quaternion-rotate-local-y! ((arg0 quaternion) (arg1 quaternion) (arg2 float))
(let ((a2-1 (quaternion-vector-angle! (new-stack-quaternion0) (new 'static 'vector :y 1.0 :w 1.0) arg2)))
(quaternion-normalize! (quaternion*! arg0 arg1 a2-1))
)
)
(defun quaternion-rotate-local-z! ((arg0 quaternion) (arg1 quaternion) (arg2 float))
(let ((a2-1 (quaternion-vector-angle! (new-stack-quaternion0) (new 'static 'vector :z 1.0 :w 1.0) arg2)))
(quaternion-normalize! (quaternion*! arg0 arg1 a2-1))
)
)
(defun quaternion-rotate-y! ((arg0 quaternion) (arg1 quaternion) (arg2 float))
(let ((a1-2 (quaternion-vector-angle! (new-stack-quaternion0) (new 'static 'vector :y 1.0 :w 1.0) arg2)))
(quaternion-normalize! (quaternion*! arg0 a1-2 arg1))
)
)
(defun quaternion-rotate-x! ((arg0 quaternion) (arg1 quaternion) (arg2 float))
(let ((a1-3 (quaternion-vector-angle! (new-stack-quaternion0) (vector-x-quaternion! (new-stack-vector0) arg1) arg2))
)
(quaternion-normalize! (quaternion*! arg0 a1-3 arg1))
)
)
(defun quaternion-rotate-z! ((arg0 quaternion) (arg1 quaternion) (arg2 float))
(let ((a1-3 (quaternion-vector-angle! (new-stack-quaternion0) (vector-z-quaternion! (new-stack-vector0) arg1) arg2))
)
(quaternion-normalize! (quaternion*! arg0 a1-3 arg1))
)
)
(defun quaternion-delta-y ((arg0 quaternion) (arg1 quaternion))
(acos (vector-dot
(vector-z-quaternion! (new 'stack-no-clear 'vector) arg0)
(vector-z-quaternion! (new 'stack-no-clear 'vector) arg1)
)
)
)
(defun quaternion-rotate-y-to-vector! ((arg0 quaternion) (arg1 quaternion) (arg2 quaternion) (arg3 float))
(let ((s5-0 (new 'stack-no-clear 'quaternion)))
(let ((t9-0 vector-xz-normalize!)
(a0-1 (new 'stack-no-clear 'vector))
)
(set! (-> a0-1 x) (-> arg2 x))
(set! (-> a0-1 y) 0.0)
(set! (-> a0-1 z) (-> arg2 z))
(set! (-> a0-1 w) 1.0)
(let ((s0-0 (t9-0 a0-1 1.0)))
(quaternion-from-two-vectors-max-angle!
s5-0
(vector-z-quaternion! (the-as vector (new 'stack-no-clear 'quaternion)) arg1)
s0-0
arg3
)
)
)
(quaternion-normalize! (quaternion*! arg0 s5-0 arg1))
)
)
(defun vector-rotate-x! ((arg0 vector) (arg1 vector) (arg2 float))
(let ((a1-2 (quaternion-vector-angle! (new 'stack-no-clear 'quaternion) (new 'static 'vector :x 1.0 :w 1.0) arg2))
(s4-0 (new 'stack-no-clear 'matrix))
)
(quaternion->matrix s4-0 a1-2)
(vector-matrix*! arg0 arg1 s4-0)
)
)
(defun vector-rotate-y! ((arg0 vector) (arg1 vector) (arg2 float))
(let ((a1-2 (quaternion-vector-angle! (new 'stack-no-clear 'quaternion) (new 'static 'vector :y 1.0 :w 1.0) arg2))
(s4-0 (new 'stack-no-clear 'matrix))
)
(quaternion->matrix s4-0 a1-2)
(vector-matrix*! arg0 arg1 s4-0)
)
)
(defun vector-rotate-z! ((arg0 vector) (arg1 vector) (arg2 float))
(let ((a1-2 (quaternion-vector-angle! (new 'stack-no-clear 'quaternion) (new 'static 'vector :z 1.0 :w 1.0) arg2))
(s4-0 (new 'stack-no-clear 'matrix))
)
(quaternion->matrix s4-0 a1-2)
(vector-matrix*! arg0 arg1 s4-0)
)
)
(defun vector-y-angle ((arg0 vector))
(atan (-> arg0 x) (-> arg0 z))
)
(defun vector-x-angle ((arg0 vector))
(atan (-> arg0 y) (vector-xz-length arg0))
)
(defun quaternion<-rotate-y-vector ((arg0 quaternion) (arg1 vector))
(quaternion-vector-angle! arg0 (new 'static 'vector :y 1.0 :w 1.0) (vector-y-angle arg1))
)
(defun-debug quaternion-validate ((arg0 quaternion))
(with-pp
(let ((f0-0 (quaternion-norm arg0)))
(when (or (< 1.01 f0-0) (< f0-0 0.99))
(format #t "WARNING: bad quaternion (magnitude ~F) process is " f0-0)
(if (and pp (type? pp process-tree))
(format #t "~A~%" (-> pp name))
(format #t "#f~%")
)
)
)
(none)
)
)
(defun quaternion-xz-angle ((arg0 quaternion))
(let ((gp-0 (new 'stack-no-clear 'matrix))
(s5-0 (new 'stack-no-clear 'vector))
)
(quaternion->matrix gp-0 arg0)
(set-vector! s5-0 0.0 0.0 1.0 1.0)
(vector-matrix*! s5-0 s5-0 gp-0)
(vector-y-angle s5-0)
)
)
+3
View File
@@ -20,6 +20,9 @@
(rot vector :inline :offset-assert 32)
(scale vector :inline :offset-assert 48)
)
(:methods
(new (symbol type) _type_ 0)
)
:method-count-assert 9
:size-assert #x40
:flag-assert #x900000040
@@ -7,6 +7,15 @@
(define-extern deg-diff (function float float float))
(define-extern sin (function float float))
(define-extern vector-sin-rad! (function vector vector vector))
(define-extern vector-sincos-rad! (function vector vector vector int))
(define-extern sincos-rad! (function (pointer float) float int))
(define-extern sincos! (function (pointer float) float int))
(define-extern vector-rad<-vector-deg/2! (function vector vector int))
(define-extern vector-sincos! (function vector vector vector int))
(define-extern cos (function float float))
(define-extern atan-series-rad (function float float))
(define-extern atan2-rad (function float float float))
(define-extern atan (function float float float))
(define-extern acos (function float float))
(define-extern acos-rad (function float float))
File diff suppressed because it is too large Load Diff
+8
View File
@@ -7,11 +7,18 @@
(define-extern vector-cross! (function vector vector vector vector))
(define-extern vector-float*! (function vector vector float vector))
(define-extern vector+float*! (function vector vector vector float vector))
(define-extern vector-negate! (function vector vector vector))
(define-extern vector-identity! (function vector vector))
(define-extern vector-length (function vector float))
(define-extern vector-length-squared (function vector float))
(define-extern vector-xz-length (function vector float))
(define-extern vector-vector-distance (function vector vector float))
(define-extern vector-vector-distance-squared (function vector vector float))
(define-extern vector-normalize! (function vector float vector))
(define-extern vector-normalize-copy! (function vector vector float vector))
(define-extern vector-normalize-ret-len! (function vector float float))
(define-extern vector-xz-normalize! (function vector float vector))
(defmacro init-vf0-vector ()
@@ -218,6 +225,7 @@
(x float :offset 0)
(y float :offset 4)
)
:allow-misaligned
:method-count-assert 9
:size-assert #x8
:flag-assert #x900000008
File diff suppressed because it is too large Load Diff
+628
View File
@@ -5,3 +5,631 @@
;; name in dgo: pad
;; dgos: ENGINE, GAME
(define-extern get-current-time (function time-frame))
(define-extern get-integral-current-time (function time-frame))
(define-extern get-current-language (function language-enum))
(define-extern add-debug-cursor (function symbol bucket-id int int int none))
(defenum pad-buttons
:bitfield #t
:type uint32
(select 0)
(l3 1)
(r3 2)
(start 3)
(up 4)
(right 5)
(down 6)
(left 7)
(l2 8)
(r2 9)
(l1 10)
(r1 11)
(triangle 12)
(circle 13)
(x 14)
(square 15)
)
(deftype scf-time (structure)
((stat uint8 :offset-assert 0)
(second uint8 :offset-assert 1)
(minute uint8 :offset-assert 2)
(hour uint8 :offset-assert 3)
(week uint8 :offset-assert 4)
(day uint8 :offset-assert 5)
(month uint8 :offset-assert 6)
(year uint8 :offset-assert 7)
)
:method-count-assert 9
:size-assert #x8
:flag-assert #x900000008
)
(define *cheat-mode* #t)
(deftype hw-cpad (basic)
((valid uint8 :offset-assert 4)
(status uint8 :offset-assert 5)
(button0 uint16 :offset-assert 6)
(rightx uint8 :offset-assert 8)
(righty uint8 :offset-assert 9)
(leftx uint8 :offset-assert 10)
(lefty uint8 :offset-assert 11)
(abutton uint8 12 :offset-assert 12)
(dummy uint8 12 :offset-assert 24)
)
:method-count-assert 9
:size-assert #x24
:flag-assert #x900000024
)
(deftype cpad-info (hw-cpad)
((number int32 :offset-assert 36)
(cpad-file int32 :offset-assert 40)
(button0-abs pad-buttons 3 :offset-assert 44)
(button0-shadow-abs pad-buttons 1 :offset-assert 56)
(button0-rel pad-buttons 3 :offset-assert 60)
(stick0-dir float :offset-assert 72)
(stick0-speed float :offset-assert 76)
(new-pad int32 :offset-assert 80)
(state int32 :offset-assert 84)
(align uint8 6 :offset-assert 88)
(direct uint8 6 :offset-assert 94)
(buzz-val uint8 2 :offset-assert 100)
(buzz-pause-val uint8 1 :offset-assert 102)
(buzz-pause-time uint8 :offset-assert 103)
(buzz-time time-frame 2 :offset-assert 104)
(buzz basic :offset-assert 120)
(buzz-act int32 :offset-assert 124)
(change-time uint64 :offset-assert 128)
(old-rightx uint8 2 :offset-assert 136)
(old-righty uint8 2 :offset-assert 138)
(old-leftx uint8 2 :offset-assert 140)
(old-lefty uint8 2 :offset-assert 142)
)
:method-count-assert 10
:size-assert #x90
:flag-assert #xa00000090
(:methods
(new (symbol type int) _type_ 0)
(dummy-9 () none 9)
)
)
(defun cpad-invalid! ((arg0 cpad-info))
(logior! (-> arg0 valid) 128)
(set! (-> arg0 button0) (the-as uint 0))
(set! (-> arg0 button0-abs 0) (pad-buttons))
(set! (-> arg0 button0-shadow-abs 0) (pad-buttons))
(set! (-> arg0 button0-rel 0) (pad-buttons))
(dotimes (v1-2 12)
(nop!)
(set! (-> arg0 abutton v1-2) (the-as uint 0))
)
(set! (-> arg0 stick0-dir) 0.0)
(set! (-> arg0 stick0-speed) 0.0)
(set! (-> arg0 rightx) (the-as uint 128))
(set! (-> arg0 righty) (the-as uint 128))
(set! (-> arg0 leftx) (the-as uint 128))
(set! (-> arg0 lefty) (the-as uint 128))
(set! (-> arg0 align 0) (the-as uint 0))
(set! (-> arg0 align 1) (the-as uint 1))
(set! (-> arg0 align 2) (the-as uint 255))
(set! (-> arg0 align 3) (the-as uint 255))
(set! (-> arg0 align 4) (the-as uint 255))
(set! (-> arg0 align 5) (the-as uint 255))
(dotimes (v1-14 6)
(nop!)
(set! (-> arg0 direct v1-14) (the-as uint 0))
)
(dotimes (v1-17 2)
(nop!)
(set! (-> arg0 buzz-val v1-17) (the-as uint 0))
(set! (-> arg0 buzz-time v1-17) 0)
)
(set! (-> arg0 buzz-pause-val 0) (the-as uint 0))
(set! (-> arg0 buzz-time 0) 0)
arg0
)
(defmethod new cpad-info ((allocation symbol) (type-to-make type) (arg0 int))
(let ((s5-0 (object-new allocation type-to-make (the-as int (-> type-to-make size)))))
(set! (-> s5-0 number) arg0)
(set! (-> s5-0 buzz) #f)
(cpad-open s5-0 arg0)
(cpad-invalid! s5-0)
)
)
(deftype cpad-list (basic)
((num-cpads int32 :offset-assert 4)
(cpads cpad-info 2 :offset-assert 8)
)
(:methods
(new (symbol type) _type_ 0)
)
:method-count-assert 9
:size-assert #x10
:flag-assert #x900000010
)
(defmethod new cpad-list ((allocation symbol) (type-to-make type))
(let ((gp-0 (object-new allocation type-to-make (the-as int (-> type-to-make size)))))
(set! (-> gp-0 num-cpads) 2)
(set! (-> gp-0 cpads 0) (new 'global 'cpad-info 0))
(set! (-> gp-0 cpads 1) (new 'global 'cpad-info 1))
gp-0
)
)
(defun analog-input ((arg0 int) (arg1 float) (arg2 float) (arg3 float) (arg4 float))
(let* ((f1-1 (- (the float arg0) arg1))
(f0-3 (- (fabs f1-1) arg2))
(v1-0 (- arg3 arg2))
)
(if (< f1-1 0.0)
(set! arg4 (- arg4))
)
(the-as float (cond
((>= 0.0 f0-3)
0
)
((>= f0-3 v1-0)
arg4
)
(else
(/ (* f0-3 arg4) v1-0)
)
)
)
)
)
(defun cpad-set-buzz! ((arg0 cpad-info) (arg1 int) (arg2 int) (arg3 time-frame))
(cond
((zero? arg2)
(set! (-> arg0 buzz-val arg1) (the-as uint 0))
0
)
((= arg2 (-> arg0 buzz-val arg1))
(set! (-> arg0 buzz-time arg1) (max (-> arg0 buzz-time arg1) (+ (get-current-time) arg3)))
)
((< (-> arg0 buzz-val arg1) (the-as uint arg2))
(set! (-> arg0 buzz-val arg1) (the-as uint arg2))
(set! (-> arg0 buzz-time arg1) (+ (get-current-time) arg3))
)
)
0
(none)
)
(define *cpad-list* (new 'global 'cpad-list))
(define *cpad-debug* #f)
(defun service-cpads ()
(let ((gp-0 *cpad-list*))
(dotimes (s5-0 (-> gp-0 num-cpads))
(let ((s4-0 (-> *cpad-list* cpads s5-0)))
(set! (-> s4-0 old-leftx 1) (-> s4-0 old-leftx 0))
(set! (-> s4-0 old-leftx 0) (-> s4-0 leftx))
(set! (-> s4-0 old-lefty 1) (-> s4-0 old-lefty 0))
(set! (-> s4-0 old-lefty 0) (-> s4-0 lefty))
(set! (-> s4-0 old-rightx 1) (-> s4-0 old-rightx 0))
(set! (-> s4-0 old-rightx 0) (-> s4-0 rightx))
(set! (-> s4-0 old-righty 1) (-> s4-0 old-righty 0))
(set! (-> s4-0 old-righty 0) (-> s4-0 righty))
(cpad-get-data s4-0)
((method-of-object s4-0 dummy-9))
(cond
((zero? (logand (-> s4-0 valid) 128))
(dotimes (s3-0 2)
(cond
((and (-> s4-0 buzz) (< (get-current-time) (-> s4-0 buzz-time s3-0)) (= *master-mode* 'game))
(let ((v1-20 s3-0))
(cond
((zero? v1-20)
(set! (-> s4-0 direct s3-0)
(logand (ash (-> s4-0 buzz-val s3-0) (- (the-as int (logand (get-integral-current-time) 7)))) 1)
)
)
((= v1-20 1)
(set! (-> s4-0 direct s3-0) (-> s4-0 buzz-val s3-0))
)
)
)
)
((and (zero? s3-0) (> (-> s4-0 buzz-pause-time) 0))
(set! (-> s4-0 direct s3-0)
(logand (ash (-> s4-0 buzz-pause-val s3-0) (- (the-as int (logand (get-integral-current-time) 7)))) 1)
)
(+! (-> s4-0 buzz-pause-time) -1)
)
(else
(set! (-> s4-0 buzz-val s3-0) (the-as uint 0))
(set! (-> s4-0 direct s3-0) (the-as uint 0))
(when (zero? s3-0)
(set! (-> s4-0 buzz-pause-time) (the-as uint 0))
0
)
)
)
)
(when (< (the-as uint 192) (-> s4-0 direct 1))
(set! (-> s4-0 direct 0) (the-as uint 0))
0
)
(set! (-> s4-0 button0-abs 2) (-> s4-0 button0-abs 1))
(set! (-> s4-0 button0-abs 1) (-> s4-0 button0-shadow-abs 0))
(set! (-> s4-0 button0-rel 2) (-> s4-0 button0-rel 1))
(set! (-> s4-0 button0-rel 1) (-> s4-0 button0-rel 0))
;; what is going on here
(when (= (-> s4-0 status) 115)
(set! (-> s4-0 abutton 0) (the-as uint (if (logtest? (-> s4-0 button0-abs 0) (pad-buttons right))
255
0
)
)
)
(set! (-> s4-0 abutton 1) (the-as uint (if (logtest? (-> s4-0 button0-abs 0) (pad-buttons left))
255
0
)
)
)
(set! (-> s4-0 abutton 2) (the-as uint (if (logtest? (-> s4-0 button0-abs 0) (pad-buttons up))
255
0
)
)
)
(set! (-> s4-0 abutton 3) (the-as uint (if (logtest? (-> s4-0 button0-abs 0) (pad-buttons down))
255
0
)
)
)
(set! (-> s4-0 abutton 6) (the-as uint (if (logtest? (-> s4-0 button0-abs 0) (pad-buttons x))
255
0
)
)
)
(set! (-> s4-0 abutton 5) (the-as uint (if (logtest? (-> s4-0 button0-abs 0) (pad-buttons circle))
255
0
)
)
)
(set! (-> s4-0 abutton 4) (the-as uint (if (logtest? (-> s4-0 button0-abs 0) (pad-buttons triangle))
255
0
)
)
)
(set! (-> s4-0 abutton 7) (the-as uint (if (logtest? (-> s4-0 button0-abs 0) (pad-buttons square))
255
0
)
)
)
(set! (-> s4-0 abutton 8) (the-as uint (if (logtest? (-> s4-0 button0-abs 0) (pad-buttons l1))
255
0
)
)
)
(set! (-> s4-0 abutton 10) (the-as uint (if (logtest? (-> s4-0 button0-abs 0) (pad-buttons l2))
255
0
)
)
)
(set! (-> s4-0 abutton 9) (the-as uint (if (logtest? (-> s4-0 button0-abs 0) (pad-buttons r1))
255
0
)
)
)
(set! (-> s4-0 abutton 11) (the-as uint (if (logtest? (-> s4-0 button0-abs 0) (pad-buttons r2))
255
0
)
)
)
)
;; what's this
(let ((s3-1 (the int (-> s4-0 button0))))
(cond
((< (-> s4-0 lefty) (the-as uint 30))
(set! s3-1 (logior #x10000 s3-1))
)
((< (the-as uint 225) (-> s4-0 lefty))
(set! s3-1 (logior #x40000 s3-1))
)
)
(cond
((< (-> s4-0 leftx) (the-as uint 30))
(set! s3-1 (logior #x80000 s3-1))
)
((< (the-as uint 225) (-> s4-0 leftx))
(set! s3-1 (logior #x20000 s3-1))
)
)
(cond
((< (-> s4-0 righty) (the-as uint 30))
(set! s3-1 (logior #x100000 s3-1))
)
((< (the-as uint 225) (-> s4-0 righty))
(set! s3-1 (logior #x400000 s3-1))
)
)
(cond
((< (-> s4-0 rightx) (the-as uint 30))
(set! s3-1 (logior #x800000 s3-1))
)
((< (the-as uint 225) (-> s4-0 rightx))
(set! s3-1 (logior #x200000 s3-1))
)
)
(let ((v1-123 (get-current-language)))
(cond
((or (= v1-123 (language-enum japanese)) (= v1-123 (language-enum uk-english)))
(case (scf-get-territory)
((2 3)
(if (logtest? s3-1 8192)
(set! s3-1 (logior #x1000000 s3-1))
)
)
(else
(if (logtest? s3-1 #x6000)
(set! s3-1 (logior #x1000000 s3-1))
)
)
)
)
((let ((v1-135 (scf-get-territory)))
(or (= v1-135 2) (= v1-135 3))
)
(if (logtest? s3-1 #x6000)
(set! s3-1 (logior #x1000000 s3-1))
)
)
(else
(if (logtest? s3-1 #x4000)
(set! s3-1 (logior #x1000000 s3-1))
)
)
)
)
(set! (-> s4-0 button0-shadow-abs 0) (the-as pad-buttons s3-1))
(set! (-> s4-0 button0-abs 0) (the-as pad-buttons s3-1))
)
(set! (-> s4-0 button0-rel 0) (logclear (-> s4-0 button0-abs 0) (-> s4-0 button0-abs 1)))
(when *cpad-debug*
(set! (-> s4-0 leftx) (the-as uint 255))
(set! (-> s4-0 rightx) (the-as uint 255))
)
(set! (-> s4-0 stick0-speed) 1.0)
(cond
((= (shr (-> s4-0 status) 4) 7)
(let ((f30-0 (* 0.0078125 (the float (+ (-> s4-0 leftx) -128))))
(f28-0 (* 0.0078125 (the float (- 127 (the-as int (-> s4-0 lefty))))))
)
(set! (-> s4-0 stick0-dir) (atan (- f30-0) f28-0))
(set! (-> s4-0 stick0-speed) (fmin 1.0 (sqrtf (+ (* f30-0 f30-0) (* f28-0 f28-0)))))
)
(if (< (-> s4-0 stick0-speed) 0.3)
(set! (-> s4-0 stick0-speed) 0.0)
)
)
(else
(set! (-> s4-0 leftx) (the-as uint 128))
(set! (-> s4-0 lefty) (the-as uint 128))
(set! (-> s4-0 rightx) (the-as uint 128))
(set! (-> s4-0 righty) (the-as uint 128))
(set! (-> s4-0 stick0-dir) 0.0)
(set! (-> s4-0 stick0-speed) 0.0)
)
)
(if (or (!= (-> s4-0 button0-abs 0) (-> s4-0 button0-abs 1))
(or (< 0.3 (-> s4-0 stick0-speed)) (zero? (-> s4-0 change-time)))
)
(set! (-> s4-0 change-time) (the-as uint (get-current-time)))
)
)
(else
(cpad-invalid! s4-0)
)
)
)
)
)
*cpad-list*
)
(defun buzz-stop! ((arg0 int))
(cpad-set-buzz! (-> *cpad-list* cpads arg0) 0 0 0)
(cpad-set-buzz! (-> *cpad-list* cpads arg0) 1 0 0)
0
(none)
)
(deftype mouse-info (basic)
((active symbol :offset-assert 4)
(cursor basic :offset-assert 8)
(valid symbol :offset-assert 12)
(id uint8 :offset-assert 16)
(status uint16 :offset-assert 18)
(button0 uint16 :offset-assert 20)
(deltax int8 :offset-assert 22)
(deltay int8 :offset-assert 23)
(wheel uint8 :offset-assert 24)
(change-time time-frame :offset-assert 32)
(button0-abs uint32 3 :offset-assert 40)
(button0-shadow-abs uint32 1 :offset-assert 52)
(button0-rel uint32 3 :offset-assert 56)
(pos vector 2 :inline :offset-assert 80)
(posx float :offset 80)
(posy float :offset 84)
(oldposx float :offset 96)
(oldposy float :offset 100)
(speedx float :offset 92)
(speedy float :offset 108)
)
(:methods
(new (symbol type) _type_ 0)
)
:method-count-assert 9
:size-assert #x70
:flag-assert #x900000070
)
(defmethod inspect mouse-info ((obj mouse-info))
(when (not obj)
(return obj)
)
(format #t "[~8x] ~A~%" obj (-> obj type))
(format #t "~1Tactive: ~A~%" (-> obj active))
(format #t "~1Tcursor: ~A~%" (-> obj cursor))
(format #t "~1Tvalid: ~A~%" (-> obj valid))
(format #t "~1Tid: ~D~%" (-> obj id))
(format #t "~1Tstatus: #x~X~%" (-> obj status))
(format #t "~1Tbutton0: #x~X~%" (-> obj button0))
(format #t "~1Tdeltax: ~D~%" (-> obj deltax))
(format #t "~1Tdeltay: ~D~%" (-> obj deltay))
(format #t "~1Twheel: ~D~%" (-> obj wheel))
(format #t "~1Tchange-time: ~D~%" (-> obj change-time))
(format #t "~1Tbutton0-abs[3] @ #x~X~%" (-> obj button0-abs))
(format #t "~1Tbutton0-shadow-abs[1] @ #x~X~%" (-> obj button0-shadow-abs))
(format #t "~1Tbutton0-rel[3] @ #x~X~%" (-> obj button0-rel))
(format #t "~1Tpos[2] @ #x~X~%" (-> obj pos))
(dotimes (s5-0 2)
(format #t "~T [~D]~1Tpos: ~`vector`P~%" s5-0 (-> obj pos s5-0))
)
(format #t "~1Tposx: ~f~%" (-> obj posx))
(format #t "~1Tposy: ~f~%" (-> obj posy))
(format #t "~1Toldposx: ~f~%" (-> obj oldposx))
(format #t "~1Toldposy: ~f~%" (-> obj oldposy))
(format #t "~1Tspeedx: ~f~%" (-> obj speedx))
(format #t "~1Tspeedy: ~f~%" (-> obj speedy))
obj
)
(defmethod new mouse-info ((allocation symbol) (type-to-make type))
(let ((v0-0 (object-new allocation type-to-make (the-as int (-> type-to-make size)))))
(set! (-> v0-0 active) #f)
(set! (-> v0-0 valid) #f)
(set! (-> v0-0 cursor) #f)
v0-0
)
)
(define *mouse* (new 'global 'mouse-info))
(defun service-mouse ()
(let ((gp-0 *mouse*))
(mouse-get-data gp-0)
(set! (-> gp-0 pos 1 quad) (-> gp-0 pos 0 quad))
(set! (-> gp-0 button0-abs 2) (-> gp-0 button0-abs 1))
(set! (-> gp-0 button0-abs 1) (-> gp-0 button0-shadow-abs 0))
(set! (-> gp-0 button0-rel 2) (-> gp-0 button0-rel 1))
(set! (-> gp-0 button0-rel 1) (-> gp-0 button0-rel 0))
(set! (-> gp-0 button0-rel 0) (the-as uint 0))
(set! (-> gp-0 speedx) 0.0)
(set! (-> gp-0 speedy) 0.0)
(cond
((or (not (-> gp-0 valid)) (not (-> gp-0 active)))
(set! (-> gp-0 valid) #f)
(set! (-> gp-0 status) (the-as uint 0))
(set! (-> gp-0 pos 0 quad) (the-as uint128 0))
(set! (-> gp-0 pos 1 quad) (the-as uint128 0))
)
((logtest? (-> gp-0 status) 1)
(set! (-> gp-0 change-time) (get-current-time))
(set! (-> gp-0 speedx) (* (sign (the float (-> gp-0 deltax))) (pow (fabs (the float (-> gp-0 deltax))) 1.3)))
(set! (-> gp-0 speedy) (* (sign (the float (-> gp-0 deltay))) (pow (fabs (the float (-> gp-0 deltay))) 1.3)))
(set! (-> gp-0 posx) (fmax -256.0 (fmin 256.0 (+ (-> gp-0 posx) (-> gp-0 speedx)))))
(set! (-> gp-0 posy) (fmax -208.0 (fmin 208.0 (+ (-> gp-0 posy) (-> gp-0 speedy)))))
(let ((v1-22 (-> gp-0 button0)))
(set! (-> gp-0 button0-shadow-abs 0) v1-22)
(set! (-> gp-0 button0-abs 0) v1-22)
)
(set! (-> gp-0 button0-rel 0) (logclear (-> gp-0 button0-abs 0) (-> gp-0 button0-abs 1)))
)
)
(if (and (-> gp-0 active) (-> gp-0 valid) (-> gp-0 cursor))
(add-debug-cursor
#t
(bucket-id debug)
(+ (the int (-> gp-0 posx)) 256)
(+ (the int (-> gp-0 posy)) 208)
(the-as int (-> gp-0 button0-abs 0))
)
)
)
(none)
)
(defmacro cpad-pressed (pad-idx)
`(-> *cpad-list* cpads ,pad-idx button0-rel 0)
)
(defmacro cpad-hold (pad-idx)
`(-> *cpad-list* cpads ,pad-idx button0-abs 0)
)
(defmacro cpad-pressed? (pad-idx &rest buttons)
`(logtest? (cpad-pressed ,pad-idx) (pad-buttons ,@buttons))
)
(defmacro cpad-hold? (pad-idx &rest buttons)
`(logtest? (cpad-hold ,pad-idx) (pad-buttons ,@buttons))
)
(defmacro cpad-clear! (pad-idx &rest buttons)
`(begin
(logclear! (cpad-pressed ,pad-idx) (pad-buttons ,@buttons))
(logclear! (cpad-hold ,pad-idx) (pad-buttons ,@buttons))
)
)
(defmacro cpad-change-time (pad-idx)
`(-> *cpad-list* cpads ,pad-idx change-time)
)
(defmacro check-cheat-code (cheat-var pad-idx buttons &rest body)
"execute body when a cheat code made up of sequential inputs has been inputted"
`(when (nonzero? (cpad-pressed ,pad-idx)) ;; only check when some button has been pressed
(case ,cheat-var
,@(apply-i
(lambda (x i)
`((,i)
(if (cpad-pressed? ,pad-idx ,x)
,(if (< i (- (length buttons) 1))
`(1+! ,cheat-var)
`(begin ,@body (set! ,cheat-var 0))
)
(set! ,cheat-var 0)
)
)
)
buttons)
)
)
)
(defmacro cheats-sound-play (cheat?)
"play the appropriate sound for inputting a cheat code"
`(if ,cheat?
(sound-play "select-menu")
(sound-play "cursor-options")
)
)
+10
View File
@@ -5,6 +5,16 @@
;; name in dgo: timer-h
;; dgos: ENGINE, GAME
;; There are two sources for timing:
;; - EE TIMER1, used for the frame profiler. There are 9765 counts of this per frame. It gets reset in drawable.
;; - The "stopwatch" system, used for reading the CPU clock cycle counter, at 300 MHz (32-bit)
;; The Emotion Engine has 4 hardware timers, timer1 is used as the
(defconstant TIMER0_BANK #x10000000) ;; has HOLD register!
(defconstant TIMER1_BANK #x10000800) ;; has HOLD register!
(defconstant TIMER2_BANK #x10001000) ;; does NOT have HOLD register!
(defconstant TIMER3_BANK #x10001800) ;; does NOT have HOLD register!
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; PC Port Timer
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+264
View File
@@ -5,3 +5,267 @@
;; name in dgo: timer
;; dgos: ENGINE, GAME
(defun timer-count ((timer timer-bank))
"Return a timer's counter value"
(#when PC_PORT
(when (= timer TIMER1_BANK)
(return (- (get-bus-clock/256) *timer-reset-value*))
)
(format 0 "Unknown timer #x~X requested.~%" timer)
)
(.sync.l)
(let ((count (-> timer count)))
(.sync.l)
count
)
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Interrupt Control
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; cop0 status register "interrupt enable" flag
;; if cop0 status is needed anywhere else, move this elsewhere
(defconstant COP0_STATUS_IE (the-as uint #x1))
(defun disable-irq ()
"Disable all interrupts. Has no effect on PC Port"
(rlet ((status :class gpr :type uint))
(let ((status-mask (lognot COP0_STATUS_IE)))
(.mfc0 status Status)
(logand! status status-mask) ;; should status-mask be replaced directly?
(.mtc0 Status status)
(.sync.p)
)
)
)
(defun enable-irq ()
"Enable all interrupts. Has no effect on PC Port."
(rlet ((status :class gpr :type uint))
(.mfc0 status Status)
(logior! status COP0_STATUS_IE)
(.mtc0 Status status)
(.sync.p)
)
)
(defun stopwatch-init ((obj stopwatch))
"Init a stopwatch"
(set! (-> obj begin-level) 0)
(set! (-> obj prev-time-elapsed) 0)
)
(defun stopwatch-reset ((obj stopwatch))
"Restart a stopwatch's times"
(set! (-> obj prev-time-elapsed) 0)
(when (> (-> obj begin-level) 0)
(let ((count 0))
(.mfc0 count Count)
(#when PC_PORT
(set! count (the int (get-cpu-clock)))
)
(set! (-> obj start-time) count)
)
)
)
(defun stopwatch-start ((obj stopwatch))
"Start a stopwatch from scratch"
(when (zero? (-> obj begin-level))
(set! (-> obj begin-level) 1)
(let ((count 0))
(.mfc0 count Count)
(#when PC_PORT
(set! count (the int (get-cpu-clock)))
)
(set! (-> obj start-time) count)
)
)
)
(defun stopwatch-stop ((obj stopwatch))
"Fully stop a stopwatch and save its elapsed time"
(when (> (-> obj begin-level) 0)
(set! (-> obj begin-level) 0)
(let ((count 0))
(let ((count 0))
(.mfc0 count Count) ;; wrong register? a typo in a rlet? who knows.
(#when PC_PORT
(set! count (the int (get-cpu-clock)))
)
(+! (-> obj prev-time-elapsed) (- count (-> obj start-time)))
)
)
)
(none)
)
(defun stopwatch-begin ((obj stopwatch))
"Begin a stopwatch level, and starts it if it hasn't yet"
(when (zero? (-> obj begin-level))
(let ((count 0))
(.mfc0 count Count)
(#when PC_PORT
(set! count (the int (get-cpu-clock)))
)
(set! (-> obj start-time) count)
)
)
(+! (-> obj begin-level) 1)
)
(defun stopwatch-end ((obj stopwatch))
"End a stopwatch level. Stops the stopwatch if it's back to level zero.
There is no guard against ending a stopwatch too many times, and a negative level
will cause errors!"
(+! (-> obj begin-level) -1)
(when (zero? (-> obj begin-level))
(set! (-> obj begin-level) 0)
(let ((count 0))
(.mfc0 count Count)
(#when PC_PORT
(set! count (the int (get-cpu-clock)))
)
(+! (-> obj prev-time-elapsed) (- count (-> obj start-time)))
)
)
(none)
)
(defun stopwatch-elapsed-ticks ((obj stopwatch))
"Returns the elapsed time so far (in clock cycles) of a stopwatch"
(let ((elapsed (-> obj prev-time-elapsed)))
(when (> (-> obj begin-level) 0)
(let ((count 0))
(.mfc0 count Count)
(#when PC_PORT
(set! count (the int (get-cpu-clock)))
)
(+! elapsed (- count (-> obj start-time)))
(set! count elapsed) ;; ??
)
)
elapsed
)
)
(defglobalconstant EE_SECONDS_PER_TICK (/ 1.0 3000000)) ;; 300MHz is a "decent enough" estimate
(defmacro cpu-ticks-to-seconds (ticks)
`(* ,EE_SECONDS_PER_TICK ,ticks)
)
(defun stopwatch-elapsed-seconds ((obj stopwatch))
"Returns the elapsed time so far (in seconds) of a stopwatch"
(cpu-ticks-to-seconds (stopwatch-elapsed-ticks obj))
)
(defmethod update-rates! clock ((obj clock) (arg0 float))
"Set the clock ratio and recompute the rates."
;; remember the clock-ratio
(set! (-> obj clock-ratio) arg0)
;; first, figure out ticks / renderered frame
(let ((f0-6 (if (nonzero? *display*)
;; ticks per frame, no lag * how much lag * our ratio
(* (-> *display* time-factor) (-> *display* dog-ratio) arg0)
(* 5.0 arg0)
)
)
)
;; want a time-adjust-ratio of 1.0 on NTSC, at 60fps (should be 5 ticks/frame)
(set! (-> obj time-adjust-ratio) (* 0.2 f0-6))
)
;; time-adjust-ratio of 1 works out to 60 fps:
(set! (-> obj seconds-per-frame) (* 0.016666668 (-> obj time-adjust-ratio)))
(set! (-> obj frames-per-second) (if (= (-> obj time-adjust-ratio) 0.0)
0.0
(* 60.0 (/ 1.0 (-> obj time-adjust-ratio)))
)
)
;; weird sparticle stuff.
(let* ((v1-12 (- (-> obj frame-counter) (-> obj old-frame-counter)))
(f0-14 v1-12)
(f1-9 (* 0.2 (the float v1-12)))
)
(set-vector! (-> obj sparticle-data) (the-as float f0-14) (* 5.0 f1-9) f1-9 f1-9)
)
arg0
)
(defmethod advance-by! clock ((obj clock) (arg0 float))
"Advance time by the given amount (time-frame units)"
;; unused
(the int (+ arg0 (-> obj accum)))
;; add the time
(+! (-> obj integral-accum) arg0)
;; remember the old frame-counter
(set! (-> obj old-integral-frame-counter) (-> obj integral-frame-counter))
;; count "frames" (really vsyncs)
(while (>= (-> obj integral-accum) (-> *display* time-factor))
(+! (-> obj integral-frame-counter) 1)
(set! (-> obj integral-accum) (- (-> obj integral-accum) (-> *display* time-factor)))
)
;; count time frames
(let ((v1-7 (the int (+ arg0 (-> obj accum)))))
(set! (-> obj accum) (- (+ arg0 (-> obj accum)) (the float v1-7)))
(set! (-> obj old-frame-counter) (-> obj frame-counter))
(+! (-> obj frame-counter) v1-7)
)
;; update rates each time - this will compensate for lag, so we have to do it each time.
(update-rates! obj (-> obj clock-ratio))
obj
)
(defmethod tick! clock ((obj clock))
"Per-frame update function for a clock"
(if (zero? (logand (-> obj mask) (-> *kernel-context* prevent-from-run)))
(advance-by! obj (* (-> *display* time-factor) (-> *display* dog-ratio) (-> obj clock-ratio)))
(set! (-> obj sparticle-data x) 0.0)
)
obj
)
(defmethod reset! clock ((obj clock))
"Reset a clock to defaults."
(set! (-> obj frame-counter) (seconds 1000))
(set! (-> obj integral-frame-counter) (the-as uint #x493e0))
(set! (-> obj accum) 0.0)
(set! (-> obj old-frame-counter) (+ (-> obj frame-counter) -1))
(set! (-> obj old-integral-frame-counter) (+ (-> obj integral-frame-counter) -1))
(update-rates! obj 1.0)
(none)
)
(defmethod save! clock ((obj clock) (arg0 (pointer uint64)))
"Save clock state, return number of bytes used (16)"
(set! (-> arg0 0) (the-as uint (-> obj frame-counter)))
(set! (-> arg0 1) (-> obj integral-frame-counter))
16
)
(defmethod load! clock ((obj clock) (arg0 (pointer uint64)))
"Load clock state, return number of bytes used (16)"
(set! (-> obj frame-counter) (the-as time-frame (-> arg0 0)))
(set! (-> obj integral-frame-counter) (-> arg0 1))
(set! (-> obj accum) 0.0)
(set! (-> obj integral-accum) 0.0)
(set! (-> obj old-frame-counter) (-> obj frame-counter))
(set! (-> obj old-integral-frame-counter) (-> obj integral-frame-counter))
16
)
+71
View File
@@ -5,3 +5,74 @@
;; name in dgo: vif-h
;; dgos: ENGINE, GAME
;;-*-Lisp-*-
(in-package goal)
(deftype vif-stat (uint32)
((vps uint8 :offset 0 :size 2)
(vew uint8 :offset 2 :size 1)
(mrk uint8 :offset 6 :size 1)
(vss uint8 :offset 8 :size 1)
(vfs uint8 :offset 9 :size 1)
(vis uint8 :offset 10 :size 1)
(int uint8 :offset 11 :size 1)
(er0 uint8 :offset 12 :size 1)
(er1 uint8 :offset 13 :size 1)
(fqc uint8 :offset 24 :size 4)
)
:method-count-assert 9
:size-assert #x4
:flag-assert #x900000004
)
(deftype vif-fbrst (uint32)
((rst uint8 :offset 0 :size 1)
(fbk uint8 :offset 1 :size 1)
(stp uint8 :offset 2 :size 1)
(stc uint8 :offset 3 :size 1)
)
:method-count-assert 9
:size-assert #x4
:flag-assert #x900000004
)
(deftype vif-err (uint32)
((mii uint8 :offset 0 :size 1)
(me0 uint8 :offset 1 :size 1)
(me1 uint8 :offset 2 :size 1)
)
:method-count-assert 9
:size-assert #x4
:flag-assert #x900000004
)
(deftype vif-bank (structure)
((stat uint32 :offset-assert 0)
(fbrst uint32 :offset 16)
(err vif-err :offset 32)
(mark uint32 :offset 48)
(cycle uint32 :offset 64)
(mode uint32 :offset 80)
(num uint32 :offset 96)
(mask uint32 :offset 112)
(code uint32 :offset 128)
(itops uint32 :offset 144)
(base uint32 :offset 160)
(offset uint32 :offset 176)
(tops uint32 :offset 192)
(itop uint32 :offset 208)
(top uint32 :offset 224)
(r0 uint32 :offset 256)
(r1 uint32 :offset 272)
(r2 uint32 :offset 288)
(r3 uint32 :offset 304)
(c0 uint32 :offset 320)
(c1 uint32 :offset 336)
(c2 uint32 :offset 352)
(c3 uint32 :offset 368)
)
:method-count-assert 9
:size-assert #x174
:flag-assert #x900000174
)
+231
View File
@@ -5,3 +5,234 @@
;; name in dgo: vu1-macros
;; dgos: ENGINE, GAME
(defmacro vu-clip (vfr cf)
"Returns the result of VCLIP.
NOTE: this implementation is pretty inefficient.
If this ends up used a lot, it's probably worth rewriting.
"
`(let ((vec (new 'stack 'vector))
(flag ,cf)
)
(.svf vec ,vfr)
(let* ((w-plus (fabs (-> vec w)))
(w-minus (- 0.0 w-plus))
)
;; CF = CF << 6
(set! flag (logand #xffffff (shl flag 6)))
(when (> (-> vec x) w-plus)
(logior! flag 1)
)
(when (< (-> vec x) w-minus)
(logior! flag 2)
)
(when (> (-> vec y) w-plus)
(logior! flag 4)
)
(when (< (-> vec y) w-minus)
(logior! flag 8)
)
(when (> (-> vec z) w-plus)
(logior! flag 16)
)
(when (< (-> vec z) w-minus)
(logior! flag 32)
)
)
flag
)
)
(defmacro vftoi4.xyzw (dst src)
"convert to 28.4 integer. This does the multiply while the number is still
a float. This will have issues for very large floats, but it seems like this
is how PCSX2 does it as well, so maybe it's right?
NOTE: this is the only version of the instruction used in Jak 1, so we
don't need to worry about masks."
`(begin
(rlet ((temp :class vf))
(set! temp 16.0)
(.mul.x.vf temp ,src temp)
(.ftoi.vf ,dst temp)
)
)
)
(defmacro vftoi12.xyzw (dst src)
"convert to 20.12 integer. This does the multiply while the number is still
a float. This will have issues for very large floats, but it seems like this
is how PCSX2 does it as well, so maybe it's right?
NOTE: this is the only version of the instruction used in Jak 1, so we
don't need to worry about masks."
`(begin
(rlet ((temp :class vf))
(set! temp 4096.0)
(.mul.x.vf temp ,src temp)
(.ftoi.vf ,dst temp)
)
)
)
(defmacro vftoi15.xyzw (dst src)
"convert to 17.15 integer. This does the multiply while the number is still
a float. This will have issues for very large floats, but it seems like this
is how PCSX2 does it as well, so maybe it's right?
NOTE: this is the only version of the instruction used in Jak 1, so we
don't need to worry about masks."
`(begin
(rlet ((temp :class vf))
(set! temp 32768.0)
(.mul.x.vf temp ,src temp)
(.ftoi.vf ,dst temp)
)
)
)
(defmacro vitof4.xyzw (dst src)
"convert from a 28.4 integer. This does the multiply while the number is still
a float. This will have issues for very large floats, but it seems like this
is how PCSX2 does it as well, so maybe it's right?
NOTE: this is the only version of the instruction used in Jak 1, so we
don't need to worry about masks."
`(begin
(rlet ((temp :class vf))
(.itof.vf ,dst ,src)
(set! temp 0.0625)
(.mul.x.vf ,dst ,dst temp)
)
)
)
(defmacro vitof12.xyzw (dst src)
"convert from a 20.12 integer. This does the multiply while the number is still
a float. This will have issues for very large floats, but it seems like this
is how PCSX2 does it as well, so maybe it's right?
NOTE: this is the only version of the instruction used in Jak 1, so we
don't need to worry about masks."
`(begin
(rlet ((temp :class vf))
(.itof.vf ,dst ,src)
(set! temp 0.000244140625)
(.mul.x.vf ,dst ,dst temp)
)
)
)
(defmacro vitof15.xyzw (dst src)
"convert from a 17.15 integer. This does the multiply while the number is still
a float. This will have issues for very large floats, but it seems like this
is how PCSX2 does it as well, so maybe it's right?
NOTE: this is the only version of the instruction used in Jak 1, so we
don't need to worry about masks."
`(begin
(rlet ((temp :class vf))
(.itof.vf ,dst ,src)
(set! temp 0.000030517578125)
(.mul.x.vf ,dst ,dst temp)
)
)
)
;; In the original game, init-for-transform stashed a bunch of stuff in registers, to be used by other functions.
;; In OpenGOAL, this seems risky so we're going to back up this manually.
;; This does mean this file now has code, but it's not a big deal.
;; This seems like it is very old GOAL code and is really only used for debug and a few weird leftovers.
(deftype transform-regs (structure)
;; Eventually we might want to actually name some of these fields to be more comprehensible?
(;; vf0 not included!
(vf1 uint128)
(vf2 uint128)
(vf3 uint128)
(vf4 uint128)
(vf5 uint128)
(vf6 uint128)
(vf7 uint128)
(vf8 uint128)
(vf9 uint128)
(vf10 uint128)
(vf11 uint128)
(vf12 uint128)
(vf13 uint128)
(vf14 uint128)
(vf15 uint128)
(vf16 uint128)
(vf17 uint128)
(vf18 uint128)
(vf19 uint128)
(vf20 uint128)
(vf21 uint128)
(vf22 uint128)
(vf23 uint128)
(vf24 uint128)
(vf25 uint128)
(vf26 uint128)
(vf27 uint128)
(vf28 uint128)
(vf29 uint128)
(vf30 uint128)
(vf31 uint128)
)
)
(define *transform-regs* (new 'static 'transform-regs))
(defmacro with-vf0 (&rest body)
"Macro for using the ps2-style vf0 register."
`(rlet ((vf0 :class vf))
(init-vf0-vector)
,@body
)
)
(defmacro load-vf (reg)
"Load a vf from the preserved vf registers"
`(.lvf ,reg (&-> *transform-regs* ,reg))
)
(defmacro save-vf (reg)
"Save a vf to the preserved vf registers"
`(.svf (&-> *transform-regs* ,reg) ,reg)
)
(defmacro with-vf (regs &key (rw 'read) &rest body)
"Macro for using the specified ps2-style vf registers. These are preserved in *transform-regs*
Each register name in regs must be a valid vf register name. vf0 CANNOT be used! Use with-vf0 for that instead.
rw specifies the read/write mode:
'read means the registers will be read from the preserved registers. This is the default
'write means the registers will be written to the preserved registers at the end
'readwrite (or 'rw) means both
#f means neither, turning this into a fancy macro around rlet."
`(rlet (,@(apply (lambda (x) `(,x :class vf)) regs))
,@(if (or (eq? rw ''read) (eq? rw ''readwrite) (eq? rw ''rw))
(apply (lambda (y)
`(load-vf ,y)
) regs)
'()
)
,@body
;; this will mess up the return value!
,@(if (or (eq? rw ''write) (eq? rw ''readwrite) (eq? rw ''rw))
(apply (lambda (y)
`(save-vf ,y)
) regs)
'()
)
)
)
+422
View File
@@ -5,3 +5,425 @@
;; name in dgo: gsound-h
;; dgos: ENGINE, GAME
(defenum sound-command
:type uint16
; (load-bank)
; (load-music)
; (unload-bank)
; (play)
; (pause-sound)
; (stop-sound)
; (continue-sound)
; (set-param)
; (set-master-volume)
; (pause-group)
; (stop-group)
; (continue-group)
; (get-irx-version)
; (set-falloff-curve)
; (set-sound-falloff)
; (reload-info)
; (set-language)
; (set-flava)
; (set-reverb)
; (set-ear-trans)
; (shutdown)
; (list-sounds)
; (unload-music)
; (set-fps)
)
(defenum sound-group
:bitfield #t
:type uint8
; (sfx)
; (music)
; (dialog)
; (sog3)
; (ambient)
; (sog5)
; (sog6)
; (sog7)
)
(defenum sound-mask
:bitfield #t
:type uint16
; (volume)
; (pitch)
; (bend)
; (unused)
; (time)
; (trans)
; (fo-min)
; (fo-max)
; (fo-curve)
)
(deftype sound-stream-name (structure)
((name uint8 48 :offset-assert 0)
)
:method-count-assert 9
:size-assert #x30
:flag-assert #x900000030
)
(deftype sound-id (uint32)
()
:method-count-assert 10
:size-assert #x4
:flag-assert #xa00000004
(:methods
(unused-9 () none 9)
)
)
(deftype sound-bank-id (uint32)
()
:method-count-assert 9
:size-assert #x4
:flag-assert #x900000004
)
(deftype sound-name (uint128)
((lo uint64 :offset 0 :size 64)
(hi uint64 :offset 64 :size 64)
)
:method-count-assert 9
:size-assert #x10
:flag-assert #x900000010
)
;; definition of type sound-rpc-cmd
(deftype sound-rpc-cmd (structure)
((rsvd1 uint16 :offset-assert 0)
(command sound-command :offset-assert 2)
)
:method-count-assert 9
:size-assert #x4
:flag-assert #x900000004
)
(deftype sound-play-params (structure)
((mask uint16 :offset-assert 0)
(pitch-mod int16 :offset-assert 2)
(bend int16 :offset-assert 4)
(fo-min int16 :offset-assert 6)
(fo-max int16 :offset-assert 8)
(fo-curve int8 :offset-assert 10)
(priority int8 :offset-assert 11)
(volume int32 :offset-assert 12)
(trans int32 3 :offset-assert 16)
(group uint8 :offset-assert 28)
(reg uint8 3 :offset-assert 29)
)
:allow-misaligned
:method-count-assert 9
:size-assert #x20
:flag-assert #x900000020
)
(deftype sound-rpc-bank-cmd (sound-rpc-cmd)
((bank-name sound-name :offset-assert 16)
)
:method-count-assert 9
:size-assert #x20
:flag-assert #x900000020
)
(deftype sound-rpc-test-cmd (sound-rpc-cmd)
((ee-addr uint32 :offset-assert 4)
(param0 uint16 :offset-assert 8)
)
:method-count-assert 9
:size-assert #xa
:flag-assert #x90000000a
)
(deftype sound-rpc-sound-cmd (sound-rpc-cmd)
((id sound-id :offset-assert 4)
)
:method-count-assert 9
:size-assert #x8
:flag-assert #x900000008
)
(deftype sound-rpc-group-cmd (sound-rpc-cmd)
((group sound-group :offset-assert 4)
)
:method-count-assert 9
:size-assert #x5
:flag-assert #x900000005
)
(deftype sound-rpc-load-bank (sound-rpc-bank-cmd)
((ee-addr uint32 :offset-assert 32)
)
:method-count-assert 9
:size-assert #x24
:flag-assert #x900000024
)
(deftype sound-rpc-load-music (sound-rpc-bank-cmd)
()
:method-count-assert 9
:size-assert #x20
:flag-assert #x900000020
)
(deftype sound-rpc-unload-bank (sound-rpc-bank-cmd)
()
:method-count-assert 9
:size-assert #x20
:flag-assert #x900000020
)
(deftype sound-rpc-play (sound-rpc-sound-cmd)
((name sound-name :offset-assert 16)
(params sound-play-params :inline :offset-assert 32)
)
:method-count-assert 9
:size-assert #x40
:flag-assert #x900000040
)
(deftype sound-rpc-pause-sound (sound-rpc-sound-cmd)
()
:method-count-assert 9
:size-assert #x8
:flag-assert #x900000008
)
(deftype sound-rpc-stop-sound (sound-rpc-sound-cmd)
()
:method-count-assert 9
:size-assert #x8
:flag-assert #x900000008
)
(deftype sound-rpc-continue-sound (sound-rpc-sound-cmd)
()
:method-count-assert 9
:size-assert #x8
:flag-assert #x900000008
)
(deftype sound-rpc-set-param (sound-rpc-sound-cmd)
((params sound-play-params :inline :offset-assert 8)
(auto-time int32 :offset-assert 40)
(auto-from int32 :offset-assert 44)
)
:method-count-assert 9
:size-assert #x30
:flag-assert #x900000030
)
(deftype sound-rpc-set-master-volume (sound-rpc-group-cmd)
((volume int32 :offset-assert 8)
)
:method-count-assert 9
:size-assert #xc
:flag-assert #x90000000c
)
(deftype sound-rpc-pause-group (sound-rpc-group-cmd)
()
:method-count-assert 9
:size-assert #x5
:flag-assert #x900000005
)
(deftype sound-rpc-stop-group (sound-rpc-group-cmd)
()
:method-count-assert 9
:size-assert #x5
:flag-assert #x900000005
)
(deftype sound-rpc-continue-group (sound-rpc-group-cmd)
()
:method-count-assert 9
:size-assert #x5
:flag-assert #x900000005
)
(deftype sound-rpc-get-irx-version (sound-rpc-cmd)
((major uint32 :offset-assert 4)
(minor uint32 :offset-assert 8)
(ee-addr pointer :offset-assert 12)
)
:method-count-assert 9
:size-assert #x10
:flag-assert #x900000010
)
(deftype sound-rpc-set-language (sound-rpc-cmd)
((lang uint32 :offset-assert 4)
)
:method-count-assert 9
:size-assert #x8
:flag-assert #x900000008
)
(deftype sound-rpc-set-stereo-mode (sound-rpc-cmd)
((mode int32 :offset-assert 4)
)
:method-count-assert 9
:size-assert #x8
:flag-assert #x900000008
)
(deftype sound-rpc-set-reverb (sound-rpc-cmd)
((core uint8 :offset-assert 4)
(reverb int32 :offset-assert 8)
(left uint32 :offset-assert 12)
(right uint32 :offset-assert 16)
)
:method-count-assert 9
:size-assert #x14
:flag-assert #x900000014
)
(deftype sound-rpc-set-ear-trans (sound-rpc-cmd)
((ear-trans1 int32 3 :offset-assert 4)
(ear-trans0 int32 3 :offset-assert 16)
(cam-trans int32 3 :offset-assert 28)
(cam-angle int32 :offset-assert 40)
)
:method-count-assert 9
:size-assert #x2c
:flag-assert #x90000002c
)
(deftype sound-rpc-set-flava (sound-rpc-cmd)
((flava uint8 :offset-assert 4)
(excitement uint8 :offset-assert 5)
)
:method-count-assert 9
:size-assert #x6
:flag-assert #x900000006
)
(deftype sound-rpc-set-midi-reg (sound-rpc-cmd)
((reg int32 :offset-assert 4)
(value int16 :offset-assert 8)
)
:method-count-assert 9
:size-assert #xa
:flag-assert #x90000000a
)
(deftype sound-rpc-shutdown (sound-rpc-cmd)
()
:method-count-assert 9
:size-assert #x4
:flag-assert #x900000004
)
(deftype sound-rpc-set-fps (sound-rpc-cmd)
((fps uint8 :offset-assert 4)
)
:method-count-assert 9
:size-assert #x5
:flag-assert #x900000005
)
(deftype sound-rpc-list-sounds (sound-rpc-cmd)
()
:method-count-assert 9
:size-assert #x4
:flag-assert #x900000004
)
(deftype sound-rpc-unload-music (sound-rpc-cmd)
()
:method-count-assert 9
:size-assert #x4
:flag-assert #x900000004
)
(deftype sound-rpc-union (structure)
((data uint32 20 :offset-assert 0)
(load-bank sound-rpc-load-bank :offset 0)
(unload-bank sound-rpc-unload-bank :offset 0)
(play sound-rpc-play :offset 0)
(pause-sound sound-rpc-pause-sound :offset 0)
(stop-sound sound-rpc-stop-sound :offset 0)
(continue-sound sound-rpc-continue-sound :offset 0)
(set-param sound-rpc-set-param :offset 0)
(set-master-volume sound-rpc-set-master-volume :offset 0)
(pause-group sound-rpc-pause-group :offset 0)
(stop-group sound-rpc-stop-group :offset 0)
(continue-group sound-rpc-continue-group :offset 0)
(get-irx-version sound-rpc-get-irx-version :offset 0)
(set-language sound-rpc-set-language :offset 0)
(set-reverb sound-rpc-set-reverb :offset 0)
(set-ear-trans sound-rpc-set-ear-trans :offset 0)
(set-flava sound-rpc-set-flava :offset 0)
(set-midi-reg sound-rpc-set-midi-reg :offset 0)
(set-fps sound-rpc-set-fps :offset 0)
(shutdown sound-rpc-shutdown :offset 0)
(list-sounds sound-rpc-list-sounds :offset 0)
(unload-music sound-rpc-unload-music :offset 0)
)
:method-count-assert 9
:size-assert #x50
:flag-assert #x900000050
)
(deftype sound-spec (basic)
((mask sound-mask :offset-assert 4)
(num float :offset-assert 8)
(group sound-group :offset-assert 12)
(reg uint8 3 :offset-assert 13)
(sound-name-char uint8 16 :offset-assert 16)
(sound-name sound-name :offset 16)
(trans int32 4 :offset-assert 32)
(volume int32 :offset-assert 48)
(pitch-mod int32 :offset-assert 52)
(bend int32 :offset-assert 56)
(fo-min int16 :offset-assert 60)
(fo-max int16 :offset-assert 62)
(fo-curve int8 :offset-assert 64)
(priority int8 :offset-assert 65)
(auto-time int32 :offset-assert 68)
(auto-from int32 :offset-assert 72)
)
:method-count-assert 9
:size-assert #x4c
:flag-assert #x90000004c
)
(define *current-sound-id* (the-as sound-id #x10000))
(deftype ambient-sound (basic)
((spec sound-spec :offset-assert 4)
(playing-id sound-id :offset-assert 8)
(trans vector :inline :offset-assert 16)
(name sound-name :offset-assert 32)
(play-time time-frame :offset-assert 48)
(time-base time-frame :offset-assert 56)
(time-random time-frame :offset-assert 64)
(volume int32 :offset-assert 72)
(pitch int32 :offset-assert 76)
(falloff-near int32 :offset-assert 80)
(falloff-far int32 :offset-assert 84)
(falloff-mode int32 :offset-assert 88)
(params (pointer float) :offset-assert 92)
(param-count int32 :offset-assert 96)
(entity entity :offset-assert 100)
(sound-count int32 :offset-assert 104)
)
:method-count-assert 16
:size-assert #x6c
:flag-assert #x100000006c
(:methods
(dummy-9 () none 9)
(dummy-10 () none 10)
(dummy-11 () none 11)
(dummy-12 () none 12)
(dummy-13 () none 13)
(dummy-14 () none 14)
(dummy-15 () none 15)
)
)
+47
View File
@@ -5,3 +5,50 @@
;; name in dgo: capture-h
;; dgos: ENGINE, GAME
(declare-file (debug))
(when *debug-segment*
(deftype gs-store-image-packet (structure)
((vifcode vif-tag 4 :offset-assert 0)
(giftag gif-tag :offset-assert 16)
(bitbltbuf gs-bitbltbuf :offset-assert 32)
(bitbltbuf-addr gs-reg64 :offset-assert 40)
(trxpos gs-trxpos :offset-assert 48)
(trxpos-addr gs-reg64 :offset-assert 56)
(trxreg gs-trxreg :offset-assert 64)
(trxreg-addr gs-reg64 :offset-assert 72)
(finish int64 :offset-assert 80)
(finish-addr gs-reg64 :offset-assert 88)
(trxdir gs-trxdir :offset-assert 96)
(trxdir-addr gs-reg64 :offset-assert 104)
)
:method-count-assert 9
:size-assert #x70
:flag-assert #x900000070
)
(deftype screen-shot-work (structure)
((count int16 :offset-assert 0)
(size int16 :offset-assert 2)
(name basic :offset-assert 4)
(highres-enable basic :offset-assert 8)
(hud-enable basic :offset-assert 12)
)
:method-count-assert 9
:size-assert #x10
:flag-assert #x900000010
)
(define *screen-shot-work* (new 'global 'screen-shot-work))
(set! (-> *screen-shot-work* count) -1)
(set! (-> *screen-shot-work* size) -1)
(set! (-> *screen-shot-work* highres-enable) #f)
(set! (-> *screen-shot-work* hud-enable) #f)
(define *image-name* (new 'global 'string 32 (the-as string #f)))
)
+106
View File
@@ -5,3 +5,109 @@
;; name in dgo: profile-h
;; dgos: ENGINE, GAME
(deftype profile-segment (structure)
((name basic :offset-assert 0)
(start-time int16 :offset-assert 4)
(end-time int16 :offset-assert 6)
(count uint8 :offset-assert 8)
(vu-count uint8 :offset-assert 9)
(depth uint16 :offset-assert 10)
(color uint32 :offset-assert 12)
(code-time uint16 :offset 4)
(vu-time uint16 :offset 6)
)
:allow-misaligned
:method-count-assert 9
:size-assert #x10
:flag-assert #x900000010
)
(deftype profile-collapse (structure)
((count int32 :offset-assert 0)
(data profile-segment 48 :inline :offset-assert 4)
)
:method-count-assert 9
:size-assert #x304
:flag-assert #x900000304
)
(deftype profile-segment-array (basic)
((count int16 :offset-assert 4)
(depth int8 :offset-assert 6)
(max-depth int8 :offset-assert 7)
(base-time int16 :offset-assert 8)
(segment basic 9 :offset-assert 12)
(data profile-segment 512 :inline :offset-assert 48)
)
:method-count-assert 13
:size-assert #x2030
:flag-assert #xd00002030
(:methods
(get-total-time (_type_) int 9)
(dummy-10 () none 10)
(dummy-11 () none 11)
(dummy-12 () none 12)
)
)
(deftype profile-array (structure)
((data profile-segment-array 2 :offset-assert 0)
)
:method-count-assert 12
:size-assert #x8
:flag-assert #xc00000008
(:methods
(dummy-9 () none 9)
(dummy-10 () none 10)
(dummy-11 () none 11)
)
)
(defmethod get-total-time profile-segment-array ((obj profile-segment-array))
(- (-> obj data 0 end-time) (-> obj data 0 start-time))
)
(define *profile-gap-color* (new 'static 'rgba :r #x30 :g #x30 :b #x30 :a #x80))
(define *profile-all-color* (new 'static 'rgba :r #x55 :g #x55 :b #x55 :a #x80))
(define *profile-particles-color* (new 'static 'rgba :r #x80 :g #x40 :b #x40 :a #x80))
(define *profile-target-color* (new 'static 'rgba :r #x40 :g #x80 :b #x40 :a #x80))
(define *profile-target-post-color* (new 'static 'rgba :r #x40 :g #x40 :b #x80 :a #x80))
(define *profile-joints-color* (new 'static 'rgba :r #x70 :g #x70 :b #x20 :a #x80))
(define *profile-debug-color* (new 'static 'rgba :r #x80 :g #x80 :b #x80 :a #x80))
(define *profile-draw-hook-color* (new 'static 'rgba :r #x20 :g #x70 :b #x70 :a #x80))
(define *profile-sky-color* (new 'static 'rgba :r #x80 :g #x60 :b #x20 :a #x80))
(define *profile-ocean-color* (new 'static 'rgba :r #x60 :g #x80 :b #x20 :a #x80))
(define *profile-background-color* (new 'static 'rgba :r #x60 :g #x60 :b #x40 :a #x80))
(define *profile-bsp-color* (new 'static 'rgba :r #x60 :g #x40 :b #x60 :a #x80))
(define *profile-foreground-color* (new 'static 'rgba :r #x40 :g #x60 :b #x60 :a #x80))
(define *profile-tfrag-color* (new 'static 'rgba :r #x80 :g #x80 :a #x80))
(define *profile-instance-tie-color* (new 'static 'rgba :r #x80 :b #x80 :a #x80))
(define *profile-instance-shrubbery-color* (new 'static 'rgba :g #x80 :b #x80 :a #x80))
(define *profile-generic-tie-color* (new 'static 'rgba :r #x80 :g #x20 :b #x60 :a #x80))
(define *profile-bones-color* (new 'static 'rgba :r #x20 :g #x80 :b #x60 :a #x80))
(define *profile-generic-merc-color* (new 'static 'rgba :r #x20 :g #x60 :b #x80 :a #x80))
(define *profile-shadow-color* (new 'static 'rgba :r #x48 :g #x48 :b #x70 :a #x80))
(define *profile-update-actors-color* (new 'static 'rgba :r #x48 :g #x70 :b #x48 :a #x80))
(define *profile-menu-hook-color* (new 'static 'rgba :r #x70 :g #x48 :b #x48 :a #x80))
(define *profile-texture-color* (new 'static 'rgba :r #x80 :g #x70 :b #x10 :a #x80))
(define *profile-effects-color* (new 'static 'rgba :r #x70 :g #x80 :b #x10 :a #x80))
(define *profile-sprite-color* (new 'static 'rgba :r #x70 :g #x10 :b #x80 :a #x80))
(define *profile-merc-color* (new 'static 'rgba :r #x10 :g #x70 :b #x80 :a #x80))
(define *profile-actors-color* (new 'static 'rgba :r #x80 :g #x10 :b #x70 :a #x80))
(define *profile-collide-color* (new 'static 'rgba :r #x80 :g #x40 :b #x80 :a #x80))
(define *profile-nav-color* (new 'static 'rgba :r #x38 :g #x48 :b #x80 :a #x80))
(define *profile-camera-color* (new 'static 'rgba :r #x80 :g #x80 :b #x80 :a #x80))
(define *profile-blit-color* (new 'static 'rgba :r #xff :g #xff :b #x80 :a #x80))
(define *profile-hud-color* (new 'static 'rgba :r #xff :g #x80 :b #xff :a #x80))
(define *profile-emerc-color* (new 'static 'rgba :r #x80 :g #xff :b #xff :a #x80))
(when *debug-segment*
(define *profile-array* (new 'debug 'profile-array))
(set! (-> *profile-array* data 0) (new 'debug 'profile-segment-array))
(set! (-> *profile-array* data 1) (new 'debug 'profile-segment-array))
(define *profile-collapse* (new 'debug 'profile-collapse))
(define *profile-interrupt-segment* (-> *profile-array* data 1))
(define *profile-interrupt-start* #f)
)
+12
View File
@@ -5,6 +5,18 @@
;; name in dgo: types-h
;; dgos: ENGINE, GAME
(defenum language-enum
:type int64
(english)
(french)
(german)
(spanish)
(italian)
(japanese)
(uk-english)
)
(deftype part-id (uint32)
()
:method-count-assert 9
+13
View File
@@ -90,8 +90,21 @@
(define-extern dgo-load (function string kheap link-flag int none))
(define-extern malloc (function symbol int pointer))
(declare-type cpad-info basic)
(define-extern cpad-open (function cpad-info int cpad-info))
(define-extern cpad-get-data (function cpad-info cpad-info))
(declare-type mouse-info basic)
(define-extern mouse-get-data (function mouse-info none))
(define-extern scf-get-territory (function int)) ;; not actually a scf function...
(define-extern __read-ee-timer (function uint))
(define-extern __mem-move (function pointer pointer uint none))
(define-extern file-stream-read (function file-stream pointer int int))
(define-extern file-stream-open (function file-stream basic symbol file-stream))
(define-extern file-stream-length (function file-stream int))
;; PC stuff
+55 -1
View File
@@ -1189,4 +1189,58 @@
,@body
)
)
)
)
;;;;;;;;;;;;;;;;;;;;;;;;
;; Decompiler Macros
;;;;;;;;;;;;;;;;;;;;;;;;
;; inserted by the decompiler for assembly branches.
(defmacro b! (pred destination &key (delay '()) &key (likely-delay '()))
"Branch!"
;; evaluate the predicate
`(let ((should-branch ,pred))
;; normal delay slot:
,delay
(when should-branch
,likely-delay
(goto ,destination)
)
)
)
;; the decompiler may fail to recognize setting fields of a 128-bit bitfield
;; and will rely on this macro:
(defmacro copy-and-set-field (original field-name field-value)
`(let ((temp-copy ,original))
(set! (-> temp-copy ,field-name) ,field-value)
temp-copy
)
)
;; inserted by the decompiler if a c->goal bool conversion can't be compacted into a single
;; expression.
(defmacro cmove-#f-zero (dest condition src)
`(if (zero? ,condition)
(set! ,dest #f)
(set! ,dest ,src)
)
)
(defmacro empty-form ()
`(none)
)
;;;;;;;;;;;;;;;;;;;;;;;
;; PC Port asm macros
;;;;;;;;;;;;;;;;;;;;;;;
(#when PC_PORT
;; SYNC is an EE instruction that waits for various memory access and DMA to be completed
;; DMA will be instant in the PC port, so these are no longer necessary
(fake-asm .sync.l)
(fake-asm .sync.p)
;; Copies the contents of a cop0 (system control) register to a gpr
(fake-asm .mfc0 dest src)
;; Copies the contents of a gpr to a cop0 (system control) register
(fake-asm .mtc0 dest src)
)
+3 -3
View File
@@ -169,9 +169,9 @@
:flag-assert #xf0000005c
(:methods
(new (symbol type int) _type_ 0)
(update-rates! (_type_ float) none 9)
(advance-by! (_type_ float) none 10)
(tick! (_type_) none 11)
(update-rates! (_type_ float) float 9)
(advance-by! (_type_ float) clock 10)
(tick! (_type_) clock 11)
(save! (_type_ (pointer uint64)) int 12)
(load! (_type_ (pointer uint64)) int 13)
(reset! (_type_) none 14)
+6 -1
View File
@@ -847,7 +847,12 @@ void Compiler::fill_static_array_inline(const goos::Object& form,
if (is_integer(content_type)) {
typecheck(form, TypeSpec("integer"), sr.typespec());
} else {
typecheck(form, content_type, sr.typespec());
if (sr.is_symbol() && sr.symbol_name() == "#f") {
// allow #f for any structure.
typecheck(form, TypeSpec("structure"), content_type);
} else {
typecheck(form, content_type, sr.typespec());
}
}
if (sr.is_symbol()) {
ASSERT(deref_info.stride == 4);