mirror of
https://github.com/open-goal/jak-project
synced 2026-09-10 04:22:13 -04:00
more temp stuff
This commit is contained in:
@@ -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") &&
|
||||
|
||||
@@ -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;
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
@@ -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) {
|
||||
|
||||
+2774
-1332
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)"]
|
||||
]
|
||||
}
|
||||
@@ -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,
|
||||
|
||||
@@ -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!": []
|
||||
}
|
||||
|
||||
@@ -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": []
|
||||
}
|
||||
|
||||
@@ -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());
|
||||
|
||||
@@ -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
|
||||
)
|
||||
|
||||
|
||||
@@ -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)
|
||||
)
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
@@ -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)
|
||||
)
|
||||
)
|
||||
)
|
||||
|
||||
)
|
||||
|
||||
|
||||
|
||||
|
||||
@@ -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
|
||||
|
||||
@@ -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!)
|
||||
)
|
||||
@@ -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
@@ -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)
|
||||
@@ -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
|
||||
)
|
||||
|
||||
|
||||
@@ -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
|
||||
)
|
||||
)
|
||||
|
||||
|
||||
|
||||
@@ -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
|
||||
)
|
||||
|
||||
@@ -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
|
||||
)
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
@@ -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)
|
||||
)
|
||||
)
|
||||
|
||||
|
||||
|
||||
@@ -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))
|
||||
|
||||
|
||||
@@ -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
|
||||
)
|
||||
|
||||
@@ -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)
|
||||
|
||||
|
||||
|
||||
|
||||
@@ -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
|
||||
)
|
||||
)
|
||||
)
|
||||
)
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
@@ -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
|
||||
)
|
||||
|
||||
|
||||
|
||||
|
||||
@@ -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
|
||||
)
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
@@ -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
|
||||
)
|
||||
)
|
||||
@@ -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
|
||||
)
|
||||
)
|
||||
|
||||
@@ -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)
|
||||
)
|
||||
)
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
@@ -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
@@ -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
@@ -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")
|
||||
)
|
||||
)
|
||||
|
||||
@@ -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
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
|
||||
@@ -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
|
||||
)
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
@@ -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
|
||||
)
|
||||
|
||||
@@ -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)
|
||||
'()
|
||||
)
|
||||
|
||||
)
|
||||
)
|
||||
|
||||
|
||||
|
||||
@@ -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)
|
||||
)
|
||||
)
|
||||
|
||||
@@ -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)))
|
||||
|
||||
|
||||
)
|
||||
|
||||
|
||||
|
||||
|
||||
@@ -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)
|
||||
)
|
||||
|
||||
|
||||
|
||||
|
||||
@@ -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
|
||||
|
||||
@@ -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
|
||||
|
||||
@@ -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)
|
||||
)
|
||||
|
||||
@@ -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)
|
||||
|
||||
@@ -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);
|
||||
|
||||
Reference in New Issue
Block a user