New Pretty Printer (#994)

* begin work on improved pretty printer

* update ref

* finish pretty printer

* force line break for defstate
This commit is contained in:
water111
2021-12-04 16:06:01 -05:00
committed by GitHub
parent e69266bc95
commit dbc266c00b
362 changed files with 203258 additions and 275281 deletions
+3 -1
View File
@@ -11,7 +11,9 @@ add_library(common
goos/Interpreter.cpp
goos/Object.cpp
goos/ParseHelpers.cpp
goos/Printer.cpp
goos/PrettyPrinter.cpp
goos/PrettyPrinter2.cpp
goos/Reader.cpp
goos/TextDB.cpp
goos/ReplUtils.cpp
@@ -36,7 +38,7 @@ add_library(common
util/os.cpp
util/print_float.cpp
util/FontUtils.cpp
util/image_loading.cpp)
util/image_loading.cpp "goos/Printer.cpp" "goos/Printer.h" "goos/PrettyPrinter2.cpp" "goos/PrettyPrinter2.h")
target_link_libraries(common fmt lzokay replxx libzstd_static)
+3 -96
View File
@@ -13,37 +13,10 @@
#include "third-party/fmt/core.h"
#include "common/log/log.h"
#include "common/goos/PrettyPrinter2.h"
namespace pretty_print {
namespace {
// the integer representation is used here instead, wouldn't want really long numbers
const std::unordered_set<u32> banned_floats = {};
// print these floats (shown as ints here) as a named constant instead
const std::unordered_map<u32, std::string> const_floats = {{0x40490fda, "PI"},
{0xc0490fda, "MINUS_PI"}};
} // namespace
/*!
* Print a float in a nice representation if possible, or an exact 32-bit integer constant to
* be reinterpreted.
*/
goos::Object float_representation(float value) {
u32 int_value;
memcpy(&int_value, &value, 4);
u8 exp = (int_value >> 23) & 0xff;
u32 mant = int_value & 0x7fffff;
if ((exp == 0 && mant != 0) || exp == 0xff) {
// lg::warn("PS2-incompatible float (0x{:08X}) detected! Writing as the-as cast.", int_value);
return pretty_print::build_list("the-as", "float", fmt::format("#x{:x}", int_value));
} else if (const_floats.find(int_value) != const_floats.end()) {
return pretty_print::to_symbol(const_floats.at(int_value));
} else if (banned_floats.find(int_value) == banned_floats.end()) {
return goos::Object::make_float(value);
} else {
return pretty_print::build_list("the-as", "float", fmt::format("#x{:x}", int_value));
}
}
/*!
* A single token which cannot be split between lines.
*/
@@ -769,7 +742,7 @@ void insertSpecialBreaks(NodePool& pool, PrettyPrinterNode* node) {
}
}
std::string to_string(const goos::Object& obj, int line_length) {
std::string to_string_v1(const goos::Object& obj, int line_length) {
NodePool pool;
std::vector<FormToken> tokens;
add_to_token_list(obj, &tokens);
@@ -834,70 +807,4 @@ std::string to_string(const goos::Object& obj, int line_length) {
return pretty;
}
std::unique_ptr<goos::Reader> pretty_printer_reader;
goos::Reader& get_pretty_printer_reader() {
if (!pretty_printer_reader) {
pretty_printer_reader = std::make_unique<goos::Reader>();
}
return *pretty_printer_reader;
}
goos::Object to_symbol(const std::string& str) {
return goos::SymbolObject::make_new(get_pretty_printer_reader().symbolTable, str);
}
goos::Object build_list(const std::string& str) {
return build_list(to_symbol(str));
}
goos::Object build_list(const goos::Object& obj) {
return goos::PairObject::make_new(obj, goos::Object::make_empty_list());
}
goos::Object build_list(const std::vector<goos::Object>& objects) {
if (objects.empty()) {
return goos::Object::make_empty_list();
} else {
return build_list(objects.data(), objects.size());
}
}
// build a list out of an array of forms
goos::Object build_list(const goos::Object* objects, int count) {
assert(count);
auto car = objects[0];
goos::Object cdr;
if (count - 1) {
cdr = build_list(objects + 1, count - 1);
} else {
cdr = goos::Object::make_empty_list();
}
return goos::PairObject::make_new(car, cdr);
}
// build a list out of a vector of strings that are converted to symbols
goos::Object build_list(const std::vector<std::string>& symbols) {
if (symbols.empty()) {
return goos::Object::make_empty_list();
}
std::vector<goos::Object> f;
f.reserve(symbols.size());
for (auto& x : symbols) {
f.push_back(to_symbol(x));
}
return build_list(f.data(), f.size());
}
void append(goos::Object& _in, const goos::Object& add) {
auto* in = &_in;
while (in->is_pair() && !in->as_pair()->cdr.is_empty_list()) {
in = &in->as_pair()->cdr;
}
if (!in->is_pair()) {
assert(false); // invalid list
}
in->as_pair()->cdr = add;
}
} // namespace pretty_print
+3 -41
View File
@@ -10,49 +10,11 @@
#include <vector>
#include "common/goos/Object.h"
#include "common/goos/Reader.h"
#include "common/goos/Printer.h"
#include "common/goos/PrettyPrinter2.h"
namespace pretty_print {
// main pretty print function
std::string to_string(const goos::Object& obj, int line_length = 80);
// string -> object (as a symbol)
goos::Object to_symbol(const std::string& str);
// list with a single symbol from a string
goos::Object build_list(const std::string& str);
// wrap an object in a list
goos::Object build_list(const goos::Object& obj);
// build a list out of a vector of forms
goos::Object build_list(const std::vector<goos::Object>& objects);
// build a list out of an array of forms
goos::Object build_list(const goos::Object* objects, int count);
// build a list out of a vector of strings that are converted to symbols
goos::Object build_list(const std::vector<std::string>& symbols);
// fancy wrapper functions. Due to template magic these can call each other
// and accept mixed arguments!
template <typename... Args>
goos::Object build_list(const goos::Object& car, Args... rest);
template <typename... Args>
goos::Object build_list(const std::string& str, Args... rest) {
return goos::PairObject::make_new(to_symbol(str), build_list(rest...));
}
template <typename... Args>
goos::Object build_list(const goos::Object& car, Args... rest) {
return goos::PairObject::make_new(car, build_list(rest...));
}
goos::Reader& get_pretty_printer_reader();
goos::Object float_representation(float value);
void append(goos::Object& _in, const goos::Object& add);
std::string to_string_v1(const goos::Object& obj, int line_length = 80);
} // namespace pretty_print
+424
View File
@@ -0,0 +1,424 @@
#include "PrettyPrinter2.h"
#include "common/common_types.h"
#include "common/util/assert.h"
#include "third-party/fmt/core.h"
namespace pretty_print {
namespace v2 {
// Note: there's some recursive stuff, but we only recurse once per list depth.
// The previous issues we had with stack overflow only happened when there was a stack frame per
// element in a list.
// TODO: there's a different style of splitting that we should do for forms like:
// set!, and, or, <, >, +... where we try leaving operator + one other.
// The main node type.
// unlike v1, this nests lists.
// these have pointers to parents, so generally not safe to copy.
struct Node {
Node() = default;
Node(const std::string& str) {
kind = Kind::ATOM;
atom_str = str;
}
Node(std::vector<Node>&& list, bool is_list) {
kind = is_list ? Kind::LIST : Kind::PAIR;
if (!is_list) {
assert(list.size() == 2);
}
child_nodes = std::move(list);
}
enum class Kind : u8 { ATOM, LIST, PAIR, INVALID } kind = Kind::INVALID;
std::vector<Node> child_nodes;
std::string atom_str;
// number of quotes this is wrapped in.
u32 quoted = 0;
Node* parent = nullptr;
u32 my_depth = 0;
void link(Node* this_parent, std::vector<Node*>* bfs_order, u32 depth) {
parent = this_parent;
my_depth = depth;
bfs_order->push_back(this);
switch (kind) {
case Kind::ATOM:
break;
case Kind::LIST:
case Kind::PAIR:
assert(!child_nodes.empty());
for (auto& child : child_nodes) {
child.link(this, bfs_order, depth + 1);
}
break;
default:
assert(false);
}
}
bool needs_end_paren_newline() const {
if (break_list) {
return true;
}
if (!child_nodes.empty()) {
return child_nodes.back().needs_end_paren_newline();
}
return false;
}
// how wide is this text? not including the indentation of this subtree.
u32 text_len = 0;
bool break_list = false;
u8 top_line_count = 0;
u8 sub_elt_indent = 0;
};
Node to_node(const goos::Object& obj) {
switch (obj.type) {
case goos::ObjectType::EMPTY_LIST:
// just treat this as a printing "atom"
return Node("()");
case goos::ObjectType::INTEGER:
case goos::ObjectType::FLOAT:
case goos::ObjectType::CHAR:
case goos::ObjectType::SYMBOL:
case goos::ObjectType::STRING:
// these are all atoms that the pretty printer should just treat as a blob.
return Node(obj.print());
case goos::ObjectType::PAIR: {
// we've got three cases: quoted thing, proper list, improper list.
auto& first = obj.as_pair()->car;
if (first.is_symbol() && first.as_symbol()->name == "quote") {
auto& second = obj.as_pair()->cdr;
if (second.is_pair() && second.as_pair()->cdr.is_empty_list()) {
Node result = to_node(second.as_pair()->car);
result.quoted++;
return result;
}
}
// not quoted, so either list or pair
std::vector<Node> children;
auto* to_print = &obj;
for (;;) {
if (to_print->is_pair()) {
// first print the car:
children.push_back(to_node(to_print->as_pair()->car));
// then load up the cdr as the next thing to print
to_print = &to_print->as_pair()->cdr;
if (to_print->is_empty_list()) {
// we're done, add a close paren and finish
return Node(std::move(children), true);
}
} else {
children.push_back(to_node(*to_print));
assert(false); // untested
return Node(std::move(children), false);
}
}
} break;
// these are unsupported by the pretty printer.
case goos::ObjectType::ARRAY: // todo, we should probably handle arrays.
case goos::ObjectType::LAMBDA:
case goos::ObjectType::MACRO:
case goos::ObjectType::ENVIRONMENT:
throw std::runtime_error("tried to pretty print a goos object kind which is not supported.");
default:
assert(false);
}
}
void recompute_lengths(const std::vector<Node*>& bfs_order) {
// iterate from leaves up
for (auto it = bfs_order.rbegin(); it != bfs_order.rend(); it++) {
Node* node = *it;
switch (node->kind) {
case Node::Kind::ATOM:
node->text_len = node->atom_str.length() + node->quoted;
break;
case Node::Kind::LIST: {
if (node->break_list) {
// special case compute first line length
int first_line_len = 1 + node->quoted; // open paren + quotes
int nodes_on_first_line =
std::min(int(node->child_nodes.size()), int(node->top_line_count));
if (nodes_on_first_line > 0) {
for (int node_idx = 0; node_idx < nodes_on_first_line; node_idx++) {
first_line_len += node->child_nodes.at(node_idx).text_len;
first_line_len++; // trailing space
}
first_line_len--; // last one doesn't have a trailing space
}
int max_line_len = first_line_len;
// now the length of all the things below
for (u32 node_idx = nodes_on_first_line; node_idx < node->child_nodes.size();
node_idx++) {
int line_len = node->sub_elt_indent + node->child_nodes.at(node_idx).text_len;
max_line_len = std::max(max_line_len, line_len);
}
node->text_len = max_line_len;
} else {
node->text_len = 1 + node->quoted; // open paren + quotes
for (auto& child : node->child_nodes) {
node->text_len += (child.text_len + 1); // space or close paren.
}
}
} break;
default:
assert(false);
}
}
}
/*!
* Note: this has special cases for how to insert breaks.
* These rules will be used if the printer decides it should break up the list.
* If you want to force a form to always be broken up, see insert_required_breaks
*/
void break_list(Node* node) {
assert(!node->break_list);
node->break_list = true;
node->sub_elt_indent = 2;
node->top_line_count = 1;
const std::unordered_set<std::string> sameline_splitters = {
"if", "<", ">", "<=", ">=", "set!", "=", "!=", "+", "-", "*", "/", "the", "->"};
if (node->child_nodes.at(0).kind == Node::Kind::LIST) {
// ((foo
// bar
node->sub_elt_indent = 1;
} else if (node->child_nodes.at(0).kind == Node::Kind::ATOM) {
auto& name = node->child_nodes[0].atom_str;
if (name == "defun" || name == "defun-debug" || name == "defbehavior" || name == "defstate") {
// things with three things in the top line: (defun <name> <args>
node->top_line_count = 3;
} else if (name == "defmethod") {
// things with 4 things in the top line: (defmethod <method> <type> <args>
node->top_line_count = 4;
} else if (name == "until" || name == "while" || name == "dotimes" || name == "countdown" ||
name == "when" || name == "behavior" || name == "lambda") {
node->top_line_count = 2;
} else if (name == "let" || name == "let*" || name == "rlet") {
// special case for things like let.
node->top_line_count = 2; // (let <defs>
if (node->child_nodes.size() > 1 && node->child_nodes[1].child_nodes.size() > 1 &&
!node->child_nodes[1].break_list) {
// and break the defs.
break_list(&node->child_nodes[1]);
}
} else if (sameline_splitters.count(name) > 0) {
// if has a special indent rule:
node->top_line_count = 2;
node->sub_elt_indent += name.size();
} else if (name == "cond") {
// cond should always be broken up
for (size_t i = 1; i < node->child_nodes.size(); i++) {
auto& cond_body = node->child_nodes[i];
if (cond_body.kind == Node::Kind::LIST && !cond_body.break_list) {
break_list(&cond_body);
}
}
} else if (name == "case") {
// case gets a second thing on top, plus break up everything.
node->top_line_count = 2;
for (size_t i = 2; i < node->child_nodes.size(); i++) {
auto& cond_body = node->child_nodes[i];
if (cond_body.kind == Node::Kind::LIST && !cond_body.break_list) {
break_list(&cond_body);
}
}
}
}
Node* child = node;
for (Node* p = node->parent; p; p = p->parent) {
if (!p->break_list && &p->child_nodes.back() != child) {
break_list(p);
}
child = p;
}
}
void insert_required_breaks(const std::vector<Node*>& bfs_order) {
const std::unordered_set<std::string> always_break = {
"when", "defun-debug", "countdown", "case", "defun", "defmethod",
"let", "until", "while", "if", "dotimes", "cond",
"else", "defbehavior", "with-pp", "rlet", "defstate"};
for (auto node : bfs_order) {
if (!node->break_list && node->kind == Node::Kind::LIST &&
node->child_nodes.at(0).kind == Node::Kind::ATOM) {
if (always_break.count(node->child_nodes[0].atom_str) > 0) {
break_list(node);
}
}
}
}
int run_algorithm(const std::vector<Node*>& bfs_order, int line_length) {
// our approach is to go in reverse order and find the first list node that is:
// - too long
// - not already split.
// the "magic" of v2 is:
// the "too long" check above igores the sublist.
int num_broken = 0;
std::optional<s32> min_depth;
for (auto it = bfs_order.rbegin(); it != bfs_order.rend(); it++) {
Node* node = *it;
if (min_depth && node->my_depth < min_depth) {
break;
}
if (node->kind != Node::Kind::ATOM && (int)node->text_len > line_length &&
node->break_list == false) {
break_list(node);
num_broken++;
if (!min_depth) {
min_depth = node->my_depth;
}
}
}
recompute_lengths(bfs_order);
return num_broken;
}
int compute_extra_offset(const std::string& str, int s0, int ei) {
assert(!str.empty());
for (size_t i = str.length(); i-- > 0;) {
if ((int)i == s0) {
return ei + str.length() - s0;
} else if (i == '\n') {
return str.length() - i;
}
}
return ei + str.length() - s0;
}
void append_node_to_string(const Node* node,
std::string& str,
int init_indent_level,
int next_indent_level) {
for (int i = 0; i < init_indent_level; i++) {
str.push_back(' ');
}
for (u32 i = 0; i < node->quoted; i++) {
str.push_back('\'');
}
switch (node->kind) {
case Node::Kind::ATOM:
str.append(node->atom_str);
break;
case Node::Kind::LIST:
if (node->break_list) {
str.push_back('(');
size_t node_idx = 0;
int listing_indent = next_indent_level + node->quoted + node->sub_elt_indent;
int extra_indent = 0;
for (; node_idx < node->top_line_count; node_idx++) {
size_t s0 = str.length();
append_node_to_string(&node->child_nodes.at(node_idx), str, 0,
listing_indent + extra_indent);
// extra_indent += (str.length() - s0);
extra_indent = compute_extra_offset(str, s0, extra_indent);
str.push_back(' ');
}
if (node->top_line_count > 0) {
str.pop_back();
}
str.push_back('\n');
for (; node_idx < node->child_nodes.size(); node_idx++) {
append_node_to_string(&node->child_nodes.at(node_idx), str, listing_indent,
listing_indent);
str.push_back('\n');
}
for (int i = 0; i < listing_indent; i++) {
str.push_back(' ');
}
str.push_back(')');
} else {
str.push_back('(');
assert(!node->child_nodes.empty());
int listing_indent = next_indent_level + node->quoted;
int extra_indent = 1;
int c0 = 0;
for (auto& child : node->child_nodes) {
size_t s0 = str.length();
append_node_to_string(&child, str, 0, listing_indent + extra_indent);
str.push_back(' ');
extra_indent += (str.length() - s0);
if (&child == &node->child_nodes.at(0) && !child.break_list) {
//
if (child.kind == Node::Kind::LIST) {
c0 = 0;
} else {
c0 = str.length() - s0;
}
}
}
str.pop_back();
if (node->needs_end_paren_newline()) {
str.push_back('\n');
for (int i = 0; i < listing_indent + c0 + 1; i++) {
str.push_back(' ');
}
}
str.push_back(')');
}
break;
default:
assert(false);
}
}
std::string node_to_string(const Node* node) {
std::string result;
append_node_to_string(node, result, 0, 0);
return result;
}
} // namespace v2
std::string to_string(const goos::Object& obj, int line_length) {
using namespace v2;
// construct the tree
Node root = to_node(obj);
// create tree links and order by depth
std::vector<Node*> bfs_order;
root.link(nullptr, &bfs_order, 0);
insert_required_breaks(bfs_order);
// compute subtree lengths
recompute_lengths(bfs_order);
int max_depth = 0;
for (auto node : bfs_order) {
max_depth = std::max((int)node->my_depth, max_depth);
}
int num_broken = 1;
while (num_broken) {
num_broken = run_algorithm(bfs_order, line_length);
}
return node_to_string(&root);
}
} // namespace pretty_print
+13
View File
@@ -0,0 +1,13 @@
#pragma once
#include <string>
#include <vector>
#include "common/goos/Object.h"
#include "common/goos/Reader.h"
#include "common/goos/Printer.h"
namespace pretty_print {
// main pretty print function
std::string to_string(const goos::Object& obj, int line_length = 110);
} // namespace pretty_print
+102
View File
@@ -0,0 +1,102 @@
#include "Printer.h"
#include "third-party/fmt/core.h"
namespace pretty_print {
namespace {
// the integer representation is used here instead, wouldn't want really long numbers
const std::unordered_set<u32> banned_floats = {};
// print these floats (shown as ints here) as a named constant instead
const std::unordered_map<u32, std::string> const_floats = {{0x40490fda, "PI"},
{0xc0490fda, "MINUS_PI"}};
} // namespace
/*!
* Print a float in a nice representation if possible, or an exact 32-bit integer constant to
* be reinterpreted.
*/
goos::Object float_representation(float value) {
u32 int_value;
memcpy(&int_value, &value, 4);
u8 exp = (int_value >> 23) & 0xff;
u32 mant = int_value & 0x7fffff;
if ((exp == 0 && mant != 0) || exp == 0xff) {
// lg::warn("PS2-incompatible float (0x{:08X}) detected! Writing as the-as cast.", int_value);
return pretty_print::build_list("the-as", "float", fmt::format("#x{:x}", int_value));
} else if (const_floats.find(int_value) != const_floats.end()) {
return pretty_print::to_symbol(const_floats.at(int_value));
} else if (banned_floats.find(int_value) == banned_floats.end()) {
return goos::Object::make_float(value);
} else {
return pretty_print::build_list("the-as", "float", fmt::format("#x{:x}", int_value));
}
}
std::unique_ptr<goos::Reader> pretty_printer_reader;
goos::Reader& get_pretty_printer_reader() {
if (!pretty_printer_reader) {
pretty_printer_reader = std::make_unique<goos::Reader>();
}
return *pretty_printer_reader;
}
goos::Object to_symbol(const std::string& str) {
return goos::SymbolObject::make_new(get_pretty_printer_reader().symbolTable, str);
}
goos::Object build_list(const std::string& str) {
return build_list(to_symbol(str));
}
goos::Object build_list(const goos::Object& obj) {
return goos::PairObject::make_new(obj, goos::Object::make_empty_list());
}
goos::Object build_list(const std::vector<goos::Object>& objects) {
if (objects.empty()) {
return goos::Object::make_empty_list();
} else {
return build_list(objects.data(), objects.size());
}
}
// build a list out of an array of forms
goos::Object build_list(const goos::Object* objects, int count) {
assert(count);
auto car = objects[0];
goos::Object cdr;
if (count - 1) {
cdr = build_list(objects + 1, count - 1);
} else {
cdr = goos::Object::make_empty_list();
}
return goos::PairObject::make_new(car, cdr);
}
// build a list out of a vector of strings that are converted to symbols
goos::Object build_list(const std::vector<std::string>& symbols) {
if (symbols.empty()) {
return goos::Object::make_empty_list();
}
std::vector<goos::Object> f;
f.reserve(symbols.size());
for (auto& x : symbols) {
f.push_back(to_symbol(x));
}
return build_list(f.data(), f.size());
}
void append(goos::Object& _in, const goos::Object& add) {
auto* in = &_in;
while (in->is_pair() && !in->as_pair()->cdr.is_empty_list()) {
in = &in->as_pair()->cdr;
}
if (!in->is_pair()) {
assert(false); // invalid list
}
in->as_pair()->cdr = add;
}
} // namespace pretty_print
+48
View File
@@ -0,0 +1,48 @@
#pragma once
#include <string>
#include <vector>
#include "common/goos/Object.h"
#include "common/goos/Reader.h"
namespace pretty_print {
// string -> object (as a symbol)
goos::Object to_symbol(const std::string& str);
// list with a single symbol from a string
goos::Object build_list(const std::string& str);
// wrap an object in a list
goos::Object build_list(const goos::Object& obj);
// build a list out of a vector of forms
goos::Object build_list(const std::vector<goos::Object>& objects);
// build a list out of an array of forms
goos::Object build_list(const goos::Object* objects, int count);
// build a list out of a vector of strings that are converted to symbols
goos::Object build_list(const std::vector<std::string>& symbols);
// fancy wrapper functions. Due to template magic these can call each other
// and accept mixed arguments!
template <typename... Args>
goos::Object build_list(const goos::Object& car, Args... rest);
template <typename... Args>
goos::Object build_list(const std::string& str, Args... rest) {
return goos::PairObject::make_new(to_symbol(str), build_list(rest...));
}
template <typename... Args>
goos::Object build_list(const goos::Object& car, Args... rest) {
return goos::PairObject::make_new(car, build_list(rest...));
}
goos::Reader& get_pretty_printer_reader();
goos::Object float_representation(float value);
void append(goos::Object& _in, const goos::Object& add);
} // namespace pretty_print
+8 -5
View File
@@ -10,8 +10,8 @@ namespace decompiler {
/*!
* Look through files in a DGO and find the bsp-header file (the level)
*/
ObjectFileRecord get_bsp_file(const std::vector<ObjectFileRecord>& records) {
ObjectFileRecord result;
std::optional<ObjectFileRecord> get_bsp_file(const std::vector<ObjectFileRecord>& records) {
std::optional<ObjectFileRecord> result;
bool found = false;
for (auto& file : records) {
if (file.name.length() > 4 && file.name.substr(file.name.length() - 4) == "-vis") {
@@ -20,7 +20,6 @@ ObjectFileRecord get_bsp_file(const std::vector<ObjectFileRecord>& records) {
result = file;
}
}
assert(found);
return result;
}
@@ -57,10 +56,14 @@ void extract_from_level(ObjectFileDB& db,
}
auto bsp_rec = get_bsp_file(db.obj_files_by_dgo.at(dgo_name));
std::string level_name = bsp_rec.name.substr(0, bsp_rec.name.length() - 4);
if (!bsp_rec) {
lg::warn("Skipping extract for {} because the BSP file was not found", dgo_name);
return;
}
std::string level_name = bsp_rec->name.substr(0, bsp_rec->name.length() - 4);
fmt::print("Processing level {} ({})\n", dgo_name, level_name);
auto& bsp_file = db.lookup_record(bsp_rec);
auto& bsp_file = db.lookup_record(*bsp_rec);
bool ok = is_valid_bsp(bsp_file.linked_data);
assert(ok);
+9
View File
@@ -840,3 +840,12 @@
(defmacro cpad-hold? (pad-idx &rest buttons)
`(logtest? (cpad-hold ,pad-idx) (pad-buttons ,@buttons))
)
(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)
(fake-asm .mtpc dest src)
(fake-asm .mfpc dest src)
+872 -1308
View File
File diff suppressed because it is too large Load Diff
File diff suppressed because it is too large Load Diff
+2051 -2891
View File
File diff suppressed because it is too large Load Diff
File diff suppressed because it is too large Load Diff
+8 -15
View File
@@ -43,20 +43,13 @@
;; definition for method 0 of type align-control
;; INFO: Return type mismatch object vs align-control.
(defmethod
new
align-control
((allocation symbol) (type-to-make type) (arg0 process))
(let
((obj
(object-new allocation type-to-make (the-as int (-> type-to-make size)))
)
(defmethod new align-control ((allocation symbol) (type-to-make type) (arg0 process))
(let ((obj (object-new allocation type-to-make (the-as int (-> type-to-make size)))))
(when (zero? obj)
(go process-drawable-art-error "memory")
(return (the-as align-control 0))
)
(set! (-> obj process) (the-as process-drawable arg0))
obj
)
(when (zero? obj)
(go process-drawable-art-error "memory")
(return (the-as align-control 0))
)
(set! (-> obj process) (the-as process-drawable arg0))
obj
)
)
+134 -204
View File
@@ -8,148 +8,112 @@
(defmethod TODO-RENAME-9 align-control ((obj align-control))
(local-vars (a0-9 symbol) (s7-0 none) (ra-0 int))
(with-pp
(let ((s5-0 (-> obj process skel active-channels)))
(dotimes (s4-0 s5-0)
(let* ((a0-3 (-> obj process skel channel s4-0))
(v1-5 (-> a0-3 frame-group))
(a0-4 (-> a0-3 command))
(a1-0 'stack)
(a2-0 (= a0-4 a1-0))
)
(cond
((or a2-0 (begin
(set! a1-0 'stack1)
(= a0-4 a1-0)
(let ((s5-0 (-> obj process skel active-channels)))
(dotimes (s4-0 s5-0)
(let* ((a0-3 (-> obj process skel channel s4-0))
(v1-5 (-> a0-3 frame-group))
(a0-4 (-> a0-3 command))
(a1-0 'stack)
(a2-0 (= a0-4 a1-0))
)
(cond
((or a2-0 (begin (set! a1-0 'stack1) (= a0-4 a1-0)))
)
(else
(when (!= (-> v1-5 type) art-joint-anim)
(let ((t9-0 (the-as (function object object object object) enter-state))
(a0-7 "align joint-anim")
)
(set! (-> pp next-state) process-drawable-art-error)
(t9-0 a0-7 (the-as object a1-0) a2-0)
)
)
(.lw ra-0 return-from-thread s7-0)
(.jr ra-0)
(nop!)
0
)
)
)
)
)
(else
(when (!= (-> v1-5 type) art-joint-anim)
(let
((t9-0 (the-as (function object object object object) enter-state))
(a0-7 "align joint-anim")
)
(let* ((a0-8 (-> obj process skel root-channel 0))
(v1-16 (-> a0-8 frame-group))
(f0-0 (-> a0-8 frame-num))
)
(set! (-> pp next-state) process-drawable-art-error)
(t9-0 a0-7 (the-as object a1-0) a2-0)
)
(.lw ra-0 return-from-thread s7-0)
(.jr ra-0)
(nop!)
0
(= (-> a0-8 num-func) num-func-loop!)
(cond
((or (not v1-16) (!= (-> obj frame-group) v1-16))
(set! a0-9 #t)
)
((= (-> a0-8 num-func) num-func-loop!)
(set! a0-9 (< (* (-> a0-8 param 0) (- f0-0 (-> obj frame-num))) 0.0))
)
(else
(set! a0-9 (= f0-0 0.0))
)
)
)
)
)
)
(let* ((a0-8 (-> obj process skel root-channel 0))
(v1-16 (-> a0-8 frame-group))
(f0-0 (-> a0-8 frame-num))
(if a0-9
(logior! (-> obj flags) 1)
(set! (-> obj flags) (logand -2 (-> obj flags)))
)
(= (-> a0-8 num-func) num-func-loop!)
(cond
((or (not v1-16) (!= (-> obj frame-group) v1-16))
(set! a0-9 #t)
(set! (-> obj frame-group) v1-16)
(set! (-> obj frame-num) f0-0)
)
((= (-> a0-8 num-func) num-func-loop!)
(set! a0-9 (< (* (-> a0-8 param 0) (- f0-0 (-> obj frame-num))) 0.0))
)
(else
(set! a0-9 (= f0-0 0.0))
)
)
(if a0-9
(logior! (-> obj flags) 1)
(set! (-> obj flags) (logand -2 (-> obj flags)))
)
(set! (-> obj frame-group) v1-16)
(set! (-> obj frame-num) f0-0)
)
(mem-copy!
(the-as pointer (-> obj transform 1))
(the-as pointer (-> obj transform))
48
)
(quaternion-copy!
(the-as quaternion (-> obj transform 1 rot))
(-> obj align quat)
)
(set! (-> obj transform 1 scale quad) (-> obj align scale quad))
(let* ((a2-5 (-> obj matrix 1 vector))
(a3-0 (-> obj matrix))
(v1-19 (-> a3-0 0 vector 0 quad))
(a0-18 (-> a3-0 0 vector 1 quad))
(a1-12 (-> a3-0 0 vector 2 quad))
(a3-1 (-> a3-0 0 vector 3 quad))
)
(set! (-> a2-5 0 quad) v1-19)
(set! (-> a2-5 1 quad) a0-18)
(set! (-> a2-5 2 quad) a1-12)
(set! (-> a2-5 3 quad) a3-1)
)
(let ((s5-1 (-> obj process node-list data 1)))
(cspace<-matrix-no-push-joint! s5-1 (-> obj process skel))
(let* ((v1-23 (-> obj matrix))
(a3-2 (-> s5-1 bone transform))
(a0-21 (-> a3-2 vector 0 quad))
(a1-14 (-> a3-2 vector 1 quad))
(a2-6 (-> a3-2 vector 2 quad))
(a3-3 (-> a3-2 vector 3 quad))
(mem-copy! (the-as pointer (-> obj transform 1)) (the-as pointer (-> obj transform)) 48)
(quaternion-copy! (the-as quaternion (-> obj transform 1 rot)) (-> obj align quat))
(set! (-> obj transform 1 scale quad) (-> obj align scale quad))
(let* ((a2-5 (-> obj matrix 1 vector))
(a3-0 (-> obj matrix))
(v1-19 (-> a3-0 0 vector 0 quad))
(a0-18 (-> a3-0 0 vector 1 quad))
(a1-12 (-> a3-0 0 vector 2 quad))
(a3-1 (-> a3-0 0 vector 3 quad))
)
(set! (-> v1-23 0 vector 0 quad) a0-21)
(set! (-> v1-23 0 vector 1 quad) a1-14)
(set! (-> v1-23 0 vector 2 quad) a2-6)
(set! (-> v1-23 0 vector 3 quad) a3-3)
)
(vector*!
(the-as vector (-> obj transform))
(-> s5-1 bone transform vector 3)
(-> obj process root scale)
)
)
(vector-!
(the-as vector (-> obj delta))
(the-as vector (-> obj transform))
(the-as vector (-> obj transform 1))
)
(set-vector!
(-> obj align scale)
(vector-length (the-as vector (-> obj matrix)))
(vector-length (-> obj matrix 0 vector 1))
(vector-length (-> obj matrix 0 vector 2))
1.0
)
(vector-!
(-> obj delta scale)
(-> obj align scale)
(-> obj transform 1 scale)
)
(let
((a2-8
(matrix-inv-scale! (new 'stack-no-clear 'matrix) (-> obj align scale))
(set! (-> a2-5 0 quad) v1-19)
(set! (-> a2-5 1 quad) a0-18)
(set! (-> a2-5 2 quad) a1-12)
(set! (-> a2-5 3 quad) a3-1)
)
)
(quaternion-normalize!
(matrix->quaternion
(-> obj align quat)
(matrix*! a2-8 (the-as matrix (-> obj matrix)) a2-8)
(let ((s5-1 (-> obj process node-list data 1)))
(cspace<-matrix-no-push-joint! s5-1 (-> obj process skel))
(let* ((v1-23 (-> obj matrix))
(a3-2 (-> s5-1 bone transform))
(a0-21 (-> a3-2 vector 0 quad))
(a1-14 (-> a3-2 vector 1 quad))
(a2-6 (-> a3-2 vector 2 quad))
(a3-3 (-> a3-2 vector 3 quad))
)
(set! (-> v1-23 0 vector 0 quad) a0-21)
(set! (-> v1-23 0 vector 1 quad) a1-14)
(set! (-> v1-23 0 vector 2 quad) a2-6)
(set! (-> v1-23 0 vector 3 quad) a3-3)
)
(vector*! (the-as vector (-> obj transform)) (-> s5-1 bone transform vector 3) (-> obj process root scale))
)
)
)
(let
((a1-24
(quaternion-inverse!
(new 'stack-no-clear 'quaternion)
(the-as quaternion (-> obj transform 1 rot))
)
(vector-!
(the-as vector (-> obj delta))
(the-as vector (-> obj transform))
(the-as vector (-> obj transform 1))
)
)
(quaternion-normalize!
(quaternion*! (-> obj delta quat) a1-24 (-> obj align quat))
)
(set-vector!
(-> obj align scale)
(vector-length (the-as vector (-> obj matrix)))
(vector-length (-> obj matrix 0 vector 1))
(vector-length (-> obj matrix 0 vector 2))
1.0
)
(vector-! (-> obj delta scale) (-> obj align scale) (-> obj transform 1 scale))
(let ((a2-8 (matrix-inv-scale! (new 'stack-no-clear 'matrix) (-> obj align scale))))
(quaternion-normalize!
(matrix->quaternion (-> obj align quat) (matrix*! a2-8 (the-as matrix (-> obj matrix)) a2-8))
)
)
(let ((a1-24 (quaternion-inverse! (new 'stack-no-clear 'quaternion) (the-as quaternion (-> obj transform 1 rot)))))
(quaternion-normalize! (quaternion*! (-> obj delta quat) a1-24 (-> obj align quat)))
)
(-> obj delta)
)
(-> obj delta)
)
)
;; definition for method 12 of type align-control
@@ -164,99 +128,65 @@
)
;; definition for method 10 of type align-control
(defmethod
TODO-RENAME-10
align-control
((obj align-control) (arg0 int) (arg1 float) (arg2 float) (arg3 float))
(defmethod TODO-RENAME-10 align-control ((obj align-control) (arg0 int) (arg1 float) (arg2 float) (arg3 float))
(when (zero? (logand (-> obj flags) 1))
(let* ((a0-1 (-> obj process))
(t9-0 (method-of-object a0-1 dummy-16))
(v1-4 (-> obj delta))
(t1-0 (new 'stack-no-clear 'vector))
)
(set! (-> t1-0 x) arg1)
(set! (-> t1-0 y) arg2)
(set! (-> t1-0 z) arg3)
(set! (-> t1-0 w) 1.0)
(t9-0 a0-1 arg0 (the-as (inline-array vector) v1-4) t1-0)
(let* ((a0-1 (-> obj process))
(t9-0 (method-of-object a0-1 dummy-16))
(v1-4 (-> obj delta))
(t1-0 (new 'stack-no-clear 'vector))
)
(set! (-> t1-0 x) arg1)
(set! (-> t1-0 y) arg2)
(set! (-> t1-0 z) arg3)
(set! (-> t1-0 w) 1.0)
(t9-0 a0-1 arg0 (the-as (inline-array vector) v1-4) t1-0)
)
)
)
(-> obj process root)
)
;; definition for method 26 of type trsqv
(defmethod
TODO-RENAME-26
trsqv
((obj trsqv) (arg0 int) (arg1 vector) (arg2 float))
(defmethod TODO-RENAME-26 trsqv ((obj trsqv) (arg0 int) (arg1 vector) (arg2 float))
(let ((gp-0 (-> obj transv)))
(when (logtest? arg0 4)
(set! (-> gp-0 x) (-> arg1 x))
(set! (-> gp-0 z) (-> arg1 z))
(let
((f0-4
(fmin (* (vector-xz-length arg1) (-> *display* frames-per-second)) arg2)
)
(when (logtest? arg0 4)
(set! (-> gp-0 x) (-> arg1 x))
(set! (-> gp-0 z) (-> arg1 z))
(let ((f0-4 (fmin (* (vector-xz-length arg1) (-> *display* frames-per-second)) arg2)))
(vector-xz-normalize! gp-0 f0-4)
)
)
(vector-xz-normalize! gp-0 f0-4)
)
)
)
obj
)
;; definition for method 11 of type align-control
;; INFO: Return type mismatch trsqv vs none.
(defmethod
TODO-RENAME-11
align-control
((obj align-control)
(arg0 int)
(arg1 vector)
(arg2 int)
(arg3 float)
(arg4 float)
)
(defmethod TODO-RENAME-11 align-control ((obj align-control) (arg0 int) (arg1 vector) (arg2 int) (arg3 float) (arg4 float))
(when (zero? (logand (-> obj flags) 1))
(let ((s5-0 (-> obj delta)))
(let ((s3-0 (-> obj process root transv)))
(if (logtest? arg0 2)
(set!
(-> s3-0 y)
(* (-> s5-0 trans y) arg3 (-> *display* frames-per-second))
)
)
(when (logtest? arg0 4)
(set! (-> s3-0 x) (-> arg1 x))
(set! (-> s3-0 z) (-> arg1 z))
(let
((f0-8
(*
(fmin
(vector-xz-length arg1)
(* (vector-xz-length (-> s5-0 trans)) arg4)
)
(-> *display* frames-per-second)
(let ((s5-0 (-> obj delta)))
(let ((s3-0 (-> obj process root transv)))
(if (logtest? arg0 2)
(set! (-> s3-0 y) (* (-> s5-0 trans y) arg3 (-> *display* frames-per-second)))
)
(when (logtest? arg0 4)
(set! (-> s3-0 x) (-> arg1 x))
(set! (-> s3-0 z) (-> arg1 z))
(let ((f0-8 (* (fmin (vector-xz-length arg1) (* (vector-xz-length (-> s5-0 trans)) arg4))
(-> *display* frames-per-second)
)
)
(t9-2 vector-xz-normalize!)
)
(set! (-> obj last-speed) f0-8)
(t9-2 s3-0 f0-8)
)
)
)
(t9-2 vector-xz-normalize!)
)
(set! (-> obj last-speed) f0-8)
(t9-2 s3-0 f0-8)
)
(if (logtest? arg0 16)
(quaternion-normalize! (quaternion*! (-> obj process root quat) (-> obj process root quat) (-> s5-0 quat)))
)
)
)
(if (logtest? arg0 16)
(quaternion-normalize!
(quaternion*!
(-> obj process root quat)
(-> obj process root quat)
(-> s5-0 quat)
)
)
)
)
)
(-> obj process root)
(none)
)
+2 -10
View File
@@ -176,16 +176,8 @@
(format #t "~Tnum-uploads: ~D~%" (-> obj num-uploads))
(format #t "~Tmtx-acc[2] @ #x~X~%" (-> obj mtx-acc))
(format #t "~Ttq-acc[100] @ #x~X~%" (-> obj tq-acc))
(format
#t
"~Tjacp-hdr: #<joint-anim-compressed-hdr @ #x~X>~%"
(-> obj jacp-hdr)
)
(format
#t
"~Tfixed-data: #<joint-anim-compressed-fixed @ #x~X>~%"
(-> obj fixed-data)
)
(format #t "~Tjacp-hdr: #<joint-anim-compressed-hdr @ #x~X>~%" (-> obj jacp-hdr))
(format #t "~Tfixed-data: #<joint-anim-compressed-fixed @ #x~X>~%" (-> obj fixed-data))
(format #t "~Tframe-data[2] @ #x~X~%" (-> obj frame-data))
(format #t "~Tflatten-array[576] @ #x~X~%" (-> obj mtx-acc))
(format #t "~Tflattened[24] @ #x~X~%" (-> obj mtx-acc))
+976 -1238
View File
File diff suppressed because it is too large Load Diff
+9 -6
View File
@@ -145,12 +145,15 @@
;; definition for method 2 of type cspace
(defmethod print cspace ((obj cspace))
(format #t "#<cspace ~S @ #x~X>" (if (-> obj joint)
(-> obj joint name)
"nojoint"
)
obj
)
(format
#t
"#<cspace ~S @ #x~X>"
(if (-> obj joint)
(-> obj joint name)
"nojoint"
)
obj
)
obj
)
File diff suppressed because it is too large Load Diff
+25 -25
View File
@@ -15,17 +15,17 @@
(set! (-> *redline-table* *redline-index*) arg0)
(set! *redline-index* (+ *redline-index* 1))
(when (>= *redline-index* 400)
(set! *redline-index* 0)
0
)
(set! *redline-index* 0)
0
)
(none)
)
;; definition for function float-lookup-redline
(defun float-lookup-redline ((arg0 float))
(let ((a0-3 (mod (+ (the int arg0) -1 *redline-index*) 400)))
(-> *redline-table* a0-3)
)
(-> *redline-table* a0-3)
)
)
;; definition for symbol *blueline-table*, type (pointer float)
@@ -40,17 +40,17 @@
(set! (-> *blueline-table* *blueline-index*) arg0)
(set! *blueline-index* (+ *blueline-index* 1))
(when (>= *blueline-index* 400)
(set! *blueline-index* 0)
0
)
(set! *blueline-index* 0)
0
)
(none)
)
;; definition for function float-lookup-blueline
(defun float-lookup-blueline ((arg0 float))
(let ((a0-3 (mod (+ (the int arg0) -1 *blueline-index*) 400)))
(-> *blueline-table* a0-3)
)
(-> *blueline-table* a0-3)
)
)
;; definition for symbol *greenline-table*, type (pointer float)
@@ -65,17 +65,17 @@
(set! (-> *greenline-table* *greenline-index*) arg0)
(set! *greenline-index* (+ *greenline-index* 1))
(when (>= *greenline-index* 400)
(set! *greenline-index* 0)
0
)
(set! *greenline-index* 0)
0
)
(none)
)
;; definition for function float-lookup-greenline
(defun float-lookup-greenline ((arg0 float))
(let ((a0-3 (mod (+ (the int arg0) -1 *greenline-index*) 400)))
(-> *greenline-table* a0-3)
)
(-> *greenline-table* a0-3)
)
)
;; definition for symbol *yellowline-table*, type (pointer float)
@@ -90,17 +90,17 @@
(set! (-> *yellowline-table* *yellowline-index*) arg0)
(set! *yellowline-index* (+ *yellowline-index* 1))
(when (>= *yellowline-index* 400)
(set! *yellowline-index* 0)
0
)
(set! *yellowline-index* 0)
0
)
(none)
)
;; definition for function float-lookup-yellowline
(defun float-lookup-yellowline ((arg0 float))
(let ((a0-3 (mod (+ (the int arg0) -1 *yellowline-index*) 400)))
(-> *yellowline-table* a0-3)
)
(-> *yellowline-table* a0-3)
)
)
;; definition for symbol *timeplot-table*, type (pointer float)
@@ -115,17 +115,17 @@
(set! (-> *timeplot-table* *timeplot-index*) arg0)
(set! *timeplot-index* (+ *timeplot-index* 1))
(when (>= *timeplot-index* 400)
(set! *timeplot-index* 0)
0
)
(set! *timeplot-index* 0)
0
)
(none)
)
;; definition for function float-lookup-timeplot
(defun float-lookup-timeplot ((arg0 float))
(let ((a0-3 (mod (+ (the int arg0) -1 *timeplot-index*) 400)))
(-> *timeplot-table* a0-3)
)
(-> *timeplot-table* a0-3)
)
)
;; definition (perm) for symbol *cam-layout*, type symbol
+18 -21
View File
@@ -12,9 +12,9 @@
;; definition for function matrix-local->world
(defun matrix-local->world ((arg0 symbol) (arg1 symbol))
(if arg0
(-> *math-camera* inv-camera-rot-smooth)
(-> *math-camera* inv-camera-rot)
)
(-> *math-camera* inv-camera-rot-smooth)
(-> *math-camera* inv-camera-rot)
)
)
;; definition for function matrix-world->local
@@ -28,16 +28,16 @@
;; definition for function camera-pos
(defun camera-pos ()
(cond
(*camera-combiner*
(-> *camera-combiner* trans)
(*camera-combiner*
(-> *camera-combiner* trans)
)
(*math-camera*
(-> *math-camera* trans)
)
(else
*camera-dummy-vector*
)
)
(*math-camera*
(-> *math-camera* trans)
)
(else
*camera-dummy-vector*
)
)
)
;; definition for function math-camera-pos
@@ -50,8 +50,8 @@
(let ((f0-0 (-> *math-camera* camera-rot vector 0 x))
(f1-0 (-> *math-camera* camera-rot vector 0 z))
)
(atan f1-0 f0-0)
)
(atan f1-0 f0-0)
)
)
;; definition for function camera-teleport-to-entity
@@ -59,14 +59,11 @@
;; Used lq/sq
(defbehavior camera-teleport-to-entity process ((arg0 entity-actor))
(let ((gp-0 (new 'stack 'transformq)))
(set!
(-> gp-0 trans quad)
(-> (the-as transform (-> arg0 extra)) scale quad)
(set! (-> gp-0 trans quad) (-> (the-as transform (-> arg0 extra)) scale quad))
(quaternion-copy! (-> gp-0 quat) (-> arg0 quat))
(vector-identity! (-> gp-0 scale))
(send-event *camera* 'teleport-to-transformq gp-0)
)
(quaternion-copy! (-> gp-0 quat) (-> arg0 quat))
(vector-identity! (-> gp-0 scale))
(send-event *camera* 'teleport-to-transformq gp-0)
)
0
(none)
)
+3076 -4191
View File
File diff suppressed because it is too large Load Diff
File diff suppressed because it is too large Load Diff
+21 -44
View File
@@ -18,55 +18,32 @@
(defun cam-start ((arg0 symbol))
(cam-stop)
(let ((s5-0 (get-process *camera-dead-pool* camera-combiner #x4000)))
(when s5-0
(let ((t9-2 (method-of-type camera-combiner activate)))
(t9-2
(the-as camera-combiner s5-0)
*camera-pool*
'camera-combiner
(the-as pointer #x70004000)
(when s5-0
(let ((t9-2 (method-of-type camera-combiner activate)))
(t9-2 (the-as camera-combiner s5-0) *camera-pool* 'camera-combiner (the-as pointer #x70004000))
)
(run-now-in-process s5-0 cam-combiner-init)
(-> s5-0 ppointer)
)
)
(run-now-in-process s5-0 cam-combiner-init)
(-> s5-0 ppointer)
)
)
(let ((s5-1 (get-process *camera-master-dead-pool* camera-master #x4000)))
(set! *camera* (the-as camera-master (ppointer->process (when s5-1
(let
((t9-5
(method-of-type
camera-master
activate
)
)
)
(t9-5
(the-as
camera-master
s5-1
)
*camera-pool*
'camera-master
(the-as
pointer
#x70004000
)
)
)
(run-next-time-in-process
s5-1
cam-master-init
)
(-> s5-1 ppointer)
)
)
)
(set! *camera*
(the-as camera-master
(ppointer->process
(when s5-1
(let ((t9-5 (method-of-type camera-master activate)))
(t9-5 (the-as camera-master s5-1) *camera-pool* 'camera-master (the-as pointer #x70004000))
)
(run-next-time-in-process s5-1 cam-master-init)
(-> s5-1 ppointer)
)
)
)
)
)
)
(if arg0
(reset-cameras)
)
(reset-cameras)
)
0
(none)
)
File diff suppressed because it is too large Load Diff
+2616 -3746
View File
File diff suppressed because it is too large Load Diff
+2 -6
View File
@@ -20,14 +20,10 @@
(define-perm *camera-other-trans* vector (vector-reset! (new 'global 'vector)))
;; definition (perm) for symbol *camera-other-matrix*, type matrix
(define-perm *camera-other-matrix* matrix
(matrix-identity! (new 'global 'matrix))
)
(define-perm *camera-other-matrix* matrix (matrix-identity! (new 'global 'matrix)))
;; definition (perm) for symbol *camera-smush-control*, type smush-control
(define-perm *camera-smush-control* smush-control
(set-zero! (new 'global 'smush-control))
)
(define-perm *camera-smush-control* smush-control (set-zero! (new 'global 'smush-control)))
;; definition (perm) for symbol *camera-other-root*, type vector
(define-perm *camera-other-root* vector (vector-reset! (new 'global 'vector)))
File diff suppressed because it is too large Load Diff
+81 -157
View File
@@ -26,50 +26,28 @@
(format #t "~Tjoypad: ~D~%" (-> obj joypad))
(format #t "~Tmin-detectable-velocity: ~f~%" (-> obj min-detectable-velocity))
(format #t "~Tattack-timeout: ~D~%" (-> obj attack-timeout))
(format
#t
"~Tdefault-string-max-y: (meters ~m)~%"
(-> obj default-string-max-y)
)
(format
#t
"~Tdefault-string-min-y: (meters ~m)~%"
(-> obj default-string-min-y)
)
(format
#t
"~Tdefault-string-max-z: (meters ~m)~%"
(-> obj default-string-max-z)
)
(format
#t
"~Tdefault-string-min-z: (meters ~m)~%"
(-> obj default-string-min-z)
)
(format
#t
"~Tdefault-string-push-z: (meters ~m)~%"
(-> obj default-string-push-z)
)
(format #t "~Tdefault-string-max-y: (meters ~m)~%" (-> obj default-string-max-y))
(format #t "~Tdefault-string-min-y: (meters ~m)~%" (-> obj default-string-min-y))
(format #t "~Tdefault-string-max-z: (meters ~m)~%" (-> obj default-string-max-z))
(format #t "~Tdefault-string-min-z: (meters ~m)~%" (-> obj default-string-min-z))
(format #t "~Tdefault-string-push-z: (meters ~m)~%" (-> obj default-string-push-z))
(format #t "~Tdefault-tilt-adjust: (deg ~r)~%" (-> obj default-tilt-adjust))
obj
)
;; definition for symbol *CAMERA-bank*, type camera-bank
(define
*CAMERA-bank*
(new 'static 'camera-bank
:collide-move-rad 1638.4
:min-detectable-velocity 40.96
:attack-timeout (seconds 0.25)
:default-string-max-y (meters 3.0)
:default-string-min-y (meters 1.0)
:default-string-max-z (meters 12.5)
:default-string-min-z (meters 5.0)
:default-string-push-z (meters 10.0)
:default-tilt-adjust (degrees -6.5000005)
)
)
(define *CAMERA-bank* (new 'static 'camera-bank
:collide-move-rad 1638.4
:min-detectable-velocity 40.96
:attack-timeout (seconds 0.25)
:default-string-max-y (meters 3.0)
:default-string-min-y (meters 1.0)
:default-string-max-z (meters 12.5)
:default-string-min-z (meters 5.0)
:default-string-push-z (meters 10.0)
:default-tilt-adjust (degrees -6.5000005)
)
)
;; definition of type cam-index
(deftype cam-index (structure)
@@ -188,16 +166,8 @@
(format #t "~Tsample-len: ~f~%" (-> obj sample-len))
(format #t "~Tused-count: ~D~%" (-> obj used-count))
(format #t "~Told-position: #<vector @ #x~X>~%" (-> obj old-position))
(format
#t
"~Tdebug-old-position: #<vector @ #x~X>~%"
(-> obj debug-old-position)
)
(format
#t
"~Tdebug-out-position: #<vector @ #x~X>~%"
(-> obj debug-out-position)
)
(format #t "~Tdebug-old-position: #<vector @ #x~X>~%" (-> obj debug-old-position))
(format #t "~Tdebug-out-position: #<vector @ #x~X>~%" (-> obj debug-out-position))
(format #t "~Tdebug-last-point: ~D~%" (-> obj debug-last-point))
obj
)
@@ -237,10 +207,7 @@
;; definition for method 9 of type cam-float-seeker
;; INFO: Return type mismatch int vs none.
(defmethod
init-cam-float-seeker
cam-float-seeker
((obj cam-float-seeker) (arg0 float) (arg1 float) (arg2 float) (arg3 float))
(defmethod init-cam-float-seeker cam-float-seeker ((obj cam-float-seeker) (arg0 float) (arg1 float) (arg2 float) (arg3 float))
(set! (-> obj target) arg0)
(set! (-> obj value) arg0)
(set! (-> obj vel) 0.0)
@@ -253,10 +220,7 @@
;; definition for method 10 of type cam-float-seeker
;; INFO: Return type mismatch int vs none.
(defmethod
copy-cam-float-seeker
cam-float-seeker
((obj cam-float-seeker) (arg0 cam-float-seeker))
(defmethod copy-cam-float-seeker cam-float-seeker ((obj cam-float-seeker) (arg0 cam-float-seeker))
(set! (-> obj target) (-> arg0 target))
(set! (-> obj value) (-> arg0 value))
(set! (-> obj vel) (-> arg0 vel))
@@ -275,21 +239,20 @@
(let* ((pos-error (- (+ (-> obj target) offset) (-> obj value)))
(partial-velocity-limit (* (-> obj max-partial) (fabs pos-error)))
)
(let
((daccel (* pos-error (* (-> obj accel) (-> *display* time-adjust-ratio)))))
(+! (-> obj vel) daccel)
(let ((daccel (* pos-error (* (-> obj accel) (-> *display* time-adjust-ratio)))))
(+! (-> obj vel) daccel)
)
(let ((abs-vel (fabs (-> obj vel)))
(abs-vel-limit (fmin partial-velocity-limit (-> obj max-vel)))
)
(if (< abs-vel-limit abs-vel)
(set! (-> obj vel) (* (-> obj vel) (/ abs-vel-limit abs-vel)))
)
)
)
(let ((abs-vel (fabs (-> obj vel)))
(abs-vel-limit (fmin partial-velocity-limit (-> obj max-vel)))
)
(if (< abs-vel-limit abs-vel)
(set! (-> obj vel) (* (-> obj vel) (/ abs-vel-limit abs-vel)))
)
)
)
(let ((dpos (* (-> obj vel) (-> *display* time-adjust-ratio))))
(+! (-> obj value) dpos)
)
(+! (-> obj value) dpos)
)
0
(none)
)
@@ -298,9 +261,9 @@
(defmethod jump-to-target! cam-float-seeker ((obj cam-float-seeker) (arg0 float))
(set! (-> obj value) (+ (-> obj target) arg0))
(let ((f0-2 0.0))
(set! (-> obj vel) f0-2)
f0-2
)
(set! (-> obj vel) f0-2)
f0-2
)
)
;; definition of type cam-vector-seeker
@@ -336,20 +299,17 @@
;; definition for method 9 of type cam-vector-seeker
;; INFO: Return type mismatch int vs none.
;; Used lq/sq
(defmethod
init!
cam-vector-seeker
((obj cam-vector-seeker) (arg0 vector) (arg1 float) (arg2 float) (arg3 float))
(defmethod init! cam-vector-seeker ((obj cam-vector-seeker) (arg0 vector) (arg1 float) (arg2 float) (arg3 float))
(cond
(arg0
(set! (-> obj target quad) (-> arg0 quad))
(set! (-> obj value quad) (-> arg0 quad))
(arg0
(set! (-> obj target quad) (-> arg0 quad))
(set! (-> obj value quad) (-> arg0 quad))
)
(else
(vector-reset! (-> obj target))
(vector-reset! (-> obj value))
)
)
(else
(vector-reset! (-> obj target))
(vector-reset! (-> obj value))
)
)
(vector-reset! (-> obj vel))
(set! (-> obj accel) arg1)
(set! (-> obj max-vel) arg2)
@@ -362,34 +322,30 @@
;; INFO: Return type mismatch int vs none.
(defmethod update! cam-vector-seeker ((obj cam-vector-seeker) (arg0 vector))
(let ((gp-0 (new 'stack-no-clear 'vector)))
0.0
(cond
(arg0
(vector+! gp-0 (-> obj target) arg0)
(vector-! gp-0 gp-0 (-> obj value))
)
(else
(vector-! gp-0 (-> obj target) (-> obj value))
)
)
(let ((f30-1 (* (-> obj max-partial) (vector-length gp-0))))
(vector-float*!
gp-0
gp-0
(* (-> obj accel) (-> *display* time-adjust-ratio))
)
(vector+! (-> obj vel) (-> obj vel) gp-0)
(let ((f0-4 (vector-length (-> obj vel)))
(f1-2 (fmin f30-1 (-> obj max-vel)))
)
(if (< f1-2 f0-4)
(vector-float*! (-> obj vel) (-> obj vel) (/ f1-2 f0-4))
0.0
(cond
(arg0
(vector+! gp-0 (-> obj target) arg0)
(vector-! gp-0 gp-0 (-> obj value))
)
(else
(vector-! gp-0 (-> obj target) (-> obj value))
)
)
)
(let ((f30-1 (* (-> obj max-partial) (vector-length gp-0))))
(vector-float*! gp-0 gp-0 (* (-> obj accel) (-> *display* time-adjust-ratio)))
(vector+! (-> obj vel) (-> obj vel) gp-0)
(let ((f0-4 (vector-length (-> obj vel)))
(f1-2 (fmin f30-1 (-> obj max-vel)))
)
(if (< f1-2 f0-4)
(vector-float*! (-> obj vel) (-> obj vel) (/ f1-2 f0-4))
)
)
)
(vector-float*! gp-0 (-> obj vel) (-> *display* time-adjust-ratio))
(vector+! (-> obj value) (-> obj value) gp-0)
)
(vector-float*! gp-0 (-> obj vel) (-> *display* time-adjust-ratio))
(vector+! (-> obj value) (-> obj value) gp-0)
)
0
(none)
)
@@ -423,16 +379,8 @@
(format #t "~Ttilt-adjust: #<cam-float-seeker @ #x~X>~%" (-> obj tilt-adjust))
(format #t "~Tuse-point-of-interest: ~A~%" (-> obj use-point-of-interest))
(format #t "~Tpoint-of-interest: ~`vector`P~%" (-> obj point-of-interest))
(format
#t
"~Tpoint-of-interest-blend: #<cam-float-seeker @ #x~X>~%"
(-> obj point-of-interest-blend)
)
(format
#t
"~Tunderwater-blend: #<cam-float-seeker @ #x~X>~%"
(-> obj underwater-blend)
)
(format #t "~Tpoint-of-interest-blend: #<cam-float-seeker @ #x~X>~%" (-> obj point-of-interest-blend))
(format #t "~Tunderwater-blend: #<cam-float-seeker @ #x~X>~%" (-> obj underwater-blend))
obj
)
@@ -460,8 +408,8 @@
;; definition for method 3 of type camera-combiner
(defmethod inspect camera-combiner ((obj camera-combiner))
(let ((t9-0 (method-of-type process inspect)))
(t9-0 obj)
)
(t9-0 obj)
)
(format #t "~T~Ttrans: ~`vector`P~%" (-> obj trans))
(format #t "~T~Tinv-camera-rot: ~`matrix`P~%" (-> obj inv-camera-rot))
(format #t "~T~Tfov: ~f~%" (-> obj fov))
@@ -469,11 +417,7 @@
(format #t "~T~Tinterp-step: ~f~%" (-> obj interp-step))
(format #t "~T~Tdist-from-src: ~f~%" (-> obj dist-from-src))
(format #t "~T~Tdist-from-dest: ~f~%" (-> obj dist-from-dest))
(format
#t
"~T~Tflip-control-axis: #<vector @ #x~X>~%"
(-> obj flip-control-axis)
)
(format #t "~T~Tflip-control-axis: #<vector @ #x~X>~%" (-> obj flip-control-axis))
(format #t "~T~Tvelocity: #<vector @ #x~X>~%" (-> obj velocity))
(format #t "~T~Ttracking-status: ~D~%" (-> obj tracking-status))
(format #t "~T~Ttracking-options: ~D~%" (-> obj tracking-options))
@@ -544,8 +488,8 @@
;; definition for method 3 of type camera-slave
(defmethod inspect camera-slave ((obj camera-slave))
(let ((t9-0 (method-of-type process inspect)))
(t9-0 obj)
)
(t9-0 obj)
)
(format #t "~T~Ttrans: ~`vector`P~%" (-> obj trans))
(format #t "~T~Tfov: ~f~%" (-> obj fov))
(format #t "~T~Tfov0: ~f~%" (-> obj fov0))
@@ -558,11 +502,7 @@
(format #t "~T~Tview-flat: ~`vector`P~%" (-> obj view-flat))
(format #t "~T~Tstring-vel-dir: ~D~%" (-> obj string-vel-dir))
(format #t "~T~Tstring-trans: ~`vector`P~%" (-> obj string-trans))
(format
#t
"~T~Tposition-spline: #<tracking-spline @ #x~X>~%"
(-> obj position-spline)
)
(format #t "~T~Tposition-spline: #<tracking-spline @ #x~X>~%" (-> obj position-spline))
(format #t "~T~Tpivot-pt: ~`vector`P~%" (-> obj pivot-pt))
(format #t "~T~Tpivot-rad: ~f~%" (-> obj pivot-rad))
(format #t "~T~Tcircular-follow: #<vector @ #x~X>~%" (-> obj circular-follow))
@@ -576,11 +516,7 @@
(format #t "~T~Tlos-state: ~D~%" (-> obj los-state))
(format #t "~T~Tgood-point: ~`vector`P~%" (-> obj good-point))
(format #t "~T~Tlos-tgt-spline-pt: ~D~%" (-> obj los-tgt-spline-pt))
(format
#t
"~T~Tlos-tgt-spline-pt-incarnation: ~D~%"
(-> obj los-tgt-spline-pt-incarnation)
)
(format #t "~T~Tlos-tgt-spline-pt-incarnation: ~D~%" (-> obj los-tgt-spline-pt-incarnation))
(format #t "~T~Tlos-last-pos: ~`vector`P~%" (-> obj los-last-pos))
(format #t "~T~Tintro-curve: #<curve @ #x~X>~%" (-> obj intro-curve))
(format #t "~T~Tintro-offset: #<vector @ #x~X>~%" (-> obj intro-offset))
@@ -672,8 +608,8 @@
;; definition for method 3 of type camera-master
(defmethod inspect camera-master ((obj camera-master))
(let ((t9-0 (method-of-type process inspect)))
(t9-0 obj)
)
(t9-0 obj)
)
(format #t "~T~Tmaster-options: ~D~%" (-> obj master-options))
(format #t "~T~Tnum-slaves: ~D~%" (-> obj num-slaves))
(format #t "~T~Tslave[2] @ #x~X~%" (-> obj slave))
@@ -685,16 +621,8 @@
(format #t "~T~TstringMaxLength: ~f~%" (-> obj stringMaxLength))
(format #t "~T~TstringMinHeight: ~f~%" (-> obj stringMinHeight))
(format #t "~T~TstringMaxHeight: ~f~%" (-> obj stringMaxHeight))
(format
#t
"~T~Tstring-min: #<cam-vector-seeker @ #x~X>~%"
(-> obj string-min)
)
(format
#t
"~T~Tstring-max: #<cam-vector-seeker @ #x~X>~%"
(-> obj string-max)
)
(format #t "~T~Tstring-min: #<cam-vector-seeker @ #x~X>~%" (-> obj string-min))
(format #t "~T~Tstring-max: #<cam-vector-seeker @ #x~X>~%" (-> obj string-max))
(format #t "~T~Tstring-push-z: ~f~%" (-> obj string-push-z))
(format #t "~T~TstringCliffHeight: ~f~%" (-> obj stringCliffHeight))
(format #t "~T~Tno-intro: ~D~%" (-> obj no-intro))
@@ -722,11 +650,7 @@
(format #t "~T~Tpitch-off: ~`vector`P~%" (-> obj pitch-off))
(format #t "~T~Tfoot-offset: ~f~%" (-> obj foot-offset))
(format #t "~T~Thead-offset: ~f~%" (-> obj head-offset))
(format
#t
"~T~Ttarget-spline: #<tracking-spline @ #x~X>~%"
(-> obj target-spline)
)
(format #t "~T~Ttarget-spline: #<tracking-spline @ #x~X>~%" (-> obj target-spline))
(format #t "~T~Tease-from: #<vector @ #x~X>~%" (-> obj ease-from))
(format #t "~T~Tease-t: ~f~%" (-> obj ease-t))
(format #t "~T~Tease-step: ~f~%" (-> obj ease-step))
+1415 -1806
View File
File diff suppressed because it is too large Load Diff
+2 -10
View File
@@ -160,16 +160,8 @@
(format #t "~Tsprite-2d-hvdf: #<vector @ #x~X>~%" (-> obj sprite-2d-hvdf))
(format #t "~Tcamera-rot: #<matrix @ #x~X>~%" (-> obj camera-rot))
(format #t "~Tinv-camera-rot: #<matrix @ #x~X>~%" (-> obj inv-camera-rot))
(format
#t
"~Tinv-camera-rot-smooth: #<matrix @ #x~X>~%"
(-> obj inv-camera-rot-smooth)
)
(format
#t
"~Tinv-camera-rot-smooth-from: #<quaternion @ #x~X>~%"
(-> obj inv-camera-rot-smooth-from)
)
(format #t "~Tinv-camera-rot-smooth: #<matrix @ #x~X>~%" (-> obj inv-camera-rot-smooth))
(format #t "~Tinv-camera-rot-smooth-from: #<quaternion @ #x~X>~%" (-> obj inv-camera-rot-smooth-from))
(format #t "~Tcamera-temp: #<matrix @ #x~X>~%" (-> obj camera-temp))
(format #t "~Tprev-camera-temp: #<matrix @ #x~X>~%" (-> obj prev-camera-temp))
(format #t "~Thmge-scale: #<vector @ #x~X>~%" (-> obj hmge-scale))
+367 -483
View File
@@ -22,14 +22,8 @@
;; definition for function fog-corrector-setup
;; INFO: Return type mismatch float vs none.
(defun fog-corrector-setup ((corrector fog-corrector) (math-cam math-camera))
(set!
(-> corrector fog-end)
(* (-> math-cam fog-end) (-> math-cam fov-correction-factor))
)
(set!
(-> corrector fog-start)
(* (-> math-cam fog-start) (-> math-cam fov-correction-factor))
)
(set! (-> corrector fog-end) (* (-> math-cam fog-end) (-> math-cam fov-correction-factor)))
(set! (-> corrector fog-start) (* (-> math-cam fog-start) (-> math-cam fov-correction-factor)))
(none)
)
@@ -38,298 +32,208 @@
;; definition for function update-math-camera
;; Used lq/sq
(defun
update-math-camera
((math-cam math-camera) (video-mode symbol) (aspect symbol))
(defun update-math-camera ((math-cam math-camera) (video-mode symbol) (aspect symbol))
(set! (-> math-cam x-ratio) (tan (* 0.5 (-> math-cam fov))))
(if (= aspect 'aspect4x3)
(set! (-> math-cam y-ratio) (* 0.75 (-> math-cam x-ratio)))
(set! (-> math-cam y-ratio) (* 0.5625 (-> math-cam x-ratio)))
)
(set! (-> math-cam y-ratio) (* 0.75 (-> math-cam x-ratio)))
(set! (-> math-cam y-ratio) (* 0.5625 (-> math-cam x-ratio)))
)
(let ((x-rat (-> math-cam x-ratio))
(y-rat (-> math-cam y-ratio))
(cull-info (-> math-cam cull-info))
)
(/ (+ 1.0 (* 4.0 x-rat x-rat)) (+ 1.0 (* x-rat x-rat)))
(let ((y-thing (/ (+ 1.0 (* 4.0 y-rat y-rat)) (+ 1.0 (* y-rat y-rat)))))
(set!
(-> cull-info x-fact)
(/
(+ 1.0 (* 4.0 x-rat x-rat))
(* x-rat (sqrtf (+ 1.0 (* 16.0 x-rat x-rat))))
(/ (+ 1.0 (* 4.0 x-rat x-rat)) (+ 1.0 (* x-rat x-rat)))
(let ((y-thing (/ (+ 1.0 (* 4.0 y-rat y-rat)) (+ 1.0 (* y-rat y-rat)))))
(set! (-> cull-info x-fact) (/ (+ 1.0 (* 4.0 x-rat x-rat)) (* x-rat (sqrtf (+ 1.0 (* 16.0 x-rat x-rat))))))
(set! (-> cull-info y-fact) (/ (+ 1.0 (* 4.0 y-rat y-rat)) (* y-rat (sqrtf (+ 1.0 (* 16.0 y-rat y-rat))))))
(set! (-> cull-info z-fact)
(sqrtf (+ (* (+ -4.0 y-thing) (+ -4.0 y-thing) y-rat y-rat) (* (+ -1.0 y-thing) (+ -1.0 y-thing))))
)
)
)
(set!
(-> cull-info y-fact)
(/
(+ 1.0 (* 4.0 y-rat y-rat))
(* y-rat (sqrtf (+ 1.0 (* 16.0 y-rat y-rat))))
(let* ((near-x (* x-rat (-> math-cam d)))
(near-y (* y-rat (-> math-cam d)))
(near-corner-dist-sqr (+ (* near-x near-x) (* near-y near-y)))
(near-z (-> math-cam d))
)
(set! (-> cull-info cam-radius) (sqrtf (+ near-corner-dist-sqr (* near-z near-z))))
)
)
(set!
(-> cull-info z-fact)
(sqrtf
(+
(* (+ -4.0 y-thing) (+ -4.0 y-thing) y-rat y-rat)
(* (+ -1.0 y-thing) (+ -1.0 y-thing))
)
)
)
)
(let* ((near-x (* x-rat (-> math-cam d)))
(near-y (* y-rat (-> math-cam d)))
(near-corner-dist-sqr (+ (* near-x near-x) (* near-y near-y)))
(near-z (-> math-cam d))
)
(set!
(-> cull-info cam-radius)
(sqrtf (+ near-corner-dist-sqr (* near-z near-z)))
)
)
(let* ((dx-rat-2 (* (-> math-cam d) (-> math-cam x-ratio)))
(d-temp-2 (-> math-cam d))
(dx-rat-times-4 (* 4.0 dx-rat-2))
(d-temp-3 (-> math-cam d))
)
(let
((inverse-x-len
(/ 1.0 (sqrtf (+ (* dx-rat-2 dx-rat-2) (* d-temp-2 d-temp-2))))
)
(inverse-x-len-2
(/
1.0
(sqrtf (+ (* dx-rat-times-4 dx-rat-times-4) (* d-temp-3 d-temp-3)))
(let* ((dx-rat-2 (* (-> math-cam d) (-> math-cam x-ratio)))
(d-temp-2 (-> math-cam d))
(dx-rat-times-4 (* 4.0 dx-rat-2))
(d-temp-3 (-> math-cam d))
)
(let ((inverse-x-len (/ 1.0 (sqrtf (+ (* dx-rat-2 dx-rat-2) (* d-temp-2 d-temp-2)))))
(inverse-x-len-2 (/ 1.0 (sqrtf (+ (* dx-rat-times-4 dx-rat-times-4) (* d-temp-3 d-temp-3)))))
)
(set! (-> cull-info xz-dir-ax) (* dx-rat-2 inverse-x-len))
(set! (-> cull-info xz-dir-az) (* d-temp-2 inverse-x-len))
(set! (-> cull-info xz-dir-bx) (* dx-rat-times-4 inverse-x-len-2))
(set! (-> cull-info xz-dir-bz) (* d-temp-3 inverse-x-len-2))
)
)
(set! (-> cull-info xz-cross-ab) (- (* dx-rat-2 d-temp-3) (* d-temp-2 dx-rat-times-4)))
)
(set! (-> cull-info xz-dir-ax) (* dx-rat-2 inverse-x-len))
(set! (-> cull-info xz-dir-az) (* d-temp-2 inverse-x-len))
(set! (-> cull-info xz-dir-bx) (* dx-rat-times-4 inverse-x-len-2))
(set! (-> cull-info xz-dir-bz) (* d-temp-3 inverse-x-len-2))
)
(set!
(-> cull-info xz-cross-ab)
(- (* dx-rat-2 d-temp-3) (* d-temp-2 dx-rat-times-4))
)
)
(let* ((dy-rat (* (-> math-cam d) (-> math-cam y-ratio)))
(d-temp-4 (-> math-cam d))
(dy-rat-times-4 (* 4.0 dy-rat))
(d-temp-5 (-> math-cam d))
)
(let
((inverse-y-len
(/ 1.0 (sqrtf (+ (* dy-rat dy-rat) (* d-temp-4 d-temp-4))))
)
(inverse-y-len-2
(/
1.0
(sqrtf (+ (* dy-rat-times-4 dy-rat-times-4) (* d-temp-5 d-temp-5)))
(let* ((dy-rat (* (-> math-cam d) (-> math-cam y-ratio)))
(d-temp-4 (-> math-cam d))
(dy-rat-times-4 (* 4.0 dy-rat))
(d-temp-5 (-> math-cam d))
)
(let ((inverse-y-len (/ 1.0 (sqrtf (+ (* dy-rat dy-rat) (* d-temp-4 d-temp-4)))))
(inverse-y-len-2 (/ 1.0 (sqrtf (+ (* dy-rat-times-4 dy-rat-times-4) (* d-temp-5 d-temp-5)))))
)
(set! (-> cull-info yz-dir-ay) (* dy-rat inverse-y-len))
(set! (-> cull-info yz-dir-az) (* d-temp-4 inverse-y-len))
(set! (-> cull-info yz-dir-by) (* dy-rat-times-4 inverse-y-len-2))
(set! (-> cull-info yz-dir-bz) (* d-temp-5 inverse-y-len-2))
)
)
(set! (-> cull-info yz-cross-ab) (- (* dy-rat d-temp-5) (* d-temp-4 dy-rat-times-4)))
)
(set! (-> cull-info yz-dir-ay) (* dy-rat inverse-y-len))
(set! (-> cull-info yz-dir-az) (* d-temp-4 inverse-y-len))
(set! (-> cull-info yz-dir-by) (* dy-rat-times-4 inverse-y-len-2))
(set! (-> cull-info yz-dir-bz) (* d-temp-5 inverse-y-len-2))
)
(set!
(-> cull-info yz-cross-ab)
(- (* dy-rat d-temp-5) (* d-temp-4 dy-rat-times-4))
)
)
)
(fog-corrector-setup *math-camera-fog-correction* math-cam)
(matrix-identity! (-> math-cam camera-rot))
(let ((fog-constant-1 100.0)
(fog-constant-2 16760631.0)
)
16777115.0
(let
((fog-at-near-plane
(/
(* (-> math-cam d) (- (-> math-cam fog-min) (-> math-cam fog-max)))
(-
(-> *math-camera-fog-correction* fog-end)
(-> *math-camera-fog-correction* fog-start)
)
)
)
(fog-factor-2 (* -0.5 (- fog-constant-2 fog-constant-1)))
)
(let
((corrected-fog
(/ fog-factor-2 (* (-> math-cam d) (- (-> math-cam f) (-> math-cam d))))
)
(cam-fov-mult (-> math-cam fov-correction-factor))
)
(set!
(-> math-cam perspective vector 0 x)
(*
cam-fov-mult
(- (/ (-> math-cam x-pix) (* (-> math-cam x-ratio) (-> math-cam d))))
)
)
(set!
(-> math-cam perspective vector 1 y)
(*
cam-fov-mult
(- (/ (-> math-cam y-pix) (* (-> math-cam y-ratio) (-> math-cam d))))
)
)
(set!
(-> math-cam perspective vector 2 z)
(* cam-fov-mult (+ (-> math-cam f) (-> math-cam d)) corrected-fog)
)
(set!
(-> math-cam perspective vector 2 w)
(* (/ cam-fov-mult (-> math-cam d)) fog-at-near-plane)
)
(set!
(-> math-cam perspective vector 3 z)
(* -2.0 corrected-fog (-> math-cam f) (-> math-cam d) cam-fov-mult)
)
)
(let ((hvdf-x 2048.0)
(hvdf-y 2048.0)
(hvdf-w
(/
(-
(* (-> *math-camera-fog-correction* fog-end) (-> math-cam fog-max))
(*
(-> *math-camera-fog-correction* fog-start)
(-> math-cam fog-min)
)
)
(-
(-> *math-camera-fog-correction* fog-end)
(-> *math-camera-fog-correction* fog-start)
)
16777115.0
(let ((fog-at-near-plane
(/ (* (-> math-cam d) (- (-> math-cam fog-min) (-> math-cam fog-max)))
(- (-> *math-camera-fog-correction* fog-end) (-> *math-camera-fog-correction* fog-start))
)
)
)
(fog-factor-2 (* -0.5 (- fog-constant-2 fog-constant-1)))
)
(let ((hvdf-z (* 0.5 (+ fog-constant-2 fog-constant-1))))
(set! (-> math-cam hmge-scale x) (/ 1.0 (-> math-cam x-clip)))
(set! (-> math-cam hmge-scale y) (/ 1.0 (-> math-cam y-clip)))
(set! (-> math-cam hmge-scale z) (/ 1.0 fog-factor-2))
(set! (-> math-cam hmge-scale w) (/ 1.0 fog-at-near-plane))
(set! (-> math-cam inv-hmge-scale x) (-> math-cam x-clip))
(set! (-> math-cam inv-hmge-scale y) (-> math-cam y-clip))
(set! (-> math-cam inv-hmge-scale z) fog-factor-2)
(set! (-> math-cam inv-hmge-scale w) fog-at-near-plane)
(set! (-> math-cam hvdf-off x) hvdf-x)
(set! (-> math-cam hvdf-off y) hvdf-y)
(set! (-> math-cam hvdf-off z) hvdf-z)
(set! (-> math-cam hvdf-off w) hvdf-w)
(set! (-> math-cam guard x) (/ (-> math-cam x-clip) (-> math-cam x-pix)))
(set! (-> math-cam guard y) (/ (-> math-cam y-clip) (-> math-cam y-pix)))
(set! (-> math-cam guard z) 1.0)
(set! (-> math-cam guard w) 1.0)
(set! (-> math-cam isometric vector 3 z) (- 16777215.0 hvdf-z))
(let ((corrected-fog (/ fog-factor-2 (* (-> math-cam d) (- (-> math-cam f) (-> math-cam d)))))
(cam-fov-mult (-> math-cam fov-correction-factor))
)
(set! (-> math-cam perspective vector 0 x)
(* cam-fov-mult (- (/ (-> math-cam x-pix) (* (-> math-cam x-ratio) (-> math-cam d)))))
)
(set! (-> math-cam perspective vector 1 y)
(* cam-fov-mult (- (/ (-> math-cam y-pix) (* (-> math-cam y-ratio) (-> math-cam d)))))
)
(set! (-> math-cam perspective vector 2 z) (* cam-fov-mult (+ (-> math-cam f) (-> math-cam d)) corrected-fog))
(set! (-> math-cam perspective vector 2 w) (* (/ cam-fov-mult (-> math-cam d)) fog-at-near-plane))
(set! (-> math-cam perspective vector 3 z)
(* -2.0 corrected-fog (-> math-cam f) (-> math-cam d) cam-fov-mult)
)
)
(let ((hvdf-x 2048.0)
(hvdf-y 2048.0)
(hvdf-w (/ (- (* (-> *math-camera-fog-correction* fog-end) (-> math-cam fog-max))
(* (-> *math-camera-fog-correction* fog-start) (-> math-cam fog-min))
)
(- (-> *math-camera-fog-correction* fog-end) (-> *math-camera-fog-correction* fog-start))
)
)
)
(let ((hvdf-z (* 0.5 (+ fog-constant-2 fog-constant-1))))
(set! (-> math-cam hmge-scale x) (/ 1.0 (-> math-cam x-clip)))
(set! (-> math-cam hmge-scale y) (/ 1.0 (-> math-cam y-clip)))
(set! (-> math-cam hmge-scale z) (/ 1.0 fog-factor-2))
(set! (-> math-cam hmge-scale w) (/ 1.0 fog-at-near-plane))
(set! (-> math-cam inv-hmge-scale x) (-> math-cam x-clip))
(set! (-> math-cam inv-hmge-scale y) (-> math-cam y-clip))
(set! (-> math-cam inv-hmge-scale z) fog-factor-2)
(set! (-> math-cam inv-hmge-scale w) fog-at-near-plane)
(set! (-> math-cam hvdf-off x) hvdf-x)
(set! (-> math-cam hvdf-off y) hvdf-y)
(set! (-> math-cam hvdf-off z) hvdf-z)
(set! (-> math-cam hvdf-off w) hvdf-w)
(set! (-> math-cam guard x) (/ (-> math-cam x-clip) (-> math-cam x-pix)))
(set! (-> math-cam guard y) (/ (-> math-cam y-clip) (-> math-cam y-pix)))
(set! (-> math-cam guard z) 1.0)
(set! (-> math-cam guard w) 1.0)
(set! (-> math-cam isometric vector 3 z) (- 16777215.0 hvdf-z))
)
(set! (-> math-cam isometric vector 3 w) fog-at-near-plane)
(let ((persp-xx (-> math-cam perspective vector 0 x))
(persp-yy (-> math-cam perspective vector 1 y))
(persp-x (* -1.9996 (-> math-cam perspective vector 0 x)))
)
(let ((sprite-row-0 (-> math-cam sprite-2d)))
(set! (-> sprite-row-0 vector 0 x) persp-x)
(set! (-> sprite-row-0 vector 0 y) 0.0)
(set! (-> sprite-row-0 vector 0 z) 0.0)
(set! (-> sprite-row-0 vector 0 w) 0.0)
)
(set-vector! (-> math-cam sprite-2d vector 1) 0.0 (- (* (/ persp-yy persp-xx) persp-x)) 0.0 0.0)
(set-vector! (-> math-cam sprite-2d vector 2) 0.0 0.0 (- persp-x) 0.0)
(set-vector!
(-> math-cam sprite-2d vector 3)
0.0
0.0
(* 500000000.0 persp-x)
(* 60.0 persp-x (-> math-cam pfog0))
)
)
(set! (-> math-cam sprite-2d-hvdf quad) (-> math-cam hvdf-off quad))
(set! (-> math-cam sprite-2d-hvdf x) 2048.0)
(set! (-> math-cam sprite-2d-hvdf y) 2048.0)
(set! (-> math-cam sprite-2d-hvdf z) (-> math-cam hvdf-off z))
(set! (-> math-cam pfog0) fog-at-near-plane)
(set! (-> math-cam pfog1) hvdf-w)
)
)
(set! (-> math-cam isometric vector 3 w) fog-at-near-plane)
(let ((persp-xx (-> math-cam perspective vector 0 x))
(persp-yy (-> math-cam perspective vector 1 y))
(persp-x (* -1.9996 (-> math-cam perspective vector 0 x)))
)
(let ((sprite-row-0 (-> math-cam sprite-2d)))
(set! (-> sprite-row-0 vector 0 x) persp-x)
(set! (-> sprite-row-0 vector 0 y) 0.0)
(set! (-> sprite-row-0 vector 0 z) 0.0)
(set! (-> sprite-row-0 vector 0 w) 0.0)
)
(set-vector!
(-> math-cam sprite-2d vector 1)
0.0
(- (* (/ persp-yy persp-xx) persp-x))
0.0
0.0
)
(set-vector! (-> math-cam sprite-2d vector 2) 0.0 0.0 (- persp-x) 0.0)
(set-vector!
(-> math-cam sprite-2d vector 3)
0.0
0.0
(* 500000000.0 persp-x)
(* 60.0 persp-x (-> math-cam pfog0))
)
)
(set! (-> math-cam sprite-2d-hvdf quad) (-> math-cam hvdf-off quad))
(set! (-> math-cam sprite-2d-hvdf x) 2048.0)
(set! (-> math-cam sprite-2d-hvdf y) 2048.0)
(set! (-> math-cam sprite-2d-hvdf z) (-> math-cam hvdf-off z))
(set! (-> math-cam pfog0) fog-at-near-plane)
(set! (-> math-cam pfog1) hvdf-w)
)
)
)
0
(make-u128 0 (shl #x301ec000 32))
(make-u128 0 (shl #x303ec000 32))
(let ((pfog (-> math-cam pfog0)))
(let ((vis-gif-0 (-> math-cam vis-gifs)))
(set! (-> vis-gif-0 0 fog0) (the-as uint pfog))
(set! (-> vis-gif-0 0 strip) (the-as uint #x301e4000))
(set! (-> vis-gif-0 0 regs) (the-as uint 1042))
(set! (-> vis-gif-0 0 fan) (the-as uint #x301ec000))
(let ((vis-gif-0 (-> math-cam vis-gifs)))
(set! (-> vis-gif-0 0 fog0) (the-as uint pfog))
(set! (-> vis-gif-0 0 strip) (the-as uint #x301e4000))
(set! (-> vis-gif-0 0 regs) (the-as uint 1042))
(set! (-> vis-gif-0 0 fan) (the-as uint #x301ec000))
)
(let ((vis-gif-1 (&-> math-cam gifgr)))
(set! (-> vis-gif-1 0) (the-as vis-gif-tag pfog))
(set! (-> vis-gif-1 1) (the-as vis-gif-tag (make-u128 0 (shl #x20164000 32))))
(set! (-> vis-gif-1 2) (the-as vis-gif-tag 65))
(set! (-> vis-gif-1 3) (the-as vis-gif-tag #x301ec000))
)
(let ((vis-gif-1-again (-> math-cam vis-gifs)))
(set! (-> vis-gif-1-again 0 fog0) (the-as uint pfog))
(set! (-> vis-gif-1-again 0 strip) (the-as uint #x303e4000))
(set! (-> vis-gif-1-again 0 regs) (the-as uint 1042))
(set! (-> vis-gif-1-again 0 fan) (the-as uint #x303ec000))
)
(let ((vis-gif-1-again-again (-> math-cam vis-gifs)))
(set! (-> vis-gif-1-again-again 0 fog0) (the-as uint pfog))
(set! (-> vis-gif-1-again-again 0 strip) (the-as uint #x303e4000))
(set! (-> vis-gif-1-again-again 0 regs) (the-as uint 1042))
(set! (-> vis-gif-1-again-again 0 fan) (the-as uint #x303ec000))
)
)
(let ((vis-gif-1 (&-> math-cam gifgr)))
(set! (-> vis-gif-1 0) (the-as vis-gif-tag pfog))
(set!
(-> vis-gif-1 1)
(the-as vis-gif-tag (make-u128 0 (shl #x20164000 32)))
)
(set! (-> vis-gif-1 2) (the-as vis-gif-tag 65))
(set! (-> vis-gif-1 3) (the-as vis-gif-tag #x301ec000))
)
(let ((vis-gif-1-again (-> math-cam vis-gifs)))
(set! (-> vis-gif-1-again 0 fog0) (the-as uint pfog))
(set! (-> vis-gif-1-again 0 strip) (the-as uint #x303e4000))
(set! (-> vis-gif-1-again 0 regs) (the-as uint 1042))
(set! (-> vis-gif-1-again 0 fan) (the-as uint #x303ec000))
)
(let ((vis-gif-1-again-again (-> math-cam vis-gifs)))
(set! (-> vis-gif-1-again-again 0 fog0) (the-as uint pfog))
(set! (-> vis-gif-1-again-again 0 strip) (the-as uint #x303e4000))
(set! (-> vis-gif-1-again-again 0 regs) (the-as uint 1042))
(set! (-> vis-gif-1-again-again 0 fan) (the-as uint #x303ec000))
)
)
(if (nonzero? sprite-distorter-generate-tables)
(sprite-distorter-generate-tables)
)
(sprite-distorter-generate-tables)
)
math-cam
)
;; definition for method 0 of type math-camera
(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)))
)
(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))
(set! (-> gp-0 isometric vector 0 x) 1.0)
(set! (-> gp-0 isometric vector 1 y) 0.5)
(set! (-> gp-0 isometric vector 2 z) -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)
)
(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))
(set! (-> gp-0 isometric vector 0 x) 1.0)
(set! (-> gp-0 isometric vector 1 y) 0.5)
(set! (-> gp-0 isometric vector 2 z) -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)
)
)
;; definition for symbol *math-camera*, type math-camera
@@ -339,87 +243,67 @@
(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)
)
(matrix->quaternion (-> *math-camera* inv-camera-rot-smooth-from) (-> *math-camera* inv-camera-rot-smooth))
)
;; definition for function move-target-from-pad
;; Used lq/sq
(defun move-target-from-pad ((trans transform) (pad-idx int))
(let ((local-trans (new-stack-vector0)))
(set! (-> local-trans x) (cond
((logtest?
(-> *cpad-list* cpads pad-idx button0-abs 0)
(pad-buttons circle)
(set! (-> local-trans x) (cond
((logtest? (-> *cpad-list* cpads pad-idx button0-abs 0) (pad-buttons circle))
-80.0
)
((logtest? (-> *cpad-list* cpads pad-idx button0-abs 0) (pad-buttons square))
80.0
)
(else
0.0
)
)
-80.0
)
((logtest?
(-> *cpad-list* cpads pad-idx button0-abs 0)
(pad-buttons square)
)
(set! (-> local-trans y) 0.0)
(set! (-> local-trans z) (cond
((logtest? (-> *cpad-list* cpads pad-idx button0-abs 0) (pad-buttons down))
-80.0
)
((logtest? (-> *cpad-list* cpads pad-idx button0-abs 0) (pad-buttons up))
80.0
)
(else
0.0
)
)
80.0
)
(else
0.0
)
)
)
(set! (-> local-trans w) 1.0)
(let ((inv-cam-rot (new-stack-vector0))
(cam-rot-mat (new-stack-matrix0))
)
(vector-negate! inv-cam-rot (-> trans rot))
(matrix-rotate-zyx! cam-rot-mat (-> trans rot))
(vector-matrix*! local-trans local-trans cam-rot-mat)
)
(vector+! (-> trans trans) (-> trans trans) local-trans)
)
(set! (-> local-trans y) 0.0)
(set! (-> local-trans z) (cond
((logtest?
(-> *cpad-list* cpads pad-idx button0-abs 0)
(pad-buttons down)
)
-80.0
)
((logtest?
(-> *cpad-list* cpads pad-idx button0-abs 0)
(pad-buttons up)
)
80.0
)
(else
0.0
)
)
)
(set! (-> local-trans w) 1.0)
(let ((inv-cam-rot (new-stack-vector0))
(cam-rot-mat (new-stack-matrix0))
)
(vector-negate! inv-cam-rot (-> trans rot))
(matrix-rotate-zyx! cam-rot-mat (-> trans rot))
(vector-matrix*! local-trans local-trans cam-rot-mat)
)
(vector+! (-> trans trans) (-> trans trans) local-trans)
)
(set! (-> trans trans w) 1.0)
(if (logtest? (-> *cpad-list* cpads pad-idx button0-abs 0) (pad-buttons r1))
(set! (-> trans trans y) (+ 80.0 (-> trans trans y)))
)
(set! (-> trans trans y) (+ 80.0 (-> trans trans y)))
)
(if (logtest? (-> *cpad-list* cpads pad-idx button0-abs 0) (pad-buttons r2))
(set! (-> trans trans y) (+ -80.0 (-> trans trans y)))
)
(set! (-> trans trans y) (+ -80.0 (-> trans trans y)))
)
(if (logtest? (-> *cpad-list* cpads pad-idx button0-abs 0) (pad-buttons x))
(set! (-> trans rot x) (+ 546.13336 (-> trans rot x)))
)
(if
(logtest?
(-> *cpad-list* cpads pad-idx button0-abs 0)
(pad-buttons triangle)
)
(set! (-> trans rot x) (+ -546.13336 (-> trans rot x)))
)
(set! (-> trans rot x) (+ 546.13336 (-> trans rot x)))
)
(if (logtest? (-> *cpad-list* cpads pad-idx button0-abs 0) (pad-buttons triangle))
(set! (-> trans rot x) (+ -546.13336 (-> trans rot x)))
)
(if (logtest? (-> *cpad-list* cpads pad-idx button0-abs 0) (pad-buttons left))
(set! (-> trans rot y) (+ 546.13336 (-> trans rot y)))
)
(if
(logtest? (-> *cpad-list* cpads pad-idx button0-abs 0) (pad-buttons right))
(set! (-> trans rot y) (+ -546.13336 (-> trans rot y)))
)
(set! (-> trans rot y) (+ 546.13336 (-> trans rot y)))
)
(if (logtest? (-> *cpad-list* cpads pad-idx button0-abs 0) (pad-buttons right))
(set! (-> trans rot y) (+ -546.13336 (-> trans rot y)))
)
trans
)
@@ -441,32 +325,32 @@
(vf30 :class vf)
(vf31 :class vf)
)
(init-vf0-vector)
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)
(.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 v1-7 63))
)
(init-vf0-vector)
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)
(.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 v1-7 63))
)
)
;; definition for function transform-point-qword!
@@ -487,33 +371,33 @@
(vf30 :class vf)
(vf31 :class vf)
)
(init-vf0-vector)
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)
(.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)
(vftoi4.xyzw vf28 vf28)
(.svf (&-> arg0 quad) vf28)
(zero? (logand v1-7 63))
)
(init-vf0-vector)
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)
(.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)
(vftoi4.xyzw vf28 vf28)
(.svf (&-> arg0 quad) vf28)
(zero? (logand v1-7 63))
)
)
;; definition for function transform-point-vector-scale!
@@ -534,34 +418,34 @@
(vf30 :class vf)
(vf31 :class vf)
)
(init-vf0-vector)
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)
(.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 v1-7 63))
(.mov v0-0 vf23)
v0-0
)
(init-vf0-vector)
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)
(.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 v1-7 63))
(.mov v0-0 vf23)
v0-0
)
)
;; definition for function init-for-transform
@@ -588,75 +472,75 @@
(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))
)
(let ((s2-0 (new 'stack 'vector4s-3)))
(matrix*! s5-0 arg0 (-> *math-camera* camera-temp))
(matrix-3x3-inverse-transpose! gp-0 arg0)
(set-vector! s3-0 0.4 0.4 0.4 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 ((gp-0 (new-stack-matrix0))
(s5-0 (new-stack-matrix0))
(s4-0 (new 'stack 'vector4s-3))
(s3-0 (new-stack-vector0))
)
(let ((s2-0 (new 'stack 'vector4s-3)))
(matrix*! s5-0 arg0 (-> *math-camera* camera-temp))
(matrix-3x3-inverse-transpose! gp-0 arg0)
(set-vector! s3-0 0.4 0.4 0.4 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* vis-gifs-quads 0))
(let ((v1-13 255))
(.mov vf6 v1-13)
)
(.mov v1-14 vf6)
(.itof.vf vf6 vf6)
(.lvf vf1 (&-> s5-0 vector 0 quad))
(.lvf vf2 (&-> s5-0 vector 1 quad))
(.lvf vf3 (&-> s5-0 vector 2 quad))
(.lvf vf4 (&-> s5-0 vector 3 quad))
(.lvf vf17 (&-> gp-0 vector 0 quad))
(.lvf vf18 (&-> gp-0 vector 1 quad))
(.lvf vf19 (&-> gp-0 vector 2 quad))
(.lvf vf23 (&-> s2-0 quad 0))
(.lvf vf24 (&-> s2-0 quad 1))
(.lvf vf25 (&-> s2-0 quad 2))
)
(.lvf vf27 (&-> s4-0 quad 0))
(.lvf vf28 (&-> s4-0 quad 1))
(.lvf vf29 (&-> s4-0 quad 2))
(.lvf vf26 (&-> s3-0 quad))
)
(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* vis-gifs-quads 0))
(let ((v1-13 255))
(.mov vf6 v1-13)
)
(.mov v1-14 vf6)
(.itof.vf vf6 vf6)
(.lvf vf1 (&-> s5-0 vector 0 quad))
(.lvf vf2 (&-> s5-0 vector 1 quad))
(.lvf vf3 (&-> s5-0 vector 2 quad))
(.lvf vf4 (&-> s5-0 vector 3 quad))
(.lvf vf17 (&-> gp-0 vector 0 quad))
(.lvf vf18 (&-> gp-0 vector 1 quad))
(.lvf vf19 (&-> gp-0 vector 2 quad))
(.lvf vf23 (&-> s2-0 quad 0))
(.lvf vf24 (&-> s2-0 quad 1))
(.lvf vf25 (&-> s2-0 quad 2))
)
(.lvf vf27 (&-> s4-0 quad 0))
(.lvf vf28 (&-> s4-0 quad 1))
(.lvf vf29 (&-> s4-0 quad 2))
(.lvf vf26 (&-> s3-0 quad))
(none)
)
(none)
)
)
+2 -2
View File
@@ -34,8 +34,8 @@
;; definition for method 3 of type pov-camera
(defmethod inspect pov-camera ((obj pov-camera))
(let ((t9-0 (method-of-type process-drawable inspect)))
(t9-0 obj)
)
(t9-0 obj)
)
(format #t "~T~Tflags: ~D~%" (-> obj flags))
(format #t "~T~Tdebounce-start-time: ~D~%" (-> obj debounce-start-time))
(format #t "~T~Tnotify-handle: ~D~%" (-> obj notify-handle))
+200 -298
View File
@@ -3,27 +3,20 @@
;; definition for method 25 of type pov-camera
(defmethod TODO-RENAME-25 pov-camera ((obj pov-camera))
(when
(or
(and
(>=
(-
(-> *display* base-frame-counter)
(the-as int (-> obj debounce-start-time))
)
60
(when (or
(and
(>= (- (-> *display* base-frame-counter) (the-as int (-> obj debounce-start-time))) 60)
(cpad-pressed? 0 triangle)
)
(logtest? (-> obj flags) 2)
)
(logclear! (-> *cpad-list* cpads 0 button0-abs 0) (pad-buttons triangle))
(logclear! (-> *cpad-list* cpads 0 button0-rel 0) (pad-buttons triangle))
(when (logtest? (-> obj flags) 1)
(send-event (handle->process (-> obj notify-handle)) 'notify 'abort-request)
#t
)
(cpad-pressed? 0 triangle)
)
(logtest? (-> obj flags) 2)
)
(logclear! (-> *cpad-list* cpads 0 button0-abs 0) (pad-buttons triangle))
(logclear! (-> *cpad-list* cpads 0 button0-rel 0) (pad-buttons triangle))
(when (logtest? (-> obj flags) 1)
(send-event (handle->process (-> obj notify-handle)) 'notify 'abort-request)
#t
)
)
)
;; definition for method 26 of type pov-camera
@@ -40,10 +33,7 @@
(defstate pov-camera-startup (pov-camera)
:virtual #t
:code
(behavior ()
(go-virtual pov-camera-start-playing)
(none)
)
(behavior () (go-virtual pov-camera-start-playing) (none))
)
;; failed to figure out what this is:
@@ -51,103 +41,74 @@
:virtual #t
:code
(behavior ()
(logclear! (-> self mask) (process-mask actor-pause))
(while (not (target-grabbed? self))
(suspend)
)
(let ((gp-0 0))
(let ((v1-7 (dummy-10 (-> self draw jgeo) "camera" (the-as type #f))))
(if v1-7
(set! gp-0 (+ (-> v1-7 number) 1))
(logclear! (-> self mask) (process-mask actor-pause))
(while (not (target-grabbed? self))
(suspend)
)
)
(let* ((s5-0 (get-process *default-dead-pool* othercam #x4000))
(v1-10 (when s5-0
(let ((t9-3 (method-of-type othercam activate)))
(t9-3
(the-as othercam s5-0)
self
'othercam
(the-as pointer #x70004000)
)
)
(run-now-in-process
s5-0
othercam-init-by-other
self
gp-0
#t
#t
)
(-> s5-0 ppointer)
)
(let ((gp-0 0))
(let ((v1-7 (dummy-10 (-> self draw jgeo) "camera" (the-as type #f))))
(if v1-7
(set! gp-0 (+ (-> v1-7 number) 1))
)
)
(send-event (ppointer->process v1-10) 'mask (-> self mask-to-clear))
)
)
(let* ((s5-0 (get-process *default-dead-pool* othercam #x4000))
(v1-10 (when s5-0
(let ((t9-3 (method-of-type othercam activate)))
(t9-3 (the-as othercam s5-0) self 'othercam (the-as pointer #x70004000))
)
(run-now-in-process s5-0 othercam-init-by-other self gp-0 #t #t)
(-> s5-0 ppointer)
)
)
)
(send-event (ppointer->process v1-10) 'mask (-> self mask-to-clear))
)
)
(go-virtual pov-camera-playing)
(none)
)
(go-virtual pov-camera-playing)
(none)
)
)
;; definition for function pov-camera-play-and-reposition
;; INFO: Return type mismatch int vs none.
(defbehavior
pov-camera-play-and-reposition pov-camera
((arg0 joint-anim-compressed) (arg1 vector) (arg2 float))
(defbehavior pov-camera-play-and-reposition pov-camera ((arg0 joint-anim-compressed) (arg1 vector) (arg2 float))
(let ((s4-0 #f))
(let ((v1-2 (-> self skel root-channel 0)))
(set! (-> v1-2 frame-group) (the-as art-joint-anim arg0))
(set! (-> v1-2 param 0) (the float (+ (-> arg0 data 9 unknown-half) -1)))
(set! (-> v1-2 param 1) arg2)
(set! (-> v1-2 frame-num) 0.0)
(joint-control-channel-group!
v1-2
(the-as art-joint-anim arg0)
num-func-seek!
)
)
(until (ja-done? 0)
(let
((v1-4
(and
(not s4-0)
(< (the float (+ (-> (if (> (-> self skel active-channels) 0)
(-> self skel root-channel 0 frame-group)
)
data
0
length
)
-4
(let ((v1-2 (-> self skel root-channel 0)))
(set! (-> v1-2 frame-group) (the-as art-joint-anim arg0))
(set! (-> v1-2 param 0) (the float (+ (-> arg0 data 9 unknown-half) -1)))
(set! (-> v1-2 param 1) arg2)
(set! (-> v1-2 frame-num) 0.0)
(joint-control-channel-group! v1-2 (the-as art-joint-anim arg0) num-func-seek!)
)
(until (ja-done? 0)
(let ((v1-4 (and (not s4-0) (< (the float (+ (-> (if (> (-> self skel active-channels) 0)
(-> self skel root-channel 0 frame-group)
)
data
0
length
)
-4
)
)
(ja-frame-num 0)
)
)
)
)
(ja-frame-num 0)
)
(when v1-4
(set! s4-0 #t)
(send-event *camera* 'teleport-to-vector-start-string arg1)
)
)
(suspend)
(let ((a0-4 (-> self skel root-channel 0)))
(set! (-> a0-4 param 0) (the float (+ (-> a0-4 frame-group data 0 length) -1)))
(set! (-> a0-4 param 1) arg2)
(joint-control-channel-group-eval! a0-4 (the-as art-joint-anim #f) num-func-seek!)
)
)
)
(when v1-4
(set! s4-0 #t)
(send-event *camera* 'teleport-to-vector-start-string arg1)
)
)
(suspend)
(let ((a0-4 (-> self skel root-channel 0)))
(set!
(-> a0-4 param 0)
(the float (+ (-> a0-4 frame-group data 0 length) -1))
)
(set! (-> a0-4 param 1) arg2)
(joint-control-channel-group-eval!
a0-4
(the-as art-joint-anim #f)
num-func-seek!
)
)
)
)
0
(none)
)
@@ -157,140 +118,105 @@
:virtual #t
:event
(behavior ((arg0 process) (arg1 int) (arg2 symbol) (arg3 event-message-block))
(case arg2
(('abort)
(when (logtest? (-> self flags) 1)
(logior! (-> self flags) 2)
(if (= (-> self anim-name type) string)
(go-virtual pov-camera-abort)
)
(case arg2
(('abort)
(when (logtest? (-> self flags) 1)
(logior! (-> self flags) 2)
(if (= (-> self anim-name type) string)
(go-virtual pov-camera-abort)
)
)
)
)
)
)
:enter
(behavior ()
(set!
(-> self debounce-start-time)
(the-as uint (-> *display* base-frame-counter))
(set! (-> self debounce-start-time) (the-as uint (-> *display* base-frame-counter)))
(if (= (-> self anim-name type) string)
(backup-load-state-and-set-cmds *load-state* (-> self command-list))
)
(none)
)
(if (= (-> self anim-name type) string)
(backup-load-state-and-set-cmds *load-state* (-> self command-list))
)
(none)
)
:exit
(behavior ()
(if (= (-> self anim-name type) string)
(restore-load-state-and-cleanup *load-state*)
(if (= (-> self anim-name type) string)
(restore-load-state-and-cleanup *load-state*)
)
(clear-pending-settings-from-process *setting-control* self 'music-volume)
(clear-pending-settings-from-process *setting-control* self 'sfx-volume)
(none)
)
(clear-pending-settings-from-process *setting-control* self 'music-volume)
(clear-pending-settings-from-process *setting-control* self 'sfx-volume)
(none)
)
:code
(behavior ()
(push-setting!
*setting-control*
self
'music-volume
'rel
(-> self music-volume-movie)
0
)
(push-setting!
*setting-control*
self
'sfx-volume
'rel
(-> self sfx-volume-movie)
0
)
(cond
((= (-> self anim-name type) string)
(let ((a0-4 (-> self skel root-channel 0)))
(set! (-> a0-4 frame-group) (if (> (-> self skel active-channels) 0)
(-> self skel root-channel 0 frame-group)
)
(push-setting! *setting-control* self 'music-volume 'rel (-> self music-volume-movie) 0)
(push-setting! *setting-control* self 'sfx-volume 'rel (-> self sfx-volume-movie) 0)
(cond
((= (-> self anim-name type) string)
(let ((a0-4 (-> self skel root-channel 0)))
(set! (-> a0-4 frame-group) (if (> (-> self skel active-channels) 0)
(-> self skel root-channel 0 frame-group)
)
)
(set! (-> a0-4 param 0) (the float (+ (-> (if (> (-> self skel active-channels) 0)
(-> self skel root-channel 0 frame-group)
)
data
0
length
)
-1
)
)
)
(set! (-> a0-4 param 1) 1.0)
(set! (-> a0-4 frame-num) 0.0)
(joint-control-channel-group!
a0-4
(if (> (-> self skel active-channels) 0)
(-> self skel root-channel 0 frame-group)
)
num-func-seek!
)
)
(until (ja-done? 0)
(TODO-RENAME-25 self)
(suspend)
(let ((a0-6 (-> self skel root-channel 0)))
(set! (-> a0-6 param 0) (the float (+ (-> a0-6 frame-group data 0 length) -1)))
(set! (-> a0-6 param 1) 1.0)
(joint-control-channel-group-eval! a0-6 (the-as art-joint-anim #f) num-func-seek!)
)
)
)
(set!
(-> a0-4 param 0)
(the float (+ (-> (if (> (-> self skel active-channels) 0)
(-> self skel root-channel 0 frame-group)
)
data
0
length
)
-1
)
)
)
(set! (-> a0-4 param 1) 1.0)
(set! (-> a0-4 frame-num) 0.0)
(joint-control-channel-group!
a0-4
(if (> (-> self skel active-channels) 0)
(-> self skel root-channel 0 frame-group)
)
num-func-seek!
((= (-> self anim-name type) spool-anim)
(ja-play-spooled-anim
(the-as spool-anim (-> self anim-name))
(the-as art-joint-anim #f)
(the-as art-joint-anim #f)
(method-of-object self TODO-RENAME-25)
)
)
)
(until (ja-done? 0)
(TODO-RENAME-25 self)
(suspend)
(let ((a0-6 (-> self skel root-channel 0)))
(set!
(-> a0-6 param 0)
(the float (+ (-> a0-6 frame-group data 0 length) -1))
)
(set! (-> a0-6 param 1) 1.0)
(joint-control-channel-group-eval!
a0-6
(the-as art-joint-anim #f)
num-func-seek!
)
)
)
)
((= (-> self anim-name type) spool-anim)
(ja-play-spooled-anim
(the-as spool-anim (-> self anim-name))
(the-as art-joint-anim #f)
(the-as art-joint-anim #f)
(method-of-object self TODO-RENAME-25)
)
)
(go-virtual pov-camera-done-playing)
(none)
)
(go-virtual pov-camera-done-playing)
(none)
)
:post
(behavior ()
(if (= (-> self anim-name type) string)
(execute-commands-up-to *load-state* (ja-aframe-num 0))
(if (= (-> self anim-name type) string)
(execute-commands-up-to *load-state* (ja-aframe-num 0))
)
(ja-post)
(none)
)
(ja-post)
(none)
)
)
;; failed to figure out what this is:
(defstate pov-camera-abort (pov-camera)
:virtual #t
:enter
(behavior ()
(logior! (-> self flags) 2)
(none)
)
(behavior () (logior! (-> self flags) 2) (none))
:code
(behavior ()
(set-blackout-frames 10)
(suspend)
(suspend)
(go-virtual pov-camera-done-playing)
(none)
)
(behavior () (set-blackout-frames 10) (suspend) (suspend) (go-virtual pov-camera-done-playing) (none))
)
;; failed to figure out what this is:
@@ -298,19 +224,16 @@
:virtual #t
:code
(behavior ()
(while (begin
self
(not ((method-of-object self target-released?)))
)
(while (begin self (not ((method-of-object self target-released?))))
(suspend)
)
(send-event (handle->process (-> self notify-handle)) 'notify 'die)
(suspend)
(suspend)
(dummy-18 self)
(deactivate self)
(none)
)
(send-event (handle->process (-> self notify-handle)) 'notify 'die)
(suspend)
(suspend)
(dummy-18 self)
(deactivate self)
(none)
)
)
;; definition for method 27 of type pov-camera
@@ -329,15 +252,7 @@
;; definition for function pov-camera-init-by-other
;; INFO: Return type mismatch object vs none.
;; Used lq/sq
(defbehavior
pov-camera-init-by-other pov-camera
((arg0 vector)
(arg1 skeleton-group)
(arg2 string)
(arg3 int)
(arg4 process-drawable)
(arg5 pair)
)
(defbehavior pov-camera-init-by-other pov-camera ((arg0 vector) (arg1 skeleton-group) (arg2 string) (arg3 int) (arg4 process-drawable) (arg5 pair))
(set-stack-size! self)
(set! (-> *game-info* pov-camera-handle) (process->handle self))
(set! (-> self flags) arg3)
@@ -345,81 +260,68 @@
(set! (-> self music-volume-movie) 100.0)
(set! (-> self sfx-volume-movie) 100.0)
(if arg4
(set! (-> self notify-handle) (process->handle arg4))
(set! (-> self notify-handle) (the-as handle #f))
)
(set!
(-> self debounce-start-time)
(the-as uint (-> *display* base-frame-counter))
)
(logclear!
(-> self mask)
(process-mask actor-pause movie enemy platform projectile)
)
(set! (-> self notify-handle) (process->handle arg4))
(set! (-> self notify-handle) (the-as handle #f))
)
(set! (-> self debounce-start-time) (the-as uint (-> *display* base-frame-counter)))
(logclear! (-> self mask) (process-mask actor-pause movie enemy platform projectile))
(set! (-> self root) (new 'process 'trsqv))
(set! (-> self root trans quad) (-> arg0 quad))
(when (logtest? (-> self flags) 4)
(let
((v1-20
(if (and (nonzero? arg4) (type-type? (-> arg4 type) process-drawable))
arg4
)
(let ((v1-20 (if (and (nonzero? arg4) (type-type? (-> arg4 type) process-drawable))
arg4
)
)
)
(quaternion-copy! (-> self root quat) (-> v1-20 root quat))
)
)
(quaternion-copy! (-> self root quat) (-> v1-20 root quat))
)
)
(initialize-skeleton self arg1 '())
(logior! (-> self draw status) 32)
(logior! (-> self skel status) 1)
(set! (-> self anim-name) arg2)
(cond
((= (-> arg2 type) string)
(logior! (-> self skel status) 32)
(let ((s5-1 (dummy-10 (-> self draw art-group) arg2 art-joint-anim)))
(if (not s5-1)
(go process-drawable-art-error arg2)
)
(ja-channel-set! 1)
(set!
(-> self skel root-channel 0 frame-group)
(the-as art-joint-anim s5-1)
)
((= (-> arg2 type) string)
(logior! (-> self skel status) 32)
(let ((s5-1 (dummy-10 (-> self draw art-group) arg2 art-joint-anim)))
(if (not s5-1)
(go process-drawable-art-error arg2)
)
(ja-channel-set! 1)
(set! (-> self skel root-channel 0 frame-group) (the-as art-joint-anim s5-1))
)
)
((= (-> arg2 type) spool-anim)
)
)
((= (-> arg2 type) spool-anim)
)
)
(set! (-> self mask-to-clear) (the-as uint #x4a0800))
(set!
(-> self event-hook)
(lambda :behavior pov-camera
((arg0 process) (arg1 int) (arg2 symbol) (arg3 event-message-block))
(let ((v1-0 arg2))
(the-as object (cond
((= v1-0 'mask)
(let ((v0-0 (the-as number (-> arg3 param 0))))
(set! (-> self mask-to-clear) (the-as uint v0-0))
v0-0
)
)
((= v1-0 'music-movie-volume)
(let ((f0-0 (the-as float (-> arg3 param 0))))
(set! (-> self music-volume-movie) f0-0)
f0-0
)
)
((= v1-0 'sfx-movie-volume)
(let ((f0-1 (the-as float (-> arg3 param 0))))
(set! (-> self sfx-volume-movie) f0-1)
f0-1
)
)
)
)
)
)
)
(set! (-> self event-hook) (lambda :behavior pov-camera
((arg0 process) (arg1 int) (arg2 symbol) (arg3 event-message-block))
(let ((v1-0 arg2))
(the-as object (cond
((= v1-0 'mask)
(let ((v0-0 (the-as number (-> arg3 param 0))))
(set! (-> self mask-to-clear) (the-as uint v0-0))
v0-0
)
)
((= v1-0 'music-movie-volume)
(let ((f0-0 (the-as float (-> arg3 param 0))))
(set! (-> self music-volume-movie) f0-0)
f0-0
)
)
((= v1-0 'sfx-movie-volume)
(let ((f0-1 (the-as float (-> arg3 param 0))))
(set! (-> self sfx-volume-movie) f0-1)
f0-1
)
)
)
)
)
)
)
((method-of-object self dummy-27))
(go-virtual pov-camera-startup)
(none)
+5 -24
View File
@@ -16,10 +16,7 @@
)
;; definition for method 3 of type collide-using-spheres-params
(defmethod
inspect
collide-using-spheres-params
((obj collide-using-spheres-params))
(defmethod inspect collide-using-spheres-params ((obj collide-using-spheres-params))
(format #t "[~8x] ~A~%" obj 'collide-using-spheres-params)
(format #t "~Tspheres: #x~X~%" (-> obj spheres))
(format #t "~Tnum-spheres: ~D~%" (-> obj num-spheres))
@@ -71,11 +68,7 @@
(format #t "~Tclosest-pt: #<vector @ #x~X>~%" (-> obj closest-pt))
(format #t "~Ttri-normal: #<vector @ #x~X>~%" (-> obj tri-normal))
(format #t "~Ttri-bbox4w: #<bounding-box4w @ #x~X>~%" (-> obj tri-bbox4w))
(format
#t
"~Tspheres-bbox4w: #<bounding-box4w @ #x~X>~%"
(-> obj spheres-bbox4w)
)
(format #t "~Tspheres-bbox4w: #<bounding-box4w @ #x~X>~%" (-> obj spheres-bbox4w))
(format #t "~Tspheres[64] @ #x~X~%" (-> obj spheres))
obj
)
@@ -221,11 +214,7 @@
(format #t "~Tignore-mask: ~D~%" (-> obj ignore-mask))
(format #t "~Tproc: ~A~%" (-> obj proc))
(format #t "~Tcollide-box: #<bounding-box @ #x~X>~%" (-> obj collide-box))
(format
#t
"~Tcollide-box4w: #<bounding-box4w @ #x~X>~%"
(-> obj collide-box4w)
)
(format #t "~Tcollide-box4w: #<bounding-box4w @ #x~X>~%" (-> obj collide-box4w))
(format #t "~Tcollide-with: ~D~%" (-> obj collide-with))
(format #t "~Tprims[100] @ #x~X~%" (-> obj prims))
(format #t "~Ttris[461] @ #x~X~%" (-> obj tris))
@@ -282,16 +271,8 @@
;; definition for method 3 of type collide-work
(defmethod inspect collide-work ((obj collide-work))
(format #t "[~8x] ~A~%" obj 'collide-work)
(format
#t
"~Tcollide-sphere-neg-r: #<sphere @ #x~X>~%"
(-> obj collide-sphere-neg-r)
)
(format
#t
"~Tcollide-box4w: #<bounding-box4w @ #x~X>~%"
(-> obj collide-box4w)
)
(format #t "~Tcollide-sphere-neg-r: #<sphere @ #x~X>~%" (-> obj collide-sphere-neg-r))
(format #t "~Tcollide-box4w: #<bounding-box4w @ #x~X>~%" (-> obj collide-box4w))
(format #t "~Tinv-mat: #<matrix @ #x~X>~%" (-> obj inv-mat))
obj
)
+52 -110
View File
@@ -30,11 +30,7 @@
(format #t "[~8x] ~A~%" obj 'edge-grab-info)
(format #t "~Tworld-vertex[6] @ #x~X~%" (-> obj world-vertex))
(format #t "~Tlocal-vertex[6] @ #x~X~%" (-> obj local-vertex))
(format
#t
"~Tactor-cshape-prim-offset: ~D~%"
(-> obj actor-cshape-prim-offset)
)
(format #t "~Tactor-cshape-prim-offset: ~D~%" (-> obj actor-cshape-prim-offset))
(format #t "~Tactor-handle: ~D~%" (-> obj actor-handle))
(format #t "~Thanging-matrix: #<matrix @ #x~X>~%" (-> obj hanging-matrix))
(format #t "~Tedge-vertex[2] @ #x~X~%" (-> obj world-vertex))
@@ -198,123 +194,69 @@
(format #t "~Tnum-verts: ~D~%" (-> obj num-verts))
(format #t "~Tnum-edges: ~D~%" (-> obj num-edges))
(format #t "~Tnum-tris: ~D~%" (-> obj num-tris))
(format
#t
"~Tcache-fill-box: #<bounding-box @ #x~X>~%"
(-> obj cache-fill-box)
)
(format
#t
"~Twithin-reach-box: #<bounding-box @ #x~X>~%"
(-> obj within-reach-box)
)
(format
#t
"~Twithin-reach-box4w: #<bounding-box4w @ #x~X>~%"
(-> obj within-reach-box4w)
)
(format #t "~Tcache-fill-box: #<bounding-box @ #x~X>~%" (-> obj cache-fill-box))
(format #t "~Twithin-reach-box: #<bounding-box @ #x~X>~%" (-> obj within-reach-box))
(format #t "~Twithin-reach-box4w: #<bounding-box4w @ #x~X>~%" (-> obj within-reach-box4w))
(format #t "~Tsearch-pt: #<vector @ #x~X>~%" (-> obj search-pt))
(format #t "~Tsearch-dir-vec: #<vector @ #x~X>~%" (-> obj search-dir-vec))
(format
#t
"~Tmax-dist-sqrd-to-outward-pt: ~f~%"
(-> obj max-dist-sqrd-to-outward-pt)
)
(format #t "~Tmax-dist-sqrd-to-outward-pt: ~f~%" (-> obj max-dist-sqrd-to-outward-pt))
(format #t "~Tmax-dir-cosa-delta: ~f~%" (-> obj max-dir-cosa-delta))
(format #t "~Tsplit-dists[2] @ #x~X~%" (-> obj split-dists))
(format #t "~Toutward-offset: #<vector @ #x~X>~%" (-> obj outward-offset))
(format
#t
"~Tlocal-cache-fill-box: #<bounding-box @ #x~X>~%"
(-> obj local-cache-fill-box)
)
(format
#t
"~Tlocal-within-reach-box: #<bounding-box @ #x~X>~%"
(-> obj local-within-reach-box)
)
(format
#t
"~Tlocal-player-spheres[12] @ #x~X~%"
(-> obj local-player-spheres)
)
(format
#t
"~Tworld-player-spheres[12] @ #x~X~%"
(-> obj world-player-spheres)
)
(format
#t
"~Tlocal-player-hanging-spheres[6] @ #x~X~%"
(-> obj local-player-spheres)
)
(format
#t
"~Tworld-player-hanging-spheres[6] @ #x~X~%"
(-> obj world-player-spheres)
)
(format
#t
"~Tlocal-player-leap-up-spheres[6] @ #x~X~%"
(-> obj local-player-leap-up-spheres)
)
(format
#t
"~Tworld-player-leap-up-spheres[6] @ #x~X~%"
(-> obj world-player-leap-up-spheres)
)
(format #t "~Tlocal-cache-fill-box: #<bounding-box @ #x~X>~%" (-> obj local-cache-fill-box))
(format #t "~Tlocal-within-reach-box: #<bounding-box @ #x~X>~%" (-> obj local-within-reach-box))
(format #t "~Tlocal-player-spheres[12] @ #x~X~%" (-> obj local-player-spheres))
(format #t "~Tworld-player-spheres[12] @ #x~X~%" (-> obj world-player-spheres))
(format #t "~Tlocal-player-hanging-spheres[6] @ #x~X~%" (-> obj local-player-spheres))
(format #t "~Tworld-player-hanging-spheres[6] @ #x~X~%" (-> obj world-player-spheres))
(format #t "~Tlocal-player-leap-up-spheres[6] @ #x~X~%" (-> obj local-player-leap-up-spheres))
(format #t "~Tworld-player-leap-up-spheres[6] @ #x~X~%" (-> obj world-player-leap-up-spheres))
(format #t "~Tverts[64] @ #x~X~%" (-> obj verts))
(format #t "~Tedges[96] @ #x~X~%" (-> obj edges))
(format #t "~Ttris[48] @ #x~X~%" (-> obj tris))
(format
#t
"~Thold-list: #<collide-edge-hold-list @ #x~X>~%"
(-> obj hold-list)
)
(format #t "~Thold-list: #<collide-edge-hold-list @ #x~X>~%" (-> obj hold-list))
obj
)
;; definition for symbol *collide-edge-work*, type collide-edge-work
(define
*collide-edge-work*
(new 'static 'collide-edge-work
:max-dist-sqrd-to-outward-pt 37748736.0
:max-dir-cosa-delta 0.6
:split-dists
(new 'static 'array float 2 1024.0 1433.6)
:outward-offset
(new 'static 'vector :x 708.608 :y 13312.0 :w 1.0)
:local-cache-fill-box
(new 'static 'bounding-box
:min
(new 'static 'vector :x -8192.0 :y -11059.2 :z -8192.0 :w 1.0)
:max
(new 'static 'vector :x 8192.0 :y 24576.0 :z 8192.0 :w 1.0)
)
:local-within-reach-box
(new 'static 'bounding-box
:min
(new 'static 'vector :x -6144.0 :y 5324.8 :z -6144.0 :w 1.0)
:max
(new 'static 'vector :x 6144.0 :y 11059.2 :z 6144.0 :w 1.0)
)
:local-player-spheres
(new 'static 'inline-array sphere 12
(new 'static 'sphere :x 1720.32 :y -819.2 :w 1433.6)
(new 'static 'sphere :x 2293.76 :y -3276.8 :w 1884.16)
(new 'static 'sphere :x 1966.08 :y -6144.0 :w 1556.48)
(new 'static 'sphere :x 1966.08 :y -8601.6 :w 1556.48)
(new 'static 'sphere :x 1761.28 :y -11059.2 :w 1351.68)
(new 'static 'sphere :x 1679.36 :y -13312.0 :w 1269.76)
(new 'static 'sphere :x -737.28 :y 4096.0 :w 3072.0)
(new 'static 'sphere :x -737.28 :y 6553.6 :w 3072.0)
(new 'static 'sphere :x -737.28 :y 9420.8 :w 3072.0)
(new 'static 'sphere :x 1720.32 :y 3686.4 :w 2949.12)
(new 'static 'sphere :x 1720.32 :y 5734.4 :w 2949.12)
(new 'static 'sphere :x 1720.32 :y 8601.6 :w 2949.12)
)
)
)
(define *collide-edge-work* (new 'static 'collide-edge-work
:max-dist-sqrd-to-outward-pt 37748736.0
:max-dir-cosa-delta 0.6
:split-dists
(new 'static 'array float 2 1024.0 1433.6)
:outward-offset
(new 'static 'vector :x 708.608 :y 13312.0 :w 1.0)
:local-cache-fill-box
(new 'static 'bounding-box
:min
(new 'static 'vector :x -8192.0 :y -11059.2 :z -8192.0 :w 1.0)
:max
(new 'static 'vector :x 8192.0 :y 24576.0 :z 8192.0 :w 1.0)
)
:local-within-reach-box
(new 'static 'bounding-box
:min
(new 'static 'vector :x -6144.0 :y 5324.8 :z -6144.0 :w 1.0)
:max
(new 'static 'vector :x 6144.0 :y 11059.2 :z 6144.0 :w 1.0)
)
:local-player-spheres
(new 'static 'inline-array sphere 12
(new 'static 'sphere :x 1720.32 :y -819.2 :w 1433.6)
(new 'static 'sphere :x 2293.76 :y -3276.8 :w 1884.16)
(new 'static 'sphere :x 1966.08 :y -6144.0 :w 1556.48)
(new 'static 'sphere :x 1966.08 :y -8601.6 :w 1556.48)
(new 'static 'sphere :x 1761.28 :y -11059.2 :w 1351.68)
(new 'static 'sphere :x 1679.36 :y -13312.0 :w 1269.76)
(new 'static 'sphere :x -737.28 :y 4096.0 :w 3072.0)
(new 'static 'sphere :x -737.28 :y 6553.6 :w 3072.0)
(new 'static 'sphere :x -737.28 :y 9420.8 :w 3072.0)
(new 'static 'sphere :x 1720.32 :y 3686.4 :w 2949.12)
(new 'static 'sphere :x 1720.32 :y 5734.4 :w 2949.12)
(new 'static 'sphere :x 1720.32 :y 8601.6 :w 2949.12)
)
)
)
;; definition (perm) for symbol *edge-grab-info*, type edge-grab-info
(define-perm *edge-grab-info* edge-grab-info (new 'global 'edge-grab-info))
+1 -4
View File
@@ -83,10 +83,7 @@
)
;; definition for method 3 of type drawable-inline-array-collide-fragment
(defmethod
inspect
drawable-inline-array-collide-fragment
((obj drawable-inline-array-collide-fragment))
(defmethod inspect drawable-inline-array-collide-fragment ((obj drawable-inline-array-collide-fragment))
(format #t "[~8x] ~A~%" obj (-> obj type))
(format #t "~Tid: ~D~%" (-> obj id))
(format #t "~Tbsphere: ~`vector`P~%" (-> obj bsphere))
+53 -105
View File
@@ -2,42 +2,30 @@
(in-package goal)
;; definition for method 9 of type drawable-tree-collide-fragment
(defmethod
login
drawable-tree-collide-fragment
((obj drawable-tree-collide-fragment))
(defmethod login drawable-tree-collide-fragment ((obj drawable-tree-collide-fragment))
obj
)
;; definition for method 10 of type drawable-tree-collide-fragment
;; INFO: Return type mismatch int vs none.
(defmethod
draw
drawable-tree-collide-fragment
((obj drawable-tree-collide-fragment) (arg0 drawable) (arg1 display-frame))
(defmethod draw drawable-tree-collide-fragment ((obj drawable-tree-collide-fragment) (arg0 drawable) (arg1 display-frame))
(when *display-render-collision*
(dotimes (s4-0 (-> obj length))
(draw (-> obj data s4-0) (-> obj data s4-0) arg1)
(dotimes (s4-0 (-> obj length))
(draw (-> obj data s4-0) (-> obj data s4-0) arg1)
)
)
)
0
(none)
)
;; definition for method 16 of type drawable-tree-collide-fragment
(defmethod
dummy-16
drawable-tree-collide-fragment
((obj drawable-tree-collide-fragment) (arg0 object) (arg1 object))
(defmethod dummy-16 drawable-tree-collide-fragment ((obj drawable-tree-collide-fragment) (arg0 object) (arg1 object))
arg1
)
;; definition for method 11 of type drawable-tree-collide-fragment
;; INFO: Return type mismatch int vs none.
(defmethod
collide-with-box
drawable-tree-collide-fragment
((obj drawable-tree-collide-fragment) (arg0 int) (arg1 collide-list))
(defmethod collide-with-box drawable-tree-collide-fragment ((obj drawable-tree-collide-fragment) (arg0 int) (arg1 collide-list))
(collide-with-box (-> obj data 0) (-> obj length) arg1)
0
(none)
@@ -45,10 +33,7 @@
;; definition for method 12 of type drawable-tree-collide-fragment
;; INFO: Return type mismatch int vs none.
(defmethod
collide-y-probe
drawable-tree-collide-fragment
((obj drawable-tree-collide-fragment) (arg0 int) (arg1 collide-list))
(defmethod collide-y-probe drawable-tree-collide-fragment ((obj drawable-tree-collide-fragment) (arg0 int) (arg1 collide-list))
(collide-y-probe (-> obj data 0) (-> obj length) arg1)
0
(none)
@@ -56,10 +41,7 @@
;; definition for method 13 of type drawable-tree-collide-fragment
;; INFO: Return type mismatch int vs none.
(defmethod
collide-ray
drawable-tree-collide-fragment
((obj drawable-tree-collide-fragment) (arg0 int) (arg1 collide-list))
(defmethod collide-ray drawable-tree-collide-fragment ((obj drawable-tree-collide-fragment) (arg0 int) (arg1 collide-list))
(collide-ray (-> obj data 0) (-> obj length) arg1)
0
(none)
@@ -67,100 +49,75 @@
;; definition for method 8 of type collide-fragment
;; INFO: Return type mismatch int vs collide-fragment.
(defmethod
mem-usage
collide-fragment
((obj collide-fragment) (arg0 memory-usage-block) (arg1 int))
(defmethod mem-usage collide-fragment ((obj collide-fragment) (arg0 memory-usage-block) (arg1 int))
(let ((s5-0 (if (logtest? arg1 1)
53
50
)
)
53
50
)
)
(s4-0 (-> obj mesh))
)
(set! (-> arg0 data s5-0 name) (symbol->string 'collide-fragment))
(+! (-> arg0 data s5-0 count) 1)
(let ((v1-11 (+ (asize-of obj) (asize-of s4-0))))
(+! (-> arg0 data s5-0 used) v1-11)
(+! (-> arg0 data s5-0 total) (logand -16 (+ v1-11 15)))
(set! (-> arg0 data s5-0 name) (symbol->string 'collide-fragment))
(+! (-> arg0 data s5-0 count) 1)
(let ((v1-11 (+ (asize-of obj) (asize-of s4-0))))
(+! (-> arg0 data s5-0 used) v1-11)
(+! (-> arg0 data s5-0 total) (logand -16 (+ v1-11 15)))
)
(set! (-> arg0 data (+ s5-0 1) name) "collision-poly")
(+! (-> arg0 data (+ s5-0 1) count) (-> s4-0 poly-count))
(let ((v1-22 (+ (-> s4-0 strip-data-len) (-> s4-0 poly-count))))
(+! (-> arg0 data (+ s5-0 1) used) v1-22)
(+! (-> arg0 data (+ s5-0 1) total) v1-22)
)
(set! (-> arg0 data (+ s5-0 2) name) "collision-vertex")
(+! (-> arg0 data (+ s5-0 2) count) (-> s4-0 vertex-count))
(let ((v1-31 (* (-> s4-0 vertex-data-qwc) 16)))
(+! (-> arg0 data (+ s5-0 2) used) v1-31)
(let ((v0-2 (+ (-> arg0 data (+ s5-0 2) total) v1-31)))
(set! (-> arg0 data (+ s5-0 2) total) v0-2)
(the-as collide-fragment v0-2)
)
)
)
(set! (-> arg0 data (+ s5-0 1) name) "collision-poly")
(+! (-> arg0 data (+ s5-0 1) count) (-> s4-0 poly-count))
(let ((v1-22 (+ (-> s4-0 strip-data-len) (-> s4-0 poly-count))))
(+! (-> arg0 data (+ s5-0 1) used) v1-22)
(+! (-> arg0 data (+ s5-0 1) total) v1-22)
)
(set! (-> arg0 data (+ s5-0 2) name) "collision-vertex")
(+! (-> arg0 data (+ s5-0 2) count) (-> s4-0 vertex-count))
(let ((v1-31 (* (-> s4-0 vertex-data-qwc) 16)))
(+! (-> arg0 data (+ s5-0 2) used) v1-31)
(let ((v0-2 (+ (-> arg0 data (+ s5-0 2) total) v1-31)))
(set! (-> arg0 data (+ s5-0 2) total) v0-2)
(the-as collide-fragment v0-2)
)
)
)
)
;; definition for method 9 of type drawable-inline-array-collide-fragment
(defmethod
login
drawable-inline-array-collide-fragment
((obj drawable-inline-array-collide-fragment))
(defmethod login drawable-inline-array-collide-fragment ((obj drawable-inline-array-collide-fragment))
obj
)
;; definition for method 10 of type collide-fragment
;; INFO: Return type mismatch int vs none.
(defmethod
draw
collide-fragment
((obj collide-fragment) (arg0 drawable) (arg1 display-frame))
(defmethod draw collide-fragment ((obj collide-fragment) (arg0 drawable) (arg1 display-frame))
0
(none)
)
;; definition for method 10 of type drawable-inline-array-collide-fragment
;; INFO: Return type mismatch int vs none.
(defmethod
draw
drawable-inline-array-collide-fragment
((obj drawable-inline-array-collide-fragment)
(arg0 drawable)
(arg1 display-frame)
)
(defmethod draw drawable-inline-array-collide-fragment ((obj drawable-inline-array-collide-fragment) (arg0 drawable) (arg1 display-frame))
(dotimes (s4-0 (-> obj length))
(let ((s3-0 (-> obj data s4-0)))
(if (sphere-cull (-> s3-0 bsphere))
(draw s3-0 s3-0 arg1)
)
(let ((s3-0 (-> obj data s4-0)))
(if (sphere-cull (-> s3-0 bsphere))
(draw s3-0 s3-0 arg1)
)
)
)
)
0
(none)
)
;; definition for method 11 of type drawable-inline-array-collide-fragment
;; INFO: Return type mismatch int vs none.
(defmethod
collide-with-box
drawable-inline-array-collide-fragment
((obj drawable-inline-array-collide-fragment) (arg0 int) (arg1 collide-list))
(collide-with-box
(the-as collide-fragment (-> obj data))
(-> obj length)
arg1
)
(defmethod collide-with-box drawable-inline-array-collide-fragment ((obj drawable-inline-array-collide-fragment) (arg0 int) (arg1 collide-list))
(collide-with-box (the-as collide-fragment (-> obj data)) (-> obj length) arg1)
0
(none)
)
;; definition for method 12 of type drawable-inline-array-collide-fragment
;; INFO: Return type mismatch int vs none.
(defmethod
collide-y-probe
drawable-inline-array-collide-fragment
((obj drawable-inline-array-collide-fragment) (arg0 int) (arg1 collide-list))
(defmethod collide-y-probe drawable-inline-array-collide-fragment ((obj drawable-inline-array-collide-fragment) (arg0 int) (arg1 collide-list))
(collide-y-probe (the-as collide-fragment (-> obj data)) (-> obj length) arg1)
0
(none)
@@ -168,32 +125,23 @@
;; definition for method 13 of type drawable-inline-array-collide-fragment
;; INFO: Return type mismatch int vs none.
(defmethod
collide-ray
drawable-inline-array-collide-fragment
((obj drawable-inline-array-collide-fragment) (arg0 int) (arg1 collide-list))
(defmethod collide-ray drawable-inline-array-collide-fragment ((obj drawable-inline-array-collide-fragment) (arg0 int) (arg1 collide-list))
(collide-ray (the-as collide-fragment (-> obj data)) (-> obj length) arg1)
0
(none)
)
;; definition for method 8 of type drawable-inline-array-collide-fragment
(defmethod
mem-usage
drawable-inline-array-collide-fragment
((obj drawable-inline-array-collide-fragment)
(arg0 memory-usage-block)
(arg1 int)
)
(defmethod mem-usage drawable-inline-array-collide-fragment ((obj drawable-inline-array-collide-fragment) (arg0 memory-usage-block) (arg1 int))
(set! (-> arg0 length) (max 1 (-> arg0 length)))
(set! (-> arg0 data 0 name) (symbol->string 'drawable-group))
(+! (-> arg0 data 0 count) 1)
(let ((v1-7 32))
(+! (-> arg0 data 0 used) v1-7)
(+! (-> arg0 data 0 total) (logand -16 (+ v1-7 15)))
)
(+! (-> arg0 data 0 used) v1-7)
(+! (-> arg0 data 0 total) (logand -16 (+ v1-7 15)))
)
(dotimes (s3-0 (-> obj length))
(mem-usage (-> obj data s3-0) arg0 arg1)
)
(mem-usage (-> obj data s3-0) arg0 arg1)
)
obj
)
+1 -3
View File
@@ -135,9 +135,7 @@
)
;; definition (perm) for symbol *collide-mesh-cache*, type collide-mesh-cache
(define-perm *collide-mesh-cache* collide-mesh-cache
(new 'global 'collide-mesh-cache)
)
(define-perm *collide-mesh-cache* collide-mesh-cache (new 'global 'collide-mesh-cache))
;; failed to figure out what this is:
(set! (-> *collide-mesh-cache* id) (the-as uint 1))
+127 -234
View File
@@ -27,10 +27,7 @@
)
;; definition for method 9 of type collide-sticky-rider
(defmethod
set-rider!
collide-sticky-rider
((obj collide-sticky-rider) (arg0 handle))
(defmethod set-rider! collide-sticky-rider ((obj collide-sticky-rider) (arg0 handle))
(set! (-> obj rider-handle) arg0)
(set! (-> obj sticky-prim) #f)
#f
@@ -137,11 +134,7 @@
(format #t "~Tbest-dist: ~f~%" (-> obj best-dist))
(format #t "~Tbest-from-prim: ~A~%" (-> obj best-from-prim))
(format #t "~Tbest-to-prim: ~A~%" (-> obj best-to-prim))
(format
#t
"~Tbest-from-tri: #<collide-tri-result @ #x~X>~%"
(-> obj best-from-tri)
)
(format #t "~Tbest-from-tri: #<collide-tri-result @ #x~X>~%" (-> obj best-from-tri))
obj
)
@@ -173,22 +166,13 @@
)
;; definition for symbol *collide-hit-by-player-list*, type engine
(define
*collide-hit-by-player-list*
(new 'global 'engine 'collide-hit-by-player-list 768)
)
(define *collide-hit-by-player-list* (new 'global 'engine 'collide-hit-by-player-list 768))
;; definition for symbol *collide-usually-hit-by-player-list*, type engine
(define
*collide-usually-hit-by-player-list*
(new 'global 'engine 'collide-usually-hit-by-player-list 256)
)
(define *collide-usually-hit-by-player-list* (new 'global 'engine 'collide-usually-hit-by-player-list 256))
;; definition for symbol *collide-hit-by-others-list*, type engine
(define
*collide-hit-by-others-list*
(new 'global 'engine 'collide-hit-by-others-list 96)
)
(define *collide-hit-by-others-list* (new 'global 'engine 'collide-hit-by-others-list 96))
;; definition for symbol *collide-player-list*, type engine
(define *collide-player-list* (new 'global 'engine 'collide-player-list 32))
@@ -445,11 +429,7 @@
(format #t "~Trot: ~`vector`P~%" (-> obj quat))
(format #t "~Tscale: ~`vector`P~%" (-> obj scale))
(format #t "~Tquat: #<quaternion @ #x~X>~%" (-> obj quat))
(format
#t
"~Tpause-adjust-distance: (meters ~m)~%"
(-> obj pause-adjust-distance)
)
(format #t "~Tpause-adjust-distance: (meters ~m)~%" (-> obj pause-adjust-distance))
(format #t "~Tnav-radius: (meters ~m)~%" (-> obj nav-radius))
(format #t "~Ttransv: ~`vector`P~%" (-> obj transv))
(format #t "~Trotv: ~`vector`P~%" (-> obj rotv))
@@ -522,11 +502,7 @@
(format #t "~Trot: ~`vector`P~%" (-> obj quat))
(format #t "~Tscale: ~`vector`P~%" (-> obj scale))
(format #t "~Tquat: #<quaternion @ #x~X>~%" (-> obj quat))
(format
#t
"~Tpause-adjust-distance: (meters ~m)~%"
(-> obj pause-adjust-distance)
)
(format #t "~Tpause-adjust-distance: (meters ~m)~%" (-> obj pause-adjust-distance))
(format #t "~Tnav-radius: (meters ~m)~%" (-> obj nav-radius))
(format #t "~Ttransv: ~`vector`P~%" (-> obj transv))
(format #t "~Trotv: ~`vector`P~%" (-> obj rotv))
@@ -574,126 +550,75 @@
)
;; definition for method 0 of type collide-shape-prim
(defmethod
new
collide-shape-prim
((allocation symbol)
(type-to-make type)
(cshape collide-shape)
(prim-id uint)
(size-bytes int)
)
(defmethod new collide-shape-prim ((allocation symbol) (type-to-make type) (cshape collide-shape) (prim-id uint) (size-bytes int))
(let ((v0-0 (object-new allocation type-to-make size-bytes)))
(set! (-> v0-0 cshape) cshape)
(set! (-> v0-0 prim-id) prim-id)
(set! (-> v0-0 prim-core action) (the-as uint 0))
(set! (-> v0-0 prim-core collide-as) (the-as uint 0))
(set! (-> v0-0 collide-with) (the-as uint 0))
(set! (-> v0-0 transform-index) -2)
(set! (-> v0-0 prim-core offense) 0)
(set! (-> v0-0 prim-core prim-type) -2)
v0-0
)
(set! (-> v0-0 cshape) cshape)
(set! (-> v0-0 prim-id) prim-id)
(set! (-> v0-0 prim-core action) (the-as uint 0))
(set! (-> v0-0 prim-core collide-as) (the-as uint 0))
(set! (-> v0-0 collide-with) (the-as uint 0))
(set! (-> v0-0 transform-index) -2)
(set! (-> v0-0 prim-core offense) 0)
(set! (-> v0-0 prim-core prim-type) -2)
v0-0
)
)
;; definition for method 0 of type collide-shape-prim-sphere
;; INFO: Return type mismatch collide-shape-prim vs collide-shape-prim-sphere.
(defmethod
new
collide-shape-prim-sphere
((allocation symbol)
(type-to-make type)
(cshape collide-shape)
(prim-id uint)
)
(let
((obj
(the-as
collide-shape-prim-sphere
((method-of-type collide-shape-prim new)
allocation
type-to-make
cshape
prim-id
76
)
)
)
(defmethod new collide-shape-prim-sphere ((allocation symbol) (type-to-make type) (cshape collide-shape) (prim-id uint))
(let ((obj (the-as
collide-shape-prim-sphere
((method-of-type collide-shape-prim new) allocation type-to-make cshape prim-id 76)
)
)
)
(set! (-> obj pat) (new 'static 'pat-surface :mode (pat-mode obstacle)))
(set! (-> obj prim-core prim-type) -1)
(the-as collide-shape-prim-sphere obj)
)
(set! (-> obj pat) (new 'static 'pat-surface :mode (pat-mode obstacle)))
(set! (-> obj prim-core prim-type) -1)
(the-as collide-shape-prim-sphere obj)
)
)
;; definition for method 0 of type collide-shape-prim-mesh
;; INFO: Return type mismatch collide-shape-prim vs collide-shape-prim-mesh.
(defmethod
new
collide-shape-prim-mesh
((allocation symbol)
(type-to-make type)
(cshape collide-shape)
(mesh-id uint)
(prim-id uint)
)
(let
((obj
(the-as
collide-shape-prim-mesh
((method-of-type collide-shape-prim new)
allocation
type-to-make
cshape
prim-id
92
)
)
)
(defmethod new collide-shape-prim-mesh ((allocation symbol) (type-to-make type) (cshape collide-shape) (mesh-id uint) (prim-id uint))
(let ((obj (the-as
collide-shape-prim-mesh
((method-of-type collide-shape-prim new) allocation type-to-make cshape prim-id 92)
)
)
)
(set! (-> obj mesh) #f)
(set! (-> obj mesh-id) (the-as int mesh-id))
(set! (-> obj mesh-cache-id) (the-as uint 0))
(set! (-> obj prim-core prim-type) 1)
(the-as collide-shape-prim-mesh obj)
)
(set! (-> obj mesh) #f)
(set! (-> obj mesh-id) (the-as int mesh-id))
(set! (-> obj mesh-cache-id) (the-as uint 0))
(set! (-> obj prim-core prim-type) 1)
(the-as collide-shape-prim-mesh obj)
)
)
;; definition for method 0 of type collide-shape-prim-group
;; INFO: Return type mismatch collide-shape-prim vs collide-shape-prim-group.
(defmethod
new
collide-shape-prim-group
((allocation symbol)
(type-to-make type)
(cshape collide-shape)
(elt-count uint)
(prim-id int)
)
(let
((obj
(the-as
collide-shape-prim-group
((method-of-type collide-shape-prim new)
allocation
type-to-make
cshape
(the-as uint prim-id)
(the-as int (+ (-> type-to-make size) (* (+ elt-count -1) 4)))
)
(defmethod new collide-shape-prim-group ((allocation symbol) (type-to-make type) (cshape collide-shape) (elt-count uint) (prim-id int))
(let ((obj (the-as collide-shape-prim-group ((method-of-type collide-shape-prim new)
allocation
type-to-make
cshape
(the-as uint prim-id)
(the-as int (+ (-> type-to-make size) (* (+ elt-count -1) 4)))
)
)
)
)
(set! (-> obj allocated-prims) (the-as int elt-count))
(set! (-> obj num-prims) 0)
(set! (-> obj prim-core prim-type) 0)
(while (nonzero? elt-count)
(+! elt-count -1)
(set! (-> obj prims elt-count) #f)
(nop!)
)
)
(the-as collide-shape-prim-group obj)
)
(set! (-> obj allocated-prims) (the-as int elt-count))
(set! (-> obj num-prims) 0)
(set! (-> obj prim-core prim-type) 0)
(while (nonzero? elt-count)
(+! elt-count -1)
(set! (-> obj prims elt-count) #f)
(nop!)
)
(the-as collide-shape-prim-group obj)
)
)
;; definition for method 4 of type collide-shape-prim-group
@@ -708,82 +633,54 @@
)
;; definition for method 0 of type collide-shape
(defmethod
new
collide-shape
((allocation symbol)
(type-to-make type)
(proc process-drawable)
(collide-list-kind collide-list-enum)
)
(let
((obj
(object-new allocation type-to-make (the-as int (-> type-to-make size)))
)
)
(set! (-> obj process) proc)
(set! (-> obj max-iteration-count) (the-as uint 1))
(set! (-> obj nav-flags) (the-as uint 1))
(set! (-> obj event-self) #f)
(set! (-> obj event-other) #f)
(set! (-> obj riders) #f)
(set! (-> obj root-prim) #f)
(case (-> proc type symbol)
(('camera)
(set!
(-> obj pat-ignore-mask)
(new 'static 'pat-surface :skip #x2 :nocamera #x1)
(defmethod new collide-shape ((allocation symbol) (type-to-make type) (proc process-drawable) (collide-list-kind collide-list-enum))
(let ((obj (object-new allocation type-to-make (the-as int (-> type-to-make size)))))
(set! (-> obj process) proc)
(set! (-> obj max-iteration-count) (the-as uint 1))
(set! (-> obj nav-flags) (the-as uint 1))
(set! (-> obj event-self) #f)
(set! (-> obj event-other) #f)
(set! (-> obj riders) #f)
(set! (-> obj root-prim) #f)
(case (-> proc type symbol)
(('camera)
(set! (-> obj pat-ignore-mask) (new 'static 'pat-surface :skip #x2 :nocamera #x1))
)
(else
(set! (-> obj pat-ignore-mask) (new 'static 'pat-surface :skip #x1 :noentity #x1))
)
)
(else
(set!
(-> obj pat-ignore-mask)
(new 'static 'pat-surface :skip #x1 :noentity #x1)
(set! (-> obj trans w) 1.0)
(quaternion-identity! (-> obj quat))
(vector-identity! (-> obj scale))
(cond
((= collide-list-kind (collide-list-enum hit-by-player))
(add-connection *collide-hit-by-player-list* proc #f obj #f #f)
)
((= collide-list-kind (collide-list-enum usually-hit-by-player))
(add-connection *collide-usually-hit-by-player-list* proc #f obj #f #f)
)
((= collide-list-kind (collide-list-enum hit-by-others))
(add-connection *collide-hit-by-others-list* proc #f obj #f #f)
)
((= collide-list-kind (collide-list-enum player))
(add-connection *collide-player-list* proc #f obj #f #f)
)
(else
(format 0 "Unsupported collide-list-enum in collide-shape constructor!~%")
)
)
)
obj
)
(set! (-> obj trans w) 1.0)
(quaternion-identity! (-> obj quat))
(vector-identity! (-> obj scale))
(cond
((= collide-list-kind (collide-list-enum hit-by-player))
(add-connection *collide-hit-by-player-list* proc #f obj #f #f)
)
((= collide-list-kind (collide-list-enum usually-hit-by-player))
(add-connection *collide-usually-hit-by-player-list* proc #f obj #f #f)
)
((= collide-list-kind (collide-list-enum hit-by-others))
(add-connection *collide-hit-by-others-list* proc #f obj #f #f)
)
((= collide-list-kind (collide-list-enum player))
(add-connection *collide-player-list* proc #f obj #f #f)
)
(else
(format 0 "Unsupported collide-list-enum in collide-shape constructor!~%")
)
)
obj
)
)
;; definition for method 0 of type collide-sticky-rider-group
(defmethod
new
collide-sticky-rider-group
((allocation symbol) (type-to-make type) (arg0 int))
(let
((obj
(object-new
allocation
type-to-make
(the-as int (+ (-> type-to-make size) (* (+ arg0 -1) 32)))
)
)
(defmethod new collide-sticky-rider-group ((allocation symbol) (type-to-make type) (arg0 int))
(let ((obj (object-new allocation type-to-make (the-as int (+ (-> type-to-make size) (* (+ arg0 -1) 32))))))
(set! (-> obj allocated-riders) arg0)
(set! (-> obj num-riders) 0)
obj
)
(set! (-> obj allocated-riders) arg0)
(set! (-> obj num-riders) 0)
obj
)
)
;; definition for method 4 of type collide-sticky-rider-group
@@ -798,37 +695,33 @@
)
;; definition for symbol *collide-shape-prim-backgnd*, type collide-shape-prim-mesh
(define
*collide-shape-prim-backgnd*
(new 'static 'collide-shape-prim-mesh
:cshape #f
:prim-core
(new 'static 'collide-prim-core
:world-sphere (new 'static 'vector :w 204800000.0)
:collide-as #x1
:action #x1
:offense 4
:prim-type 2
)
:local-sphere (new 'static 'vector :w 204800000.0)
:mesh #f
)
)
(define *collide-shape-prim-backgnd* (new 'static 'collide-shape-prim-mesh
:cshape #f
:prim-core
(new 'static 'collide-prim-core
:world-sphere (new 'static 'vector :w 204800000.0)
:collide-as #x1
:action #x1
:offense 4
:prim-type 2
)
:local-sphere (new 'static 'vector :w 204800000.0)
:mesh #f
)
)
;; definition for symbol *collide-shape-prim-water*, type collide-shape-prim-mesh
(define
*collide-shape-prim-water*
(new 'static 'collide-shape-prim-mesh
:cshape #f
:prim-core
(new 'static 'collide-prim-core
:world-sphere (new 'static 'vector :w 204800000.0)
:collide-as #x20
:action #x1
:offense 4
:prim-type 2
)
:local-sphere (new 'static 'vector :w 204800000.0)
:mesh #f
)
)
(define *collide-shape-prim-water* (new 'static 'collide-shape-prim-mesh
:cshape #f
:prim-core
(new 'static 'collide-prim-core
:world-sphere (new 'static 'vector :w 204800000.0)
:collide-as #x20
:action #x1
:offense 4
:prim-type 2
)
:local-sphere (new 'static 'vector :w 204800000.0)
:mesh #f
)
)
+1 -9
View File
@@ -193,15 +193,7 @@
;; definition for method 9 of type collide-history
;; Used lq/sq
(defmethod
update!
collide-history
((obj collide-history)
(cshape collide-shape-moving)
(xs vector)
(transv vector)
(transv-out vector)
)
(defmethod update! collide-history ((obj collide-history) (cshape collide-shape-moving) (xs vector) (transv vector) (transv-out vector))
(set! (-> obj intersect quad) (-> xs quad))
(set! (-> obj transv quad) (-> transv quad))
(set! (-> obj transv-out quad) (-> transv-out quad))
+26 -36
View File
@@ -82,40 +82,35 @@
;; INFO: Return type mismatch symbol vs none.
(defmethod init-list! touching-prims-entry-pool ((obj touching-prims-entry-pool))
(let ((prev (the-as touching-prims-entry #f)))
(let ((current (the-as touching-prims-entry (-> obj nodes))))
(set! (-> obj head) current)
(countdown (a0-1 64)
(set! (-> current prev) prev)
(let ((next (&+ current 240)))
(set! (-> current next) (the-as touching-prims-entry next))
(set! (-> current allocated?) #f)
(set! prev current)
(set! current (the-as touching-prims-entry next))
(let ((current (the-as touching-prims-entry (-> obj nodes))))
(set! (-> obj head) current)
(countdown (a0-1 64)
(set! (-> current prev) prev)
(let ((next (&+ current 240)))
(set! (-> current next) (the-as touching-prims-entry next))
(set! (-> current allocated?) #f)
(set! prev current)
(set! current (the-as touching-prims-entry next))
)
)
)
)
(set! (-> prev next) #f)
)
(set! (-> prev next) #f)
)
(none)
)
;; definition for method 0 of type touching-prims-entry-pool
;; INFO: Return type mismatch structure vs touching-prims-entry-pool.
(defmethod
new
touching-prims-entry-pool
((allocation symbol) (type-to-make type))
(defmethod new touching-prims-entry-pool ((allocation symbol) (type-to-make type))
(let ((t9-0 (method-of-type structure new))
(v1-1 type-to-make)
)
(-> type-to-make size)
(let ((gp-0 (t9-0 allocation v1-1)))
((method-of-type touching-prims-entry-pool init-list!)
(the-as touching-prims-entry-pool gp-0)
)
(the-as touching-prims-entry-pool gp-0)
(-> type-to-make size)
(let ((gp-0 (t9-0 allocation v1-1)))
((method-of-type touching-prims-entry-pool init-list!) (the-as touching-prims-entry-pool gp-0))
(the-as touching-prims-entry-pool gp-0)
)
)
)
)
;; definition of type touching-shapes-entry
@@ -186,13 +181,13 @@
(let ((t9-0 (method-of-type structure new))
(v1-1 type-to-make)
)
(-> type-to-make size)
(let ((obj (the-as touching-list (t9-0 allocation v1-1))))
(set! (-> obj num-touching-shapes) 0)
(set! (-> obj resolve-u) 0)
obj
(-> type-to-make size)
(let ((obj (the-as touching-list (t9-0 allocation v1-1))))
(set! (-> obj num-touching-shapes) 0)
(set! (-> obj resolve-u) 0)
obj
)
)
)
)
;; definition for method 16 of type touching-shapes-entry
@@ -201,17 +196,12 @@
)
;; definition for method 17 of type touching-shapes-entry
(defmethod
unknown1
touching-shapes-entry
((obj touching-shapes-entry) (arg0 (pointer uint32)))
(defmethod unknown1 touching-shapes-entry ((obj touching-shapes-entry) (arg0 (pointer uint32)))
(-> arg0 0)
)
;; definition (perm) for symbol *touching-prims-entry-pool*, type touching-prims-entry-pool
(define-perm *touching-prims-entry-pool* touching-prims-entry-pool
(new 'global 'touching-prims-entry-pool)
)
(define-perm *touching-prims-entry-pool* touching-prims-entry-pool (new 'global 'touching-prims-entry-pool))
;; definition (perm) for symbol *touching-list*, type touching-list
(define-perm *touching-list* touching-list (new 'global 'touching-list))
+380 -442
View File
@@ -4,91 +4,88 @@
;; definition for method 10 of type touching-prims-entry-pool
(defmethod get-size touching-prims-entry-pool ((obj touching-prims-entry-pool))
(let ((v0-0 0))
(let ((v1-0 (-> obj head)))
(while v1-0
(+! v0-0 1)
(set! v1-0 (-> v1-0 next))
(nop!)
(nop!)
(nop!)
)
(let ((v1-0 (-> obj head)))
(while v1-0
(+! v0-0 1)
(set! v1-0 (-> v1-0 next))
(nop!)
(nop!)
(nop!)
)
)
v0-0
)
v0-0
)
)
;; definition for method 9 of type touching-prims-entry-pool
(defmethod alloc-node touching-prims-entry-pool ((obj touching-prims-entry-pool))
(let ((gp-0 (-> obj head)))
(cond
(gp-0
(let ((v1-0 (-> gp-0 next)))
(set! (-> obj head) v1-0)
(if v1-0
(set! (-> v1-0 prev) #f)
)
(cond
(gp-0
(let ((v1-0 (-> gp-0 next)))
(set! (-> obj head) v1-0)
(if v1-0
(set! (-> v1-0 prev) #f)
)
)
(set! (-> gp-0 allocated?) #t)
(set! (-> gp-0 next) #f)
(set! (-> gp-0 prev) #f)
)
(else
(format 0 "ERROR: touching-prims-entry-pool::alloc-node() failed!~%")
)
)
(set! (-> gp-0 allocated?) #t)
(set! (-> gp-0 next) #f)
(set! (-> gp-0 prev) #f)
)
(else
(format 0 "ERROR: touching-prims-entry-pool::alloc-node() failed!~%")
)
gp-0
)
gp-0
)
)
;; definition for method 12 of type touching-prims-entry-pool
(defmethod
free-node
touching-prims-entry-pool
((obj touching-prims-entry-pool) (arg0 touching-prims-entry))
(defmethod free-node touching-prims-entry-pool ((obj touching-prims-entry-pool) (arg0 touching-prims-entry))
(when (-> arg0 allocated?)
(set! (-> arg0 allocated?) #f)
(let ((v1-1 (-> obj head)))
(set! (-> arg0 next) v1-1)
(set! (-> arg0 prev) #f)
(set! (-> obj head) arg0)
(when v1-1
(set! (-> v1-1 prev) arg0)
arg0
)
(set! (-> arg0 allocated?) #f)
(let ((v1-1 (-> obj head)))
(set! (-> arg0 next) v1-1)
(set! (-> arg0 prev) #f)
(set! (-> obj head) arg0)
(when v1-1
(set! (-> v1-1 prev) arg0)
arg0
)
)
)
)
)
;; definition for method 15 of type touching-shapes-entry
(defmethod free-entry-list touching-shapes-entry ((obj touching-shapes-entry))
(when (-> obj cshape1)
(set! (-> obj cshape1) #f)
(let ((gp-0 (-> obj head)))
(when gp-0
(set! (-> obj head) #f)
(let ((s5-0 *touching-prims-entry-pool*))
(while gp-0
(let ((a1-0 gp-0))
(set! gp-0 (-> a1-0 next))
(free-node s5-0 a1-0)
(set! (-> obj cshape1) #f)
(let ((gp-0 (-> obj head)))
(when gp-0
(set! (-> obj head) #f)
(let ((s5-0 *touching-prims-entry-pool*))
(while gp-0
(let ((a1-0 gp-0))
(set! gp-0 (-> a1-0 next))
(free-node s5-0 a1-0)
)
)
)
#f
)
)
)
#f
)
)
)
)
;; definition for method 14 of type touching-list
;; INFO: Return type mismatch int vs none.
(defmethod dummy-14 touching-list ((obj touching-list))
(let ((s5-0 (the-as object (-> obj touching-shapes))))
(countdown (s4-0 (-> obj num-touching-shapes))
(free-entry-list (the-as touching-shapes-entry s5-0))
(set! s5-0 (&+ (the-as touching-shapes-entry s5-0) 16))
(countdown (s4-0 (-> obj num-touching-shapes))
(free-entry-list (the-as touching-shapes-entry s5-0))
(set! s5-0 (&+ (the-as touching-shapes-entry s5-0) 16))
)
)
)
(set! (-> obj num-touching-shapes) 0)
(set! (-> obj resolve-u) 0)
0
@@ -97,59 +94,49 @@
;; definition for method 13 of type touching-list
;; INFO: Return type mismatch object vs touching-shapes-entry.
(defmethod
get-shapes-entry
touching-list
((obj touching-list) (arg0 collide-shape) (arg1 collide-shape))
(defmethod get-shapes-entry touching-list ((obj touching-list) (arg0 collide-shape) (arg1 collide-shape))
(let ((v0-0 (the-as object (-> obj touching-shapes))))
(let ((v1-0 (the-as object #f)))
(countdown (a3-0 (-> obj num-touching-shapes))
(let ((t0-0 (-> (the-as touching-shapes-entry v0-0) cshape1)))
(set! v1-0 (cond
(t0-0
(if
(or
(and
(= t0-0 arg0)
(= (-> (the-as touching-shapes-entry v0-0) cshape2) arg1)
)
(and
(= t0-0 arg1)
(= (-> (the-as touching-shapes-entry v0-0) cshape2) arg0)
)
)
(return (the-as touching-shapes-entry v0-0))
)
v1-0
)
(else
v0-0
)
)
)
(let ((v1-0 (the-as object #f)))
(countdown (a3-0 (-> obj num-touching-shapes))
(let ((t0-0 (-> (the-as touching-shapes-entry v0-0) cshape1)))
(set! v1-0 (cond
(t0-0
(if (or
(and (= t0-0 arg0) (= (-> (the-as touching-shapes-entry v0-0) cshape2) arg1))
(and (= t0-0 arg1) (= (-> (the-as touching-shapes-entry v0-0) cshape2) arg0))
)
(return (the-as touching-shapes-entry v0-0))
)
v1-0
)
(else
v0-0
)
)
)
)
(set! v0-0 (&+ (the-as touching-shapes-entry v0-0) 16))
)
(cond
(v1-0
(set! v0-0 v1-0)
)
(else
(when (>= (-> obj num-touching-shapes) 32)
(format 0 "ERROR: touching-list::get-shapes-entry() failed!~%")
(return (the-as touching-shapes-entry #f))
)
(+! (-> obj num-touching-shapes) 1)
)
)
)
(set! v0-0 (&+ (the-as touching-shapes-entry v0-0) 16))
)
(cond
(v1-0
(set! v0-0 v1-0)
)
(else
(when (>= (-> obj num-touching-shapes) 32)
(format 0 "ERROR: touching-list::get-shapes-entry() failed!~%")
(return (the-as touching-shapes-entry #f))
)
(+! (-> obj num-touching-shapes) 1)
)
)
(set! (-> (the-as touching-shapes-entry v0-0) cshape1) arg0)
(set! (-> (the-as touching-shapes-entry v0-0) cshape2) arg1)
(set! (-> (the-as touching-shapes-entry v0-0) head) #f)
(set! (-> (the-as touching-shapes-entry v0-0) resolve-u) 1)
(set! (-> obj resolve-u) 1)
(the-as touching-shapes-entry v0-0)
)
(set! (-> (the-as touching-shapes-entry v0-0) cshape1) arg0)
(set! (-> (the-as touching-shapes-entry v0-0) cshape2) arg1)
(set! (-> (the-as touching-shapes-entry v0-0) head) #f)
(set! (-> (the-as touching-shapes-entry v0-0) resolve-u) 1)
(set! (-> obj resolve-u) 1)
(the-as touching-shapes-entry v0-0)
)
)
;; definition of type add-prims-touching-work
@@ -173,112 +160,109 @@
;; definition for method 9 of type touching-list
;; INFO: Return type mismatch int vs none.
;; WARN: Expression building failed: Function (method 9 touching-list) has a return type of none, but the expression builder found a return statement.
(defmethod
dummy-9
touching-list
((obj touching-list)
(arg0 collide-shape-prim)
(arg1 collide-shape-prim)
(arg2 float)
(arg3 collide-shape)
(arg4 collide-mesh-cache-tri)
)
(defmethod dummy-9 touching-list ((obj touching-list)
(arg0 collide-shape-prim)
(arg1 collide-shape-prim)
(arg2 float)
(arg3 collide-shape)
(arg4 collide-mesh-cache-tri)
)
(let ((gp-0 (new 'stack-no-clear 'touching-shapes-entry)))
(set! (-> gp-0 cshape1) arg3)
(set! (-> gp-0 cshape2) (the-as collide-shape arg4))
(let ((s2-0 (get-shapes-entry obj (-> arg0 cshape) (-> arg1 cshape))))
(when s2-0
(when (= (-> s2-0 cshape1) (-> arg1 cshape))
(let ((v1-4 arg0))
(set! arg0 arg1)
(set! arg1 v1-4)
)
(set! (-> gp-0 cshape1) arg3)
(set! (-> gp-0 cshape2) (the-as collide-shape arg4))
(let ((s2-0 (get-shapes-entry obj (-> arg0 cshape) (-> arg1 cshape))))
(when s2-0
(when (= (-> s2-0 cshape1) (-> arg1 cshape))
(let ((v1-4 arg0))
(set! arg0 arg1)
(set! arg1 v1-4)
)
)
(let ((s0-0 (-> s2-0 head)))
(while s0-0
(when (and (= (-> s0-0 prim1 cprim) arg0) (= (-> s0-0 prim2 cprim) arg1))
(when (< arg2 (-> s0-0 u))
(-> s0-0 u)
(let ((v1-12 (-> s0-0 prim1))
(a1-2 (-> gp-0 cshape1))
)
(cond
(a1-2
(set! (-> v1-12 has-tri?) #t)
(mem-copy! (the-as pointer (-> v1-12 tri)) (the-as pointer a1-2) 84)
)
(else
(set! (-> v1-12 has-tri?) #f)
)
)
)
(let ((v1-15 (-> s0-0 prim2))
(a1-3 (-> gp-0 cshape2))
)
(cond
(a1-3
(set! (-> v1-15 has-tri?) #t)
(mem-copy! (the-as pointer (-> v1-15 tri)) (the-as pointer a1-3) 84)
)
(else
(set! (-> v1-15 has-tri?) #f)
)
)
)
)
(return 0)
)
(set! s0-0 (-> s0-0 next))
)
)
(let ((s0-1 (alloc-node *touching-prims-entry-pool*)))
(when s0-1
(let ((v1-22 (-> s2-0 head)))
(set! (-> s0-1 next) v1-22)
(set! (-> s0-1 prev) #f)
(set! (-> s2-0 head) s0-1)
(if v1-22
(set! (-> v1-22 prev) s0-1)
)
)
(set! (-> s0-1 u) arg2)
(when (>= arg2 0.0)
(set! (-> s2-0 resolve-u) 1)
(set! (-> obj resolve-u) 1)
)
(let ((v1-26 (-> s0-1 prim1))
(a1-4 (-> gp-0 cshape1))
)
(set! (-> v1-26 cprim) arg0)
(cond
(a1-4
(set! (-> v1-26 has-tri?) #t)
(mem-copy! (the-as pointer (-> v1-26 tri)) (the-as pointer a1-4) 84)
)
(else
(set! (-> v1-26 has-tri?) #f)
)
)
)
(let ((v1-29 (-> s0-1 prim2))
(a1-5 (-> gp-0 cshape2))
)
(set! (-> v1-29 cprim) arg1)
(cond
(a1-5
(set! (-> v1-29 has-tri?) #t)
(mem-copy! (the-as pointer (-> v1-29 tri)) (the-as pointer a1-5) 84)
)
(else
(set! (-> v1-29 has-tri?) #f)
)
)
)
)
)
)
)
(let ((s0-0 (-> s2-0 head)))
(while s0-0
(when (and (= (-> s0-0 prim1 cprim) arg0) (= (-> s0-0 prim2 cprim) arg1))
(when (< arg2 (-> s0-0 u))
(-> s0-0 u)
(let ((v1-12 (-> s0-0 prim1))
(a1-2 (-> gp-0 cshape1))
)
(cond
(a1-2
(set! (-> v1-12 has-tri?) #t)
(mem-copy! (the-as pointer (-> v1-12 tri)) (the-as pointer a1-2) 84)
)
(else
(set! (-> v1-12 has-tri?) #f)
)
)
)
(let ((v1-15 (-> s0-0 prim2))
(a1-3 (-> gp-0 cshape2))
)
(cond
(a1-3
(set! (-> v1-15 has-tri?) #t)
(mem-copy! (the-as pointer (-> v1-15 tri)) (the-as pointer a1-3) 84)
)
(else
(set! (-> v1-15 has-tri?) #f)
)
)
)
)
(return 0)
)
(set! s0-0 (-> s0-0 next))
)
)
(let ((s0-1 (alloc-node *touching-prims-entry-pool*)))
(when s0-1
(let ((v1-22 (-> s2-0 head)))
(set! (-> s0-1 next) v1-22)
(set! (-> s0-1 prev) #f)
(set! (-> s2-0 head) s0-1)
(if v1-22
(set! (-> v1-22 prev) s0-1)
)
)
(set! (-> s0-1 u) arg2)
(when (>= arg2 0.0)
(set! (-> s2-0 resolve-u) 1)
(set! (-> obj resolve-u) 1)
)
(let ((v1-26 (-> s0-1 prim1))
(a1-4 (-> gp-0 cshape1))
)
(set! (-> v1-26 cprim) arg0)
(cond
(a1-4
(set! (-> v1-26 has-tri?) #t)
(mem-copy! (the-as pointer (-> v1-26 tri)) (the-as pointer a1-4) 84)
)
(else
(set! (-> v1-26 has-tri?) #f)
)
)
)
(let ((v1-29 (-> s0-1 prim2))
(a1-5 (-> gp-0 cshape2))
)
(set! (-> v1-29 cprim) arg1)
(cond
(a1-5
(set! (-> v1-29 has-tri?) #t)
(mem-copy! (the-as pointer (-> v1-29 tri)) (the-as pointer a1-5) 84)
)
(else
(set! (-> v1-29 has-tri?) #f)
)
)
)
)
)
)
)
)
0
(none)
)
@@ -287,62 +271,59 @@
;; INFO: Return type mismatch int vs none.
(defmethod dummy-11 touching-list ((obj touching-list) (arg0 float))
(when (nonzero? (-> obj resolve-u))
(set! (-> obj resolve-u) 0)
(let ((s5-0 (the-as object (-> obj touching-shapes))))
(countdown (s4-0 (-> obj num-touching-shapes))
(when (nonzero? (-> (the-as touching-shapes-entry s5-0) resolve-u))
(set! (-> (the-as touching-shapes-entry s5-0) resolve-u) 0)
(when (-> (the-as touching-shapes-entry s5-0) cshape1)
(let ((s3-0 (-> (the-as touching-shapes-entry s5-0) head)))
(while s3-0
(let ((f0-0 (-> s3-0 u)))
(set! s3-0 (cond
((>= f0-0 0.0)
(cond
((>= arg0 f0-0)
(set! (-> s3-0 u) -1.0)
(set! s3-0 (-> s3-0 next))
)
(else
(let ((a1-1 s3-0))
(let ((v1-7 (-> s3-0 next)))
(let ((a0-1 (-> s3-0 prev)))
(if a0-1
(set! (-> a0-1 next) v1-7)
(set!
(-> (the-as touching-shapes-entry s5-0) head)
v1-7
)
)
(if v1-7
(set! (-> v1-7 prev) a0-1)
)
)
(set! s3-0 v1-7)
)
(free-node *touching-prims-entry-pool* a1-1)
)
)
(set! (-> obj resolve-u) 0)
(let ((s5-0 (the-as object (-> obj touching-shapes))))
(countdown (s4-0 (-> obj num-touching-shapes))
(when (nonzero? (-> (the-as touching-shapes-entry s5-0) resolve-u))
(set! (-> (the-as touching-shapes-entry s5-0) resolve-u) 0)
(when (-> (the-as touching-shapes-entry s5-0) cshape1)
(let ((s3-0 (-> (the-as touching-shapes-entry s5-0) head)))
(while s3-0
(let ((f0-0 (-> s3-0 u)))
(set! s3-0 (cond
((>= f0-0 0.0)
(cond
((>= arg0 f0-0)
(set! (-> s3-0 u) -1.0)
(set! s3-0 (-> s3-0 next))
)
(else
(let ((a1-1 s3-0))
(let ((v1-7 (-> s3-0 next)))
(let ((a0-1 (-> s3-0 prev)))
(if a0-1
(set! (-> a0-1 next) v1-7)
(set! (-> (the-as touching-shapes-entry s5-0) head) v1-7)
)
(if v1-7
(set! (-> v1-7 prev) a0-1)
)
)
(set! s3-0 v1-7)
)
(free-node *touching-prims-entry-pool* a1-1)
)
)
)
s3-0
)
(else
(-> s3-0 next)
)
)
)
s3-0
)
(else
(-> s3-0 next)
)
)
)
)
)
)
(if (not (-> (the-as touching-shapes-entry s5-0) head))
(set! (-> (the-as touching-shapes-entry s5-0) cshape1) #f)
)
)
)
)
(set! s5-0 (&+ (the-as touching-shapes-entry s5-0) 16))
)
(if (not (-> (the-as touching-shapes-entry s5-0) head))
(set! (-> (the-as touching-shapes-entry s5-0) cshape1) #f)
)
)
)
(set! s5-0 (&+ (the-as touching-shapes-entry s5-0) 16))
)
)
)
0
(none)
)
@@ -351,241 +332,198 @@
;; INFO: Return type mismatch int vs none.
(defmethod dummy-12 touching-list ((obj touching-list))
(let ((gp-0 (the-as object (-> obj touching-shapes))))
(countdown (s5-0 (-> obj num-touching-shapes))
(let ((s4-0 (-> (the-as touching-shapes-entry gp-0) cshape1)))
(when s4-0
(let ((s3-0 (-> (the-as touching-shapes-entry gp-0) cshape2)))
(when (= (-> s3-0 process type) target)
(let ((v1-2 s4-0))
(set! s4-0 s3-0)
(set! s3-0 v1-2)
)
)
(let ((v1-4 (-> s4-0 event-self)))
(when v1-4
(let ((a1-0 (new 'stack-no-clear 'event-message-block)))
(set! (-> a1-0 from) (-> s3-0 process))
(set! (-> a1-0 num-params) 1)
(set! (-> a1-0 message) (the-as symbol v1-4))
(set! (-> a1-0 param 0) (the-as uint gp-0))
(send-event-function (-> s4-0 process) a1-0)
(countdown (s5-0 (-> obj num-touching-shapes))
(let ((s4-0 (-> (the-as touching-shapes-entry gp-0) cshape1)))
(when s4-0
(let ((s3-0 (-> (the-as touching-shapes-entry gp-0) cshape2)))
(when (= (-> s3-0 process type) target)
(let ((v1-2 s4-0))
(set! s4-0 s3-0)
(set! s3-0 v1-2)
)
)
(let ((v1-4 (-> s4-0 event-self)))
(when v1-4
(let ((a1-0 (new 'stack-no-clear 'event-message-block)))
(set! (-> a1-0 from) (-> s3-0 process))
(set! (-> a1-0 num-params) 1)
(set! (-> a1-0 message) (the-as symbol v1-4))
(set! (-> a1-0 param 0) (the-as uint gp-0))
(send-event-function (-> s4-0 process) a1-0)
)
)
)
(let ((v1-5 (-> s4-0 event-other)))
(when v1-5
(let ((a1-1 (new 'stack-no-clear 'event-message-block)))
(set! (-> a1-1 from) (-> s4-0 process))
(set! (-> a1-1 num-params) 1)
(set! (-> a1-1 message) (the-as symbol v1-5))
(set! (-> a1-1 param 0) (the-as uint gp-0))
(send-event-function (-> s3-0 process) a1-1)
)
)
)
(let ((v1-6 (-> s3-0 event-self)))
(when v1-6
(let ((a1-2 (new 'stack-no-clear 'event-message-block)))
(set! (-> a1-2 from) (-> s4-0 process))
(set! (-> a1-2 num-params) 1)
(set! (-> a1-2 message) (the-as symbol v1-6))
(set! (-> a1-2 param 0) (the-as uint gp-0))
(send-event-function (-> s3-0 process) a1-2)
)
)
)
(let ((v1-7 (-> s3-0 event-other)))
(when v1-7
(let ((a1-3 (new 'stack-no-clear 'event-message-block)))
(set! (-> a1-3 from) (-> s3-0 process))
(set! (-> a1-3 num-params) 1)
(set! (-> a1-3 message) (the-as symbol v1-7))
(set! (-> a1-3 param 0) (the-as uint gp-0))
(send-event-function (-> s4-0 process) a1-3)
)
)
)
)
)
)
)
(let ((v1-5 (-> s4-0 event-other)))
(when v1-5
(let ((a1-1 (new 'stack-no-clear 'event-message-block)))
(set! (-> a1-1 from) (-> s4-0 process))
(set! (-> a1-1 num-params) 1)
(set! (-> a1-1 message) (the-as symbol v1-5))
(set! (-> a1-1 param 0) (the-as uint gp-0))
(send-event-function (-> s3-0 process) a1-1)
)
)
)
(let ((v1-6 (-> s3-0 event-self)))
(when v1-6
(let ((a1-2 (new 'stack-no-clear 'event-message-block)))
(set! (-> a1-2 from) (-> s4-0 process))
(set! (-> a1-2 num-params) 1)
(set! (-> a1-2 message) (the-as symbol v1-6))
(set! (-> a1-2 param 0) (the-as uint gp-0))
(send-event-function (-> s3-0 process) a1-2)
)
)
)
(let ((v1-7 (-> s3-0 event-other)))
(when v1-7
(let ((a1-3 (new 'stack-no-clear 'event-message-block)))
(set! (-> a1-3 from) (-> s3-0 process))
(set! (-> a1-3 num-params) 1)
(set! (-> a1-3 message) (the-as symbol v1-7))
(set! (-> a1-3 param 0) (the-as uint gp-0))
(send-event-function (-> s4-0 process) a1-3)
)
)
)
)
(set! gp-0 (&+ (the-as touching-shapes-entry gp-0) 16))
)
)
(set! gp-0 (&+ (the-as touching-shapes-entry gp-0) 16))
)
)
0
(none)
)
;; definition for method 12 of type touching-shapes-entry
(defmethod
prims-touching?
touching-shapes-entry
((obj touching-shapes-entry) (arg0 collide-shape-moving) (arg1 uint))
(defmethod prims-touching? touching-shapes-entry ((obj touching-shapes-entry) (arg0 collide-shape-moving) (arg1 uint))
(cond
((= (-> obj cshape1) arg0)
(let ((v1-1 (-> obj head)))
(while v1-1
(if (logtest? (-> v1-1 prim1 cprim prim-id) arg1)
(return v1-1)
((= (-> obj cshape1) arg0)
(let ((v1-1 (-> obj head)))
(while v1-1
(if (logtest? (-> v1-1 prim1 cprim prim-id) arg1)
(return v1-1)
)
(set! v1-1 (-> v1-1 next))
)
)
(set! v1-1 (-> v1-1 next))
)
)
)
((= (-> obj cshape2) arg0)
(let ((v1-4 (-> obj head)))
(while v1-4
(if (logtest? (-> v1-4 prim2 cprim prim-id) arg1)
(return v1-4)
((= (-> obj cshape2) arg0)
(let ((v1-4 (-> obj head)))
(while v1-4
(if (logtest? (-> v1-4 prim2 cprim prim-id) arg1)
(return v1-4)
)
(set! v1-4 (-> v1-4 next))
)
)
(set! v1-4 (-> v1-4 next))
)
(else
(format 0 "ERROR: touching-shapes-entry::prims-touching? : Bogus cshape value!~%")
)
)
)
(else
(format
0
"ERROR: touching-shapes-entry::prims-touching? : Bogus cshape value!~%"
)
)
)
(the-as touching-prims-entry #f)
)
;; definition for method 13 of type touching-shapes-entry
(defmethod
prims-touching-action?
touching-shapes-entry
((obj touching-shapes-entry) (arg0 collide-shape) (arg1 uint) (arg2 uint))
(defmethod prims-touching-action? touching-shapes-entry ((obj touching-shapes-entry) (arg0 collide-shape) (arg1 uint) (arg2 uint))
(cond
((= (-> obj cshape1) arg0)
(let ((v1-1 (-> obj head)))
(while v1-1
(let ((a0-1 (-> v1-1 prim1 cprim)))
(if
(and
(logtest? arg1 (-> a0-1 prim-core action))
(zero? (logand arg2 (-> a0-1 prim-core action)))
((= (-> obj cshape1) arg0)
(let ((v1-1 (-> obj head)))
(while v1-1
(let ((a0-1 (-> v1-1 prim1 cprim)))
(if (and (logtest? arg1 (-> a0-1 prim-core action)) (zero? (logand arg2 (-> a0-1 prim-core action))))
(return v1-1)
)
)
(set! v1-1 (-> v1-1 next))
)
(return v1-1)
)
)
(set! v1-1 (-> v1-1 next))
)
)
)
((= (-> obj cshape2) arg0)
(let ((v1-4 (-> obj head)))
(while v1-4
(let ((a0-5 (-> v1-4 prim2 cprim)))
(if
(and
(logtest? arg1 (-> a0-5 prim-core action))
(zero? (logand arg2 (-> a0-5 prim-core action)))
((= (-> obj cshape2) arg0)
(let ((v1-4 (-> obj head)))
(while v1-4
(let ((a0-5 (-> v1-4 prim2 cprim)))
(if (and (logtest? arg1 (-> a0-5 prim-core action)) (zero? (logand arg2 (-> a0-5 prim-core action))))
(return v1-4)
)
)
(set! v1-4 (-> v1-4 next))
)
(return v1-4)
)
)
(set! v1-4 (-> v1-4 next))
)
(else
(format 0 "ERROR: touching-shapes-entry::prims-touching-action? : Bogus cshape value!~%")
)
)
)
(else
(format
0
"ERROR: touching-shapes-entry::prims-touching-action? : Bogus cshape value!~%"
)
)
)
(the-as touching-prims-entry #f)
)
;; definition for method 10 of type touching-shapes-entry
(defmethod
get-touched-shape
touching-shapes-entry
((obj touching-shapes-entry) (arg0 collide-shape))
(defmethod get-touched-shape touching-shapes-entry ((obj touching-shapes-entry) (arg0 collide-shape))
(cond
((= (-> obj cshape1) arg0)
(return (-> obj cshape2))
((= (-> obj cshape1) arg0)
(return (-> obj cshape2))
)
((= (-> obj cshape2) arg0)
(return (-> obj cshape1))
)
)
((= (-> obj cshape2) arg0)
(return (-> obj cshape1))
)
)
(the-as collide-shape #f)
)
;; definition for method 9 of type touching-prims-entry
(defmethod
get-touched-prim
touching-prims-entry
((obj touching-prims-entry) (arg0 trsqv) (arg1 touching-prims-entry))
(defmethod get-touched-prim touching-prims-entry ((obj touching-prims-entry) (arg0 trsqv) (arg1 touching-prims-entry))
(cond
((= (-> arg1 next) arg0)
(return (-> obj prim1 cprim))
((= (-> arg1 next) arg0)
(return (-> obj prim1 cprim))
)
((= (-> arg1 prev) arg0)
(return (-> obj prim2 cprim))
)
)
((= (-> arg1 prev) arg0)
(return (-> obj prim2 cprim))
)
)
(the-as collide-shape-prim #f)
)
;; definition for method 12 of type touching-prims-entry
(defmethod
get-touched-tri
touching-prims-entry
((obj touching-prims-entry)
(arg0 touching-prims-entry)
(arg1 touching-prims-entry)
)
(defmethod get-touched-tri touching-prims-entry ((obj touching-prims-entry) (arg0 touching-prims-entry) (arg1 touching-prims-entry))
(let ((v0-0 (the-as collide-tri-result #f)))
(cond
((= (-> arg1 next) arg0)
(let ((v1-2 (-> obj prim1)))
(if (-> v1-2 has-tri?)
(set! v0-0 (-> v1-2 tri))
(cond
((= (-> arg1 next) arg0)
(let ((v1-2 (-> obj prim1)))
(if (-> v1-2 has-tri?)
(set! v0-0 (-> v1-2 tri))
)
)
)
((= (-> arg1 prev) arg0)
(let ((v1-5 (-> obj prim2)))
(if (-> v1-5 has-tri?)
(set! v0-0 (-> v1-5 tri))
)
)
)
)
)
((= (-> arg1 prev) arg0)
(let ((v1-5 (-> obj prim2)))
(if (-> v1-5 has-tri?)
(set! v0-0 (-> v1-5 tri))
)
)
)
v0-0
)
v0-0
)
)
;; definition for method 11 of type touching-prims-entry
(defmethod
dummy-11
touching-prims-entry
((obj touching-prims-entry) (arg0 vector))
(defmethod dummy-11 touching-prims-entry ((obj touching-prims-entry) (arg0 vector))
(let* ((s4-0 (-> obj prim1 cprim))
(s3-0 (-> obj prim2 cprim))
(gp-1
(vector-!
(new 'stack-no-clear 'vector)
(the-as vector (-> s3-0 prim-core))
(the-as vector (-> s4-0 prim-core))
)
)
(gp-1 (vector-!
(new 'stack-no-clear 'vector)
(the-as vector (-> s3-0 prim-core))
(the-as vector (-> s4-0 prim-core))
)
)
)
(let
((f1-2
(-
(- (vector-length gp-1) (-> s3-0 prim-core world-sphere w))
(-> s4-0 prim-core world-sphere w)
)
(let ((f1-2 (- (- (vector-length gp-1) (-> s3-0 prim-core world-sphere w)) (-> s4-0 prim-core world-sphere w))))
(vector-normalize! gp-1 (+ (-> s4-0 prim-core world-sphere w) (* 0.5 f1-2)))
)
)
(vector-normalize! gp-1 (+ (-> s4-0 prim-core world-sphere w) (* 0.5 f1-2)))
(vector+! arg0 gp-1 (the-as vector (-> s4-0 prim-core)))
)
(vector+! arg0 gp-1 (the-as vector (-> s4-0 prim-core)))
)
arg0
)
+19 -26
View File
@@ -2,29 +2,22 @@
(in-package goal)
;; definition for symbol *collide-vif0-init*, type (array uint32)
(define
*collide-vif0-init*
(the-as (array uint32)
(new
'static
'boxed-array
:type uint32 :length 12 :allocated-length 12
#x30000000
#x4d000000
#x4d000000
#x4d000000
#x3f800000
#x5000001
#x20000000
#x40404040
#x1000404
#x0
#x0
#x0
)
)
)
(define *collide-vif0-init* (the-as (array uint32) (new
'static
'boxed-array
:type uint32 :length 12 :allocated-length 12
#x30000000
#x4d000000
#x4d000000
#x4d000000
#x3f800000
#x5000001
#x20000000
#x40404040
#x1000404
#x0
#x0
#x0
)
)
)
+164 -176
View File
@@ -6,85 +6,83 @@
;; Used lq/sq
(defun drawable-sphere-box-intersect? ((arg0 drawable) (arg1 bounding-box4w))
(local-vars
(r0-0 int)
(r0-1 int)
(r0-2 uint128)
(r0-3 int)
(v1-1 uint128)
(v1-2 uint128)
(v1-3 uint128)
(a0-1 uint128)
(a1-2 uint128)
(a2-0 uint128)
(f31-0 none)
)
(r0-0 int)
(r0-1 int)
(r0-2 uint128)
(r0-3 int)
(v1-1 uint128)
(v1-2 uint128)
(v1-3 uint128)
(a0-1 uint128)
(a1-2 uint128)
(a2-0 uint128)
(f31-0 none)
)
(rlet ((vf1 :class vf)
(vf2 :class vf)
(vf3 :class vf)
(vf4 :class vf)
)
(nop!)
(nop!)
(.lvf vf1 (&-> arg0 bsphere quad))
(.add.w.vf vf2 vf1 vf1 :mask #b111)
(let ((v1-0 (-> arg1 min quad)))
(.sub.w.vf vf1 vf1 vf1 :mask #b111)
(let ((a1-1 (-> arg1 max quad)))
(.ftoi.vf vf4 vf2)
(nop!)
(.ftoi.vf vf3 vf1)
(nop!)
(.mov a0-1 vf4)
(nop!)
(.mov a2-0 vf3)
(nop!)
(.pcgtw a1-2 a2-0 a1-1)
)
(.mov r0-0 f31-0)
(.pcgtw v1-1 v1-0 a0-1)
)
(.mov r0-1 f31-0)
(.por v1-2 a1-2 v1-1)
(.mov r0-2 f31-0)
(.ppach v1-3 r0-2 v1-2)
(.mov r0-3 f31-0)
(let ((v1-4 (shl (the-as int v1-3) 16)))
(nop!)
(zero? v1-4)
(nop!)
(.lvf vf1 (&-> arg0 bsphere quad))
(.add.w.vf vf2 vf1 vf1 :mask #b111)
(let ((v1-0 (-> arg1 min quad)))
(.sub.w.vf vf1 vf1 vf1 :mask #b111)
(let ((a1-1 (-> arg1 max quad)))
(.ftoi.vf vf4 vf2)
(nop!)
(.ftoi.vf vf3 vf1)
(nop!)
(.mov a0-1 vf4)
(nop!)
(.mov a2-0 vf3)
(nop!)
(.pcgtw a1-2 a2-0 a1-1)
)
(.mov r0-0 f31-0)
(.pcgtw v1-1 v1-0 a0-1)
)
(.mov r0-1 f31-0)
(.por v1-2 a1-2 v1-1)
(.mov r0-2 f31-0)
(.ppach v1-3 r0-2 v1-2)
(.mov r0-3 f31-0)
(let ((v1-4 (shl (the-as int v1-3) 16)))
(nop!)
(zero? v1-4)
)
)
)
)
;; definition for function instance-sphere-box-intersect?
;; WARN: Function may read a register that is not set: f31
;; Used lq/sq
(defun
instance-sphere-box-intersect?
((arg0 drawable) (arg1 instance-tie) (arg2 bounding-box4w))
(defun instance-sphere-box-intersect? ((arg0 drawable) (arg1 instance-tie) (arg2 bounding-box4w))
(local-vars
(r0-0 uint128)
(r0-1 int)
(r0-2 uint128)
(r0-3 int)
(r0-4 int)
(r0-5 uint128)
(r0-6 int)
(v1-3 uint128)
(v1-4 uint128)
(v1-5 uint128)
(a0-2 uint128)
(a1-2 uint128)
(a2-1 uint128)
(a3-1 uint128)
(a3-3 uint128)
(a3-4 uint128)
(t0-1 uint128)
(t0-2 uint128)
(t1-0 uint128)
(t2-1 uint128)
(t2-2 uint128)
(f31-0 none)
)
(r0-0 uint128)
(r0-1 int)
(r0-2 uint128)
(r0-3 int)
(r0-4 int)
(r0-5 uint128)
(r0-6 int)
(v1-3 uint128)
(v1-4 uint128)
(v1-5 uint128)
(a0-2 uint128)
(a1-2 uint128)
(a2-1 uint128)
(a3-1 uint128)
(a3-3 uint128)
(a3-4 uint128)
(t0-1 uint128)
(t0-2 uint128)
(t1-0 uint128)
(t2-1 uint128)
(t2-2 uint128)
(f31-0 none)
)
(rlet ((acc :class vf)
(vf0 :class vf)
(vf1 :class vf)
@@ -98,89 +96,89 @@
(vf8 :class vf)
(vf9 :class vf)
)
(init-vf0-vector)
(nop!)
(let ((v1-0 (-> arg1 max-scale)))
(init-vf0-vector)
(nop!)
(let ((a3-0 (the-as uint128 (-> arg1 origin vector4h 3 long))))
(nop!)
(let ((t2-0 (the-as uint128 (-> arg1 origin vector4h 0 long))))
(.pextlh a3-1 a3-0 r0-0)
(let ((t0-0 (the-as uint128 (-> arg1 origin vector4h 1 long))))
(.pw.sra t1-0 a3-1 10)
(let ((a3-2 (the-as uint128 (-> arg1 origin vector4h 2 long))))
(.pextlh t2-1 t2-0 r0-0)
(.mov r0-1 f31-0)
(.pw.sra t2-2 t2-1 16)
(.mov r0-2 f31-0)
(.pextlh t0-1 t0-0 r0-2)
(.mov vf8 t1-0)
(.pw.sra t0-2 t0-1 16)
(.mov vf5 t2-2)
(.pextlh a3-3 a3-2 r0-2)
(let ((v1-0 (-> arg1 max-scale)))
(nop!)
(let ((a3-0 (the-as uint128 (-> arg1 origin vector4h 3 long))))
(nop!)
(let ((t2-0 (the-as uint128 (-> arg1 origin vector4h 0 long))))
(.pextlh a3-1 a3-0 r0-0)
(let ((t0-0 (the-as uint128 (-> arg1 origin vector4h 1 long))))
(.pw.sra t1-0 a3-1 10)
(let ((a3-2 (the-as uint128 (-> arg1 origin vector4h 2 long))))
(.pextlh t2-1 t2-0 r0-0)
(.mov r0-1 f31-0)
(.pw.sra t2-2 t2-1 16)
(.mov r0-2 f31-0)
(.pextlh t0-1 t0-0 r0-2)
(.mov vf8 t1-0)
(.pw.sra t0-2 t0-1 16)
(.mov vf5 t2-2)
(.pextlh a3-3 a3-2 r0-2)
)
)
)
)
)
(.mov vf6 t0-2)
(.pw.sra a3-4 a3-3 16)
(.lvf vf9 (&-> arg1 bsphere quad))
(nop!)
(.mov vf7 a3-4)
(nop!)
(.mov vf10 v1-0)
)
)
(.mov vf6 t0-2)
(.pw.sra a3-4 a3-3 16)
(.lvf vf9 (&-> arg1 bsphere quad))
(.itof.vf vf8 vf8)
(nop!)
(.mov vf7 a3-4)
(vitof12.xyzw vf5 vf5)
(nop!)
(.mov vf10 v1-0)
)
(.itof.vf vf8 vf8)
(nop!)
(vitof12.xyzw vf5 vf5)
(nop!)
(vitof12.xyzw vf6 vf6)
(nop!)
(vitof12.xyzw vf7 vf7)
(nop!)
(.add.vf vf8 vf8 vf9 :mask #b111)
(nop!)
(nop!)
(.lvf vf9 (&-> arg0 bsphere quad))
(vitof12.xyzw vf10 vf10)
(nop!)
(.mul.w.vf vf10 vf10 vf9 :mask #b1)
(nop!)
(.mul.x.vf acc vf5 vf9)
(nop!)
(.add.mul.y.vf acc vf6 vf9 acc)
(let ((v1-2 (-> arg2 min quad)))
(.add.mul.z.vf acc vf7 vf9 acc)
(let ((a1-1 (-> arg2 max quad)))
(.add.mul.w.vf vf1 vf8 vf0 acc)
(nop!)
(.add.x.vf vf2 vf1 vf10 :mask #b111)
(nop!)
(.sub.x.vf vf1 vf1 vf10 :mask #b111)
(nop!)
(.ftoi.vf vf4 vf2)
(nop!)
(.ftoi.vf vf3 vf1)
(nop!)
(.mov a0-2 vf4)
(nop!)
(.mov a2-1 vf3)
(nop!)
(.pcgtw a1-2 a2-1 a1-1)
)
(.mov r0-3 f31-0)
(.pcgtw v1-3 v1-2 a0-2)
)
(.mov r0-4 f31-0)
(.por v1-4 a1-2 v1-3)
(.mov r0-5 f31-0)
(.ppach v1-5 r0-5 v1-4)
(.mov r0-6 f31-0)
(let ((v1-6 (shl (the-as int v1-5) 16)))
(vitof12.xyzw vf6 vf6)
(nop!)
(zero? v1-6)
(vitof12.xyzw vf7 vf7)
(nop!)
(.add.vf vf8 vf8 vf9 :mask #b111)
(nop!)
(nop!)
(.lvf vf9 (&-> arg0 bsphere quad))
(vitof12.xyzw vf10 vf10)
(nop!)
(.mul.w.vf vf10 vf10 vf9 :mask #b1)
(nop!)
(.mul.x.vf acc vf5 vf9)
(nop!)
(.add.mul.y.vf acc vf6 vf9 acc)
(let ((v1-2 (-> arg2 min quad)))
(.add.mul.z.vf acc vf7 vf9 acc)
(let ((a1-1 (-> arg2 max quad)))
(.add.mul.w.vf vf1 vf8 vf0 acc)
(nop!)
(.add.x.vf vf2 vf1 vf10 :mask #b111)
(nop!)
(.sub.x.vf vf1 vf1 vf10 :mask #b111)
(nop!)
(.ftoi.vf vf4 vf2)
(nop!)
(.ftoi.vf vf3 vf1)
(nop!)
(.mov a0-2 vf4)
(nop!)
(.mov a2-1 vf3)
(nop!)
(.pcgtw a1-2 a2-1 a1-1)
)
(.mov r0-3 f31-0)
(.pcgtw v1-3 v1-2 a0-2)
)
(.mov r0-4 f31-0)
(.por v1-4 a1-2 v1-3)
(.mov r0-5 f31-0)
(.ppach v1-5 r0-5 v1-4)
(.mov r0-6 f31-0)
(let ((v1-6 (shl (the-as int v1-5) 16)))
(nop!)
(zero? v1-6)
)
)
)
)
;; definition for function instance-tfragment-add-debug-sphere
@@ -193,39 +191,29 @@
(vf12 :class vf)
(vf9 :class vf)
)
(init-vf0-vector)
(nop!)
(let ((v1-0 (the-as uint128 (-> arg1 origin vector4h 3 long))))
(.pextlh v1-1 v1-0 r0-0)
(init-vf0-vector)
(nop!)
(let ((v1-0 (the-as uint128 (-> arg1 origin vector4h 3 long))))
(.pextlh v1-1 v1-0 r0-0)
)
(.lvf vf9 (&-> arg0 bsphere quad))
(.pw.sra v1-2 v1-1 10)
(.lvf vf10 (&-> arg1 bsphere quad))
(nop!)
(.mov vf12 v1-2)
(.itof.vf vf12 vf12)
(nop!)
(.add.vf vf10 vf10 vf12 :mask #b111)
(nop!)
(.add.vf vf9 vf9 vf10 :mask #b111)
(nop!)
(.add.w.vf vf11 vf0 vf9 :mask #b1)
(nop!)
(.mov a3-0 vf11)
(nop!)
(let ((a2-0 (new-stack-vector0)))
(.svf (&-> a2-0 quad) vf9)
(add-debug-sphere #t (bucket-id debug-draw0) a2-0 a3-0 (new 'static 'rgba :r #x80 :g #x80 :b #x80 :a #x80))
)
)
(.lvf vf9 (&-> arg0 bsphere quad))
(.pw.sra v1-2 v1-1 10)
(.lvf vf10 (&-> arg1 bsphere quad))
(nop!)
(.mov vf12 v1-2)
(.itof.vf vf12 vf12)
(nop!)
(.add.vf vf10 vf10 vf12 :mask #b111)
(nop!)
(.add.vf vf9 vf9 vf10 :mask #b111)
(nop!)
(.add.w.vf vf11 vf0 vf9 :mask #b1)
(nop!)
(.mov a3-0 vf11)
(nop!)
(let ((a2-0 (new-stack-vector0)))
(.svf (&-> a2-0 quad) vf9)
(add-debug-sphere
#t
(bucket-id debug-draw0)
a2-0
a3-0
(new 'static 'rgba :r #x80 :g #x80 :b #x80 :a #x80)
)
)
)
)
+9 -29
View File
@@ -99,20 +99,13 @@
;; definition for method 0 of type joint-anim-frame
;; INFO: Return type mismatch structure vs joint-anim-frame.
(defmethod
new
joint-anim-frame
((allocation symbol) (type-to-make type) (arg0 int))
(defmethod new joint-anim-frame ((allocation symbol) (type-to-make type) (arg0 int))
(let ((v1-1 (max 0 (+ arg0 -2))))
(the-as
joint-anim-frame
(new-dynamic-structure
allocation
type-to-make
(the-as int (+ (-> type-to-make size) (* 48 v1-1)))
)
(the-as
joint-anim-frame
(new-dynamic-structure allocation type-to-make (the-as int (+ (-> type-to-make size) (* 48 v1-1))))
)
)
)
)
;; definition of type joint-anim-compressed-hdr
@@ -151,10 +144,7 @@
)
;; definition for method 3 of type joint-anim-compressed-fixed
(defmethod
inspect
joint-anim-compressed-fixed
((obj joint-anim-compressed-fixed))
(defmethod inspect joint-anim-compressed-fixed ((obj joint-anim-compressed-fixed))
(format #t "[~8x] ~A~%" obj 'joint-anim-compressed-fixed)
(format #t "~Thdr: #<joint-anim-compressed-hdr @ #x~X>~%" (-> obj hdr))
(format #t "~Toffset-64: ~D~%" (-> obj offset-64))
@@ -179,10 +169,7 @@
)
;; definition for method 3 of type joint-anim-compressed-frame
(defmethod
inspect
joint-anim-compressed-frame
((obj joint-anim-compressed-frame))
(defmethod inspect joint-anim-compressed-frame ((obj joint-anim-compressed-frame))
(format #t "[~8x] ~A~%" obj 'joint-anim-compressed-frame)
(format #t "~Toffset-64: ~D~%" (-> obj offset-64))
(format #t "~Toffset-32: ~D~%" (-> obj offset-32))
@@ -206,10 +193,7 @@
)
;; definition for method 3 of type joint-anim-compressed-control
(defmethod
inspect
joint-anim-compressed-control
((obj joint-anim-compressed-control))
(defmethod inspect joint-anim-compressed-control ((obj joint-anim-compressed-control))
(format #t "[~8x] ~A~%" obj 'joint-anim-compressed-control)
(format #t "~Tnum-frames: ~D~%" (-> obj num-frames))
(format #t "~Tfixed-qwc: ~D~%" (-> obj fixed-qwc))
@@ -496,11 +480,7 @@
(format #t "~Tcolor-mult: #<rgbaf @ #x~X>~%" (-> obj color-mult))
(format #t "~Tcolor-emissive: #<rgbaf @ #x~X>~%" (-> obj color-emissive))
(format #t "~Tsecondary-interp: ~f~%" (-> obj secondary-interp))
(format
#t
"~Tcurrent-secondary-interp: ~f~%"
(-> obj current-secondary-interp)
)
(format #t "~Tcurrent-secondary-interp: ~f~%" (-> obj current-secondary-interp))
(format #t "~Tshadow-mask: ~D~%" (-> obj shadow-mask))
(format #t "~Tlevel-index: ~D~%" (-> obj level-index))
(format #t "~Torigin-joint-index: ~D~%" (-> obj origin-joint-index))
+678 -904
View File
File diff suppressed because it is too large Load Diff
+2272 -2931
View File
File diff suppressed because it is too large Load Diff
+4 -23
View File
@@ -17,10 +17,7 @@
)
;; definition for method 3 of type __assert-info-private-struct
(defmethod
inspect
__assert-info-private-struct
((obj __assert-info-private-struct))
(defmethod inspect __assert-info-private-struct ((obj __assert-info-private-struct))
(format #t "[~8x] ~A~%" obj '__assert-info-private-struct)
(format #t "~Tfilename: ~A~%" (-> obj filename))
(format #t "~Tline-num: ~D~%" (-> obj line-num))
@@ -29,14 +26,7 @@
)
;; definition for method 9 of type __assert-info-private-struct
(defmethod
set-pos
__assert-info-private-struct
((obj __assert-info-private-struct)
(filename string)
(line-num uint)
(column-num uint)
)
(defmethod set-pos __assert-info-private-struct ((obj __assert-info-private-struct) (filename string) (line-num uint) (column-num uint))
(set! (-> obj filename) filename)
(set! (-> obj line-num) line-num)
(set! (-> obj column-num) column-num)
@@ -44,17 +34,8 @@
)
;; definition for method 10 of type __assert-info-private-struct
(defmethod
print-pos
__assert-info-private-struct
((obj __assert-info-private-struct))
(format
#t
"file ~S.gc, line ~D, col ~D.~%"
(-> obj filename)
(-> obj line-num)
(-> obj column-num)
)
(defmethod print-pos __assert-info-private-struct ((obj __assert-info-private-struct))
(format #t "file ~S.gc, line ~D, col ~D.~%" (-> obj filename) (-> obj line-num) (-> obj column-num))
0
)
+53 -79
View File
@@ -26,58 +26,34 @@
(f30-0 1.0)
(s4-0 0)
)
(set-vector! s5-0 0.0 0.0 0.0 1.0)
(dotimes (s3-0 10)
(let ((f28-0 (* f30-0 (sin (* 3276.8 (the float s3-0)))))
(f26-0 (* f30-0 (sin (* 3276.8 (the float (+ s3-0 1))))))
(s2-0 (new-stack-vector0))
(s1-0 (new-stack-vector0))
(s0-0 (new-stack-vector0))
(set-vector! s5-0 0.0 0.0 0.0 1.0)
(dotimes (s3-0 10)
(let ((f28-0 (* f30-0 (sin (* 3276.8 (the float s3-0)))))
(f26-0 (* f30-0 (sin (* 3276.8 (the float (+ s3-0 1))))))
(s2-0 (new-stack-vector0))
(s1-0 (new-stack-vector0))
(s0-0 (new-stack-vector0))
)
(set! (-> s2-0 y) (+ (-> s5-0 y) (* (cos (* 3276.8 (the float s3-0))) f30-0)))
(set! (-> s1-0 y) (-> s2-0 y))
(set! (-> s0-0 y) (+ (-> s5-0 y) (* (cos (* 3276.8 (the float (+ s3-0 1)))) f30-0)))
(set! sv-80 0)
(while (< sv-80 10)
(set! (-> s2-0 x) (+ (-> s5-0 x) (* (cos (* 6553.6 (the float sv-80))) f28-0)))
(set! (-> s2-0 z) (+ (-> s5-0 z) (* (sin (* 6553.6 (the float sv-80))) f28-0)))
(set! (-> s1-0 x) (+ (-> s5-0 x) (* (cos (* 6553.6 (the float (+ sv-80 1)))) f28-0)))
(set! (-> s1-0 z) (+ (-> s5-0 z) (* (sin (* 6553.6 (the float (+ sv-80 1)))) f28-0)))
(set! (-> s0-0 x) (+ (-> s5-0 x) (* (cos (* 6553.6 (the float sv-80))) f26-0)))
(set! (-> s0-0 z) (+ (-> s5-0 z) (* (sin (* 6553.6 (the float sv-80))) f26-0)))
(set! (-> arg0 point s4-0 quad) (-> s2-0 quad))
(set! (-> arg0 point (+ s4-0 1) quad) (-> s1-0 quad))
(set! (-> arg0 point (+ s4-0 2) quad) (-> s0-0 quad))
(+! s4-0 3)
(set! sv-80 (+ sv-80 1))
)
(set!
(-> s2-0 y)
(+ (-> s5-0 y) (* (cos (* 3276.8 (the float s3-0))) f30-0))
)
)
(set! (-> s1-0 y) (-> s2-0 y))
(set!
(-> s0-0 y)
(+ (-> s5-0 y) (* (cos (* 3276.8 (the float (+ s3-0 1)))) f30-0))
)
(set! sv-80 0)
(while (< sv-80 10)
(set!
(-> s2-0 x)
(+ (-> s5-0 x) (* (cos (* 6553.6 (the float sv-80))) f28-0))
)
(set!
(-> s2-0 z)
(+ (-> s5-0 z) (* (sin (* 6553.6 (the float sv-80))) f28-0))
)
(set!
(-> s1-0 x)
(+ (-> s5-0 x) (* (cos (* 6553.6 (the float (+ sv-80 1)))) f28-0))
)
(set!
(-> s1-0 z)
(+ (-> s5-0 z) (* (sin (* 6553.6 (the float (+ sv-80 1)))) f28-0))
)
(set!
(-> s0-0 x)
(+ (-> s5-0 x) (* (cos (* 6553.6 (the float sv-80))) f26-0))
)
(set!
(-> s0-0 z)
(+ (-> s5-0 z) (* (sin (* 6553.6 (the float sv-80))) f26-0))
)
(set! (-> arg0 point s4-0 quad) (-> s2-0 quad))
(set! (-> arg0 point (+ s4-0 1) quad) (-> s1-0 quad))
(set! (-> arg0 point (+ s4-0 2) quad) (-> s0-0 quad))
(+! s4-0 3)
(set! sv-80 (+ sv-80 1))
)
)
)
)
0
(none)
)
@@ -91,41 +67,39 @@
;; definition for function add-debug-sphere-from-table
;; INFO: Return type mismatch int vs none.
;; Used lq/sq
(defun
add-debug-sphere-from-table
((arg0 bucket-id) (arg1 vector) (arg2 float) (arg3 rgba))
(defun add-debug-sphere-from-table ((arg0 bucket-id) (arg1 vector) (arg2 float) (arg3 rgba))
(rlet ((vf1 :class vf)
(vf2 :class vf)
(vf3 :class vf)
(vf4 :class vf)
(vf5 :class vf)
)
(let ((s4-0 (new-stack-vector0))
(s3-0 (new-stack-vector0))
(s2-0 (new-stack-vector0))
(points (-> *debug-sphere-table* point))
)
(.lvf vf1 (&-> arg1 quad))
(.mov vf2 arg2)
(dotimes (s0-0 100)
(.lvf vf3 (&-> points 0 quad))
(.lvf vf4 (&-> points 1 quad))
(.lvf vf5 (&-> points 2 quad))
(set! points (the-as (inline-array vector) (-> points 3)))
(.mul.x.vf vf3 vf3 vf2)
(.mul.x.vf vf4 vf4 vf2)
(.mul.x.vf vf5 vf5 vf2)
(.add.vf vf3 vf3 vf1)
(.add.vf vf4 vf4 vf1)
(.add.vf vf5 vf5 vf1)
(.svf (&-> s4-0 quad) vf3)
(.svf (&-> s3-0 quad) vf4)
(.svf (&-> s2-0 quad) vf5)
(add-debug-line #t arg0 s4-0 s3-0 arg3 #f (the-as rgba -1))
(add-debug-line #t arg0 s4-0 s2-0 arg3 #f (the-as rgba -1))
)
(let ((s4-0 (new-stack-vector0))
(s3-0 (new-stack-vector0))
(s2-0 (new-stack-vector0))
(points (-> *debug-sphere-table* point))
)
(.lvf vf1 (&-> arg1 quad))
(.mov vf2 arg2)
(dotimes (s0-0 100)
(.lvf vf3 (&-> points 0 quad))
(.lvf vf4 (&-> points 1 quad))
(.lvf vf5 (&-> points 2 quad))
(set! points (the-as (inline-array vector) (-> points 3)))
(.mul.x.vf vf3 vf3 vf2)
(.mul.x.vf vf4 vf4 vf2)
(.mul.x.vf vf5 vf5 vf2)
(.add.vf vf3 vf3 vf1)
(.add.vf vf4 vf4 vf1)
(.add.vf vf5 vf5 vf1)
(.svf (&-> s4-0 quad) vf3)
(.svf (&-> s3-0 quad) vf4)
(.svf (&-> s2-0 quad) vf5)
(add-debug-line #t arg0 s4-0 s3-0 arg3 #f (the-as rgba -1))
(add-debug-line #t arg0 s4-0 s2-0 arg3 #f (the-as rgba -1))
)
)
0
(none)
)
0
(none)
)
)
+1016 -1393
View File
File diff suppressed because it is too large Load Diff
+3892 -8336
View File
File diff suppressed because it is too large Load Diff
File diff suppressed because it is too large Load Diff
+995 -1443
View File
File diff suppressed because it is too large Load Diff
+68 -95
View File
@@ -4,18 +4,17 @@
;; this file is debug only
(when *debug-segment*
;; failed to figure out what this is:
(set!
(-> *part-group-id-table* 105)
(new 'static 'sparticle-launch-group
:length 2
:duration #xbb8
:linger-duration #x5dc
:name "group-part-tester"
:launcher
(new 'static 'inline-array sparticle-group-item 2 (sp-item 56) (sp-item 57))
:bounds (new 'static 'sphere :w 4096.0)
)
)
(set! (-> *part-group-id-table* 105)
(new 'static 'sparticle-launch-group
:length 2
:duration #xbb8
:linger-duration #x5dc
:name "group-part-tester"
:launcher
(new 'static 'inline-array sparticle-group-item 2 (sp-item 56) (sp-item 57))
:bounds (new 'static 'sphere :w 4096.0)
)
)
;; definition of type part-tester
(deftype part-tester (process)
@@ -32,8 +31,8 @@
;; definition for method 3 of type part-tester
(defmethod inspect part-tester ((obj part-tester))
(let ((t9-0 (method-of-type process inspect)))
(t9-0 obj)
)
(t9-0 obj)
)
(format #t "~T~Troot: ~A~%" (-> obj root))
(format #t "~T~Tpart: ~A~%" (-> obj part))
(format #t "~T~Told-group: ~A~%" (-> obj old-group))
@@ -46,8 +45,8 @@
;; definition for method 10 of type part-tester
(defmethod deactivate part-tester ((obj part-tester))
(if (nonzero? (-> obj part))
(kill-and-free-particles (-> obj part))
)
(kill-and-free-particles (-> obj part))
)
((method-of-type process deactivate) obj)
(none)
)
@@ -56,62 +55,51 @@
(defstate part-tester-idle (part-tester)
:code
(behavior ()
(while #t
(let ((gp-0 (entity-by-name *part-tester-name*)))
(when gp-0
(let ((s5-0 (-> gp-0 extra process)))
(if
(and
s5-0
(type-type? (-> s5-0 type) process-drawable)
(nonzero? (-> (the-as process-drawable s5-0) root))
)
(set!
(-> self root trans quad)
(-> (the-as process-drawable s5-0) root trans quad)
)
(set! (-> self root trans quad) (-> gp-0 extra trans quad))
(while #t
(let ((gp-0 (entity-by-name *part-tester-name*)))
(when gp-0
(let ((s5-0 (-> gp-0 extra process)))
(if (and s5-0 (type-type? (-> s5-0 type) process-drawable) (nonzero? (-> (the-as process-drawable s5-0) root)))
(set! (-> self root trans quad) (-> (the-as process-drawable s5-0) root trans quad))
(set! (-> self root trans quad) (-> gp-0 extra trans quad))
)
)
)
)
)
(add-debug-x
#t
(bucket-id debug-draw1)
(-> self root trans)
(the-as rgba (new 'static 'rgba :r #xff :g #xff :b #xff :a #x80))
)
(let ((gp-1 (-> *part-group-id-table* 105)))
(let ((s5-1 (-> self root trans)))
(when (!= gp-1 (-> self old-group))
(when (nonzero? (-> self part))
(kill-and-free-particles (-> self part))
(set! (-> self heap-cur) (&-> (-> self part) type))
)
(set! (-> self part) (create-launch-control gp-1 self))
)
(if (nonzero? (-> self part))
(spawn (-> self part) (cond
((logtest? (-> gp-1 flags) (sp-group-flag screen-space))
*zero-vector*
)
(else
(empty)
s5-1
)
)
)
)
)
(set! (-> self old-group) gp-1)
)
(suspend)
)
)
(add-debug-x
#t
(bucket-id debug-draw1)
(-> self root trans)
(the-as rgba (new 'static 'rgba :r #xff :g #xff :b #xff :a #x80))
)
(let ((gp-1 (-> *part-group-id-table* 105)))
(let ((s5-1 (-> self root trans)))
(when (!= gp-1 (-> self old-group))
(when (nonzero? (-> self part))
(kill-and-free-particles (-> self part))
(set! (-> self heap-cur) (&-> (-> self part) type))
)
(set! (-> self part) (create-launch-control gp-1 self))
)
(if (nonzero? (-> self part))
(spawn (-> self part) (cond
((logtest?
(-> gp-1 flags)
(sp-group-flag screen-space)
)
*zero-vector*
)
(else
(empty)
s5-1
)
)
)
)
)
(set! (-> self old-group) gp-1)
)
(suspend)
(none)
)
(none)
)
)
;; definition for function part-tester-init-by-other
@@ -126,41 +114,26 @@
)
;; definition (perm) for symbol *debug-part-dead-pool*, type dead-pool
(define-perm *debug-part-dead-pool* dead-pool
(new 'debug 'dead-pool 1 #x10000 '*debug-part-dead-pool*)
)
(define-perm *debug-part-dead-pool* dead-pool (new 'debug 'dead-pool 1 #x10000 '*debug-part-dead-pool*))
;; definition for function start-part
;; INFO: Return type mismatch (pointer process) vs none.
(defun start-part ()
(kill-by-type part-tester *active-pool*)
(let ((gp-0 (get-process *debug-part-dead-pool* part-tester #x4000)))
(when gp-0
(let ((t9-2 (method-of-type part-tester activate)))
(t9-2
(the-as part-tester gp-0)
*default-pool*
'part-tester
(the-as pointer #x70004000)
(when gp-0
(let ((t9-2 (method-of-type part-tester activate)))
(t9-2 (the-as part-tester gp-0) *default-pool* 'part-tester (the-as pointer #x70004000))
)
(run-now-in-process gp-0 part-tester-init-by-other (if *anim-tester*
(-> *anim-tester* 0 root trans)
(target-pos 0)
)
)
(-> gp-0 ppointer)
)
)
(run-now-in-process gp-0 part-tester-init-by-other (if *anim-tester*
(->
*anim-tester*
0
root
trans
)
(target-pos 0)
)
)
(-> gp-0 ppointer)
)
)
(none)
)
)
+16 -19
View File
@@ -129,17 +129,17 @@
(defmethod reset! perf-stat ((obj perf-stat))
(local-vars (r0-0 none))
(let ((v1-0 (-> obj ctrl)))
(+! (-> obj count) 1)
(b! (zero? v1-0) cfg-2 :delay (nop!))
(.mtc0 Perf r0-0)
(.sync.l)
(.sync.p)
(.mtpc pcr0 r0-0)
(.mtpc pcr1 r0-0)
(.sync.l)
(.sync.p)
(.mtc0 Perf v1-0)
)
(+! (-> obj count) 1)
(b! (zero? v1-0) cfg-2 :delay (nop!))
(.mtc0 Perf r0-0)
(.sync.l)
(.sync.p)
(.mtpc pcr0 r0-0)
(.mtpc pcr1 r0-0)
(.sync.l)
(.sync.p)
(.mtc0 Perf v1-0)
)
(.sync.l)
(.sync.p)
(label cfg-2)
@@ -171,15 +171,12 @@
;; definition for method 13 of type perf-stat
;; INFO: Return type mismatch int vs none.
(defmethod
update-wait-stats
perf-stat
((obj perf-stat) (arg0 uint) (arg1 uint) (arg2 uint))
(defmethod update-wait-stats perf-stat ((obj perf-stat) (arg0 uint) (arg1 uint) (arg2 uint))
(when (nonzero? (-> obj ctrl))
(+! (-> obj to-vu0-waits) arg0)
(+! (-> obj to-spr-waits) arg1)
(+! (-> obj from-spr-waits) arg2)
)
(+! (-> obj to-vu0-waits) arg0)
(+! (-> obj to-spr-waits) arg1)
(+! (-> obj from-spr-waits) arg2)
)
0
(none)
)
+135 -154
View File
@@ -2,14 +2,12 @@
(in-package goal)
;; definition for symbol *viewer-sg*, type skeleton-group
(define
*viewer-sg*
(new 'static 'skeleton-group
:bounds (new 'static 'vector :w 16384.0)
:lod-dist
(new 'static 'array float 4 4095996000.0 0.0 0.0 0.0)
)
)
(define *viewer-sg* (new 'static 'skeleton-group
:bounds (new 'static 'vector :w 16384.0)
:lod-dist
(new 'static 'array float 4 4095996000.0 0.0 0.0 0.0)
)
)
;; definition of type viewer
(deftype viewer (process-drawable)
@@ -24,8 +22,8 @@
;; definition for method 3 of type viewer
(defmethod inspect viewer ((obj viewer))
(let ((t9-0 (method-of-type process-drawable inspect)))
(t9-0 obj)
)
(t9-0 obj)
)
(format #t "~T~Tjanim: ~A~%" (-> obj janim))
obj
)
@@ -34,34 +32,27 @@
(defstate viewer-process (viewer)
:code
(behavior ()
(while #t
(let ((a0-0 (-> self skel root-channel 0)))
(set! (-> a0-0 frame-group) (-> self janim))
(set! (-> a0-0 param 0) (the float (+ (-> self janim data 0 length) -1)))
(set! (-> a0-0 param 1) 1.0)
(set! (-> a0-0 frame-num) 0.0)
(joint-control-channel-group! a0-0 (-> self janim) num-func-seek!)
)
(until (ja-done? 0)
(TODO-RENAME-9 (-> self align))
(TODO-RENAME-10 (-> self align) 31 1.0 1.0 1.0)
(suspend)
(let ((a0-3 (-> self skel root-channel 0)))
(set!
(-> a0-3 param 0)
(the float (+ (-> a0-3 frame-group data 0 length) -1))
)
(set! (-> a0-3 param 1) 1.0)
(joint-control-channel-group-eval!
a0-3
(the-as art-joint-anim #f)
num-func-seek!
)
(while #t
(let ((a0-0 (-> self skel root-channel 0)))
(set! (-> a0-0 frame-group) (-> self janim))
(set! (-> a0-0 param 0) (the float (+ (-> self janim data 0 length) -1)))
(set! (-> a0-0 param 1) 1.0)
(set! (-> a0-0 frame-num) 0.0)
(joint-control-channel-group! a0-0 (-> self janim) num-func-seek!)
)
(until (ja-done? 0)
(TODO-RENAME-9 (-> self align))
(TODO-RENAME-10 (-> self align) 31 1.0 1.0 1.0)
(suspend)
(let ((a0-3 (-> self skel root-channel 0)))
(set! (-> a0-3 param 0) (the float (+ (-> a0-3 frame-group data 0 length) -1)))
(set! (-> a0-3 param 1) 1.0)
(joint-control-channel-group-eval! a0-3 (the-as art-joint-anim #f) num-func-seek!)
)
)
)
)
(none)
)
(none)
)
:post
(the-as (function none :behavior viewer) ja-post)
)
@@ -80,124 +71,119 @@
(let ((s5-0 (-> arg2 data))
(gp-0 (-> arg0 data))
)
(set! (-> gp-0 0) (the-as uint 0))
(dotimes (s2-0 (- (length arg2) (+ (length arg1) 2)))
(when (= (-> s5-0 0) 45)
(let ((s1-0 #f))
(dotimes (s0-0 (length arg1))
(if (!= (-> s5-0 (+ s0-0 1)) (-> arg1 data s0-0))
(goto cfg-10)
(set! (-> gp-0 0) (the-as uint 0))
(dotimes (s2-0 (- (length arg2) (+ (length arg1) 2)))
(when (= (-> s5-0 0) 45)
(let ((s1-0 #f))
(dotimes (s0-0 (length arg1))
(if (!= (-> s5-0 (+ s0-0 1)) (-> arg1 data s0-0))
(goto cfg-10)
)
)
(if (= (-> s5-0 (+ (length arg1) 1)) 45)
(set! s1-0 #t)
)
(label cfg-10)
(when s1-0
(let ((v1-22 (&+ s5-0 (+ (length arg1) 2))))
(while (and (!= (-> v1-22 0) 45) (nonzero? (-> v1-22 0)))
(set! (-> gp-0 0) (-> v1-22 0))
(set! v1-22 (&-> v1-22 1))
(set! gp-0 (&-> gp-0 1))
)
)
(set! (-> gp-0 0) (the-as uint 0))
(return #t)
)
)
)
)
(if (= (-> s5-0 (+ (length arg1) 1)) 45)
(set! s1-0 #t)
)
(label cfg-10)
(when s1-0
(let ((v1-22 (&+ s5-0 (+ (length arg1) 2))))
(while (and (!= (-> v1-22 0) 45) (nonzero? (-> v1-22 0)))
(set! (-> gp-0 0) (-> v1-22 0))
(set! v1-22 (&-> v1-22 1))
(set! gp-0 (&-> gp-0 1))
)
)
(set! (-> gp-0 0) (the-as uint 0))
(return #t)
)
(set! s5-0 (&-> s5-0 1))
)
)
(set! s5-0 (&-> s5-0 1))
)
)
#f
)
;; definition for function art-part-name
(defun art-part-name ((arg0 string))
(let ((gp-0 (-> arg0 data)))
(while (nonzero? (-> gp-0 0))
(when (= (-> gp-0 0) 45)
(copyn-string<-charp
viewer-string
(&-> gp-0 1)
(-
(length arg0)
(the-as int (+ (- -1 (the-as int (-> arg0 data))) (the-as int gp-0)))
)
(while (nonzero? (-> gp-0 0))
(when (= (-> gp-0 0) 45)
(copyn-string<-charp
viewer-string
(&-> gp-0 1)
(- (length arg0) (the-as int (+ (- -1 (the-as int (-> arg0 data))) (the-as int gp-0))))
)
(return viewer-string)
)
(set! gp-0 (&-> gp-0 1))
)
(return viewer-string)
)
(set! gp-0 (&-> gp-0 1))
)
)
(clear viewer-string)
)
;; definition for function init-viewer
(defbehavior init-viewer viewer ((arg0 string))
(let ((s2-0 (load-to-heap-by-name (-> (if (-> self entity)
(-> self entity extra level)
(-> *level* level-default)
)
art-group
)
arg0 #f global 0
)
)
(let ((s2-0 (load-to-heap-by-name
(-> (if (-> self entity)
(-> self entity extra level)
(-> *level* level-default)
)
art-group
)
arg0
#f
global
0
)
)
(s5-0 (the-as int #f))
(s4-0 (the-as int #f))
(s3-0 (the-as int #f))
)
(when s2-0
(dotimes (s1-0 (-> s2-0 length))
(cond
((and
(not s4-0)
(= (-> s2-0 data s1-0 type) merc-ctrl)
(or
(zero? (length viewer-geo-name))
(string= (art-part-name (-> s2-0 data s1-0 name)) viewer-geo-name)
)
(when s2-0
(dotimes (s1-0 (-> s2-0 length))
(cond
((and
(not s4-0)
(= (-> s2-0 data s1-0 type) merc-ctrl)
(or (zero? (length viewer-geo-name)) (string= (art-part-name (-> s2-0 data s1-0 name)) viewer-geo-name))
)
(set! s4-0 s1-0)
)
((= (-> s2-0 data s1-0 type) art-joint-geo)
(set! s3-0 s1-0)
)
((and
(= (-> s2-0 data s1-0 type) art-joint-anim)
(or (zero? (length viewer-ja-name)) (string= (art-part-name (-> s2-0 data s1-0 name)) viewer-ja-name))
)
(set! s5-0 s1-0)
)
)
(if (and s4-0 s3-0 s5-0)
(goto cfg-34)
)
)
(set! s4-0 s1-0)
)
((= (-> s2-0 data s1-0 type) art-joint-geo)
(set! s3-0 s1-0)
)
((and
(= (-> s2-0 data s1-0 type) art-joint-anim)
(or
(zero? (length viewer-ja-name))
(string= (art-part-name (-> s2-0 data s1-0 name)) viewer-ja-name)
)
(label cfg-34)
(cond
((and s4-0 s3-0 s5-0)
(set! (-> self janim) (the-as art-joint-anim (-> s2-0 data s5-0)))
(let ((a1-3 *viewer-sg*))
(set! (-> a1-3 art-group-name) arg0)
(set! (-> a1-3 jgeo) s3-0)
(set! (-> a1-3 janim) s5-0)
(set! (-> a1-3 mgeo 0) s4-0)
(initialize-skeleton self a1-3 '())
)
)
(set! s5-0 s1-0)
(set! (-> self align) (new 'process 'align-control self))
(go viewer-process)
)
(else
(go process-drawable-art-error arg0)
)
)
(if (and s4-0 s3-0 s5-0)
(goto cfg-34)
)
)
)
(label cfg-34)
(cond
((and s4-0 s3-0 s5-0)
(set! (-> self janim) (the-as art-joint-anim (-> s2-0 data s5-0)))
(let ((a1-3 *viewer-sg*))
(set! (-> a1-3 art-group-name) arg0)
(set! (-> a1-3 jgeo) s3-0)
(set! (-> a1-3 janim) s5-0)
(set! (-> a1-3 mgeo 0) s4-0)
(initialize-skeleton self a1-3 '())
)
(set! (-> self align) (new 'process 'align-control self))
(go viewer-process)
)
(else
(go process-drawable-art-error arg0)
)
)
)
)
;; definition for method 11 of type viewer
@@ -209,11 +195,11 @@
(actor-get-arg! viewer-ja-name "ja" (res-lump-struct arg0 'name string))
(actor-get-arg! viewer-geo-name "geo" (res-lump-struct arg0 'name string))
(let ((gp-1 (-> arg0 etype)))
(if (valid? gp-1 type #f #f 0)
(init-viewer (symbol->string (-> gp-1 symbol)))
(go process-drawable-art-error "unknown")
(if (valid? gp-1 type #f #f 0)
(init-viewer (symbol->string (-> gp-1 symbol)))
(go process-drawable-art-error "unknown")
)
)
)
(none)
)
@@ -237,27 +223,22 @@
(defun add-a-bunch ((arg0 string) (arg1 int) (arg2 int) (arg3 float))
(local-vars (sv-32 process))
(dotimes (s2-0 arg1)
(dotimes (s1-0 arg2)
(let ((s0-0 (new-stack-vector0)))
(position-in-front-of-camera! s0-0 40960.0 4096.0)
(+! (-> s0-0 x) (the float (* (- s2-0 (/ arg1 2)) (the int arg3))))
(+! (-> s0-0 z) (the float (* (- s1-0 (/ arg2 2)) (the int arg3))))
(set! sv-32 (get-process *default-dead-pool* viewer #x4000))
(when sv-32
(let ((t9-2 (method-of-type viewer activate)))
(t9-2
(the-as viewer sv-32)
*entity-pool*
'viewer
(the-as pointer #x70004000)
(dotimes (s1-0 arg2)
(let ((s0-0 (new-stack-vector0)))
(position-in-front-of-camera! s0-0 40960.0 4096.0)
(+! (-> s0-0 x) (the float (* (- s2-0 (/ arg1 2)) (the int arg3))))
(+! (-> s0-0 z) (the float (* (- s1-0 (/ arg2 2)) (the int arg3))))
(set! sv-32 (get-process *default-dead-pool* viewer #x4000))
(when sv-32
(let ((t9-2 (method-of-type viewer activate)))
(t9-2 (the-as viewer sv-32) *entity-pool* 'viewer (the-as pointer #x70004000))
)
(run-now-in-process sv-32 init-viewer-for-other arg0 s0-0)
(-> sv-32 ppointer)
)
)
)
(run-now-in-process sv-32 init-viewer-for-other arg0 s0-0)
(-> sv-32 ppointer)
)
)
)
)
#f
)
@@ -266,8 +247,8 @@
(defun birth-viewer ((arg0 process) (arg1 entity))
(set! (-> arg0 type) viewer)
(let ((t9-0 init-entity))
viewer
(t9-0 arg0 arg1)
)
viewer
(t9-0 arg0 arg1)
)
(the-as object #t)
)
+19 -32
View File
@@ -5,51 +5,38 @@
;; INFO: Return type mismatch pointer vs (inline-array dma-bucket).
(defun dma-buffer-add-buckets ((dma-buf dma-buffer) (count int))
(let ((v0-0 (-> dma-buf base)))
(let ((current-bucket (the-as dma-bucket v0-0)))
(dotimes (i count)
(set!
(-> current-bucket tag)
(new 'static 'dma-tag
:id (dma-tag-id next)
:addr (the-as int (&+ (the-as pointer current-bucket) 16))
)
(let ((current-bucket (the-as dma-bucket v0-0)))
(dotimes (i count)
(set! (-> current-bucket tag)
(new 'static 'dma-tag :id (dma-tag-id next) :addr (the-as int (&+ (the-as pointer current-bucket) 16)))
)
(set! (-> current-bucket last) (the-as (pointer dma-tag) current-bucket))
(set! current-bucket (the-as dma-bucket (&+ (the-as pointer current-bucket) 16)))
)
(set! (-> dma-buf base) (the-as pointer current-bucket))
)
(set! (-> current-bucket last) (the-as (pointer dma-tag) current-bucket))
(set!
current-bucket
(the-as dma-bucket (&+ (the-as pointer current-bucket) 16))
)
)
(set! (-> dma-buf base) (the-as pointer current-bucket))
(the-as (inline-array dma-bucket) v0-0)
)
(the-as (inline-array dma-bucket) v0-0)
)
)
;; definition for function dma-buffer-patch-buckets
(defun dma-buffer-patch-buckets ((bucket (inline-array dma-bucket)) (count int))
(when (nonzero? bucket)
(dotimes (i count)
(set! (-> bucket 0 last 0 addr) (the-as int (the-as pointer (-> bucket 1))))
(set! (-> bucket 0 last) (the-as (pointer dma-tag) 0))
(set! bucket (the-as (inline-array dma-bucket) (-> bucket 1)))
(dotimes (i count)
(set! (-> bucket 0 last 0 addr) (the-as int (the-as pointer (-> bucket 1))))
(set! (-> bucket 0 last) (the-as (pointer dma-tag) 0))
(set! bucket (the-as (inline-array dma-bucket) (-> bucket 1)))
)
)
)
bucket
)
;; definition for function dma-bucket-insert-tag
(defun
dma-bucket-insert-tag
((base (inline-array dma-bucket))
(idx bucket-id)
(tag-start pointer)
(tag-end (pointer dma-tag))
)
(defun dma-bucket-insert-tag ((base (inline-array dma-bucket)) (idx bucket-id) (tag-start pointer) (tag-end (pointer dma-tag)))
(let ((bucket (-> base idx)))
(set! (-> (the-as dma-bucket (-> bucket last)) next) (the-as uint tag-start))
(set! (-> bucket last) tag-end)
)
(set! (-> (the-as dma-bucket (-> bucket last)) next) (the-as uint tag-start))
(set! (-> bucket last) tag-end)
)
tag-start
)
+25 -56
View File
@@ -94,15 +94,11 @@
;; definition for method 0 of type dma-buffer
(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)))
)
(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
)
(set! (-> v0-0 base) (-> v0-0 data))
(set! (-> v0-0 allocated-length) arg0)
v0-0
)
)
;; definition for function dma-buffer-inplace-new
@@ -133,73 +129,46 @@
)
;; definition for function dma-buffer-add-vu-function
(defun
dma-buffer-add-vu-function
((dma-buf dma-buffer) (vu-func vu-function) (arg2 int))
(defun dma-buffer-add-vu-function ((dma-buf dma-buffer) (vu-func vu-function) (arg2 int))
(let ((func-ptr (&-> vu-func data 4))
(qlen (-> vu-func qlength))
(origin (-> vu-func origin))
)
(while (> qlen 0)
(let ((qwc-now (min 127 qlen)))
(let* ((dma-buf-2 dma-buf)
(buf-ptr (the-as dma-packet (-> dma-buf-2 base)))
)
(set!
(-> buf-ptr dma)
(new 'static 'dma-tag
:id (dma-tag-id ref)
:addr (the-as int func-ptr)
:qwc qwc-now
(while (> qlen 0)
(let ((qwc-now (min 127 qlen)))
(let* ((dma-buf-2 dma-buf)
(buf-ptr (the-as dma-packet (-> dma-buf-2 base)))
)
(set! (-> buf-ptr dma) (new 'static 'dma-tag :id (dma-tag-id ref) :addr (the-as int func-ptr) :qwc qwc-now))
(set! (-> buf-ptr vif0) (new 'static 'vif-tag :cmd (if (zero? arg2) 16 19)))
(set! (-> buf-ptr vif1) (new 'static 'vif-tag :cmd (vif-cmd mpg) :num (* qwc-now 2) :imm origin))
(set! (-> dma-buf-2 base) (&+ (the-as pointer buf-ptr) 16))
)
(&+! func-ptr (* qwc-now 16))
(set! qlen (- qlen qwc-now))
(+! origin (* qwc-now 2))
)
)
(set!
(-> buf-ptr vif0)
(new 'static 'vif-tag :cmd (if (zero? arg2) 16 19))
)
(set!
(-> buf-ptr vif1)
(new 'static 'vif-tag :cmd (vif-cmd mpg) :num (* qwc-now 2) :imm origin)
)
(set! (-> dma-buf-2 base) (&+ (the-as pointer buf-ptr) 16))
)
(&+! func-ptr (* qwc-now 16))
(set! qlen (- qlen qwc-now))
(+! origin (* qwc-now 2))
)
)
)
#f
)
;; definition for function dma-buffer-send
(defun dma-buffer-send ((arg0 dma-bank) (arg1 dma-buffer))
(when
(<
(-> arg1 allocated-length)
(&- (-> arg1 base) (the-as uint (-> arg1 data)))
(when (< (-> arg1 allocated-length) (&- (-> arg1 base) (the-as uint (-> arg1 data))))
(crash!)
0
)
(crash!)
0
)
(dma-send
arg0
(the-as uint (-> arg1 data))
(the-as uint (dma-buffer-length arg1))
)
(dma-send arg0 (the-as uint (-> arg1 data)) (the-as uint (dma-buffer-length arg1)))
(none)
)
;; definition for function dma-buffer-send-chain
(defun dma-buffer-send-chain ((arg0 dma-bank-source) (arg1 dma-buffer))
(when
(<
(-> arg1 allocated-length)
(&- (-> arg1 base) (the-as uint (-> arg1 data)))
(when (< (-> arg1 allocated-length) (&- (-> arg1 base) (the-as uint (-> arg1 data))))
(crash!)
0
)
(crash!)
0
)
(dma-send-chain arg0 (the-as uint (-> arg1 data)))
(none)
)
+621 -751
View File
File diff suppressed because it is too large Load Diff
+152 -170
View File
@@ -8,18 +8,18 @@
;; INFO: Return type mismatch int vs none.
(defun dma-sync-crash ((arg0 dma-bank))
(let ((v1-0 #x4c4b40))
(while (nonzero? (-> arg0 chcr str))
(cond
((zero? v1-0)
(crash!)
0
(while (nonzero? (-> arg0 chcr str))
(cond
((zero? v1-0)
(crash!)
0
)
(else
(+! v1-0 -1)
)
)
)
(else
(+! v1-0 -1)
)
)
)
)
0
(none)
)
@@ -33,14 +33,12 @@
(dma-sync (the-as pointer arg0) 0 0)
(flush-cache 0)
(.sync.l)
(set!
(-> arg0 madr)
(logior (logand #xfffffff arg1) (if (= (logand #x70000000 arg1) #x70000000)
(shl #x8000 16)
0
)
)
)
(set! (-> arg0 madr) (logior (logand #xfffffff arg1) (if (= (logand #x70000000 arg1) #x70000000)
(shl #x8000 16)
0
)
)
)
(set! (-> arg0 qwc) arg2)
(.sync.l)
(set! (-> arg0 chcr) (new 'static 'dma-chcr :str #x1))
@@ -59,19 +57,14 @@
(flush-cache 0)
(.sync.l)
(set! (-> arg0 qwc) (the-as uint 0))
(set!
(-> arg0 tadr)
(logior (logand #xfffffff arg1) (if (= (logand #x70000000 arg1) #x70000000)
(shl #x8000 16)
0
)
)
)
(set! (-> arg0 tadr) (logior (logand #xfffffff arg1) (if (= (logand #x70000000 arg1) #x70000000)
(shl #x8000 16)
0
)
)
)
(.sync.l)
(set!
(-> arg0 chcr)
(new 'static 'dma-chcr :dir #x1 :mod #x1 :tte #x1 :str #x1)
)
(set! (-> arg0 chcr) (new 'static 'dma-chcr :dir #x1 :mod #x1 :tte #x1 :str #x1))
(.sync.l)
0
(none)
@@ -87,14 +80,12 @@
(flush-cache 0)
(.sync.l)
(set! (-> arg0 qwc) (the-as uint 0))
(set!
(-> arg0 tadr)
(logior (logand #xfffffff arg1) (if (= (logand #x70000000 arg1) #x70000000)
(shl #x8000 16)
0
)
)
)
(set! (-> arg0 tadr) (logior (logand #xfffffff arg1) (if (= (logand #x70000000 arg1) #x70000000)
(shl #x8000 16)
0
)
)
)
(.sync.l)
(set! (-> arg0 chcr) (new 'static 'dma-chcr :dir #x1 :mod #x1 :str #x1))
(.sync.l)
@@ -111,19 +102,14 @@
(dma-sync (the-as pointer arg0) 0 0)
(.sync.l)
(set! (-> arg0 qwc) (the-as uint 0))
(set!
(-> arg0 tadr)
(logior (logand #xfffffff arg1) (if (= (logand #x70000000 arg1) #x70000000)
(shl #x8000 16)
0
)
)
)
(set! (-> arg0 tadr) (logior (logand #xfffffff arg1) (if (= (logand #x70000000 arg1) #x70000000)
(shl #x8000 16)
0
)
)
)
(.sync.l)
(set!
(-> arg0 chcr)
(new 'static 'dma-chcr :dir #x1 :mod #x1 :tte #x1 :str #x1)
)
(set! (-> arg0 chcr) (new 'static 'dma-chcr :dir #x1 :mod #x1 :tte #x1 :str #x1))
(.sync.l)
0
(none)
@@ -136,19 +122,19 @@
;; WARN: Unsupported inline assembly instruction kind - [sync.l]
(defun dma-send-to-spr ((sadr uint) (madr uint) (qwc uint) (sync symbol))
(let ((s5-0 (the-as dma-bank-spr #x1000d400)))
(dma-sync (the-as pointer s5-0) 0 0)
(flush-cache 0)
(.sync.l)
(set! (-> s5-0 madr) (logand #xfffffff madr))
(set! (-> s5-0 sadr) (logand #xfffffff sadr))
(set! (-> s5-0 qwc) qwc)
(.sync.l)
(set! (-> s5-0 chcr) (new 'static 'dma-chcr :str #x1))
(.sync.l)
(if sync
(dma-sync (the-as pointer s5-0) 0 0)
(flush-cache 0)
(.sync.l)
(set! (-> s5-0 madr) (logand #xfffffff madr))
(set! (-> s5-0 sadr) (logand #xfffffff sadr))
(set! (-> s5-0 qwc) qwc)
(.sync.l)
(set! (-> s5-0 chcr) (new 'static 'dma-chcr :str #x1))
(.sync.l)
(if sync
(dma-sync (the-as pointer s5-0) 0 0)
)
)
)
0
(none)
)
@@ -158,22 +144,20 @@
;; WARN: Unsupported inline assembly instruction kind - [sync.l]
;; WARN: Unsupported inline assembly instruction kind - [sync.l]
;; WARN: Unsupported inline assembly instruction kind - [sync.l]
(defun
dma-send-to-spr-no-flush
((sadr uint) (madr uint) (qwc uint) (sync symbol))
(defun dma-send-to-spr-no-flush ((sadr uint) (madr uint) (qwc uint) (sync symbol))
(let ((s5-0 (the-as dma-bank-spr #x1000d400)))
(dma-sync (the-as pointer s5-0) 0 0)
(.sync.l)
(set! (-> s5-0 madr) (logand #xfffffff madr))
(set! (-> s5-0 sadr) (logand #xfffffff sadr))
(set! (-> s5-0 qwc) qwc)
(.sync.l)
(set! (-> s5-0 chcr) (new 'static 'dma-chcr :str #x1))
(.sync.l)
(if sync
(dma-sync (the-as pointer s5-0) 0 0)
(.sync.l)
(set! (-> s5-0 madr) (logand #xfffffff madr))
(set! (-> s5-0 sadr) (logand #xfffffff sadr))
(set! (-> s5-0 qwc) qwc)
(.sync.l)
(set! (-> s5-0 chcr) (new 'static 'dma-chcr :str #x1))
(.sync.l)
(if sync
(dma-sync (the-as pointer s5-0) 0 0)
)
)
)
0
(none)
)
@@ -185,19 +169,19 @@
;; WARN: Unsupported inline assembly instruction kind - [sync.l]
(defun dma-send-from-spr ((madr uint) (sadr uint) (qwc uint) (sync symbol))
(let ((s5-0 (the-as dma-bank-spr #x1000d000)))
(dma-sync (the-as pointer s5-0) 0 0)
(flush-cache 0)
(.sync.l)
(set! (-> s5-0 madr) (logand #xfffffff madr))
(set! (-> s5-0 sadr) (logand #xfffffff sadr))
(set! (-> s5-0 qwc) qwc)
(.sync.l)
(set! (-> s5-0 chcr) (new 'static 'dma-chcr :str #x1))
(.sync.l)
(if sync
(dma-sync (the-as pointer s5-0) 0 0)
(flush-cache 0)
(.sync.l)
(set! (-> s5-0 madr) (logand #xfffffff madr))
(set! (-> s5-0 sadr) (logand #xfffffff sadr))
(set! (-> s5-0 qwc) qwc)
(.sync.l)
(set! (-> s5-0 chcr) (new 'static 'dma-chcr :str #x1))
(.sync.l)
(if sync
(dma-sync (the-as pointer s5-0) 0 0)
)
)
)
0
(none)
)
@@ -207,22 +191,20 @@
;; WARN: Unsupported inline assembly instruction kind - [sync.l]
;; WARN: Unsupported inline assembly instruction kind - [sync.l]
;; WARN: Unsupported inline assembly instruction kind - [sync.l]
(defun
dma-send-from-spr-no-flush
((madr uint) (sadr uint) (qwc uint) (sync symbol))
(defun dma-send-from-spr-no-flush ((madr uint) (sadr uint) (qwc uint) (sync symbol))
(let ((s5-0 (the-as dma-bank-spr #x1000d000)))
(dma-sync (the-as pointer s5-0) 0 0)
(.sync.l)
(set! (-> s5-0 madr) (logand #xfffffff madr))
(set! (-> s5-0 sadr) (logand #xfffffff sadr))
(set! (-> s5-0 qwc) qwc)
(.sync.l)
(set! (-> s5-0 chcr) (new 'static 'dma-chcr :str #x1))
(.sync.l)
(if sync
(dma-sync (the-as pointer s5-0) 0 0)
(.sync.l)
(set! (-> s5-0 madr) (logand #xfffffff madr))
(set! (-> s5-0 sadr) (logand #xfffffff sadr))
(set! (-> s5-0 qwc) qwc)
(.sync.l)
(set! (-> s5-0 chcr) (new 'static 'dma-chcr :str #x1))
(.sync.l)
(if sync
(dma-sync (the-as pointer s5-0) 0 0)
)
)
)
0
(none)
)
@@ -240,10 +222,10 @@
;; INFO: Return type mismatch int vs none.
(defun clear-vu0-mem ()
(let ((v1-0 (the-as (pointer uint32) #x11004000)))
(dotimes (a0-0 1024)
(set! (-> v1-0 a0-0) (the-as uint #xabadbeef))
(dotimes (a0-0 1024)
(set! (-> v1-0 a0-0) (the-as uint #xabadbeef))
)
)
)
0
(none)
)
@@ -252,10 +234,10 @@
;; INFO: Return type mismatch int vs none.
(defun clear-vu1-mem ()
(let ((v1-0 (the-as (pointer uint32) #x1100c000)))
(dotimes (a0-0 4096)
(set! (-> v1-0 a0-0) (the-as uint #xabadbeef))
(dotimes (a0-0 4096)
(set! (-> v1-0 a0-0) (the-as uint #xabadbeef))
)
)
)
0
(none)
)
@@ -264,54 +246,54 @@
;; INFO: Return type mismatch symbol vs none.
(defun dump-vu1-mem ()
(let ((gp-0 (the-as (pointer uint32) #x1100c000)))
(dotimes (s5-0 1024)
(format
0
"~4,'0X: ~8,'0X ~8,'0X ~8,'0X ~8,'0X"
s5-0
(-> gp-0 (* s5-0 4))
(-> gp-0 (+ (* s5-0 4) 1))
(-> gp-0 (+ (* s5-0 4) 2))
(-> gp-0 (+ (* s5-0 4) 3))
)
(format
0
" ~F ~F ~F ~F ~%"
(-> gp-0 (* s5-0 4))
(-> gp-0 (+ (* s5-0 4) 1))
(-> gp-0 (+ (* s5-0 4) 2))
(-> gp-0 (+ (* s5-0 4) 3))
)
(dotimes (s5-0 1024)
(format
0
"~4,'0X: ~8,'0X ~8,'0X ~8,'0X ~8,'0X"
s5-0
(-> gp-0 (* s5-0 4))
(-> gp-0 (+ (* s5-0 4) 1))
(-> gp-0 (+ (* s5-0 4) 2))
(-> gp-0 (+ (* s5-0 4) 3))
)
(format
0
" ~F ~F ~F ~F ~%"
(-> gp-0 (* s5-0 4))
(-> gp-0 (+ (* s5-0 4) 1))
(-> gp-0 (+ (* s5-0 4) 2))
(-> gp-0 (+ (* s5-0 4) 3))
)
)
)
)
(none)
)
;; definition for function dump-vu1-range
(defun dump-vu1-range ((start uint) (total-count uint))
(let ((s4-0 (the-as (pointer uint32) #x1100c000)))
(dotimes (s3-0 (the-as int total-count))
(let ((s2-0 (+ s3-0 start)))
(format
0
"~4,'0X: ~8x ~8x ~8x ~8x"
s2-0
(-> s4-0 (* s2-0 4))
(-> s4-0 (+ (* s2-0 4) 1))
(-> s4-0 (+ (* s2-0 4) 2))
(-> s4-0 (+ (* s2-0 4) 3))
(dotimes (s3-0 (the-as int total-count))
(let ((s2-0 (+ s3-0 start)))
(format
0
"~4,'0X: ~8x ~8x ~8x ~8x"
s2-0
(-> s4-0 (* s2-0 4))
(-> s4-0 (+ (* s2-0 4) 1))
(-> s4-0 (+ (* s2-0 4) 2))
(-> s4-0 (+ (* s2-0 4) 3))
)
(format
0
" ~F ~F ~F ~F ~%"
(-> s4-0 (* s2-0 4))
(-> s4-0 (+ (* s2-0 4) 1))
(-> s4-0 (+ (* s2-0 4) 2))
(-> s4-0 (+ (* s2-0 4) 3))
)
)
)
(format
0
" ~F ~F ~F ~F ~%"
(-> s4-0 (* s2-0 4))
(-> s4-0 (+ (* s2-0 4) 1))
(-> s4-0 (+ (* s2-0 4) 2))
(-> s4-0 (+ (* s2-0 4) 3))
)
)
)
)
#f
)
@@ -342,35 +324,35 @@
(spr-from-bank (the-as dma-bank-spr #x1000d000))
(qwc-remaining (shr size-bytes 4))
)
(flush-cache 0)
(dma-sync (the-as pointer spr-to-bank) 0 0)
(dma-sync (the-as pointer spr-from-bank) 0 0)
(while (> qwc-remaining 0)
(let ((qwc-transferred-now (the-as int qwc-remaining)))
(if (< (the-as uint 1024) (the-as uint qwc-transferred-now))
(set! qwc-transferred-now 1024)
(flush-cache 0)
(dma-sync (the-as pointer spr-to-bank) 0 0)
(dma-sync (the-as pointer spr-from-bank) 0 0)
(while (> qwc-remaining 0)
(let ((qwc-transferred-now (the-as int qwc-remaining)))
(if (< (the-as uint 1024) (the-as uint qwc-transferred-now))
(set! qwc-transferred-now 1024)
)
(set! qwc-remaining (- qwc-remaining (the-as uint qwc-transferred-now)))
(.sync.l)
(set! (-> spr-to-bank madr) (the-as uint src))
(set! (-> spr-to-bank sadr) (the-as uint 0))
(set! (-> spr-to-bank qwc) (the-as uint qwc-transferred-now))
(.sync.l)
(set! (-> spr-to-bank chcr) (new 'static 'dma-chcr :str #x1))
(.sync.l)
(dma-sync (the-as pointer spr-to-bank) 0 0)
(&+! src (* qwc-transferred-now 16))
(set! (-> spr-from-bank madr) (the-as uint dst))
(set! (-> spr-from-bank sadr) (the-as uint 0))
(set! (-> spr-from-bank qwc) (the-as uint qwc-transferred-now))
(.sync.l)
(set! (-> spr-from-bank chcr) (new 'static 'dma-chcr :str #x1))
(.sync.l)
(dma-sync (the-as pointer spr-from-bank) 0 0)
(&+! dst (* qwc-transferred-now 16))
)
)
(set! qwc-remaining (- qwc-remaining (the-as uint qwc-transferred-now)))
(.sync.l)
(set! (-> spr-to-bank madr) (the-as uint src))
(set! (-> spr-to-bank sadr) (the-as uint 0))
(set! (-> spr-to-bank qwc) (the-as uint qwc-transferred-now))
(.sync.l)
(set! (-> spr-to-bank chcr) (new 'static 'dma-chcr :str #x1))
(.sync.l)
(dma-sync (the-as pointer spr-to-bank) 0 0)
(&+! src (* qwc-transferred-now 16))
(set! (-> spr-from-bank madr) (the-as uint dst))
(set! (-> spr-from-bank sadr) (the-as uint 0))
(set! (-> spr-from-bank qwc) (the-as uint qwc-transferred-now))
(.sync.l)
(set! (-> spr-from-bank chcr) (new 'static 'dma-chcr :str #x1))
(.sync.l)
(dma-sync (the-as pointer spr-from-bank) 0 0)
(&+! dst (* qwc-transferred-now 16))
)
)
)
0
(none)
)
+30 -66
View File
@@ -3,32 +3,26 @@
;; definition for method 11 of type draw-node
;; INFO: Return type mismatch int vs none.
(defmethod
collide-with-box
draw-node
((obj draw-node) (arg0 int) (arg1 collide-list))
(defmethod collide-with-box draw-node ((obj draw-node) (arg0 int) (arg1 collide-list))
(dotimes (s3-0 arg0)
(if (collide-cache-using-box-test (-> obj bsphere))
(collide-with-box (-> obj child) (the-as int (-> obj child-count)) arg1)
(if (collide-cache-using-box-test (-> obj bsphere))
(collide-with-box (-> obj child) (the-as int (-> obj child-count)) arg1)
)
(&+! obj 32)
)
(&+! obj 32)
)
0
(none)
)
;; definition for method 12 of type draw-node
;; INFO: Return type mismatch int vs none.
(defmethod
collide-y-probe
draw-node
((obj draw-node) (arg0 int) (arg1 collide-list))
(defmethod collide-y-probe draw-node ((obj draw-node) (arg0 int) (arg1 collide-list))
(dotimes (s3-0 arg0)
(if (collide-cache-using-y-probe-test (-> obj bsphere))
(collide-y-probe (-> obj child) (the-as int (-> obj child-count)) arg1)
(if (collide-cache-using-y-probe-test (-> obj bsphere))
(collide-y-probe (-> obj child) (the-as int (-> obj child-count)) arg1)
)
(&+! obj 32)
)
(&+! obj 32)
)
0
(none)
)
@@ -37,32 +31,24 @@
;; INFO: Return type mismatch int vs none.
(defmethod collide-ray draw-node ((obj draw-node) (arg0 int) (arg1 collide-list))
(dotimes (s3-0 arg0)
(if (collide-cache-using-line-sphere-test (-> obj bsphere))
(collide-ray (-> obj child) (the-as int (-> obj child-count)) arg1)
(if (collide-cache-using-line-sphere-test (-> obj bsphere))
(collide-ray (-> obj child) (the-as int (-> obj child-count)) arg1)
)
(&+! obj 32)
)
(&+! obj 32)
)
0
(none)
)
;; definition for method 17 of type draw-node
;; INFO: Return type mismatch int vs none.
(defmethod
collect-ambients
draw-node
((obj draw-node) (arg0 sphere) (arg1 int) (arg2 ambient-list))
(defmethod collect-ambients draw-node ((obj draw-node) (arg0 sphere) (arg1 int) (arg2 ambient-list))
(dotimes (s2-0 arg1)
(if (spheres-overlap? arg0 (the-as sphere (-> obj bsphere)))
(collect-ambients
(-> obj child)
arg0
(the-as int (-> obj child-count))
arg2
)
(if (spheres-overlap? arg0 (the-as sphere (-> obj bsphere)))
(collect-ambients (-> obj child) arg0 (the-as int (-> obj child-count)) arg2)
)
(&+! obj 32)
)
(&+! obj 32)
)
0
(none)
)
@@ -73,41 +59,32 @@
(format #t "~Tlength: ~D~%" (-> obj length))
(format #t "~Tdata[~D]: @ #x~X~%" (-> obj length) (-> obj data))
(dotimes (s5-0 (-> obj length))
(format #t "~T [~D] ~A~%" s5-0 (-> obj data s5-0))
)
(format #t "~T [~D] ~A~%" s5-0 (-> obj data s5-0))
)
obj
)
;; definition for method 8 of type drawable-inline-array-node
(defmethod
mem-usage
drawable-inline-array-node
((obj drawable-inline-array-node) (arg0 memory-usage-block) (arg1 int))
(defmethod mem-usage drawable-inline-array-node ((obj drawable-inline-array-node) (arg0 memory-usage-block) (arg1 int))
(set! (-> arg0 length) (max 62 (-> arg0 length)))
(set! (-> arg0 data 61 name) "draw-node")
(+! (-> arg0 data 61 count) (-> obj length))
(let ((v1-6 (asize-of obj)))
(+! (-> arg0 data 61 used) v1-6)
(+! (-> arg0 data 61 total) (logand -16 (+ v1-6 15)))
)
(+! (-> arg0 data 61 used) v1-6)
(+! (-> arg0 data 61 total) (logand -16 (+ v1-6 15)))
)
obj
)
;; definition for method 5 of type drawable-inline-array-node
;; INFO: Return type mismatch uint vs int.
(defmethod asize-of drawable-inline-array-node ((obj drawable-inline-array-node))
(the-as
int
(+ (-> drawable-inline-array-node size) (* (+ (-> obj length) -1) 32))
)
(the-as int (+ (-> drawable-inline-array-node size) (* (+ (-> obj length) -1) 32)))
)
;; definition for method 11 of type drawable-inline-array-node
;; INFO: Return type mismatch int vs none.
(defmethod
collide-with-box
drawable-inline-array-node
((obj drawable-inline-array-node) (arg0 int) (arg1 collide-list))
(defmethod collide-with-box drawable-inline-array-node ((obj drawable-inline-array-node) (arg0 int) (arg1 collide-list))
(collide-with-box (the-as drawable (-> obj data)) (-> obj length) arg1)
0
(none)
@@ -115,10 +92,7 @@
;; definition for method 12 of type drawable-inline-array-node
;; INFO: Return type mismatch int vs none.
(defmethod
collide-y-probe
drawable-inline-array-node
((obj drawable-inline-array-node) (arg0 int) (arg1 collide-list))
(defmethod collide-y-probe drawable-inline-array-node ((obj drawable-inline-array-node) (arg0 int) (arg1 collide-list))
(collide-y-probe (the-as drawable (-> obj data)) (-> obj length) arg1)
0
(none)
@@ -126,10 +100,7 @@
;; definition for method 13 of type drawable-inline-array-node
;; INFO: Return type mismatch int vs none.
(defmethod
collide-ray
drawable-inline-array-node
((obj drawable-inline-array-node) (arg0 int) (arg1 collide-list))
(defmethod collide-ray drawable-inline-array-node ((obj drawable-inline-array-node) (arg0 int) (arg1 collide-list))
(collide-ray (the-as drawable (-> obj data)) (-> obj length) arg1)
0
(none)
@@ -137,14 +108,7 @@
;; definition for method 17 of type drawable-inline-array-node
;; INFO: Return type mismatch int vs none.
(defmethod
collect-ambients
drawable-inline-array-node
((obj drawable-inline-array-node)
(arg0 sphere)
(arg1 int)
(arg2 ambient-list)
)
(defmethod collect-ambients drawable-inline-array-node ((obj drawable-inline-array-node) (arg0 sphere) (arg1 int) (arg2 ambient-list))
(collect-ambients (the-as drawable (-> obj data)) arg0 (-> obj length) arg2)
0
(none)
+1 -4
View File
@@ -39,10 +39,7 @@
;; definition for method 10 of type drawable-tree-actor
;; INFO: Return type mismatch int vs none.
(defmethod
draw
drawable-tree-actor
((obj drawable-tree-actor) (arg0 drawable) (arg1 display-frame))
(defmethod draw drawable-tree-actor ((obj drawable-tree-actor) (arg0 drawable) (arg1 display-frame))
0
(none)
)
+4 -10
View File
@@ -42,19 +42,13 @@
;; definition for method 10 of type drawable-tree-ambient
;; INFO: Return type mismatch int vs none.
(defmethod
draw
drawable-tree-ambient
((obj drawable-tree-ambient) (arg0 drawable) (arg1 display-frame))
(defmethod draw drawable-tree-ambient ((obj drawable-tree-ambient) (arg0 drawable) (arg1 display-frame))
0
(none)
)
;; definition for method 16 of type drawable-tree-ambient
(defmethod
dummy-16
drawable-tree-ambient
((obj drawable-tree-ambient) (arg0 object) (arg1 object))
(defmethod dummy-16 drawable-tree-ambient ((obj drawable-tree-ambient) (arg0 object) (arg1 object))
arg1
)
@@ -90,8 +84,8 @@
;; definition for method 3 of type level-hint
(defmethod inspect level-hint ((obj level-hint))
(let ((t9-0 (method-of-type process inspect)))
(t9-0 obj)
)
(t9-0 obj)
)
(format #t "~T~Ttext-id-to-display: ~D~%" (-> obj text-id-to-display))
(format #t "~T~Tsound-to-play: ~A~%" (-> obj sound-to-play))
(format #t "~T~Ttrans: #<vector @ #x~X>~%" (-> obj trans))
+35 -62
View File
@@ -2,22 +2,11 @@
(in-package goal)
;; definition for method 0 of type drawable-group
(defmethod
new
drawable-group
((allocation symbol) (type-to-make type) (arg0 int))
(let
((v0-0
(object-new
allocation
type-to-make
(the-as int (+ (-> type-to-make size) (* (+ arg0 -1) 4)))
)
)
(defmethod new drawable-group ((allocation symbol) (type-to-make type) (arg0 int))
(let ((v0-0 (object-new allocation type-to-make (the-as int (+ (-> type-to-make size) (* (+ arg0 -1) 4))))))
(set! (-> v0-0 length) arg0)
v0-0
)
(set! (-> v0-0 length) arg0)
v0-0
)
)
;; definition for method 3 of type drawable-group
@@ -27,8 +16,8 @@
(format #t "~Tlength: ~D~%" (-> obj length))
(format #t "~Tdata[~D]: @ #x~X~%" (-> obj length) (-> obj data))
(dotimes (s5-0 (-> obj length))
(format #t "~T [~D] ~A~%" s5-0 (-> obj data s5-0))
)
(format #t "~T [~D] ~A~%" s5-0 (-> obj data s5-0))
)
obj
)
@@ -36,8 +25,8 @@
(defmethod print drawable-group ((obj drawable-group))
(format #t "#<~A @ #x~X [~D]" (-> obj type) obj (-> obj length))
(dotimes (s5-0 (-> obj length))
(format #t " ~A" (-> obj data s5-0))
)
(format #t " ~A" (-> obj data s5-0))
)
(format #t ">")
obj
)
@@ -54,44 +43,38 @@
)
;; definition for method 8 of type drawable-group
(defmethod
mem-usage
drawable-group
((obj drawable-group) (arg0 memory-usage-block) (arg1 int))
(defmethod mem-usage drawable-group ((obj drawable-group) (arg0 memory-usage-block) (arg1 int))
(set! (-> arg0 length) (max 1 (-> arg0 length)))
(set! (-> arg0 data 0 name) "drawable-group")
(+! (-> arg0 data 0 count) 1)
(let ((v1-6 (asize-of obj)))
(+! (-> arg0 data 0 used) v1-6)
(+! (-> arg0 data 0 total) (logand -16 (+ v1-6 15)))
)
(+! (-> arg0 data 0 used) v1-6)
(+! (-> arg0 data 0 total) (logand -16 (+ v1-6 15)))
)
(dotimes (s3-0 (-> obj length))
(mem-usage (-> obj data s3-0) arg0 arg1)
)
(mem-usage (-> obj data s3-0) arg0 arg1)
)
obj
)
;; definition for method 9 of type drawable-group
(defmethod login drawable-group ((obj drawable-group))
(dotimes (s5-0 (-> obj length))
(login (-> obj data s5-0))
)
(login (-> obj data s5-0))
)
obj
)
;; definition for method 10 of type drawable-group
;; INFO: Return type mismatch int vs none.
(defmethod
draw
drawable-group
((obj drawable-group) (arg0 drawable) (arg1 display-frame))
(defmethod draw drawable-group ((obj drawable-group) (arg0 drawable) (arg1 display-frame))
(when (vis-cull (-> obj id))
(when (sphere-cull (-> obj bsphere))
(dotimes (s3-0 (-> obj length))
(draw (-> obj data s3-0) (-> (the-as drawable-group arg0) data s3-0) arg1)
)
(when (sphere-cull (-> obj bsphere))
(dotimes (s3-0 (-> obj length))
(draw (-> obj data s3-0) (-> (the-as drawable-group arg0) data s3-0) arg1)
)
)
)
)
0
(none)
)
@@ -100,44 +83,34 @@
;; INFO: Return type mismatch int vs none.
(defmethod collect-stats drawable-group ((obj drawable-group))
(when (vis-cull (-> obj id))
(when (sphere-cull (-> obj bsphere))
(dotimes (s5-0 (-> obj length))
(collect-stats (-> obj data s5-0))
)
(when (sphere-cull (-> obj bsphere))
(dotimes (s5-0 (-> obj length))
(collect-stats (-> obj data s5-0))
)
)
)
)
0
(none)
)
;; definition for method 15 of type drawable-group
;; INFO: Return type mismatch int vs none.
(defmethod
debug-draw
drawable-group
((obj drawable-group) (arg0 drawable) (arg1 display-frame))
(defmethod debug-draw drawable-group ((obj drawable-group) (arg0 drawable) (arg1 display-frame))
(when (vis-cull (-> obj id))
(when (sphere-cull (-> obj bsphere))
(dotimes (s3-0 (-> obj length))
(debug-draw
(-> obj data s3-0)
(-> (the-as drawable-group arg0) data s3-0)
arg1
(when (sphere-cull (-> obj bsphere))
(dotimes (s3-0 (-> obj length))
(debug-draw (-> obj data s3-0) (-> (the-as drawable-group arg0) data s3-0) arg1)
)
)
)
)
)
0
(none)
)
;; definition for method 16 of type drawable-group
(defmethod
dummy-16
drawable-group
((obj drawable-group) (arg0 object) (arg1 object))
(defmethod dummy-16 drawable-group ((obj drawable-group) (arg0 object) (arg1 object))
(dotimes (s4-0 (-> obj length))
(set! arg1 (dummy-16 (-> obj data s4-0) arg0 arg1))
)
(set! arg1 (dummy-16 (-> obj data s4-0) arg0 arg1))
)
arg1
)
+2 -8
View File
@@ -13,10 +13,7 @@
;; definition for method 10 of type drawable-inline-array
;; INFO: Return type mismatch int vs none.
(defmethod
draw
drawable-inline-array
((obj drawable-inline-array) (arg0 drawable) (arg1 display-frame))
(defmethod draw drawable-inline-array ((obj drawable-inline-array) (arg0 drawable) (arg1 display-frame))
0
(none)
)
@@ -30,10 +27,7 @@
;; definition for method 15 of type drawable-inline-array
;; INFO: Return type mismatch int vs none.
(defmethod
debug-draw
drawable-inline-array
((obj drawable-inline-array) (arg0 drawable) (arg1 display-frame))
(defmethod debug-draw drawable-inline-array ((obj drawable-inline-array) (arg0 drawable) (arg1 display-frame))
0
(none)
)
+54 -99
View File
@@ -5,34 +5,34 @@
;; INFO: Return type mismatch object vs cspace.
(defun cspace-by-name-no-fail ((arg0 process-drawable) (arg1 string))
(let ((result (cspace-by-name arg0 arg1)))
(the-as cspace (cond
(result
(empty)
result
)
(else
(format 0 "no cspace (~A)~%" arg1)
(the-as cspace (-> arg0 node-list data))
)
)
(the-as cspace (cond
(result
(empty)
result
)
(else
(format 0 "no cspace (~A)~%" arg1)
(the-as cspace (-> arg0 node-list data))
)
)
)
)
)
)
;; definition for function cspace-index-by-name-no-fail
(defun cspace-index-by-name-no-fail ((arg0 process-drawable) (arg1 string))
(let ((v0-0 (cspace-index-by-name arg0 arg1)))
(cond
((< v0-0 0)
(format 0 "no cspace[ndx] (~A)~%" arg1)
0
)
(else
(empty)
v0-0
)
(cond
((< v0-0 0)
(format 0 "no cspace[ndx] (~A)~%" arg1)
0
)
(else
(empty)
v0-0
)
)
)
)
)
;; definition for function num-func-none
@@ -42,113 +42,68 @@
;; definition for function num-func-+!
(defun num-func-+! ((arg0 joint-control-channel) (arg1 float) (arg2 float))
(let
((f0-1
(+
(-> arg0 frame-num)
(* arg1 (* (-> arg0 frame-group speed) (-> *display* time-adjust-ratio)))
)
)
(let ((f0-1 (+ (-> arg0 frame-num) (* arg1 (* (-> arg0 frame-group speed) (-> *display* time-adjust-ratio))))))
(set! (-> arg0 frame-num) f0-1)
f0-1
)
(set! (-> arg0 frame-num) f0-1)
f0-1
)
)
;; definition for function num-func--!
(defun num-func--! ((arg0 joint-control-channel) (arg1 float) (arg2 float))
(let
((f0-1
(-
(-> arg0 frame-num)
(* arg1 (* (-> arg0 frame-group speed) (-> *display* time-adjust-ratio)))
)
)
(let ((f0-1 (- (-> arg0 frame-num) (* arg1 (* (-> arg0 frame-group speed) (-> *display* time-adjust-ratio))))))
(set! (-> arg0 frame-num) f0-1)
f0-1
)
(set! (-> arg0 frame-num) f0-1)
f0-1
)
)
;; definition for function num-func-loop!
(defun num-func-loop! ((chan joint-control-channel) (inc float) (arg2 float))
(let* ((duration (the float (+ (-> chan frame-group data 0 length) -1)))
(after-inc
(+
(-> chan frame-num)
duration
(*
inc
(* (-> chan frame-group speed) (-> *display* time-adjust-ratio))
)
(+ (-> chan frame-num) duration (* inc (* (-> chan frame-group speed) (-> *display* time-adjust-ratio))))
)
)
(wrapped
(-
after-inc
(* (the float (the int (/ after-inc duration))) duration)
)
)
(wrapped (- after-inc (* (the float (the int (/ after-inc duration))) duration)))
)
(set! (-> chan frame-num) wrapped)
wrapped
)
(set! (-> chan frame-num) wrapped)
wrapped
)
)
;; definition for function num-func-seek!
(defun num-func-seek! ((arg0 joint-control-channel) (arg1 float) (arg2 float))
(let
((f0-3
(seek
(-> arg0 frame-num)
arg1
(* arg2 (* (-> arg0 frame-group speed) (-> *display* time-adjust-ratio)))
)
)
(let ((f0-3
(seek (-> arg0 frame-num) arg1 (* arg2 (* (-> arg0 frame-group speed) (-> *display* time-adjust-ratio))))
)
)
(set! (-> arg0 frame-num) f0-3)
(set! (-> arg0 frame-num) f0-3)
f0-3
)
(set! (-> arg0 frame-num) f0-3)
(set! (-> arg0 frame-num) f0-3)
f0-3
)
)
;; definition for function num-func-blend-in!
(defun
num-func-blend-in!
((arg0 joint-control-channel) (arg1 float) (arg2 float))
(let
((f30-0
(seek (-> arg0 frame-interp) 1.0 (* arg1 (-> *display* time-adjust-ratio)))
)
(defun num-func-blend-in! ((arg0 joint-control-channel) (arg1 float) (arg2 float))
(let ((f30-0 (seek (-> arg0 frame-interp) 1.0 (* arg1 (-> *display* time-adjust-ratio)))))
(set! (-> arg0 frame-interp) f30-0)
(set! (-> arg0 frame-interp) f30-0)
(if (= f30-0 1.0)
(joint-control-reset! (-> arg0 parent) arg0)
)
f30-0
)
(set! (-> arg0 frame-interp) f30-0)
(set! (-> arg0 frame-interp) f30-0)
(if (= f30-0 1.0)
(joint-control-reset! (-> arg0 parent) arg0)
)
f30-0
)
)
;; definition for function num-func-chan
(defun num-func-chan ((arg0 joint-control-channel) (arg1 float) (arg2 float))
(let
((f0-2
(->
(the-as
joint-control-channel
(+
(the-as uint arg0)
(* 48 (- (the int arg1) (-> arg0 group-sub-index)))
(let ((f0-2
(-> (the-as joint-control-channel (+ (the-as uint arg0) (* 48 (- (the int arg1) (-> arg0 group-sub-index)))))
frame-num
)
)
)
)
frame-num
)
)
(set! (-> arg0 frame-num) f0-2)
f0-2
)
(set! (-> arg0 frame-num) f0-2)
f0-2
)
)
;; definition for function num-func-identity
File diff suppressed because it is too large Load Diff
+190 -261
View File
@@ -101,14 +101,14 @@
;; definition for method 2 of type connection
(defmethod print connection ((obj connection))
(format
#t
"#<connection (~A ~A ~A ~A) @ #x~X>"
(-> obj param0)
(-> obj param1)
(-> obj param2)
(-> obj param3)
obj
)
#t
"#<connection (~A ~A ~A ~A) @ #x~X>"
(-> obj param0)
(-> obj param1)
(-> obj param2)
(-> obj param3)
obj
)
obj
)
@@ -116,10 +116,10 @@
;; INFO: Return type mismatch pointer vs engine.
(defmethod get-engine connection ((obj connection))
(while (-> (the-as connectable obj) prev0)
(nop!)
(nop!)
(set! obj (the-as connection (-> (the-as connectable obj) prev0)))
)
(nop!)
(nop!)
(set! obj (the-as connection (-> (the-as connectable obj) prev0)))
)
(the-as engine (&+ (the-as pointer obj) -28))
)
@@ -127,19 +127,19 @@
;; INFO: Return type mismatch pointer vs process.
(defmethod get-process connection ((obj connection))
(while (-> (the-as connectable obj) prev1)
(nop!)
(nop!)
(set! obj (the-as connection (-> (the-as connectable obj) prev1)))
)
(nop!)
(nop!)
(set! obj (the-as connection (-> (the-as connectable obj) prev1)))
)
(the-as process (&+ (the-as pointer obj) -92))
)
;; definition for method 11 of type connection
(defmethod belongs-to-engine? connection ((obj connection) (arg0 engine))
(and
(< (the-as int arg0) (the-as int obj))
(< (the-as int obj) (the-as int (-> arg0 data (-> arg0 allocated-length))))
)
(< (the-as int arg0) (the-as int obj))
(< (the-as int obj) (the-as int (-> arg0 data (-> arg0 allocated-length))))
)
)
;; definition for method 21 of type engine
@@ -158,86 +158,47 @@
)
;; definition for method 0 of type engine
(defmethod
new
engine
((allocation symbol) (type-to-make type) (name basic) (length int))
(let
((obj
(the-as
object
(object-new
allocation
type-to-make
(the-as int (+ (-> type-to-make size) (* (+ length -1) 32)))
)
(defmethod new engine ((allocation symbol) (type-to-make type) (name basic) (length int))
(let ((obj (the-as
object
(object-new allocation type-to-make (the-as int (+ (-> type-to-make size) (* (+ length -1) 32))))
)
)
)
(set! (-> (the-as engine obj) allocated-length) length)
(set! (-> (the-as engine obj) length) 0)
(set! (-> (the-as engine obj) name) name)
(set! (-> (the-as engine obj) alive-list next0) (-> (the-as engine obj) alive-list-end))
(set! (-> (the-as engine obj) alive-list prev0) #f)
(set! (-> (the-as engine obj) alive-list next1) #f)
(set! (-> (the-as engine obj) alive-list prev1) #f)
(set! (-> (the-as engine obj) alive-list-end next0) #f)
(set! (-> (the-as engine obj) alive-list-end prev0) (-> (the-as engine obj) alive-list))
(set! (-> (the-as engine obj) alive-list-end next1) #f)
(set! (-> (the-as engine obj) alive-list-end prev1) #f)
(set! (-> (the-as engine obj) dead-list next0) (the-as connectable (-> (the-as engine obj) data)))
(set! (-> (the-as engine obj) dead-list prev0) #f)
(set! (-> (the-as engine obj) dead-list next1) #f)
(set! (-> (the-as engine obj) dead-list prev1) #f)
(set! (-> (the-as engine obj) dead-list-end next0) #f)
(set! (-> (the-as engine obj) dead-list-end prev0) (-> (the-as engine obj) data (+ length -1)))
(set! (-> (the-as engine obj) dead-list-end next1) #f)
(set! (-> (the-as engine obj) dead-list-end prev1) #f)
(set! (-> (the-as engine obj) data 0 prev0) (-> (the-as engine obj) dead-list))
(set! (-> (the-as engine obj) data 0 next0) (the-as connectable (&+ (the-as pointer obj) 124)))
(let ((idx-to-link 1)
(end-idx (+ length -2))
)
(while (>= end-idx idx-to-link)
(set! (-> (the-as engine obj) data idx-to-link prev0) (-> (the-as engine obj) data (+ idx-to-link -1)))
(set! (-> (the-as engine obj) data idx-to-link next0) (-> (the-as engine obj) data (+ idx-to-link 1)))
(+! idx-to-link 1)
)
)
)
(set! (-> (the-as engine obj) data (+ length -1) prev0) (-> (the-as engine obj) data (+ length -2)))
(set! (-> (the-as engine obj) data (+ length -1) next0) (-> (the-as engine obj) dead-list-end))
(the-as engine obj)
)
(set! (-> (the-as engine obj) allocated-length) length)
(set! (-> (the-as engine obj) length) 0)
(set! (-> (the-as engine obj) name) name)
(set!
(-> (the-as engine obj) alive-list next0)
(-> (the-as engine obj) alive-list-end)
)
(set! (-> (the-as engine obj) alive-list prev0) #f)
(set! (-> (the-as engine obj) alive-list next1) #f)
(set! (-> (the-as engine obj) alive-list prev1) #f)
(set! (-> (the-as engine obj) alive-list-end next0) #f)
(set!
(-> (the-as engine obj) alive-list-end prev0)
(-> (the-as engine obj) alive-list)
)
(set! (-> (the-as engine obj) alive-list-end next1) #f)
(set! (-> (the-as engine obj) alive-list-end prev1) #f)
(set!
(-> (the-as engine obj) dead-list next0)
(the-as connectable (-> (the-as engine obj) data))
)
(set! (-> (the-as engine obj) dead-list prev0) #f)
(set! (-> (the-as engine obj) dead-list next1) #f)
(set! (-> (the-as engine obj) dead-list prev1) #f)
(set! (-> (the-as engine obj) dead-list-end next0) #f)
(set!
(-> (the-as engine obj) dead-list-end prev0)
(-> (the-as engine obj) data (+ length -1))
)
(set! (-> (the-as engine obj) dead-list-end next1) #f)
(set! (-> (the-as engine obj) dead-list-end prev1) #f)
(set!
(-> (the-as engine obj) data 0 prev0)
(-> (the-as engine obj) dead-list)
)
(set!
(-> (the-as engine obj) data 0 next0)
(the-as connectable (&+ (the-as pointer obj) 124))
)
(let ((idx-to-link 1)
(end-idx (+ length -2))
)
(while (>= end-idx idx-to-link)
(set!
(-> (the-as engine obj) data idx-to-link prev0)
(-> (the-as engine obj) data (+ idx-to-link -1))
)
(set!
(-> (the-as engine obj) data idx-to-link next0)
(-> (the-as engine obj) data (+ idx-to-link 1))
)
(+! idx-to-link 1)
)
)
(set!
(-> (the-as engine obj) data (+ length -1) prev0)
(-> (the-as engine obj) data (+ length -2))
)
(set!
(-> (the-as engine obj) data (+ length -1) next0)
(-> (the-as engine obj) dead-list-end)
)
(the-as engine obj)
)
)
;; definition for method 2 of type engine
@@ -255,28 +216,28 @@
(format #t "~Tlength: ~D~%" (-> obj length))
(format #t "~Talive-list:~%")
(let ((s5-0 *print-column*))
(set! *print-column* (+ *print-column* 64))
(inspect (-> obj alive-list))
(set! *print-column* s5-0)
)
(set! *print-column* (+ *print-column* 64))
(inspect (-> obj alive-list))
(set! *print-column* s5-0)
)
(format #t "~Talive-list-end:~%")
(let ((s5-1 *print-column*))
(set! *print-column* (+ *print-column* 64))
(inspect (-> obj alive-list-end))
(set! *print-column* s5-1)
)
(set! *print-column* (+ *print-column* 64))
(inspect (-> obj alive-list-end))
(set! *print-column* s5-1)
)
(format #t "~Tdead-list:~%")
(let ((s5-2 *print-column*))
(set! *print-column* (+ *print-column* 64))
(inspect (-> obj dead-list))
(set! *print-column* s5-2)
)
(set! *print-column* (+ *print-column* 64))
(inspect (-> obj dead-list))
(set! *print-column* s5-2)
)
(format #t "~Tdead-list-end:~%")
(let ((s5-3 *print-column*))
(set! *print-column* (+ *print-column* 64))
(inspect (-> obj dead-list-end))
(set! *print-column* s5-3)
)
(set! *print-column* (+ *print-column* 64))
(inspect (-> obj dead-list-end))
(set! *print-column* s5-3)
)
(format #t "~Tdata[~D]: @ #x~X~%" (-> obj allocated-length) (-> obj data))
obj
)
@@ -293,33 +254,27 @@
)
;; definition for method 10 of type engine
(defmethod
apply-to-connections
engine
((obj engine) (f (function connectable none)))
(defmethod apply-to-connections engine ((obj engine) (f (function connectable none)))
(let* ((current (-> obj alive-list next0))
(next (-> current next0))
)
(while (!= current (-> obj alive-list-end))
(f current)
(set! current next)
(set! next (-> next next0))
(while (!= current (-> obj alive-list-end))
(f current)
(set! current next)
(set! next (-> next next0))
)
)
)
0
)
;; definition for method 11 of type engine
(defmethod
apply-to-connections-reverse
engine
((obj engine) (f (function connectable none)))
(defmethod apply-to-connections-reverse engine ((obj engine) (f (function connectable none)))
(let ((iter (-> obj alive-list-end prev0)))
(while (!= iter (-> obj alive-list))
(f iter)
(set! iter (-> iter prev0))
(while (!= iter (-> obj alive-list))
(f iter)
(set! iter (-> iter prev0))
)
)
)
0
)
@@ -327,180 +282,154 @@
(defmethod execute-connections engine ((obj engine) (arg0 object))
(set! (-> obj engine-time) (-> *display* real-frame-counter))
(let ((ct (the-as connection (-> obj alive-list-end prev0))))
(while (!= ct (-> obj alive-list))
((the-as (function basic basic basic object object) (-> ct param0))
(-> ct param1)
(-> ct param2)
(-> ct param3)
arg0
)
(set! ct (the-as connection (-> ct prev0)))
(while (!= ct (-> obj alive-list))
((the-as (function basic basic basic object object) (-> ct param0))
(-> ct param1)
(-> ct param2)
(-> ct param3)
arg0
)
(set! ct (the-as connection (-> ct prev0)))
)
)
)
0
)
;; definition for method 13 of type engine
(defmethod
execute-connections-and-move-to-dead
engine
((obj engine) (arg0 object))
(defmethod execute-connections-and-move-to-dead engine ((obj engine) (arg0 object))
(set! (-> obj engine-time) (-> *display* real-frame-counter))
(let ((ct (the-as connection (-> obj alive-list-end prev0))))
(while (!= ct (-> obj alive-list))
(let
((result
((the-as (function basic basic basic object object) (-> ct param0))
(-> ct param1)
(-> ct param2)
(-> ct param3)
arg0
(while (!= ct (-> obj alive-list))
(let ((result ((the-as (function basic basic basic object object) (-> ct param0))
(-> ct param1)
(-> ct param2)
(-> ct param3)
arg0
)
)
)
(set! ct (the-as connection (-> ct prev0)))
(if (= result 'dead)
((method-of-type connection move-to-dead) (the-as connection (-> ct next0)))
)
)
)
)
(set! ct (the-as connection (-> ct prev0)))
(if (= result 'dead)
((method-of-type connection move-to-dead)
(the-as connection (-> ct next0))
)
)
)
)
)
0
)
;; definition for method 14 of type engine
(defmethod execute-connections-if-needed engine ((obj engine) (arg0 object))
(if (!= (-> *display* real-frame-counter) (-> obj engine-time))
(execute-connections obj arg0)
)
(execute-connections obj arg0)
)
0
)
;; definition for function connection-process-apply
(defun connection-process-apply ((proc process) (func (function object none)))
(when proc
(let ((iter (-> proc connection-list next1)))
(while iter
(func iter)
(set! iter (-> iter next1))
)
(let ((iter (-> proc connection-list next1)))
(while iter
(func iter)
(set! iter (-> iter next1))
)
)
#f
)
#f
)
)
;; definition for method 9 of type engine
(defmethod inspect-all-connections engine ((obj engine))
(apply-to-connections
obj
(the-as (function connectable none) (method-of-type connection inspect))
)
(apply-to-connections obj (the-as (function connectable none) (method-of-type connection inspect)))
obj
)
;; definition for method 15 of type engine
(defmethod
add-connection
engine
((obj engine)
(proc process)
(func object)
(p1 object)
(p2 object)
(p3 object)
)
(defmethod add-connection engine ((obj engine) (proc process) (func object) (p1 object) (p2 object) (p3 object))
(let ((con (the-as connection (-> obj dead-list next0))))
(when (not (or (not proc) (= con (-> obj dead-list-end))))
(set! (-> con param0) (the-as basic func))
(set! (-> con param1) (the-as basic p1))
(set! (-> con param2) (the-as basic p2))
(set! (-> con param3) (the-as basic p3))
(set! (-> obj dead-list next0) (-> con next0))
(set! (-> con next0 prev0) (-> obj dead-list))
(set! (-> con next0) (-> obj alive-list next0))
(set! (-> con next0 prev0) con)
(set! (-> con prev0) (-> obj alive-list))
(set! (-> obj alive-list next0) con)
(set! (-> con next1) (-> proc connection-list next1))
(if (-> con next1)
(set! (-> con next1 prev1) con)
)
(set! (-> con prev1) (-> proc connection-list))
(set! (-> proc connection-list next1) con)
(+! (-> obj length) 1)
con
(when (not (or (not proc) (= con (-> obj dead-list-end))))
(set! (-> con param0) (the-as basic func))
(set! (-> con param1) (the-as basic p1))
(set! (-> con param2) (the-as basic p2))
(set! (-> con param3) (the-as basic p3))
(set! (-> obj dead-list next0) (-> con next0))
(set! (-> con next0 prev0) (-> obj dead-list))
(set! (-> con next0) (-> obj alive-list next0))
(set! (-> con next0 prev0) con)
(set! (-> con prev0) (-> obj alive-list))
(set! (-> obj alive-list next0) con)
(set! (-> con next1) (-> proc connection-list next1))
(if (-> con next1)
(set! (-> con next1 prev1) con)
)
(set! (-> con prev1) (-> proc connection-list))
(set! (-> proc connection-list next1) con)
(+! (-> obj length) 1)
con
)
)
)
)
;; definition for method 13 of type connection
(defmethod move-to-dead connection ((obj connection))
(let ((v1-1 (get-engine obj)))
(set! (-> obj prev0 next0) (-> obj next0))
(set! (-> obj next0 prev0) (-> obj prev0))
(set! (-> obj prev1 next1) (-> obj next1))
(if (-> obj next1)
(set! (-> obj next1 prev1) (-> obj prev1))
(set! (-> obj prev0 next0) (-> obj next0))
(set! (-> obj next0 prev0) (-> obj prev0))
(set! (-> obj prev1 next1) (-> obj next1))
(if (-> obj next1)
(set! (-> obj next1 prev1) (-> obj prev1))
)
(set! (-> obj next0) (-> v1-1 dead-list next0))
(set! (-> obj next0 prev0) obj)
(set! (-> obj prev0) (-> v1-1 dead-list))
(set! (-> v1-1 dead-list next0) obj)
(+! (-> v1-1 length) -1)
)
(set! (-> obj next0) (-> v1-1 dead-list next0))
(set! (-> obj next0 prev0) obj)
(set! (-> obj prev0) (-> v1-1 dead-list))
(set! (-> v1-1 dead-list next0) obj)
(+! (-> v1-1 length) -1)
)
obj
)
;; definition for function process-disconnect
(defun process-disconnect ((arg0 process))
(when arg0
(let ((gp-0 (-> arg0 connection-list next1)))
(while gp-0
((method-of-type connection move-to-dead) (the-as connection gp-0))
(set! gp-0 (-> gp-0 next1))
)
(let ((gp-0 (-> arg0 connection-list next1)))
(while gp-0
((method-of-type connection move-to-dead) (the-as connection gp-0))
(set! gp-0 (-> gp-0 next1))
)
)
)
)
0
)
;; definition for method 16 of type engine
(defmethod remove-from-process engine ((obj engine) (arg0 process))
(when arg0
(let ((s5-0 (-> arg0 connection-list next1)))
(while s5-0
(if
((method-of-type connection belongs-to-engine?)
(the-as connection s5-0)
obj
)
((method-of-type connection move-to-dead) (the-as connection s5-0))
(let ((s5-0 (-> arg0 connection-list next1)))
(while s5-0
(if ((method-of-type connection belongs-to-engine?) (the-as connection s5-0) obj)
((method-of-type connection move-to-dead) (the-as connection s5-0))
)
(set! s5-0 (-> s5-0 next1))
)
)
(set! s5-0 (-> s5-0 next1))
)
)
)
0
)
;; definition for method 17 of type engine
(defmethod
remove-matching
engine
((obj engine) (arg0 (function connection engine symbol)))
(defmethod remove-matching engine ((obj engine) (arg0 (function connection engine symbol)))
(let* ((s4-0 (-> obj alive-list next0))
(s3-0 (-> s4-0 next0))
)
(while (!= s4-0 (-> obj alive-list-end))
(if (arg0 (the-as connection s4-0) obj)
((method-of-type connection move-to-dead) (the-as connection s4-0))
)
(set! s4-0 s3-0)
(set! s3-0 (-> s3-0 next0))
(while (!= s4-0 (-> obj alive-list-end))
(if (arg0 (the-as connection s4-0) obj)
((method-of-type connection move-to-dead) (the-as connection s4-0))
)
(set! s4-0 s3-0)
(set! s3-0 (-> s3-0 next0))
)
)
)
0
)
@@ -509,12 +438,12 @@
(let* ((a0-1 (-> obj alive-list next0))
(s5-0 (-> a0-1 next0))
)
(while (!= a0-1 (-> obj alive-list-end))
((method-of-type connection move-to-dead) (the-as connection a0-1))
(set! a0-1 s5-0)
(set! s5-0 (-> s5-0 next0))
(while (!= a0-1 (-> obj alive-list-end))
((method-of-type connection move-to-dead) (the-as connection a0-1))
(set! a0-1 s5-0)
(set! s5-0 (-> s5-0 next0))
)
)
)
0
)
@@ -523,14 +452,14 @@
(let* ((current (-> obj alive-list next0))
(next (-> current next0))
)
(while (!= current (-> obj alive-list-end))
(if (= (-> (the-as connection current) param1) p1-value)
((method-of-type connection move-to-dead) (the-as connection current))
)
(set! current next)
(set! next (-> next next0))
(while (!= current (-> obj alive-list-end))
(if (= (-> (the-as connection current) param1) p1-value)
((method-of-type connection move-to-dead) (the-as connection current))
)
(set! current next)
(set! next (-> next next0))
)
)
)
0
)
@@ -539,13 +468,13 @@
(let* ((current (-> obj alive-list next0))
(next (-> current next0))
)
(while (!= current (-> obj alive-list-end))
(if (= (-> (the-as connection current) param2) p2-value)
((method-of-type connection move-to-dead) (the-as connection current))
)
(set! current next)
(set! next (-> next next0))
(while (!= current (-> obj alive-list-end))
(if (= (-> (the-as connection current) param2) p2-value)
((method-of-type connection move-to-dead) (the-as connection current))
)
(set! current next)
(set! next (-> next next0))
)
)
)
0
)
+1 -4
View File
@@ -5,10 +5,7 @@
(define *background-draw-engine* (new 'global 'engine 'draw 10))
;; definition for symbol *matrix-engine*, type (array handle)
(define
*matrix-engine*
(the-as (array handle) (new 'global 'boxed-array handle 1024))
)
(define *matrix-engine* (the-as (array handle) (new 'global 'boxed-array handle 1024)))
;; failed to figure out what this is:
(set! (-> *matrix-engine* length) 0)
+166 -226
View File
@@ -8,18 +8,16 @@
(local-vars (sv-16 res-tag))
(set! sv-16 (new 'static 'res-tag))
(let ((v1-1 (res-lump-data lump name (pointer uint32) :tag-ptr (& sv-16))))
(the-as
entity-actor
(when (and v1-1 (< idx (the-as int (-> sv-16 elt-count))))
(if (= (-> sv-16 elt-type) string)
(entity-by-name
(the-as string (-> (the-as (pointer uint32) (&+ v1-1 (* idx 4))) 0))
)
(entity-by-aid (-> (the-as (pointer uint32) (&+ v1-1 (* idx 4))) 0))
(the-as
entity-actor
(when (and v1-1 (< idx (the-as int (-> sv-16 elt-count))))
(if (= (-> sv-16 elt-type) string)
(entity-by-name (the-as string (-> (the-as (pointer uint32) (&+ v1-1 (* idx 4))) 0)))
(entity-by-aid (-> (the-as (pointer uint32) (&+ v1-1 (* idx 4))) 0))
)
)
)
)
)
)
)
;; definition for function entity-actor-count
@@ -29,9 +27,9 @@
(local-vars (tag res-tag))
(set! tag (new 'static 'res-tag))
(if (res-lump-data res name pointer :tag-ptr (& tag))
(the-as int (-> tag elt-count))
0
)
(the-as int (-> tag elt-count))
0
)
)
;; definition of type actor-link-info
@@ -85,24 +83,17 @@
)
;; definition for method 0 of type actor-link-info
(defmethod
new
actor-link-info
((allocation symbol) (type-to-make type) (proc process))
(let
((obj
(object-new allocation type-to-make (the-as int (-> type-to-make size)))
)
(defmethod new actor-link-info ((allocation symbol) (type-to-make type) (proc process))
(let ((obj (object-new allocation type-to-make (the-as int (-> type-to-make size)))))
(set! (-> obj process) proc)
(let ((ent (-> proc entity)))
(set! (-> obj next) (entity-actor-lookup ent 'next-actor 0))
)
(let ((a0-2 (-> proc entity)))
(set! (-> obj prev) (entity-actor-lookup a0-2 'prev-actor 0))
)
obj
)
(set! (-> obj process) proc)
(let ((ent (-> proc entity)))
(set! (-> obj next) (entity-actor-lookup ent 'next-actor 0))
)
(let ((a0-2 (-> proc entity)))
(set! (-> obj prev) (entity-actor-lookup a0-2 'prev-actor 0))
)
obj
)
)
;; definition for method 12 of type actor-link-info
@@ -118,162 +109,132 @@
;; definition for method 14 of type actor-link-info
;; INFO: Return type mismatch basic vs process.
(defmethod get-next-process actor-link-info ((obj actor-link-info))
(the-as
process
(and (-> obj next) (-> (the-as entity-links (-> obj next extra)) process))
)
(the-as process (and (-> obj next) (-> (the-as entity-links (-> obj next extra)) process)))
)
;; definition for method 15 of type actor-link-info
;; INFO: Return type mismatch basic vs process.
(defmethod get-prev-process actor-link-info ((obj actor-link-info))
(the-as
process
(and (-> obj prev) (-> (the-as entity-links (-> obj prev extra)) process))
)
(the-as process (and (-> obj prev) (-> (the-as entity-links (-> obj prev extra)) process)))
)
;; definition for method 11 of type actor-link-info
(defmethod link-to-next-and-prev-actor actor-link-info ((obj actor-link-info))
(let ((a0-1 (-> obj process entity)))
(set! (-> obj next) (entity-actor-lookup a0-1 'next-actor 0))
)
(set! (-> obj next) (entity-actor-lookup a0-1 'next-actor 0))
)
(let ((a0-2 (-> obj process entity)))
(set! (-> obj prev) (entity-actor-lookup a0-2 'prev-actor 0))
)
(set! (-> obj prev) (entity-actor-lookup a0-2 'prev-actor 0))
)
(-> obj next)
)
;; definition for method 16 of type actor-link-info
(defmethod
apply-function-forward
actor-link-info
((obj actor-link-info)
(arg0 (function entity-actor object object))
(arg1 object)
)
(defmethod apply-function-forward actor-link-info ((obj actor-link-info) (arg0 (function entity-actor object object)) (arg1 object))
(let ((s3-0 (-> obj next)))
(while s3-0
(if (arg0 s3-0 arg1)
(return (the-as int #f))
)
(set! s3-0 (entity-actor-lookup s3-0 'next-actor 0))
(while s3-0
(if (arg0 s3-0 arg1)
(return (the-as int #f))
)
(set! s3-0 (entity-actor-lookup s3-0 'next-actor 0))
)
)
)
0
)
;; definition for method 17 of type actor-link-info
(defmethod
apply-function-reverse
actor-link-info
((obj actor-link-info)
(arg0 (function entity-actor object object))
(arg1 object)
)
(defmethod apply-function-reverse actor-link-info ((obj actor-link-info) (arg0 (function entity-actor object object)) (arg1 object))
(let ((s3-0 (-> obj prev)))
(while s3-0
(if (arg0 s3-0 arg1)
(return (the-as int #f))
)
(set! s3-0 (entity-actor-lookup s3-0 'prev-actor 0))
(while s3-0
(if (arg0 s3-0 arg1)
(return (the-as int #f))
)
(set! s3-0 (entity-actor-lookup s3-0 'prev-actor 0))
)
)
)
0
)
;; definition for method 18 of type actor-link-info
(defmethod
apply-all
actor-link-info
((obj actor-link-info)
(arg0 (function entity-actor object object))
(arg1 object)
)
(defmethod apply-all actor-link-info ((obj actor-link-info) (arg0 (function entity-actor object object)) (arg1 object))
(let ((s4-0 (-> obj process entity)))
(while (let ((a0-2 s4-0))
(entity-actor-lookup a0-2 'prev-actor 0)
)
(set! s4-0 (entity-actor-lookup s4-0 'prev-actor 0))
(while (let ((a0-2 s4-0))
(entity-actor-lookup a0-2 'prev-actor 0)
)
(set! s4-0 (entity-actor-lookup s4-0 'prev-actor 0))
)
(while s4-0
(if (arg0 (the-as entity-actor s4-0) arg1)
(return (the-as int #f))
)
(let ((a0-4 s4-0))
(set! s4-0 (entity-actor-lookup a0-4 'next-actor 0))
)
)
)
(while s4-0
(if (arg0 (the-as entity-actor s4-0) arg1)
(return (the-as int #f))
)
(let ((a0-4 s4-0))
(set! s4-0 (entity-actor-lookup a0-4 'next-actor 0))
)
)
)
0
)
;; definition for method 20 of type actor-link-info
(defmethod
send-to-all-after
actor-link-info
((obj actor-link-info) (message symbol))
(defmethod send-to-all-after actor-link-info ((obj actor-link-info) (message symbol))
(with-pp
(let ((iter (-> obj next))
(result (the-as object #f))
)
(while iter
(let ((proc (-> iter extra process)))
(when proc
(let ((msg-block (new 'stack-no-clear 'event-message-block)))
(set! (-> msg-block from) pp)
(set! (-> msg-block num-params) 0)
(set! (-> msg-block message) message)
(set! result (or (send-event-function proc msg-block) result))
(let ((iter (-> obj next))
(result (the-as object #f))
)
(while iter
(let ((proc (-> iter extra process)))
(when proc
(let ((msg-block (new 'stack-no-clear 'event-message-block)))
(set! (-> msg-block from) pp)
(set! (-> msg-block num-params) 0)
(set! (-> msg-block message) message)
(set! result (or (send-event-function proc msg-block) result))
)
)
)
(set! iter (entity-actor-lookup iter 'next-actor 0))
)
)
result
)
(set! iter (entity-actor-lookup iter 'next-actor 0))
)
result
)
)
)
;; definition for method 21 of type actor-link-info
(defmethod
send-to-all-before
actor-link-info
((obj actor-link-info) (arg0 symbol))
(defmethod send-to-all-before actor-link-info ((obj actor-link-info) (arg0 symbol))
(with-pp
(let ((s4-0 (-> obj prev))
(s5-0 (the-as object #f))
)
(while s4-0
(let ((a0-1 (-> s4-0 extra process)))
(when a0-1
(let ((a1-1 (new 'stack-no-clear 'event-message-block)))
(set! (-> a1-1 from) pp)
(set! (-> a1-1 num-params) 0)
(set! (-> a1-1 message) arg0)
(set! s5-0 (or (send-event-function a0-1 a1-1) s5-0))
(let ((s4-0 (-> obj prev))
(s5-0 (the-as object #f))
)
(while s4-0
(let ((a0-1 (-> s4-0 extra process)))
(when a0-1
(let ((a1-1 (new 'stack-no-clear 'event-message-block)))
(set! (-> a1-1 from) pp)
(set! (-> a1-1 num-params) 0)
(set! (-> a1-1 message) arg0)
(set! s5-0 (or (send-event-function a0-1 a1-1) s5-0))
)
)
)
(set! s4-0 (entity-actor-lookup s4-0 'prev-actor 0))
)
)
s5-0
)
(set! s4-0 (entity-actor-lookup s4-0 'prev-actor 0))
)
s5-0
)
)
)
;; definition for method 23 of type actor-link-info
;; INFO: Return type mismatch int vs none.
(defmethod send-to-next actor-link-info ((obj actor-link-info) (arg0 symbol))
(let ((a0-1 (-> obj next)))
(when a0-1
(let ((a0-2 (-> (the-as entity-links (-> a0-1 extra)) process)))
(if a0-2
(send-event a0-2 arg0)
(when a0-1
(let ((a0-2 (-> (the-as entity-links (-> a0-1 extra)) process)))
(if a0-2
(send-event a0-2 arg0)
)
)
)
)
)
)
0
(none)
)
@@ -282,23 +243,20 @@
;; INFO: Return type mismatch int vs none.
(defmethod send-to-prev actor-link-info ((obj actor-link-info) (arg0 symbol))
(let ((a0-1 (-> obj prev)))
(when a0-1
(let ((a0-2 (-> (the-as entity-links (-> a0-1 extra)) process)))
(if a0-2
(send-event a0-2 arg0)
(when a0-1
(let ((a0-2 (-> (the-as entity-links (-> a0-1 extra)) process)))
(if a0-2
(send-event a0-2 arg0)
)
)
)
)
)
)
0
(none)
)
;; definition for method 22 of type actor-link-info
(defmethod
send-to-next-and-prev
actor-link-info
((obj actor-link-info) (arg0 symbol))
(defmethod send-to-next-and-prev actor-link-info ((obj actor-link-info) (arg0 symbol))
(send-to-next obj arg0)
(send-to-prev obj arg0)
(none)
@@ -317,47 +275,44 @@
(let ((actor (-> obj process entity))
(count 0)
)
(while (let ((a0-2 actor))
(entity-actor-lookup a0-2 'prev-actor 0)
)
(set! actor (entity-actor-lookup actor 'prev-actor 0))
(while (let ((a0-2 actor))
(entity-actor-lookup a0-2 'prev-actor 0)
)
(set! actor (entity-actor-lookup actor 'prev-actor 0))
)
(while actor
(+! count 1)
(let ((a0-3 actor))
(set! actor (entity-actor-lookup a0-3 'next-actor 0))
)
)
count
)
(while actor
(+! count 1)
(let ((a0-3 actor))
(set! actor (entity-actor-lookup a0-3 'next-actor 0))
)
)
count
)
)
;; definition for method 9 of type actor-link-info
(defmethod
get-matching-actor-type-mask
actor-link-info
((obj actor-link-info) (matching-type type))
(defmethod get-matching-actor-type-mask actor-link-info ((obj actor-link-info) (matching-type type))
(let ((actor (the-as entity-actor (-> obj process entity)))
(mask 0)
)
(let ((current-bit 1))
(while (let ((a0-2 actor))
(entity-actor-lookup a0-2 'prev-actor 0)
(let ((current-bit 1))
(while (let ((a0-2 actor))
(entity-actor-lookup a0-2 'prev-actor 0)
)
(set! actor (entity-actor-lookup actor 'prev-actor 0))
)
(while actor
(if (= (-> actor etype) matching-type)
(set! mask (logior mask current-bit))
)
(set! actor (entity-actor-lookup actor 'prev-actor 0))
)
(while actor
(if (= (-> actor etype) matching-type)
(set! mask (logior mask current-bit))
(let ((a0-3 actor))
(set! actor (entity-actor-lookup a0-3 'next-actor 0))
)
(set! current-bit (* current-bit 2))
)
)
(let ((a0-3 actor))
(set! actor (entity-actor-lookup a0-3 'next-actor 0))
)
(set! current-bit (* current-bit 2))
)
mask
)
mask
)
)
;; definition for method 10 of type actor-link-info
@@ -366,55 +321,47 @@
(actor this-actor)
(count 0)
)
(while (let ((a0-2 actor))
(entity-actor-lookup a0-2 'prev-actor 0)
)
(set! actor (entity-actor-lookup actor 'prev-actor 0))
(while (let ((a0-2 actor))
(entity-actor-lookup a0-2 'prev-actor 0)
)
(set! actor (entity-actor-lookup actor 'prev-actor 0))
)
(while (!= actor this-actor)
(+! count 1)
(let ((a0-3 actor))
(set! actor (entity-actor-lookup a0-3 'next-actor 0))
)
)
count
)
(while (!= actor this-actor)
(+! count 1)
(let ((a0-3 actor))
(set! actor (entity-actor-lookup a0-3 'next-actor 0))
)
)
count
)
)
;; definition for function actor-link-subtask-complete-hook
(defun
actor-link-subtask-complete-hook
((arg0 entity-actor) (arg1 (pointer symbol)))
(defun actor-link-subtask-complete-hook ((arg0 entity-actor) (arg1 (pointer symbol)))
(cond
((logtest?
(-> (the-as entity-links (-> arg0 extra)) perm status)
(entity-perm-status complete)
((logtest? (-> (the-as entity-links (-> arg0 extra)) perm status) (entity-perm-status complete))
(set! (-> arg1 0) #t)
#f
)
(set! (-> arg1 0) #t)
#f
(else
(set! (-> arg1 0) #f)
#t
)
)
(else
(set! (-> arg1 0) #f)
#t
)
)
)
;; definition for function actor-link-dead-hook
(defun actor-link-dead-hook ((arg0 entity-actor) (arg1 (pointer symbol)))
(cond
((logtest?
(-> (the-as entity-links (-> arg0 extra)) perm status)
(entity-perm-status dead)
((logtest? (-> (the-as entity-links (-> arg0 extra)) perm status) (entity-perm-status dead))
(set! (-> arg1 0) #t)
#f
)
(set! (-> arg1 0) #t)
#f
(else
(set! (-> arg1 0) #f)
#t
)
)
(else
(set! (-> arg1 0) #f)
#t
)
)
)
;; definition for function alt-actor-list-subtask-incomplete-count
@@ -422,23 +369,16 @@
(let ((alt-actor-count (entity-actor-count (-> arg0 entity) 'alt-actor))
(incomplete-count 0)
)
(dotimes (alt-actor-idx alt-actor-count)
(let
((a0-3 (entity-actor-lookup (-> arg0 entity) 'alt-actor alt-actor-idx)))
(if
(or
(not a0-3)
(zero?
(logand
(-> (the-as entity-links (-> a0-3 extra)) perm status)
(entity-perm-status complete)
)
(dotimes (alt-actor-idx alt-actor-count)
(let ((a0-3 (entity-actor-lookup (-> arg0 entity) 'alt-actor alt-actor-idx)))
(if (or
(not a0-3)
(zero? (logand (-> (the-as entity-links (-> a0-3 extra)) perm status) (entity-perm-status complete)))
)
(+! incomplete-count 1)
)
)
)
(+! incomplete-count 1)
)
)
incomplete-count
)
incomplete-count
)
)
+3 -10
View File
@@ -281,8 +281,8 @@
;; failed to figure out what this is:
(if (zero? entity-nav-login)
(set! entity-nav-login (the-as (function entity-actor none) nothing))
)
(set! entity-nav-login (the-as (function entity-actor none) nothing))
)
;; definition of type actor-bank
(deftype actor-bank (basic)
@@ -305,14 +305,7 @@
)
;; definition for symbol *ACTOR-bank*, type actor-bank
(define
*ACTOR-bank*
(new 'static 'actor-bank
:pause-dist 204800.0
:birth-dist 901120.0
:birth-max 10
)
)
(define *ACTOR-bank* (new 'static 'actor-bank :pause-dist 204800.0 :birth-dist 901120.0 :birth-max 10))
;; failed to figure out what this is:
0
+160 -166
View File
@@ -2,177 +2,171 @@
(in-package goal)
;; definition for symbol *entity-info*, type (array entity-info)
(define
*entity-info*
(the-as (array entity-info)
(new
'static
'boxed-array
:type entity-info :length 19 :allocated-length 19
(new 'static 'entity-info
:ptype
(type-ref sage-finalboss :method-count 53)
:package "l1"
:art-group '()
:pool '*16k-dead-pool*
:heap-size #x8000
)
(new 'static 'entity-info
:ptype (type-ref robotboss :method-count 21)
:package "l1"
:art-group '()
:pool '*16k-dead-pool*
:heap-size #x8000
)
(new 'static 'entity-info
:ptype
(type-ref assistant-levitator :method-count 53)
:package "l1"
:art-group '()
:pool '*16k-dead-pool*
:heap-size #x8000
)
(new 'static 'entity-info
:ptype (type-ref babak :method-count 76)
:package "l1"
:art-group '("babak")
:pool '*16k-dead-pool*
:heap-size #x2800
)
(new 'static 'entity-info
:ptype (type-ref racer :method-count 24)
:package "game"
:art-group '("racer")
:pool '*16k-dead-pool*
:heap-size #x4000
)
(new 'static 'entity-info
:ptype (type-ref springbox :method-count 20)
:package "game"
:art-group '("bounceytarp")
:pool '*16k-dead-pool*
:heap-size #x1400
)
(new 'static 'entity-info
:ptype (type-ref launcher :method-count 20)
:package "game"
:art-group '()
:pool '*16k-dead-pool*
:heap-size #x400
)
(new 'static 'entity-info
:ptype
(type-ref pickup-spawner :method-count 30)
:package "game"
:art-group '()
:pool '*16k-dead-pool*
:heap-size #xc00
)
(new 'static 'entity-info
:ptype (type-ref bucket :method-count 30)
:package "game"
:art-group '()
:pool '*16k-dead-pool*
:heap-size #xc00
)
(new 'static 'entity-info
:ptype (type-ref barrel :method-count 30)
:package "game"
:art-group '()
:pool '*16k-dead-pool*
:heap-size #xc00
)
(new 'static 'entity-info
:ptype (type-ref crate :method-count 30)
:package "game"
:art-group '()
:pool '*16k-dead-pool*
:heap-size #xc00
)
(new 'static 'entity-info
:ptype
(type-ref orb-cache-top :method-count 29)
:package "game"
:art-group '("orb-cache-top")
:pool '*16k-dead-pool*
:heap-size #x1000
)
(new 'static 'entity-info
:ptype (type-ref eco :method-count 31)
:package "game"
:art-group '()
:pool '*16k-dead-pool*
:heap-size #x1000
)
(new 'static 'entity-info
:ptype (type-ref ecovent :method-count 21)
:package "game"
:art-group '()
:pool '*16k-dead-pool*
:heap-size #x1000
)
(new 'static 'entity-info
:ptype (type-ref fuel-cell :method-count 31)
:package "game"
:art-group '()
:pool '*16k-dead-pool*
:heap-size #x1400
)
(new 'static 'entity-info
:ptype (type-ref buzzer :method-count 31)
:package "game"
:art-group '()
:pool '*16k-dead-pool*
:heap-size #x1000
)
(new 'static 'entity-info
:ptype (type-ref money :method-count 31)
:package "game"
:art-group '()
:pool '*16k-dead-pool*
:heap-size #x800
)
(new 'static 'entity-info
:ptype (type-ref water-vol :method-count 30)
:package "game"
:art-group '()
:pool '*16k-dead-pool*
:heap-size #xc00
)
(new 'static 'entity-info
:ptype
(type-ref target-start :method-count 15)
:package "game"
:art-group '()
:pool '*16k-dead-pool*
:heap-size #x400
)
)
)
)
(define *entity-info* (the-as (array entity-info) (new
'static
'boxed-array
:type entity-info :length 19 :allocated-length 19
(new 'static 'entity-info
:ptype
(type-ref sage-finalboss :method-count 53)
:package "l1"
:art-group '()
:pool '*16k-dead-pool*
:heap-size #x8000
)
(new 'static 'entity-info
:ptype (type-ref robotboss :method-count 21)
:package "l1"
:art-group '()
:pool '*16k-dead-pool*
:heap-size #x8000
)
(new 'static 'entity-info
:ptype
(type-ref assistant-levitator :method-count 53)
:package "l1"
:art-group '()
:pool '*16k-dead-pool*
:heap-size #x8000
)
(new 'static 'entity-info
:ptype (type-ref babak :method-count 76)
:package "l1"
:art-group '("babak")
:pool '*16k-dead-pool*
:heap-size #x2800
)
(new 'static 'entity-info
:ptype (type-ref racer :method-count 24)
:package "game"
:art-group '("racer")
:pool '*16k-dead-pool*
:heap-size #x4000
)
(new 'static 'entity-info
:ptype (type-ref springbox :method-count 20)
:package "game"
:art-group '("bounceytarp")
:pool '*16k-dead-pool*
:heap-size #x1400
)
(new 'static 'entity-info
:ptype (type-ref launcher :method-count 20)
:package "game"
:art-group '()
:pool '*16k-dead-pool*
:heap-size #x400
)
(new 'static 'entity-info
:ptype
(type-ref pickup-spawner :method-count 30)
:package "game"
:art-group '()
:pool '*16k-dead-pool*
:heap-size #xc00
)
(new 'static 'entity-info
:ptype (type-ref bucket :method-count 30)
:package "game"
:art-group '()
:pool '*16k-dead-pool*
:heap-size #xc00
)
(new 'static 'entity-info
:ptype (type-ref barrel :method-count 30)
:package "game"
:art-group '()
:pool '*16k-dead-pool*
:heap-size #xc00
)
(new 'static 'entity-info
:ptype (type-ref crate :method-count 30)
:package "game"
:art-group '()
:pool '*16k-dead-pool*
:heap-size #xc00
)
(new 'static 'entity-info
:ptype
(type-ref orb-cache-top :method-count 29)
:package "game"
:art-group '("orb-cache-top")
:pool '*16k-dead-pool*
:heap-size #x1000
)
(new 'static 'entity-info
:ptype (type-ref eco :method-count 31)
:package "game"
:art-group '()
:pool '*16k-dead-pool*
:heap-size #x1000
)
(new 'static 'entity-info
:ptype (type-ref ecovent :method-count 21)
:package "game"
:art-group '()
:pool '*16k-dead-pool*
:heap-size #x1000
)
(new 'static 'entity-info
:ptype (type-ref fuel-cell :method-count 31)
:package "game"
:art-group '()
:pool '*16k-dead-pool*
:heap-size #x1400
)
(new 'static 'entity-info
:ptype (type-ref buzzer :method-count 31)
:package "game"
:art-group '()
:pool '*16k-dead-pool*
:heap-size #x1000
)
(new 'static 'entity-info
:ptype (type-ref money :method-count 31)
:package "game"
:art-group '()
:pool '*16k-dead-pool*
:heap-size #x800
)
(new 'static 'entity-info
:ptype (type-ref water-vol :method-count 30)
:package "game"
:art-group '()
:pool '*16k-dead-pool*
:heap-size #xc00
)
(new 'static 'entity-info
:ptype
(type-ref target-start :method-count 15)
:package "game"
:art-group '()
:pool '*16k-dead-pool*
:heap-size #x400
)
)
)
)
;; definition for function entity-info-lookup
;; INFO: Return type mismatch basic vs entity-info.
(defun entity-info-lookup ((arg0 type))
(the-as entity-info (cond
((nonzero? (-> arg0 method-table 13))
(-> arg0 method-table 13)
)
(else
(let ((v1-1 *entity-info*))
(dotimes (a1-0 (-> v1-1 length))
(when (= arg0 (-> v1-1 a1-0 ptype))
(set!
(-> arg0 method-table 13)
(the-as function (-> v1-1 a1-0))
)
(return (the-as entity-info (-> v1-1 a1-0)))
)
)
((nonzero? (-> arg0 method-table 13))
(-> arg0 method-table 13)
)
(set! (-> arg0 method-table 13) #f)
#f
(else
(let ((v1-1 *entity-info*))
(dotimes (a1-0 (-> v1-1 length))
(when (= arg0 (-> v1-1 a1-0 ptype))
(set! (-> arg0 method-table 13) (the-as function (-> v1-1 a1-0)))
(return (the-as entity-info (-> v1-1 a1-0)))
)
)
)
(set! (-> arg0 method-table 13) #f)
#f
)
)
)
)
)
)
+199 -239
View File
@@ -4,88 +4,78 @@
;; definition for method 7 of type process
(defmethod relocate process ((obj process) (arg0 int))
(let ((v1-0 *kernel-context*))
(set! (-> v1-0 relocating-process) obj)
(set! (-> v1-0 relocating-min) (the-as int (&-> obj type)))
(set!
(-> v1-0 relocating-max)
(the-as
int
(+ (+ (-> obj allocated-length) -4 (-> process size)) (the-as int obj))
)
(set! (-> v1-0 relocating-process) obj)
(set! (-> v1-0 relocating-min) (the-as int (&-> obj type)))
(set! (-> v1-0 relocating-max)
(the-as int (+ (+ (-> obj allocated-length) -4 (-> process size)) (the-as int obj)))
)
(set! (-> v1-0 relocating-offset) arg0)
)
(set! (-> v1-0 relocating-offset) arg0)
)
(&+! (-> obj ppointer 0) arg0)
(let ((v1-5 (-> obj entity)))
(if (and v1-5 (= (-> v1-5 extra process) obj))
(&+! (-> v1-5 extra process) arg0)
(if (and v1-5 (= (-> v1-5 extra process) obj))
(&+! (-> v1-5 extra process) arg0)
)
)
)
(let ((v1-7 (-> obj connection-list next1)))
(while (the-as connection v1-7)
(let ((a0-14 (-> v1-7 prev1)))
(if
(and
(>= (the-as int a0-14) (-> *kernel-context* relocating-min))
(< (the-as int a0-14) (-> *kernel-context* relocating-max))
)
(&+! (-> v1-7 prev1) arg0)
(while (the-as connection v1-7)
(let ((a0-14 (-> v1-7 prev1)))
(if (and
(>= (the-as int a0-14) (-> *kernel-context* relocating-min))
(< (the-as int a0-14) (-> *kernel-context* relocating-max))
)
(&+! (-> v1-7 prev1) arg0)
)
)
(let ((a0-19 (-> (the-as connection v1-7) param1)))
(if (and
(>= (the-as int a0-19) (-> *kernel-context* relocating-min))
(< (the-as int a0-19) (-> *kernel-context* relocating-max))
)
(&+! (-> (the-as connection v1-7) param1) arg0)
)
)
(let ((a0-24 (-> (the-as connection v1-7) param2)))
(if (and
(>= (the-as int a0-24) (-> *kernel-context* relocating-min))
(< (the-as int a0-24) (-> *kernel-context* relocating-max))
)
(&+! (-> (the-as connection v1-7) param2) arg0)
)
)
(let ((a0-29 (-> (the-as connection v1-7) param3)))
(if (and
(>= (the-as int a0-29) (-> *kernel-context* relocating-min))
(< (the-as int a0-29) (-> *kernel-context* relocating-max))
)
(&+! (-> (the-as connection v1-7) param3) arg0)
)
)
(set! v1-7 (-> (the-as connection v1-7) next1))
)
)
(let ((a0-19 (-> (the-as connection v1-7) param1)))
(if
(and
(>= (the-as int a0-19) (-> *kernel-context* relocating-min))
(< (the-as int a0-19) (-> *kernel-context* relocating-max))
)
(&+! (-> (the-as connection v1-7) param1) arg0)
)
)
(let ((a0-24 (-> (the-as connection v1-7) param2)))
(if
(and
(>= (the-as int a0-24) (-> *kernel-context* relocating-min))
(< (the-as int a0-24) (-> *kernel-context* relocating-max))
)
(&+! (-> (the-as connection v1-7) param2) arg0)
)
)
(let ((a0-29 (-> (the-as connection v1-7) param3)))
(if
(and
(>= (the-as int a0-29) (-> *kernel-context* relocating-min))
(< (the-as int a0-29) (-> *kernel-context* relocating-max))
)
(&+! (-> (the-as connection v1-7) param3) arg0)
)
)
(set! v1-7 (-> (the-as connection v1-7) next1))
)
)
(let ((v1-10 (-> obj self)))
(if
(and
(>= (the-as int v1-10) (-> *kernel-context* relocating-min))
(< (the-as int v1-10) (-> *kernel-context* relocating-max))
)
(&+! (-> obj self) arg0)
(if (and
(>= (the-as int v1-10) (-> *kernel-context* relocating-min))
(< (the-as int v1-10) (-> *kernel-context* relocating-max))
)
(&+! (-> obj self) arg0)
)
)
)
(let ((v1-15 (-> obj ppointer)))
(if
(and
(>= (the-as int v1-15) (-> *kernel-context* relocating-min))
(< (the-as int v1-15) (-> *kernel-context* relocating-max))
)
(&+! (-> obj ppointer) arg0)
(if (and
(>= (the-as int v1-15) (-> *kernel-context* relocating-min))
(< (the-as int v1-15) (-> *kernel-context* relocating-max))
)
(&+! (-> obj ppointer) arg0)
)
)
)
(let ((s4-0 (&+ (-> obj heap-base) 4)))
(while (< (the-as int s4-0) (the-as int (-> obj heap-cur)))
(relocate s4-0 arg0)
(&+! s4-0 (logand -16 (+ (asize-of s4-0) 15)))
(while (< (the-as int s4-0) (the-as int (-> obj heap-cur)))
(relocate s4-0 arg0)
(&+! s4-0 (logand -16 (+ (asize-of s4-0) 15)))
)
)
)
(&+! (-> obj main-thread) arg0)
(&+! (-> obj top-thread) arg0)
(&+! (-> obj heap-base) arg0)
@@ -94,18 +84,18 @@
(let ((a2-4 (asize-of obj))
(a1-22 (&-> obj type))
)
(cond
((>= arg0 0)
(qmem-copy->! (&+ a1-22 arg0) a1-22 a2-4)
)
((< a2-4 2560)
(qmem-copy<-! (&+ a1-22 arg0) a1-22 a2-4)
)
(else
(ultimate-memcpy (&+ a1-22 arg0) a1-22 (the-as uint a2-4))
)
(cond
((>= arg0 0)
(qmem-copy->! (&+ a1-22 arg0) a1-22 a2-4)
)
((< a2-4 2560)
(qmem-copy<-! (&+ a1-22 arg0) a1-22 a2-4)
)
(else
(ultimate-memcpy (&+ a1-22 arg0) a1-22 (the-as uint a2-4))
)
)
)
)
(set! (-> *kernel-context* relocating-process) #f)
(&+ obj arg0)
)
@@ -120,56 +110,52 @@
;; INFO: Return type mismatch process vs process-drawable.
(defmethod relocate process-drawable ((obj process-drawable) (arg0 int))
(let ((v1-0 *kernel-context*))
(set! (-> v1-0 relocating-process) obj)
(set! (-> v1-0 relocating-min) (the-as int (&-> obj type)))
(set!
(-> v1-0 relocating-max)
(the-as
int
(+ (+ (-> obj allocated-length) -4 (-> process size)) (the-as int obj))
)
(set! (-> v1-0 relocating-process) obj)
(set! (-> v1-0 relocating-min) (the-as int (&-> obj type)))
(set! (-> v1-0 relocating-max)
(the-as int (+ (+ (-> obj allocated-length) -4 (-> process size)) (the-as int obj)))
)
(set! (-> v1-0 relocating-offset) arg0)
)
(set! (-> v1-0 relocating-offset) arg0)
)
(if (nonzero? (-> obj root))
(&+! (-> obj root) arg0)
)
(&+! (-> obj root) arg0)
)
(if (nonzero? (-> obj node-list))
(&+! (-> obj node-list) arg0)
)
(&+! (-> obj node-list) arg0)
)
(if (nonzero? (-> obj draw))
(&+! (-> obj draw) arg0)
)
(&+! (-> obj draw) arg0)
)
(if (nonzero? (-> obj skel))
(&+! (-> obj skel) arg0)
)
(&+! (-> obj skel) arg0)
)
(if (nonzero? (-> obj nav))
(&+! (-> obj nav) arg0)
)
(&+! (-> obj nav) arg0)
)
(if (nonzero? (-> obj align))
(&+! (-> obj align) arg0)
)
(&+! (-> obj align) arg0)
)
(if (nonzero? (-> obj path))
(&+! (-> obj path) arg0)
)
(&+! (-> obj path) arg0)
)
(if (nonzero? (-> obj vol))
(&+! (-> obj vol) arg0)
)
(&+! (-> obj vol) arg0)
)
(if (nonzero? (-> obj fact))
(&+! (-> obj fact) arg0)
)
(&+! (-> obj fact) arg0)
)
(if (nonzero? (-> obj link))
(&+! (-> obj link) arg0)
)
(&+! (-> obj link) arg0)
)
(if (nonzero? (-> obj part))
(&+! (-> obj part) arg0)
)
(&+! (-> obj part) arg0)
)
(if (nonzero? (-> obj water))
(&+! (-> obj water) arg0)
)
(&+! (-> obj water) arg0)
)
(if (nonzero? (-> obj sound))
(&+! (-> obj sound) arg0)
)
(&+! (-> obj sound) arg0)
)
(the-as process-drawable ((method-of-type process relocate) obj arg0))
)
@@ -178,8 +164,8 @@
(&+! (-> obj process) arg0)
(&+! (-> obj root-prim) arg0)
(if (-> obj riders)
(&+! (-> obj riders) arg0)
)
(&+! (-> obj riders) arg0)
)
obj
)
@@ -187,26 +173,20 @@
;; INFO: Return type mismatch collide-shape vs collide-shape-moving.
(defmethod relocate collide-shape-moving ((obj collide-shape-moving) (arg0 int))
(if (-> obj dynam)
(&+! (-> obj dynam) arg0)
)
(the-as
collide-shape-moving
((method-of-type collide-shape relocate) obj arg0)
)
(&+! (-> obj dynam) arg0)
)
(the-as collide-shape-moving ((method-of-type collide-shape relocate) obj arg0))
)
;; definition for method 7 of type collide-sticky-rider-group
(defmethod
relocate
collide-sticky-rider-group
((obj collide-sticky-rider-group) (arg0 int))
(defmethod relocate collide-sticky-rider-group ((obj collide-sticky-rider-group) (arg0 int))
(countdown (v1-0 (-> obj num-riders))
(let ((a2-2 (-> obj rider v1-0)))
(if (-> a2-2 sticky-prim)
(&+! (-> a2-2 sticky-prim) arg0)
)
(let ((a2-2 (-> obj rider v1-0)))
(if (-> a2-2 sticky-prim)
(&+! (-> a2-2 sticky-prim) arg0)
)
)
)
)
obj
)
@@ -217,14 +197,11 @@
)
;; definition for method 7 of type collide-shape-prim-group
(defmethod
relocate
collide-shape-prim-group
((obj collide-shape-prim-group) (arg0 int))
(defmethod relocate collide-shape-prim-group ((obj collide-shape-prim-group) (arg0 int))
(&+! (-> obj cshape) arg0)
(countdown (v1-2 (-> obj num-prims))
(&+! (-> obj prims v1-2) arg0)
)
(&+! (-> obj prims v1-2) arg0)
)
obj
)
@@ -239,69 +216,62 @@
(&+! (-> obj skeleton) arg0)
(&+! (-> obj process) arg0)
(when (-> obj ripple)
(if (-> obj ripple query)
(&+! (-> obj ripple query) arg0)
(if (-> obj ripple query)
(&+! (-> obj ripple query) arg0)
)
(&+! (-> obj ripple) arg0)
)
(&+! (-> obj ripple) arg0)
)
(let ((v1-14 (-> obj shadow-ctrl)))
(if
(and
(>= (the-as int v1-14) (-> *kernel-context* relocating-min))
(< (the-as int v1-14) (-> *kernel-context* relocating-max))
)
(&+! (-> obj shadow-ctrl) arg0)
(if (and
(>= (the-as int v1-14) (-> *kernel-context* relocating-min))
(< (the-as int v1-14) (-> *kernel-context* relocating-max))
)
(&+! (-> obj shadow-ctrl) arg0)
)
)
)
obj
)
;; definition for method 7 of type joint-control
(defmethod relocate joint-control ((obj joint-control) (arg0 int))
(if (-> obj effect)
(&+! (-> obj effect) arg0)
)
(set!
(-> obj root-channel)
(the-as
(inline-array joint-control-channel)
(+ (the-as uint (-> obj root-channel)) arg0)
)
)
(&+! (-> obj effect) arg0)
)
(set! (-> obj root-channel)
(the-as (inline-array joint-control-channel) (+ (the-as uint (-> obj root-channel)) arg0))
)
(countdown (v1-6 (-> obj allocated-length))
(&+! (-> obj channel v1-6 parent) arg0)
)
(&+! (-> obj channel v1-6 parent) arg0)
)
obj
)
;; definition for method 7 of type cspace-array
(defmethod relocate cspace-array ((obj cspace-array) (arg0 int))
(countdown (v1-0 (-> obj length))
(let ((a2-2 (-> obj data v1-0)))
(if (-> a2-2 parent)
(&+! (-> a2-2 parent) arg0)
)
(&+! (-> a2-2 bone) arg0)
(let ((a3-6 (-> a2-2 param1)))
(if
(and
(>= (the-as int a3-6) (-> *kernel-context* relocating-min))
(< (the-as int a3-6) (-> *kernel-context* relocating-max))
)
(&+! (-> a2-2 param1) arg0)
(let ((a2-2 (-> obj data v1-0)))
(if (-> a2-2 parent)
(&+! (-> a2-2 parent) arg0)
)
(&+! (-> a2-2 bone) arg0)
(let ((a3-6 (-> a2-2 param1)))
(if (and
(>= (the-as int a3-6) (-> *kernel-context* relocating-min))
(< (the-as int a3-6) (-> *kernel-context* relocating-max))
)
(&+! (-> a2-2 param1) arg0)
)
)
(let ((a3-11 (-> a2-2 param2)))
(if (and
(>= (the-as int a3-11) (-> *kernel-context* relocating-min))
(< (the-as int a3-11) (-> *kernel-context* relocating-max))
)
(&+! (-> a2-2 param2) arg0)
)
)
)
)
(let ((a3-11 (-> a2-2 param2)))
(if
(and
(>= (the-as int a3-11) (-> *kernel-context* relocating-min))
(< (the-as int a3-11) (-> *kernel-context* relocating-max))
)
(&+! (-> a2-2 param2) arg0)
)
)
)
)
obj
)
@@ -362,45 +332,35 @@
)
;; definition for method 7 of type sparticle-launch-control
(defmethod
relocate
sparticle-launch-control
((obj sparticle-launch-control) (arg0 int))
(defmethod relocate sparticle-launch-control ((obj sparticle-launch-control) (arg0 int))
(&+! (-> obj proc) arg0)
(countdown (v1-2 (-> obj length))
(let* ((a0-3 (-> obj data v1-2))
(a2-0 (-> a0-3 origin))
(let* ((a0-3 (-> obj data v1-2))
(a2-0 (-> a0-3 origin))
)
(if (and
(>= (the-as int a2-0) (-> *kernel-context* relocating-min))
(< (the-as int a2-0) (-> *kernel-context* relocating-max))
)
(&+! (-> a0-3 origin) arg0)
)
(if
(and
(>= (the-as int a2-0) (-> *kernel-context* relocating-min))
(< (the-as int a2-0) (-> *kernel-context* relocating-max))
)
(&+! (-> a0-3 origin) arg0)
)
)
)
(forall-particles-with-key
obj
(lambda ((arg0 sparticle-system) (arg1 sparticle-cpuinfo))
(let ((v1-1 (-> *kernel-context* relocating-offset)))
(set!
(-> arg1 key)
(the-as sparticle-launch-control (+ (the-as int (-> arg1 key)) v1-1))
obj
(lambda ((arg0 sparticle-system) (arg1 sparticle-cpuinfo))
(let ((v1-1 (-> *kernel-context* relocating-offset)))
(set! (-> arg1 key) (the-as sparticle-launch-control (+ (the-as int (-> arg1 key)) v1-1)))
(if (-> arg1 binding)
(set! (-> arg1 binding) (the-as sparticle-launch-state (+ (the-as int (-> arg1 binding)) v1-1)))
)
)
0
(none)
)
(if (-> arg1 binding)
(set!
(-> arg1 binding)
(the-as sparticle-launch-state (+ (the-as int (-> arg1 binding)) v1-1))
)
)
)
0
(none)
#t
#t
)
#t
#t
)
obj
)
@@ -408,8 +368,8 @@
;; INFO: Return type mismatch process vs camera-master.
(defmethod relocate camera-master ((obj camera-master) (arg0 int))
(if (nonzero? (-> obj water-drip))
(&+! (-> obj water-drip) arg0)
)
(&+! (-> obj water-drip) arg0)
)
(the-as camera-master ((method-of-type process relocate) obj arg0))
)
@@ -417,17 +377,17 @@
;; INFO: Return type mismatch process vs time-of-day-proc.
(defmethod relocate time-of-day-proc ((obj time-of-day-proc) (arg0 int))
(if (nonzero? (-> obj stars))
(&+! (-> obj stars) arg0)
)
(&+! (-> obj stars) arg0)
)
(if (nonzero? (-> obj sun))
(&+! (-> obj sun) arg0)
)
(&+! (-> obj sun) arg0)
)
(if (nonzero? (-> obj green-sun))
(&+! (-> obj green-sun) arg0)
)
(&+! (-> obj green-sun) arg0)
)
(if (nonzero? (-> obj moon))
(&+! (-> obj moon) arg0)
)
(&+! (-> obj moon) arg0)
)
(the-as time-of-day-proc ((method-of-type process relocate) obj arg0))
)
@@ -435,8 +395,8 @@
;; INFO: Return type mismatch process vs swingpole.
(defmethod relocate swingpole ((obj swingpole) (arg0 int))
(if (nonzero? (-> obj root))
(&+! (-> obj root) arg0)
)
(&+! (-> obj root) arg0)
)
(the-as swingpole ((method-of-type process relocate) obj arg0))
)
@@ -444,11 +404,11 @@
;; INFO: Return type mismatch process vs part-tracker.
(defmethod relocate part-tracker ((obj part-tracker) (arg0 int))
(if (nonzero? (-> obj root))
(&+! (-> obj root) arg0)
)
(&+! (-> obj root) arg0)
)
(if (nonzero? (-> obj part))
(&+! (-> obj part) arg0)
)
(&+! (-> obj part) arg0)
)
(the-as part-tracker ((method-of-type process relocate) obj arg0))
)
@@ -456,16 +416,16 @@
;; INFO: Return type mismatch process-drawable vs manipy.
(defmethod relocate manipy ((obj manipy) (arg0 int))
(if (nonzero? (-> obj joint 0))
(&+! (-> obj joint 0) arg0)
)
(&+! (-> obj joint 0) arg0)
)
(if (nonzero? (-> obj joint 1))
(&+! (-> obj joint 1) arg0)
)
(&+! (-> obj joint 1) arg0)
)
(if (nonzero? (-> obj joint 2))
(&+! (-> obj joint 2) arg0)
)
(&+! (-> obj joint 2) arg0)
)
(if (nonzero? (-> obj joint 3))
(&+! (-> obj joint 3) arg0)
)
(&+! (-> obj joint 3) arg0)
)
(the-as manipy ((method-of-type process-drawable relocate) obj arg0))
)
File diff suppressed because it is too large Load Diff
+9 -16
View File
@@ -41,26 +41,19 @@
)
;; definition for method 0 of type effect-control
(defmethod
new
effect-control
((allocation symbol) (type-to-make type) (arg0 process-drawable))
(defmethod new effect-control ((allocation symbol) (type-to-make type) (arg0 process-drawable))
(cond
((res-lump-struct (-> arg0 draw jgeo extra) 'effect-name structure)
(let
((v0-1
(object-new allocation type-to-make (the-as int (-> type-to-make size)))
((res-lump-struct (-> arg0 draw jgeo extra) 'effect-name structure)
(let ((v0-1 (object-new allocation type-to-make (the-as int (-> type-to-make size)))))
(set! (-> v0-1 process) arg0)
(set! (-> v0-1 last-frame-group) #f)
v0-1
)
)
(set! (-> v0-1 process) arg0)
(set! (-> v0-1 last-frame-group) #f)
v0-1
)
(else
(the-as effect-control #f)
)
)
(else
(the-as effect-control #f)
)
)
)
;; definition for method 13 of type effect-control
File diff suppressed because it is too large Load Diff
+105 -168
View File
@@ -46,63 +46,61 @@
)
;; definition for symbol *FACT-bank*, type fact-bank
(define
*FACT-bank*
(new 'static 'fact-bank
:eco-level-max 2.0
:eco-single-inc 1.0
:eco-full-inc 5.0
:eco-single-timeout (seconds 5)
:eco-full-timeout (seconds 20)
:dummy (seconds 15)
:health-max-default 3.0
:health-single-inc 1.0
:eco-pill-max-default 50.0
:health-small-inc 1.0
:buzzer-max-default 7.0
:buzzer-single-inc 1.0
:suck-bounce-dist (meters 18.0)
:suck-suck-dist (meters 7.5)
)
)
(define *FACT-bank* (new 'static 'fact-bank
:eco-level-max 2.0
:eco-single-inc 1.0
:eco-full-inc 5.0
:eco-single-timeout (seconds 5)
:eco-full-timeout (seconds 20)
:dummy (seconds 15)
:health-max-default 3.0
:health-single-inc 1.0
:eco-pill-max-default 50.0
:health-small-inc 1.0
:buzzer-max-default 7.0
:buzzer-single-inc 1.0
:suck-bounce-dist (meters 18.0)
:suck-suck-dist (meters 7.5)
)
)
;; definition for function pickup-type->string
(defun pickup-type->string ((arg0 pickup-type))
(case arg0
(((pickup-type eco-pill-random))
(case arg0
(((pickup-type eco-pill-random))
"eco-pill-random"
)
(((pickup-type buzzer))
"buzzer"
(((pickup-type buzzer))
"buzzer"
)
(((pickup-type eco-pill))
"eco-pill"
)
(((pickup-type fuel-cell))
"fuel-cell"
)
(((pickup-type money))
"money"
)
(((pickup-type eco-green))
"eco-green"
)
(((pickup-type eco-blue))
"eco-blue"
)
(((pickup-type eco-red))
"eco-red"
)
(((pickup-type eco-yellow))
"eco-yellow"
)
(((pickup-type none))
"none"
)
(else
"*unknown*"
)
)
(((pickup-type eco-pill))
"eco-pill"
)
(((pickup-type fuel-cell))
"fuel-cell"
)
(((pickup-type money))
"money"
)
(((pickup-type eco-green))
"eco-green"
)
(((pickup-type eco-blue))
"eco-blue"
)
(((pickup-type eco-red))
"eco-red"
)
(((pickup-type eco-yellow))
"eco-yellow"
)
(((pickup-type none))
"none"
)
(else
"*unknown*"
)
)
)
;; definition of type fact-info
@@ -233,138 +231,77 @@
;; definition for method 0 of type fact-info
;; Used lq/sq
(defmethod
new
fact-info
((allocation symbol)
(type-to-make type)
(proc process-drawable)
(pkup-type pickup-type)
(pkup-amount float)
)
(defmethod new fact-info ((allocation symbol) (type-to-make type) (proc process-drawable) (pkup-type pickup-type) (pkup-amount float))
(local-vars (tag res-tag))
(let
((obj
(object-new allocation type-to-make (the-as int (-> type-to-make size)))
)
)
(let ((ent (-> proc entity)))
(when (zero? obj)
(go process-drawable-art-error "memory")
(set! obj (the-as fact-info 0))
(goto cfg-10)
)
(set! (-> obj process) proc)
(set! tag (new 'static 'res-tag))
(let
((v1-6
(res-lump-data ent 'eco-info (pointer int32) :tag-ptr (& tag) :time 0.0)
)
)
(cond
(v1-6
(let ((a0-6 (-> tag elt-count)))
(set! (-> obj pickup-type) (the-as pickup-type (-> v1-6 0)))
(set! pkup-amount (cond
((< (the-as uint 1) a0-6)
(the float (-> v1-6 1))
)
(else
(empty)
pkup-amount
)
)
)
(let ((obj (object-new allocation type-to-make (the-as int (-> type-to-make size)))))
(let ((ent (-> proc entity)))
(when (zero? obj)
(go process-drawable-art-error "memory")
(set! obj (the-as fact-info 0))
(goto cfg-10)
)
(set! (-> obj pickup-amount) pkup-amount)
)
(else
(set! (-> obj pickup-type) pkup-type)
(set! (-> obj pickup-amount) pkup-amount)
)
(set! (-> obj process) proc)
(set! tag (new 'static 'res-tag))
(let ((v1-6 (res-lump-data ent 'eco-info (pointer int32) :tag-ptr (& tag) :time 0.0)))
(cond
(v1-6
(let ((a0-6 (-> tag elt-count)))
(set! (-> obj pickup-type) (the-as pickup-type (-> v1-6 0)))
(set! pkup-amount (cond
((< (the-as uint 1) a0-6)
(the float (-> v1-6 1))
)
(else
(empty)
pkup-amount
)
)
)
)
(set! (-> obj pickup-amount) pkup-amount)
)
(else
(set! (-> obj pickup-type) pkup-type)
(set! (-> obj pickup-amount) pkup-amount)
)
)
)
(set! (-> obj options) (res-lump-value ent 'options fact-options))
(if (logtest? (fact-options fade respawn) (-> obj options))
(set! (-> obj fade-time) (the int (* 300.0 (res-lump-float ent 'timeout))))
)
)
)
(set! (-> obj options) (res-lump-value ent 'options fact-options))
(if (logtest? (fact-options fade respawn) (-> obj options))
(set! (-> obj fade-time) (the int (* 300.0 (res-lump-float ent 'timeout))))
)
(label cfg-10)
obj
)
(label cfg-10)
obj
)
)
;; definition for method 11 of type fact-info
(defmethod
pickup-collectable!
fact-info
((obj fact-info) (arg0 pickup-type) (arg1 float) (arg2 handle))
(defmethod pickup-collectable! fact-info ((obj fact-info) (arg0 pickup-type) (arg1 float) (arg2 handle))
0.0
)
;; definition for method 0 of type fact-info-enemy
(defmethod
new
fact-info-enemy
((allocation symbol)
(type-to-make type)
(arg0 process-drawable)
(arg1 pickup-type)
(arg2 float)
)
(let
((obj
(the-as
fact-info-enemy
((method-of-type fact-info new) allocation type-to-make arg0 arg1 arg2)
(defmethod new fact-info-enemy ((allocation symbol) (type-to-make type) (arg0 process-drawable) (arg1 pickup-type) (arg2 float))
(let ((obj (the-as fact-info-enemy ((method-of-type fact-info new) allocation type-to-make arg0 arg1 arg2))))
(let ((entity (-> obj process entity)))
(set! (-> obj speed) (res-lump-float entity 'speed :default 1.0))
(set! (-> obj idle-distance) (res-lump-float entity 'idle-distance :default 327680.0))
(set! (-> obj notice-top) (res-lump-float entity 'notice-top :default 4096000.0))
(set! (-> obj notice-bottom) (res-lump-float entity 'notice-bottom :default 4096000.0))
(set! (-> obj cam-horz) (res-lump-float entity 'cam-horz))
(set! (-> obj cam-vert) (res-lump-float entity 'cam-vert))
(set! (-> obj cam-notice-dist) (res-lump-float entity 'cam-notice-dist :default -4096.0))
)
)
obj
)
(let ((entity (-> obj process entity)))
(set! (-> obj speed) (res-lump-float entity 'speed :default 1.0))
(set!
(-> obj idle-distance)
(res-lump-float entity 'idle-distance :default 327680.0)
)
(set!
(-> obj notice-top)
(res-lump-float entity 'notice-top :default 4096000.0)
)
(set!
(-> obj notice-bottom)
(res-lump-float entity 'notice-bottom :default 4096000.0)
)
(set! (-> obj cam-horz) (res-lump-float entity 'cam-horz))
(set! (-> obj cam-vert) (res-lump-float entity 'cam-vert))
(set!
(-> obj cam-notice-dist)
(res-lump-float entity 'cam-notice-dist :default -4096.0)
)
)
obj
)
)
;; definition for method 0 of type fact-info-target
(defmethod
new
fact-info-target
((allocation symbol)
(type-to-make type)
(arg0 process-drawable)
(arg1 pickup-type)
(arg2 float)
)
(let
((obj
(the-as
fact-info-target
((method-of-type fact-info new) allocation type-to-make arg0 arg1 arg2)
)
)
(defmethod new fact-info-target ((allocation symbol) (type-to-make type) (arg0 process-drawable) (arg1 pickup-type) (arg2 float))
(let ((obj (the-as fact-info-target ((method-of-type fact-info new) allocation type-to-make arg0 arg1 arg2))))
(set! (-> obj eco-source) (the-as handle #f))
(reset! obj #f)
obj
)
(set! (-> obj eco-source) (the-as handle #f))
(reset! obj #f)
obj
)
)
+4 -4
View File
@@ -36,8 +36,8 @@
;; definition for method 3 of type process-drawable
(defmethod inspect process-drawable ((obj process-drawable))
(let ((t9-0 (method-of-type process inspect)))
(t9-0 obj)
)
(t9-0 obj)
)
(format #t "~T~Troot: ~A~%" (-> obj root))
(format #t "~T~Tnode-list: ~A~%" (-> obj node-list))
(format #t "~T~Tdraw: ~A~%" (-> obj draw))
@@ -113,8 +113,8 @@
;; definition for method 3 of type process-drawable-reserved
(defmethod inspect process-drawable-reserved ((obj process-drawable-reserved))
(let ((t9-0 (method-of-type process-drawable inspect)))
(t9-0 obj)
)
(t9-0 obj)
)
obj
)
+17 -33
View File
@@ -28,16 +28,14 @@
)
;; definition for symbol *GAME-bank*, type game-bank
(define
*GAME-bank*
(new 'static 'game-bank
:life-max-default 99.0
:life-start-default 5.0
:life-single-inc 1.0
:money-task-inc 90.0
:money-oracle-inc 120.0
)
)
(define *GAME-bank* (new 'static 'game-bank
:life-max-default 99.0
:life-start-default 5.0
:life-single-inc 1.0
:money-task-inc 90.0
:money-oracle-inc 120.0
)
)
;; definition of type actor-id
(deftype actor-id (uint32)
@@ -111,9 +109,7 @@
;; definition for method 0 of type load-state
(defmethod new load-state ((allocation symbol) (type-to-make type))
(reset!
(object-new allocation type-to-make (the-as int (-> type-to-make size)))
)
(reset! (object-new allocation type-to-make (the-as int (-> type-to-make size))))
)
;; definition of type continue-point
@@ -285,23 +281,11 @@
;; failed to figure out what this is:
(set! gp-0 (when (or (not *game-info*) (zero? *game-info*))
(set!
gp-0
(new 'static 'game-info :mode 'debug :current-continue #f)
)
(set!
(-> gp-0 fuel-cell-time)
(the-as (array int64) (new 'global 'boxed-array uint64 116))
)
(set!
(-> gp-0 enter-level-time)
(the-as (array int64) (new 'global 'boxed-array uint64 32))
)
(set!
(-> gp-0 in-level-time)
(the-as (array int64) (new 'global 'boxed-array uint64 32))
)
(set! *game-info* gp-0)
gp-0
)
)
(set! gp-0 (new 'static 'game-info :mode 'debug :current-continue #f))
(set! (-> gp-0 fuel-cell-time) (the-as (array int64) (new 'global 'boxed-array uint64 116)))
(set! (-> gp-0 enter-level-time) (the-as (array int64) (new 'global 'boxed-array uint64 32)))
(set! (-> gp-0 in-level-time) (the-as (array int64) (new 'global 'boxed-array uint64 32)))
(set! *game-info* gp-0)
gp-0
)
)
+935 -1310
View File
File diff suppressed because it is too large Load Diff
+1470 -2224
View File
File diff suppressed because it is too large Load Diff
+14 -14
View File
@@ -28,8 +28,8 @@
;; definition for method 3 of type manipy
(defmethod inspect manipy ((obj manipy))
(let ((t9-0 (method-of-type process-drawable inspect)))
(t9-0 obj)
)
(t9-0 obj)
)
(format #t "~T~Tnew-trans-hook: ~A~%" (-> obj new-trans-hook))
(format #t "~T~Tcur-trans-hook: ~A~%" (-> obj cur-trans-hook))
(format #t "~T~Tcur-event-hook: ~A~%" (-> obj cur-event-hook))
@@ -67,8 +67,8 @@
;; definition for method 3 of type part-spawner
(defmethod inspect part-spawner ((obj part-spawner))
(let ((t9-0 (method-of-type process-drawable inspect)))
(t9-0 obj)
)
(t9-0 obj)
)
(format #t "~T~Tmode: #x~X~%" (-> obj mode))
(format #t "~T~Tenable: ~A~%" (-> obj enable))
(format #t "~T~Tradius: (meters ~m)~%" (-> obj radius))
@@ -101,8 +101,8 @@
;; definition for method 3 of type part-tracker
(defmethod inspect part-tracker ((obj part-tracker))
(let ((t9-0 (method-of-type process inspect)))
(t9-0 obj)
)
(t9-0 obj)
)
(format #t "~T~Troot: ~A~%" (-> obj root))
(format #t "~T~Tpart: ~A~%" (-> obj part))
(format #t "~T~Ttarget: ~D~%" (-> obj target))
@@ -154,8 +154,8 @@
;; definition for method 3 of type camera-tracker
(defmethod inspect camera-tracker ((obj camera-tracker))
(let ((t9-0 (method-of-type process inspect)))
(t9-0 obj)
)
(t9-0 obj)
)
(format #t "~T~Tname: ~A~%" (-> obj name))
(format #t "~T~Tgrab-target: ~D~%" (-> obj grab-target))
(format #t "~T~Tgrab-event: ~A~%" (-> obj grab-event))
@@ -198,8 +198,8 @@
;; definition for method 3 of type touch-tracker
(defmethod inspect touch-tracker ((obj touch-tracker))
(let ((t9-0 (method-of-type process-drawable inspect)))
(t9-0 obj)
)
(t9-0 obj)
)
(format #t "~T~Tduration: ~D~%" (-> obj duration))
(format #t "~T~Ttarget: ~D~%" (-> obj target))
(format #t "~T~Tevent: ~A~%" (-> obj event))
@@ -225,8 +225,8 @@
;; definition for method 3 of type swingpole
(defmethod inspect swingpole ((obj swingpole))
(let ((t9-0 (method-of-type process inspect)))
(t9-0 obj)
)
(t9-0 obj)
)
(format #t "~T~Troot: ~A~%" (-> obj root))
(format #t "~T~Tdir: ~`vector`P~%" (-> obj dir))
(format #t "~T~Trange: (meters ~m)~%" (-> obj range))
@@ -290,8 +290,8 @@
;; definition for method 3 of type othercam
(defmethod inspect othercam ((obj othercam))
(let ((t9-0 (method-of-type process inspect)))
(t9-0 obj)
)
(t9-0 obj)
)
(format #t "~T~Thand: ~D~%" (-> obj hand))
(format #t "~T~Told-global-mask: ~D~%" (-> obj old-global-mask))
(format #t "~T~Tmask-to-clear: ~D~%" (-> obj mask-to-clear))
+1944 -2514
View File
File diff suppressed because it is too large Load Diff
+1276 -1536
View File
File diff suppressed because it is too large Load Diff
+6 -6
View File
@@ -47,8 +47,8 @@
;; definition for method 3 of type projectile
(defmethod inspect projectile ((obj projectile))
(let ((t9-0 (method-of-type process-drawable inspect)))
(t9-0 obj)
)
(t9-0 obj)
)
(format #t "~T~Tbase-trans: ~`vector`P~%" (-> obj base-trans))
(format #t "~T~Ttarget: ~`vector`P~%" (-> obj target))
(format #t "~T~Ttarget-base: ~`vector`P~%" (-> obj target-base))
@@ -88,8 +88,8 @@
;; definition for method 3 of type projectile-yellow
(defmethod inspect projectile-yellow ((obj projectile-yellow))
(let ((t9-0 (method-of-type projectile inspect)))
(t9-0 obj)
)
(t9-0 obj)
)
(format #t "~T~Tmode: ~D~%" (-> obj mode))
(format #t "~T~Tangle: ~f~%" (-> obj angle))
obj
@@ -109,8 +109,8 @@
;; definition for method 3 of type projectile-blue
(defmethod inspect projectile-blue ((obj projectile-blue))
(let ((t9-0 (method-of-type projectile inspect)))
(t9-0 obj)
)
(t9-0 obj)
)
(format #t "~T~Tmode: ~D~%" (-> obj mode))
(format #t "~T~Tjoint-num: ~D~%" (-> obj joint-num))
obj
+1060 -1520
View File
File diff suppressed because it is too large Load Diff
+4 -14
View File
@@ -125,21 +125,11 @@
)
;; definition for method 0 of type setting-control
(defmethod
new
setting-control
((allocation symbol) (type-to-make type) (arg0 int))
(let
((s4-0
(object-new allocation type-to-make (the-as int (-> type-to-make size)))
)
(defmethod new setting-control ((allocation symbol) (type-to-make type) (arg0 int))
(let ((s4-0 (object-new allocation type-to-make (the-as int (-> type-to-make size)))))
(set! (-> s4-0 engine) ((method-of-type engine new) allocation engine 'setting-control arg0))
s4-0
)
(set!
(-> s4-0 engine)
((method-of-type engine new) allocation engine 'setting-control arg0)
)
s4-0
)
)
;; definition of type scf-time
+374 -493
View File
@@ -6,238 +6,196 @@
(let ((conn (the-as connection (-> arg0 alive-list-end)))
(s4-0 (-> arg0 alive-list-end prev0))
)
(while (!= (the-as connectable conn) (-> arg0 alive-list))
(case (-> conn param0)
(('border-mode)
(set! (-> obj border-mode) (the-as symbol (-> conn param1)))
)
(('allow-look-around)
(set! (-> obj allow-look-around) (the-as symbol (-> conn param1)))
)
(('ocean-off)
(set! (-> obj ocean-off) (the-as symbol (-> conn param1)))
)
(('music)
(set! (-> obj music) (the-as symbol (-> conn param1)))
)
(('process-mask)
(case (-> conn param1)
(('set)
(logior! (-> obj process-mask) (the-as int (-> conn param3)))
(while (!= (the-as connectable conn) (-> arg0 alive-list))
(case (-> conn param0)
(('border-mode)
(set! (-> obj border-mode) (the-as symbol (-> conn param1)))
)
(('clear)
(logclear! (-> obj process-mask) (the-as uint (-> conn param3)))
)
(('abs)
(set!
(-> obj process-mask)
(the-as process-mask (the-as int (-> conn param3)))
(('allow-look-around)
(set! (-> obj allow-look-around) (the-as symbol (-> conn param1)))
)
)
)
)
(('sfx-volume)
(when
(or
(zero?
(logand (-> *kernel-context* prevent-from-run) (process-mask progress))
(('ocean-off)
(set! (-> obj ocean-off) (the-as symbol (-> conn param1)))
)
(= (get-process conn) (ppointer->process *progress-process*))
)
(case (the-as symbol (-> conn param1))
(('rel)
(set!
(-> obj sfx-volume)
(* 0.01 (the-as float (-> conn param2)) (-> obj sfx-volume))
(('music)
(set! (-> obj music) (the-as symbol (-> conn param1)))
)
(('process-mask)
(case (-> conn param1)
(('set)
(logior! (-> obj process-mask) (the-as int (-> conn param3)))
)
(('clear)
(logclear! (-> obj process-mask) (the-as uint (-> conn param3)))
)
(('abs)
(set! (-> obj process-mask) (the-as process-mask (the-as int (-> conn param3))))
)
)
)
(('sfx-volume)
(when (or
(zero? (logand (-> *kernel-context* prevent-from-run) (process-mask progress)))
(= (get-process conn) (ppointer->process *progress-process*))
)
(case (the-as symbol (-> conn param1))
(('rel)
(set! (-> obj sfx-volume) (* 0.01 (the-as float (-> conn param2)) (-> obj sfx-volume)))
)
(else
(set! (-> obj sfx-volume) (the-as float (-> conn param2)))
)
)
)
)
(('music-volume)
(case (the-as symbol (-> conn param1))
(('rel)
(set! (-> obj music-volume) (* 0.01 (the-as float (-> conn param2)) (-> obj music-volume)))
)
(else
(set! (-> obj music-volume) (the-as float (-> conn param2)))
)
)
)
(('ambient-volume)
(case (the-as symbol (-> conn param1))
(('rel)
(set! (-> obj ambient-volume) (* 0.01 (the-as float (-> conn param2)) (-> obj ambient-volume)))
)
(else
(set! (-> obj ambient-volume) (the-as float (-> conn param2)))
)
)
)
(('dialog-volume)
(case (the-as symbol (-> conn param1))
(('rel)
(set! (-> obj dialog-volume) (* 0.01 (the-as float (-> conn param2)) (-> obj dialog-volume)))
)
(else
(set! (-> obj dialog-volume) (the-as float (-> conn param2)))
)
)
)
(('sfx-volume-movie)
(case (the-as symbol (-> conn param1))
(('rel)
(set! (-> obj sfx-volume-movie) (* 0.01 (the-as float (-> conn param2)) (-> obj sfx-volume-movie)))
)
(else
(set! (-> obj sfx-volume-movie) (the-as float (-> conn param2)))
)
)
)
(('music-volume-movie)
(case (the-as symbol (-> conn param1))
(('rel)
(set! (-> obj music-volume-movie) (* 0.01 (the-as float (-> conn param2)) (-> obj music-volume-movie)))
)
(else
(set! (-> obj music-volume-movie) (the-as float (-> conn param2)))
)
)
)
(('ambient-volume-movie)
(case (the-as symbol (-> conn param1))
(('rel)
(set! (-> obj ambient-volume-movie) (* 0.01 (the-as float (-> conn param2)) (-> obj ambient-volume-movie)))
)
(else
(set! (-> obj ambient-volume-movie) (the-as float (-> conn param2)))
)
)
)
(('dialog-volume-hint)
(case (the-as symbol (-> conn param1))
(('rel)
(set! (-> obj dialog-volume-hint) (* 0.01 (the-as float (-> conn param2)) (-> obj dialog-volume-hint)))
)
(else
(set! (-> obj dialog-volume-hint) (the-as float (-> conn param2)))
)
)
)
(('sound-flava)
(when (>= (the-as float (-> conn param2)) (-> obj sound-flava-priority))
(set! (-> obj sound-flava) (the-as uint (the-as int (-> conn param3))))
(set! (-> obj sound-flava-priority) (the-as float (-> conn param2)))
)
)
(('bg-r)
(set! (-> obj bg-r) (the-as float (-> conn param2)))
)
(('bg-g)
(set! (-> obj bg-g) (the-as float (-> conn param2)))
)
(('bg-b)
(set! (-> obj bg-b) (the-as float (-> conn param2)))
)
(('bg-a)
(set! (-> obj bg-a) (the-as float (-> conn param2)))
)
(('bg-a-speed)
(set! (-> obj bg-a-speed) (the-as float (-> conn param2)))
)
(('bg-a-force)
(set! (-> obj bg-a-force) (the-as float (-> conn param2)))
)
(('language)
(set! (-> obj language) (the-as language-enum (the-as int (-> conn param3))))
)
(('vibration)
(set! (-> obj vibration) (the-as symbol (-> conn param1)))
)
(('auto-save)
(set! (-> obj auto-save) (the-as symbol (-> conn param1)))
)
(('allow-pause)
(set! (-> obj allow-pause) (the-as symbol (-> conn param1)))
)
(('allow-progress)
(set! (-> obj allow-progress) (the-as symbol (-> conn param1)))
)
(('play-hints)
(set! (-> obj play-hints) (the-as symbol (-> conn param1)))
)
(('movie)
(set! (-> obj movie) (the-as (pointer progress) (-> conn param1)))
)
(('talking)
(set! (-> obj talking) (the-as (pointer progress) (-> conn param1)))
)
(('spooling)
(set! (-> obj spooling) (the-as (pointer progress) (-> conn param1)))
)
(('hint)
(set! (-> obj hint) (the-as (pointer process) (-> conn param1)))
)
(('ambient)
(set! (-> obj ambient) (the-as (pointer progress) (-> conn param1)))
)
(('common-page)
(case (-> conn param1)
(('set)
(logior! (-> obj common-page) (the-as int (-> conn param3)))
)
(('clear)
(logclear! (-> obj common-page) (the-as uint (-> conn param3)))
)
)
)
(else
(set! (-> obj sfx-volume) (the-as float (-> conn param2)))
)
)
)
(set! conn (the-as connection s4-0))
(set! s4-0 (-> (the-as connectable conn) prev0))
)
(('music-volume)
(case (the-as symbol (-> conn param1))
(('rel)
(set!
(-> obj music-volume)
(* 0.01 (the-as float (-> conn param2)) (-> obj music-volume))
)
)
(else
(set! (-> obj music-volume) (the-as float (-> conn param2)))
)
)
)
(('ambient-volume)
(case (the-as symbol (-> conn param1))
(('rel)
(set!
(-> obj ambient-volume)
(* 0.01 (the-as float (-> conn param2)) (-> obj ambient-volume))
)
)
(else
(set! (-> obj ambient-volume) (the-as float (-> conn param2)))
)
)
)
(('dialog-volume)
(case (the-as symbol (-> conn param1))
(('rel)
(set!
(-> obj dialog-volume)
(* 0.01 (the-as float (-> conn param2)) (-> obj dialog-volume))
)
)
(else
(set! (-> obj dialog-volume) (the-as float (-> conn param2)))
)
)
)
(('sfx-volume-movie)
(case (the-as symbol (-> conn param1))
(('rel)
(set!
(-> obj sfx-volume-movie)
(* 0.01 (the-as float (-> conn param2)) (-> obj sfx-volume-movie))
)
)
(else
(set! (-> obj sfx-volume-movie) (the-as float (-> conn param2)))
)
)
)
(('music-volume-movie)
(case (the-as symbol (-> conn param1))
(('rel)
(set!
(-> obj music-volume-movie)
(* 0.01 (the-as float (-> conn param2)) (-> obj music-volume-movie))
)
)
(else
(set! (-> obj music-volume-movie) (the-as float (-> conn param2)))
)
)
)
(('ambient-volume-movie)
(case (the-as symbol (-> conn param1))
(('rel)
(set!
(-> obj ambient-volume-movie)
(* 0.01 (the-as float (-> conn param2)) (-> obj ambient-volume-movie))
)
)
(else
(set! (-> obj ambient-volume-movie) (the-as float (-> conn param2)))
)
)
)
(('dialog-volume-hint)
(case (the-as symbol (-> conn param1))
(('rel)
(set!
(-> obj dialog-volume-hint)
(* 0.01 (the-as float (-> conn param2)) (-> obj dialog-volume-hint))
)
)
(else
(set! (-> obj dialog-volume-hint) (the-as float (-> conn param2)))
)
)
)
(('sound-flava)
(when (>= (the-as float (-> conn param2)) (-> obj sound-flava-priority))
(set! (-> obj sound-flava) (the-as uint (the-as int (-> conn param3))))
(set! (-> obj sound-flava-priority) (the-as float (-> conn param2)))
)
)
(('bg-r)
(set! (-> obj bg-r) (the-as float (-> conn param2)))
)
(('bg-g)
(set! (-> obj bg-g) (the-as float (-> conn param2)))
)
(('bg-b)
(set! (-> obj bg-b) (the-as float (-> conn param2)))
)
(('bg-a)
(set! (-> obj bg-a) (the-as float (-> conn param2)))
)
(('bg-a-speed)
(set! (-> obj bg-a-speed) (the-as float (-> conn param2)))
)
(('bg-a-force)
(set! (-> obj bg-a-force) (the-as float (-> conn param2)))
)
(('language)
(set!
(-> obj language)
(the-as language-enum (the-as int (-> conn param3)))
)
)
(('vibration)
(set! (-> obj vibration) (the-as symbol (-> conn param1)))
)
(('auto-save)
(set! (-> obj auto-save) (the-as symbol (-> conn param1)))
)
(('allow-pause)
(set! (-> obj allow-pause) (the-as symbol (-> conn param1)))
)
(('allow-progress)
(set! (-> obj allow-progress) (the-as symbol (-> conn param1)))
)
(('play-hints)
(set! (-> obj play-hints) (the-as symbol (-> conn param1)))
)
(('movie)
(set! (-> obj movie) (the-as (pointer progress) (-> conn param1)))
)
(('talking)
(set! (-> obj talking) (the-as (pointer progress) (-> conn param1)))
)
(('spooling)
(set! (-> obj spooling) (the-as (pointer progress) (-> conn param1)))
)
(('hint)
(set! (-> obj hint) (the-as (pointer process) (-> conn param1)))
)
(('ambient)
(set! (-> obj ambient) (the-as (pointer progress) (-> conn param1)))
)
(('common-page)
(case (-> conn param1)
(('set)
(logior! (-> obj common-page) (the-as int (-> conn param3)))
)
(('clear)
(logclear! (-> obj common-page) (the-as uint (-> conn param3)))
)
)
)
)
(set! conn (the-as connection s4-0))
(set! s4-0 (-> (the-as connectable conn) prev0))
)
)
obj
)
;; definition for method 9 of type setting-control
;; INFO: Return type mismatch int vs none.
(defmethod
push-setting!
setting-control
((obj setting-control)
(arg0 process)
(arg1 symbol)
(arg2 object)
(arg3 object)
(arg4 object)
)
(defmethod push-setting! setting-control ((obj setting-control) (arg0 process) (arg1 symbol) (arg2 object) (arg3 object) (arg4 object))
(add-connection (-> obj engine) arg0 arg1 arg2 arg3 arg4)
0
(none)
@@ -245,16 +203,7 @@
;; definition for method 10 of type setting-control
;; INFO: Return type mismatch int vs none.
(defmethod
set-setting!
setting-control
((obj setting-control)
(arg0 process)
(arg1 symbol)
(arg2 symbol)
(arg3 float)
(arg4 int)
)
(defmethod set-setting! setting-control ((obj setting-control) (arg0 process) (arg1 symbol) (arg2 symbol) (arg3 float) (arg4 int))
(clear-pending-settings-from-process obj arg0 arg1)
(add-connection (-> obj engine) arg0 arg1 arg2 arg3 arg4)
0
@@ -263,26 +212,22 @@
;; definition for method 11 of type setting-control
;; INFO: Return type mismatch int vs none.
(defmethod
clear-pending-settings-from-process
setting-control
((obj setting-control) (arg0 process) (arg1 symbol))
(defmethod clear-pending-settings-from-process setting-control ((obj setting-control) (arg0 process) (arg1 symbol))
(when arg0
(let ((s5-0 (-> obj engine))
(s4-0 (-> arg0 connection-list next1))
)
(while s4-0
(if
(and
(belongs-to-engine? (the-as connection s4-0) s5-0)
(or (= arg1 #t) (= arg1 (-> (the-as connection s4-0) param0)))
)
(move-to-dead (the-as connection s4-0))
(let ((s5-0 (-> obj engine))
(s4-0 (-> arg0 connection-list next1))
)
(while s4-0
(if (and
(belongs-to-engine? (the-as connection s4-0) s5-0)
(or (= arg1 #t) (= arg1 (-> (the-as connection s4-0) param0)))
)
(move-to-dead (the-as connection s4-0))
)
(set! s4-0 (-> s4-0 next1))
)
)
(set! s4-0 (-> s4-0 next1))
)
)
)
0
(none)
)
@@ -290,185 +235,145 @@
;; definition for method 12 of type setting-control
(defmethod copy-settings-from-target! setting-control ((obj setting-control))
(let ((gp-0 (-> obj current)))
(let ((s5-0 (-> obj target)))
(mem-copy! (the-as pointer s5-0) (the-as pointer (-> obj default)) 196)
(set!
(-> s5-0 ambient-volume)
(* 0.01 (-> obj default ambient-volume) (-> obj default sfx-volume))
)
(update-from-engine s5-0 (-> obj engine))
(set! (-> gp-0 border-mode) (-> s5-0 border-mode))
(set! (-> gp-0 common-page) (-> s5-0 common-page))
(set! (-> gp-0 vibration) (-> s5-0 vibration))
(set! (-> gp-0 auto-save) (-> s5-0 auto-save))
(set! (-> gp-0 play-hints) (-> s5-0 play-hints))
(set! (-> gp-0 movie) (-> s5-0 movie))
(set! (-> gp-0 talking) (-> s5-0 talking))
(set! (-> gp-0 spooling) (-> s5-0 spooling))
(set! (-> gp-0 hint) (-> s5-0 hint))
(set! (-> gp-0 ambient) (-> s5-0 ambient))
(set! (-> gp-0 allow-pause) (-> s5-0 allow-pause))
(set! (-> gp-0 allow-progress) (-> s5-0 allow-progress))
(set! (-> gp-0 allow-look-around) (-> s5-0 allow-look-around))
(set! (-> gp-0 ocean-off) (-> s5-0 ocean-off))
(set! (-> gp-0 ambient-volume-movie) (-> s5-0 ambient-volume-movie))
(set! (-> gp-0 music-volume-movie) (-> s5-0 music-volume-movie))
(set! (-> gp-0 sfx-volume-movie) (-> s5-0 sfx-volume-movie))
(set! (-> gp-0 dialog-volume-hint) (-> s5-0 dialog-volume-hint))
(set! (-> gp-0 process-mask) (-> s5-0 process-mask))
(let ((s5-0 (-> obj target)))
(mem-copy! (the-as pointer s5-0) (the-as pointer (-> obj default)) 196)
(set! (-> s5-0 ambient-volume) (* 0.01 (-> obj default ambient-volume) (-> obj default sfx-volume)))
(update-from-engine s5-0 (-> obj engine))
(set! (-> gp-0 border-mode) (-> s5-0 border-mode))
(set! (-> gp-0 common-page) (-> s5-0 common-page))
(set! (-> gp-0 vibration) (-> s5-0 vibration))
(set! (-> gp-0 auto-save) (-> s5-0 auto-save))
(set! (-> gp-0 play-hints) (-> s5-0 play-hints))
(set! (-> gp-0 movie) (-> s5-0 movie))
(set! (-> gp-0 talking) (-> s5-0 talking))
(set! (-> gp-0 spooling) (-> s5-0 spooling))
(set! (-> gp-0 hint) (-> s5-0 hint))
(set! (-> gp-0 ambient) (-> s5-0 ambient))
(set! (-> gp-0 allow-pause) (-> s5-0 allow-pause))
(set! (-> gp-0 allow-progress) (-> s5-0 allow-progress))
(set! (-> gp-0 allow-look-around) (-> s5-0 allow-look-around))
(set! (-> gp-0 ocean-off) (-> s5-0 ocean-off))
(set! (-> gp-0 ambient-volume-movie) (-> s5-0 ambient-volume-movie))
(set! (-> gp-0 music-volume-movie) (-> s5-0 music-volume-movie))
(set! (-> gp-0 sfx-volume-movie) (-> s5-0 sfx-volume-movie))
(set! (-> gp-0 dialog-volume-hint) (-> s5-0 dialog-volume-hint))
(set! (-> gp-0 process-mask) (-> s5-0 process-mask))
)
(set! (-> *kernel-context* prevent-from-run) (-> gp-0 process-mask))
gp-0
)
(set! (-> *kernel-context* prevent-from-run) (-> gp-0 process-mask))
gp-0
)
)
;; definition for method 13 of type setting-control
(defmethod update-per-frame-settings! setting-control ((obj setting-control))
(copy-settings-from-target! obj)
(let ((gp-0 (-> obj current)))
(let ((s5-1 (-> obj target)))
(when *sound-player-enable*
(when (!= (-> gp-0 sfx-volume) (-> s5-1 sfx-volume))
(set!
(-> gp-0 sfx-volume)
(seek
(-> gp-0 sfx-volume)
(-> s5-1 sfx-volume)
(* 100.0 (-> *display* seconds-per-frame))
(let ((s5-1 (-> obj target)))
(when *sound-player-enable*
(when (!= (-> gp-0 sfx-volume) (-> s5-1 sfx-volume))
(set! (-> gp-0 sfx-volume)
(seek (-> gp-0 sfx-volume) (-> s5-1 sfx-volume) (* 100.0 (-> *display* seconds-per-frame)))
)
(sound-set-volume (the-as uint 1) (-> gp-0 sfx-volume))
)
(when (!= (-> gp-0 music-volume) (-> s5-1 music-volume))
(set! (-> gp-0 music-volume)
(seek (-> gp-0 music-volume) (-> s5-1 music-volume) (* 100.0 (-> *display* seconds-per-frame)))
)
(sound-set-volume (the-as uint 2) (-> gp-0 music-volume))
)
(when (!= (-> gp-0 dialog-volume) (-> s5-1 dialog-volume))
(set! (-> gp-0 dialog-volume)
(seek (-> gp-0 dialog-volume) (-> s5-1 dialog-volume) (* 100.0 (-> *display* seconds-per-frame)))
)
(sound-set-volume (the-as uint 4) (-> gp-0 dialog-volume))
)
(when (!= (-> gp-0 ambient-volume) (-> s5-1 ambient-volume))
(set! (-> gp-0 ambient-volume)
(seek (-> gp-0 ambient-volume) (-> s5-1 ambient-volume) (* 100.0 (-> *display* seconds-per-frame)))
)
(sound-set-volume (the-as uint 16) (-> gp-0 ambient-volume))
)
)
)
(sound-set-volume (the-as uint 1) (-> gp-0 sfx-volume))
)
(when (!= (-> gp-0 music-volume) (-> s5-1 music-volume))
(set!
(-> gp-0 music-volume)
(seek
(-> gp-0 music-volume)
(-> s5-1 music-volume)
(* 100.0 (-> *display* seconds-per-frame))
(when (!= (-> gp-0 language) (-> s5-1 language))
(set! (-> gp-0 language) (-> s5-1 language))
(set-language (-> gp-0 language))
)
)
(sound-set-volume (the-as uint 2) (-> gp-0 music-volume))
)
(when (!= (-> gp-0 dialog-volume) (-> s5-1 dialog-volume))
(set!
(-> gp-0 dialog-volume)
(seek
(-> gp-0 dialog-volume)
(-> s5-1 dialog-volume)
(* 100.0 (-> *display* seconds-per-frame))
(when (and
(!= (-> s5-1 music) (-> gp-0 music))
(and (< 0.0 (-> *setting-control* current music-volume)) (zero? (rpc-busy? 1)) *sound-bank-1* *sound-bank-2*)
)
(cond
((-> s5-1 music)
(format 0 "Load music ~A~%" (-> s5-1 music))
(sound-music-load (string->sound-name (symbol->string (-> s5-1 music))))
)
(else
(format 0 "Unload music~%")
(sound-music-unload)
)
)
(set! (-> gp-0 music) (-> s5-1 music))
)
)
(sound-set-volume (the-as uint 4) (-> gp-0 dialog-volume))
)
(when (!= (-> gp-0 ambient-volume) (-> s5-1 ambient-volume))
(set!
(-> gp-0 ambient-volume)
(seek
(-> gp-0 ambient-volume)
(-> s5-1 ambient-volume)
(* 100.0 (-> *display* seconds-per-frame))
(set! (-> s5-1 sound-flava) (the-as uint (flava-lookup (-> gp-0 music) (the-as int (-> s5-1 sound-flava)))))
(set! (-> gp-0 sound-flava) (-> s5-1 sound-flava))
(if *sound-player-enable*
(sound-set-flava (-> gp-0 sound-flava))
)
(when (!= (-> gp-0 aspect-ratio) (-> s5-1 aspect-ratio))
(set! (-> gp-0 aspect-ratio) (-> s5-1 aspect-ratio))
(set-aspect-ratio (-> gp-0 aspect-ratio))
)
)
(sound-set-volume (the-as uint 16) (-> gp-0 ambient-volume))
(when (!= (-> gp-0 video-mode) (-> s5-1 video-mode))
(set! (-> gp-0 video-mode) (-> s5-1 video-mode))
(set-video-mode (-> gp-0 video-mode))
)
(when (!= (-> gp-0 screenx) (-> s5-1 screenx))
(set! (-> gp-0 screenx) (-> s5-1 screenx))
(set! (-> *video-parms* display-dx) (/ (-> s5-1 screenx) 2))
(set! (-> *video-parms* set-video-mode) #t)
)
(when (!= (-> gp-0 screeny) (-> s5-1 screeny))
(set! (-> gp-0 screeny) (-> s5-1 screeny))
(set! (-> *video-parms* display-dy) (* (/ (-> s5-1 screeny) 2) 2))
(set! (-> *video-parms* set-video-mode) #t)
)
(set! (-> gp-0 bg-a-speed) (-> s5-1 bg-a-speed))
(set! (-> gp-0 bg-a-force) (-> s5-1 bg-a-force))
(set! (-> gp-0 bg-r) (-> s5-1 bg-r))
(set! (-> gp-0 bg-g) (-> s5-1 bg-g))
(set! (-> gp-0 bg-b) (-> s5-1 bg-b))
(set! (-> gp-0 bg-a)
(seek (-> gp-0 bg-a) (-> s5-1 bg-a) (* (-> s5-1 bg-a-speed) (-> *display* seconds-per-frame)))
)
)
)
(when (!= (-> gp-0 language) (-> s5-1 language))
(set! (-> gp-0 language) (-> s5-1 language))
(set-language (-> gp-0 language))
)
(when
(and
(!= (-> s5-1 music) (-> gp-0 music))
(and
(< 0.0 (-> *setting-control* current music-volume))
(zero? (rpc-busy? 1))
*sound-bank-1*
*sound-bank-2*
(let ((v1-60 (-> *display* frames (-> *display* on-screen) display))
(f0-39 (-> gp-0 bg-a))
)
(if (!= (-> gp-0 bg-a-force) 0.0)
(set! f0-39 (-> gp-0 bg-a-force))
)
(set! (-> v1-60 bgcolor r) (the int (* 255.0 (-> gp-0 bg-r))))
(set! (-> v1-60 bgcolor g) (the int (* 255.0 (-> gp-0 bg-g))))
(set! (-> v1-60 bgcolor b) (the int (* 255.0 (-> gp-0 bg-b))))
(set! (-> v1-60 pmode alp) (the int (* 255.0 (- 1.0 f0-39))))
)
(set! (-> *level* border?) (-> gp-0 border-mode))
(set! (-> *texture-pool* common-page-mask) (-> gp-0 common-page))
(set! (-> *cpad-list* cpads 0 buzz) (-> gp-0 vibration))
(case (-> gp-0 ocean-off)
((#t)
(set! *ocean-off* #t)
)
(('mid)
(set! *ocean-mid-off* #t)
)
(('near)
(set! *ocean-near-off* #t)
)
)
(cond
((-> s5-1 music)
(format 0 "Load music ~A~%" (-> s5-1 music))
(sound-music-load (string->sound-name (symbol->string (-> s5-1 music))))
)
(else
(format 0 "Unload music~%")
(sound-music-unload)
)
)
(set! (-> gp-0 music) (-> s5-1 music))
)
(set!
(-> s5-1 sound-flava)
(the-as
uint
(flava-lookup (-> gp-0 music) (the-as int (-> s5-1 sound-flava)))
)
)
(set! (-> gp-0 sound-flava) (-> s5-1 sound-flava))
(if *sound-player-enable*
(sound-set-flava (-> gp-0 sound-flava))
)
(when (!= (-> gp-0 aspect-ratio) (-> s5-1 aspect-ratio))
(set! (-> gp-0 aspect-ratio) (-> s5-1 aspect-ratio))
(set-aspect-ratio (-> gp-0 aspect-ratio))
)
(when (!= (-> gp-0 video-mode) (-> s5-1 video-mode))
(set! (-> gp-0 video-mode) (-> s5-1 video-mode))
(set-video-mode (-> gp-0 video-mode))
)
(when (!= (-> gp-0 screenx) (-> s5-1 screenx))
(set! (-> gp-0 screenx) (-> s5-1 screenx))
(set! (-> *video-parms* display-dx) (/ (-> s5-1 screenx) 2))
(set! (-> *video-parms* set-video-mode) #t)
)
(when (!= (-> gp-0 screeny) (-> s5-1 screeny))
(set! (-> gp-0 screeny) (-> s5-1 screeny))
(set! (-> *video-parms* display-dy) (* (/ (-> s5-1 screeny) 2) 2))
(set! (-> *video-parms* set-video-mode) #t)
)
(set! (-> gp-0 bg-a-speed) (-> s5-1 bg-a-speed))
(set! (-> gp-0 bg-a-force) (-> s5-1 bg-a-force))
(set! (-> gp-0 bg-r) (-> s5-1 bg-r))
(set! (-> gp-0 bg-g) (-> s5-1 bg-g))
(set! (-> gp-0 bg-b) (-> s5-1 bg-b))
(set!
(-> gp-0 bg-a)
(seek
(-> gp-0 bg-a)
(-> s5-1 bg-a)
(* (-> s5-1 bg-a-speed) (-> *display* seconds-per-frame))
)
)
gp-0
)
(let ((v1-60 (-> *display* frames (-> *display* on-screen) display))
(f0-39 (-> gp-0 bg-a))
)
(if (!= (-> gp-0 bg-a-force) 0.0)
(set! f0-39 (-> gp-0 bg-a-force))
)
(set! (-> v1-60 bgcolor r) (the int (* 255.0 (-> gp-0 bg-r))))
(set! (-> v1-60 bgcolor g) (the int (* 255.0 (-> gp-0 bg-g))))
(set! (-> v1-60 bgcolor b) (the int (* 255.0 (-> gp-0 bg-b))))
(set! (-> v1-60 pmode alp) (the int (* 255.0 (- 1.0 f0-39))))
)
(set! (-> *level* border?) (-> gp-0 border-mode))
(set! (-> *texture-pool* common-page-mask) (-> gp-0 common-page))
(set! (-> *cpad-list* cpads 0 buzz) (-> gp-0 vibration))
(case (-> gp-0 ocean-off)
((#t)
(set! *ocean-off* #t)
)
(('mid)
(set! *ocean-mid-off* #t)
)
(('near)
(set! *ocean-near-off* #t)
)
)
gp-0
)
)
;; failed to figure out what this is:
@@ -477,89 +382,65 @@
(let ((gp-0 (-> *setting-control* default))
(s5-0 (-> *setting-control* current))
)
(let ((f0-2 (* 0.01 (the float (scf-get-volume)))))
(set! (-> gp-0 ocean-off) #f)
(set! (-> gp-0 allow-look-around) #t)
(set! (-> gp-0 border-mode) #f)
(set!
(-> gp-0 sfx-volume)
(the float (* 5 (the int (+ 0.5 (* 15.0 f0-2)))))
)
(set!
(-> gp-0 music-volume)
(the float (* 5 (the int (+ 0.5 (* 13.0 f0-2)))))
)
(set!
(-> gp-0 dialog-volume)
(the float (* 5 (the int (+ 0.5 (* 20.0 f0-2)))))
)
(set!
(-> gp-0 ambient-volume)
(the float (* 5 (the int (+ 0.5 (* 15.0 f0-2)))))
)
(set!
(-> gp-0 sfx-volume-movie)
(the float (* 5 (the int (+ 0.5 (* 11.0 f0-2)))))
)
(set!
(-> gp-0 music-volume-movie)
(the float (* 5 (the int (+ 0.5 (* 13.0 f0-2)))))
)
(set!
(-> gp-0 ambient-volume-movie)
(the float (* 5 (the int (+ 0.5 (* 11.0 f0-2)))))
)
(set!
(-> gp-0 dialog-volume-hint)
(the float (* 5 (the int (+ 0.5 (* 16.0 f0-2)))))
)
)
(set! (-> gp-0 language) (scf-get-language))
(set! (-> gp-0 process-mask) (process-mask execute sleep))
(set! (-> gp-0 screenx) 0)
(set! (-> gp-0 screeny) 0)
(set! (-> gp-0 vibration) #t)
(set! (-> gp-0 auto-save) #f)
(set! (-> gp-0 play-hints) #t)
(set! (-> gp-0 movie) (the-as (pointer process) #f))
(set! (-> gp-0 talking) (the-as (pointer process) #f))
(set! (-> gp-0 spooling) (the-as (pointer process) #f))
(set! (-> gp-0 hint) (the-as (pointer process) #f))
(set! (-> gp-0 ambient) (the-as (pointer process) #f))
(set! (-> gp-0 sound-flava) (the-as uint 49))
(set! (-> gp-0 sound-flava-priority) 0.0)
(set! (-> gp-0 music) #f)
(set! (-> gp-0 bg-a-speed) 8.0)
(set! (-> gp-0 allow-pause) #t)
(set! (-> gp-0 allow-progress) #t)
(case (scf-get-aspect)
((2)
(set! (-> gp-0 aspect-ratio) 'aspect16x9)
(let ((f0-2 (* 0.01 (the float (scf-get-volume)))))
(set! (-> gp-0 ocean-off) #f)
(set! (-> gp-0 allow-look-around) #t)
(set! (-> gp-0 border-mode) #f)
(set! (-> gp-0 sfx-volume) (the float (* 5 (the int (+ 0.5 (* 15.0 f0-2))))))
(set! (-> gp-0 music-volume) (the float (* 5 (the int (+ 0.5 (* 13.0 f0-2))))))
(set! (-> gp-0 dialog-volume) (the float (* 5 (the int (+ 0.5 (* 20.0 f0-2))))))
(set! (-> gp-0 ambient-volume) (the float (* 5 (the int (+ 0.5 (* 15.0 f0-2))))))
(set! (-> gp-0 sfx-volume-movie) (the float (* 5 (the int (+ 0.5 (* 11.0 f0-2))))))
(set! (-> gp-0 music-volume-movie) (the float (* 5 (the int (+ 0.5 (* 13.0 f0-2))))))
(set! (-> gp-0 ambient-volume-movie) (the float (* 5 (the int (+ 0.5 (* 11.0 f0-2))))))
(set! (-> gp-0 dialog-volume-hint) (the float (* 5 (the int (+ 0.5 (* 16.0 f0-2))))))
)
(else
(set! (-> gp-0 aspect-ratio) 'aspect4x3)
)
(set! (-> gp-0 language) (scf-get-language))
(set! (-> gp-0 process-mask) (process-mask execute sleep))
(set! (-> gp-0 screenx) 0)
(set! (-> gp-0 screeny) 0)
(set! (-> gp-0 vibration) #t)
(set! (-> gp-0 auto-save) #f)
(set! (-> gp-0 play-hints) #t)
(set! (-> gp-0 movie) (the-as (pointer process) #f))
(set! (-> gp-0 talking) (the-as (pointer process) #f))
(set! (-> gp-0 spooling) (the-as (pointer process) #f))
(set! (-> gp-0 hint) (the-as (pointer process) #f))
(set! (-> gp-0 ambient) (the-as (pointer process) #f))
(set! (-> gp-0 sound-flava) (the-as uint 49))
(set! (-> gp-0 sound-flava-priority) 0.0)
(set! (-> gp-0 music) #f)
(set! (-> gp-0 bg-a-speed) 8.0)
(set! (-> gp-0 allow-pause) #t)
(set! (-> gp-0 allow-progress) #t)
(case (scf-get-aspect)
((2)
(set! (-> gp-0 aspect-ratio) 'aspect16x9)
)
(else
(set! (-> gp-0 aspect-ratio) 'aspect4x3)
)
)
(if (zero? *boot-video-mode*)
(set! (-> gp-0 video-mode) 'ntsc)
(set! (-> gp-0 video-mode) 'pal)
)
(set! (-> s5-0 sfx-volume) (+ -1.0 (-> gp-0 sfx-volume)))
(set! (-> s5-0 music-volume) (+ -1.0 (-> gp-0 music-volume)))
(set! (-> s5-0 dialog-volume) (+ -1.0 (-> gp-0 dialog-volume)))
(set! (-> s5-0 ambient-volume) (+ -1.0 (-> gp-0 ambient-volume)))
(set! (-> s5-0 sfx-volume-movie) (-> gp-0 sfx-volume-movie))
(set! (-> s5-0 music-volume-movie) (-> gp-0 music-volume-movie))
(set! (-> s5-0 ambient-volume-movie) (-> gp-0 ambient-volume-movie))
(set! (-> s5-0 dialog-volume-hint) (-> gp-0 dialog-volume-hint))
(set! (-> s5-0 language) (+ (-> gp-0 language) -1))
(set! (-> s5-0 aspect-ratio) #f)
(set! (-> s5-0 video-mode) #f)
(set! (-> s5-0 music) #f)
(set! (-> s5-0 bg-a-speed) (-> gp-0 bg-a-speed))
(set! (-> s5-0 allow-pause) (-> gp-0 allow-pause))
(set! (-> s5-0 allow-progress) (-> gp-0 allow-progress))
(set! (-> s5-0 allow-look-around) (-> gp-0 allow-look-around))
(set! (-> s5-0 ocean-off) (-> gp-0 ocean-off))
)
(if (zero? *boot-video-mode*)
(set! (-> gp-0 video-mode) 'ntsc)
(set! (-> gp-0 video-mode) 'pal)
)
(set! (-> s5-0 sfx-volume) (+ -1.0 (-> gp-0 sfx-volume)))
(set! (-> s5-0 music-volume) (+ -1.0 (-> gp-0 music-volume)))
(set! (-> s5-0 dialog-volume) (+ -1.0 (-> gp-0 dialog-volume)))
(set! (-> s5-0 ambient-volume) (+ -1.0 (-> gp-0 ambient-volume)))
(set! (-> s5-0 sfx-volume-movie) (-> gp-0 sfx-volume-movie))
(set! (-> s5-0 music-volume-movie) (-> gp-0 music-volume-movie))
(set! (-> s5-0 ambient-volume-movie) (-> gp-0 ambient-volume-movie))
(set! (-> s5-0 dialog-volume-hint) (-> gp-0 dialog-volume-hint))
(set! (-> s5-0 language) (+ (-> gp-0 language) -1))
(set! (-> s5-0 aspect-ratio) #f)
(set! (-> s5-0 video-mode) #f)
(set! (-> s5-0 music) #f)
(set! (-> s5-0 bg-a-speed) (-> gp-0 bg-a-speed))
(set! (-> s5-0 allow-pause) (-> gp-0 allow-pause))
(set! (-> s5-0 allow-progress) (-> gp-0 allow-progress))
(set! (-> s5-0 allow-look-around) (-> gp-0 allow-look-around))
(set! (-> s5-0 ocean-off) (-> gp-0 ocean-off))
)
)
+2 -10
View File
@@ -22,16 +22,8 @@
(format #t "[~8x] ~A~%" obj 'level-hint-control)
(format #t "~Tdelay-before-playing: ~D~%" (-> obj delay-before-playing))
(format #t "~Tid: ~D~%" (-> obj id))
(format
#t
"~Tnum-attempts-before-playing: ~D~%"
(-> obj num-attempts-before-playing)
)
(format
#t
"~Tnum-success-before-killing: ~D~%"
(-> obj num-success-before-killing)
)
(format #t "~Tnum-attempts-before-playing: ~D~%" (-> obj num-attempts-before-playing))
(format #t "~Tnum-success-before-killing: ~D~%" (-> obj num-success-before-killing))
(format #t "~Tnum-attempts: ~D~%" (-> obj num-attempts))
(format #t "~Tnum-success: ~D~%" (-> obj num-success))
(format #t "~Tstart-time: ~D~%" (-> obj start-time))
+339 -504
View File
@@ -2,391 +2,254 @@
(in-package goal)
;; failed to figure out what this is:
(set!
(-> *game-info* hint-control)
(the-as
(array level-hint-control)
(new
'static
'boxed-array
:type level-hint-control :length 25 :allocated-length 25
(new 'static 'level-hint-control
:id #x917
:num-attempts-before-playing 1
:num-success-before-killing 3
)
(new 'static 'level-hint-control
:id #x90a
:num-attempts-before-playing 3
:num-success-before-killing -1
)
(new 'static 'level-hint-control
:id #x284
:num-attempts-before-playing 3
:num-success-before-killing 3
)
(new 'static 'level-hint-control
:id #x285
:num-attempts-before-playing 1
:num-success-before-killing 1
)
(new 'static 'level-hint-control
:id #x251
:num-attempts-before-playing 1
:num-success-before-killing 1
)
(new 'static 'level-hint-control
:id #x2af
:num-attempts-before-playing 1
:num-success-before-killing 1
)
(new 'static 'level-hint-control
:delay-before-playing #x384
:id #x239
:num-attempts-before-playing 1
:num-success-before-killing 1
)
(new 'static 'level-hint-control
:delay-before-playing #x5dc
:id #x29d
:num-attempts-before-playing 1
:num-success-before-killing -1
)
(new 'static 'level-hint-control
:delay-before-playing #x384
:id #x25b
:num-attempts-before-playing 1
:num-success-before-killing -1
)
(new 'static 'level-hint-control
:id #x2a4
:num-attempts-before-playing 3
:num-success-before-killing 1
)
(new 'static 'level-hint-control
:delay-before-playing #x384
:id #x2aa
:num-attempts-before-playing 1
:num-success-before-killing 1
)
(new 'static 'level-hint-control
:delay-before-playing #x5dc
:id #x33a
:num-attempts-before-playing 1
:num-success-before-killing 1
)
(new 'static 'level-hint-control
:delay-before-playing #x1194
:id #x34b
:num-attempts-before-playing 3
:num-success-before-killing 2
)
(new 'static 'level-hint-control
:delay-before-playing #x4650
:id #x34a
:num-attempts-before-playing 3
:num-success-before-killing -1
)
(new 'static 'level-hint-control
:id #x34d
:num-attempts-before-playing 3
:num-success-before-killing -1
)
(new 'static 'level-hint-control
:id #x345
:num-attempts-before-playing 3
:num-success-before-killing 2
)
(new 'static 'level-hint-control
:id #x352
:num-attempts-before-playing 1
:num-success-before-killing 1
)
(new 'static 'level-hint-control
:delay-before-playing #x2328
:id #x347
:num-attempts-before-playing 3
:num-success-before-killing 1
)
(new 'static 'level-hint-control
:id #x34e
:num-attempts-before-playing 3
:num-success-before-killing -1
)
(new 'static 'level-hint-control
:id #x444
:num-attempts-before-playing 5
:num-success-before-killing -1
)
(new 'static 'level-hint-control
:delay-before-playing #x384
:id #x438
:num-attempts-before-playing 1
:num-success-before-killing -1
)
(new 'static 'level-hint-control
:id #x433
:num-attempts-before-playing 4
:num-success-before-killing -1
)
(new 'static 'level-hint-control
:id #x70d
:num-attempts-before-playing 1
:num-success-before-killing 2
)
(new 'static 'level-hint-control
:delay-before-playing #x5dc
:id #x806
:num-attempts-before-playing 1
:num-success-before-killing 1
)
(new 'static 'level-hint-control
:delay-before-playing #x5dc
:id #x809
:num-attempts-before-playing 1
:num-success-before-killing 1
)
)
)
)
(set! (-> *game-info* hint-control)
(the-as
(array level-hint-control)
(new
'static
'boxed-array
:type level-hint-control :length 25 :allocated-length 25
(new 'static 'level-hint-control :id #x917 :num-attempts-before-playing 1 :num-success-before-killing 3)
(new 'static 'level-hint-control :id #x90a :num-attempts-before-playing 3 :num-success-before-killing -1)
(new 'static 'level-hint-control :id #x284 :num-attempts-before-playing 3 :num-success-before-killing 3)
(new 'static 'level-hint-control :id #x285 :num-attempts-before-playing 1 :num-success-before-killing 1)
(new 'static 'level-hint-control :id #x251 :num-attempts-before-playing 1 :num-success-before-killing 1)
(new 'static 'level-hint-control :id #x2af :num-attempts-before-playing 1 :num-success-before-killing 1)
(new 'static 'level-hint-control
:delay-before-playing #x384
:id #x239
:num-attempts-before-playing 1
:num-success-before-killing 1
)
(new 'static 'level-hint-control
:delay-before-playing #x5dc
:id #x29d
:num-attempts-before-playing 1
:num-success-before-killing -1
)
(new 'static 'level-hint-control
:delay-before-playing #x384
:id #x25b
:num-attempts-before-playing 1
:num-success-before-killing -1
)
(new 'static 'level-hint-control :id #x2a4 :num-attempts-before-playing 3 :num-success-before-killing 1)
(new 'static 'level-hint-control
:delay-before-playing #x384
:id #x2aa
:num-attempts-before-playing 1
:num-success-before-killing 1
)
(new 'static 'level-hint-control
:delay-before-playing #x5dc
:id #x33a
:num-attempts-before-playing 1
:num-success-before-killing 1
)
(new 'static 'level-hint-control
:delay-before-playing #x1194
:id #x34b
:num-attempts-before-playing 3
:num-success-before-killing 2
)
(new 'static 'level-hint-control
:delay-before-playing #x4650
:id #x34a
:num-attempts-before-playing 3
:num-success-before-killing -1
)
(new 'static 'level-hint-control :id #x34d :num-attempts-before-playing 3 :num-success-before-killing -1)
(new 'static 'level-hint-control :id #x345 :num-attempts-before-playing 3 :num-success-before-killing 2)
(new 'static 'level-hint-control :id #x352 :num-attempts-before-playing 1 :num-success-before-killing 1)
(new 'static 'level-hint-control
:delay-before-playing #x2328
:id #x347
:num-attempts-before-playing 3
:num-success-before-killing 1
)
(new 'static 'level-hint-control :id #x34e :num-attempts-before-playing 3 :num-success-before-killing -1)
(new 'static 'level-hint-control :id #x444 :num-attempts-before-playing 5 :num-success-before-killing -1)
(new 'static 'level-hint-control
:delay-before-playing #x384
:id #x438
:num-attempts-before-playing 1
:num-success-before-killing -1
)
(new 'static 'level-hint-control :id #x433 :num-attempts-before-playing 4 :num-success-before-killing -1)
(new 'static 'level-hint-control :id #x70d :num-attempts-before-playing 1 :num-success-before-killing 2)
(new 'static 'level-hint-control
:delay-before-playing #x5dc
:id #x806
:num-attempts-before-playing 1
:num-success-before-killing 1
)
(new 'static 'level-hint-control
:delay-before-playing #x5dc
:id #x809
:num-attempts-before-playing 1
:num-success-before-killing 1
)
)
)
)
;; failed to figure out what this is:
(set!
(-> *game-info* task-hint-control)
(new
'static
'boxed-array
:type task-hint-control-group :length 16 :allocated-length 16
(new 'static 'task-hint-control-group
:tasks
(new
'static
'boxed-array
:type task-hint-control :length 3 :allocated-length 3
(new 'static 'task-hint-control
:task (game-task training-gimmie)
:delay #x2bf20
(set! (-> *game-info* task-hint-control)
(new
'static
'boxed-array
:type task-hint-control-group :length 16 :allocated-length 16
(new 'static 'task-hint-control-group
:tasks
(new
'static
'boxed-array
:type task-hint-control :length 3 :allocated-length 3
(new 'static 'task-hint-control :task (game-task training-gimmie) :delay #x2bf20)
(new 'static 'task-hint-control :task (game-task training-door) :delay #x57e40)
(new 'static 'task-hint-control :task (game-task training-climb) :delay #x83d60)
)
)
(new 'static 'task-hint-control-group)
(new 'static 'task-hint-control-group
:tasks
(new
'static
'boxed-array
:type task-hint-control :length 3 :allocated-length 3
(new 'static 'task-hint-control :task (game-task beach-gimmie) :delay #x41eb0)
(new 'static 'task-hint-control :task (game-task beach-sentinel) :delay #x83d60)
(new 'static 'task-hint-control :task (game-task beach-cannon) :delay #xc5c10)
)
)
(new 'static 'task-hint-control-group
:tasks
(new
'static
'boxed-array
:type task-hint-control :length 2 :allocated-length 2
(new 'static 'task-hint-control :task (game-task jungle-plant) :delay #x57e40)
(new 'static 'task-hint-control :task (game-task jungle-canyon-end) :delay #xafc80)
)
)
(new 'static 'task-hint-control-group
:tasks
(new
'static
'boxed-array
:type task-hint-control :length 4 :allocated-length 4
(new 'static 'task-hint-control :task (game-task misty-boat) :delay #x57e40)
(new 'static 'task-hint-control :task (game-task misty-warehouse) :delay #x83d60)
(new 'static 'task-hint-control :task (game-task misty-bike-jump) :delay #xafc80)
(new 'static 'task-hint-control :task (game-task misty-eco-challenge) :delay #xdbba0)
)
)
(new 'static 'task-hint-control-group)
(new 'static 'task-hint-control-group)
(new 'static 'task-hint-control-group
:tasks
(new
'static
'boxed-array
:type task-hint-control :length 3 :allocated-length 3
(new 'static 'task-hint-control :task (game-task sunken-spinning-room) :delay #x57e40)
(new 'static 'task-hint-control :task (game-task sunken-sharks) :delay #x83d60)
(new 'static 'task-hint-control :task (game-task sunken-slide) :delay #xafc80)
)
)
(new 'static 'task-hint-control-group
:tasks
(new
'static
'boxed-array
:type task-hint-control :length 1 :allocated-length 1
(new 'static 'task-hint-control :task (game-task swamp-battle) :delay #xafc80)
)
)
(new 'static 'task-hint-control-group
:tasks
(new
'static
'boxed-array
:type task-hint-control :length 1 :allocated-length 1
(new 'static 'task-hint-control :task (game-task rolling-lake) :delay #xafc80)
)
)
(new 'static 'task-hint-control-group
:tasks
(new
'static
'boxed-array
:type task-hint-control :length 1 :allocated-length 1
(new 'static 'task-hint-control :task (game-task ogre-secret) :delay #x107ac0)
)
)
(new 'static 'task-hint-control-group
:tasks
(new
'static
'boxed-array
:type task-hint-control :length 1 :allocated-length 1
(new 'static 'task-hint-control :task (game-task village3-extra1) :delay #x107ac0)
)
)
(new 'static 'task-hint-control-group
:tasks
(new
'static
'boxed-array
:type task-hint-control :length 4 :allocated-length 4
(new 'static 'task-hint-control :task (game-task snow-bumpers) :delay #x57e40)
(new 'static 'task-hint-control :task (game-task snow-cage) :delay #x83d60)
(new 'static 'task-hint-control :task (game-task snow-ball) :delay #xafc80)
(new 'static 'task-hint-control :task (game-task snow-bunnies) :delay #xdbba0)
)
)
(new 'static 'task-hint-control-group
:tasks
(new
'static
'boxed-array
:type task-hint-control :length 4 :allocated-length 4
(new 'static 'task-hint-control :task (game-task cave-dark-climb) :delay #x57e40)
(new 'static 'task-hint-control :task (game-task cave-robot-climb) :delay #x83d60)
(new 'static 'task-hint-control :task (game-task cave-swing-poles) :delay #xafc80)
(new 'static 'task-hint-control :task (game-task cave-platforms) :delay #xdbba0)
)
)
(new 'static 'task-hint-control-group)
(new 'static 'task-hint-control-group)
)
)
(new 'static 'task-hint-control
:task (game-task training-door)
:delay #x57e40
)
(new 'static 'task-hint-control
:task (game-task training-climb)
:delay #x83d60
)
)
)
(new 'static 'task-hint-control-group)
(new 'static 'task-hint-control-group
:tasks
(new
'static
'boxed-array
:type task-hint-control :length 3 :allocated-length 3
(new 'static 'task-hint-control
:task (game-task beach-gimmie)
:delay #x41eb0
)
(new 'static 'task-hint-control
:task (game-task beach-sentinel)
:delay #x83d60
)
(new 'static 'task-hint-control
:task (game-task beach-cannon)
:delay #xc5c10
)
)
)
(new 'static 'task-hint-control-group
:tasks
(new
'static
'boxed-array
:type task-hint-control :length 2 :allocated-length 2
(new 'static 'task-hint-control
:task (game-task jungle-plant)
:delay #x57e40
)
(new 'static 'task-hint-control
:task (game-task jungle-canyon-end)
:delay #xafc80
)
)
)
(new 'static 'task-hint-control-group
:tasks
(new
'static
'boxed-array
:type task-hint-control :length 4 :allocated-length 4
(new 'static 'task-hint-control
:task (game-task misty-boat)
:delay #x57e40
)
(new 'static 'task-hint-control
:task (game-task misty-warehouse)
:delay #x83d60
)
(new 'static 'task-hint-control
:task (game-task misty-bike-jump)
:delay #xafc80
)
(new 'static 'task-hint-control
:task (game-task misty-eco-challenge)
:delay #xdbba0
)
)
)
(new 'static 'task-hint-control-group)
(new 'static 'task-hint-control-group)
(new 'static 'task-hint-control-group
:tasks
(new
'static
'boxed-array
:type task-hint-control :length 3 :allocated-length 3
(new 'static 'task-hint-control
:task (game-task sunken-spinning-room)
:delay #x57e40
)
(new 'static 'task-hint-control
:task (game-task sunken-sharks)
:delay #x83d60
)
(new 'static 'task-hint-control
:task (game-task sunken-slide)
:delay #xafc80
)
)
)
(new 'static 'task-hint-control-group
:tasks
(new
'static
'boxed-array
:type task-hint-control :length 1 :allocated-length 1
(new 'static 'task-hint-control
:task (game-task swamp-battle)
:delay #xafc80
)
)
)
(new 'static 'task-hint-control-group
:tasks
(new
'static
'boxed-array
:type task-hint-control :length 1 :allocated-length 1
(new 'static 'task-hint-control
:task (game-task rolling-lake)
:delay #xafc80
)
)
)
(new 'static 'task-hint-control-group
:tasks
(new
'static
'boxed-array
:type task-hint-control :length 1 :allocated-length 1
(new 'static 'task-hint-control
:task (game-task ogre-secret)
:delay #x107ac0
)
)
)
(new 'static 'task-hint-control-group
:tasks
(new
'static
'boxed-array
:type task-hint-control :length 1 :allocated-length 1
(new 'static 'task-hint-control
:task (game-task village3-extra1)
:delay #x107ac0
)
)
)
(new 'static 'task-hint-control-group
:tasks
(new
'static
'boxed-array
:type task-hint-control :length 4 :allocated-length 4
(new 'static 'task-hint-control
:task (game-task snow-bumpers)
:delay #x57e40
)
(new 'static 'task-hint-control :task (game-task snow-cage) :delay #x83d60)
(new 'static 'task-hint-control :task (game-task snow-ball) :delay #xafc80)
(new 'static 'task-hint-control
:task (game-task snow-bunnies)
:delay #xdbba0
)
)
)
(new 'static 'task-hint-control-group
:tasks
(new
'static
'boxed-array
:type task-hint-control :length 4 :allocated-length 4
(new 'static 'task-hint-control
:task (game-task cave-dark-climb)
:delay #x57e40
)
(new 'static 'task-hint-control
:task (game-task cave-robot-climb)
:delay #x83d60
)
(new 'static 'task-hint-control
:task (game-task cave-swing-poles)
:delay #xafc80
)
(new 'static 'task-hint-control
:task (game-task cave-platforms)
:delay #xdbba0
)
)
)
(new 'static 'task-hint-control-group)
(new 'static 'task-hint-control-group)
)
)
;; definition for function find-hint-control-index
(defun find-hint-control-index ((arg0 game-text-id))
(let ((gp-0 -1))
(let ((v1-2 (length (-> *game-info* hint-control))))
(dotimes (a0-2 v1-2)
(when (= (-> *game-info* hint-control a0-2 id) arg0)
(set! gp-0 a0-2)
(set! a0-2 v1-2)
(let ((v1-2 (length (-> *game-info* hint-control))))
(dotimes (a0-2 v1-2)
(when (= (-> *game-info* hint-control a0-2 id) arg0)
(set! gp-0 a0-2)
(set! a0-2 v1-2)
)
)
)
)
gp-0
)
gp-0
)
)
;; definition for function start-hint-timer
;; INFO: Return type mismatch int vs none.
(defun start-hint-timer ((arg0 game-text-id))
(let ((v1-0 (find-hint-control-index arg0)))
(when
(and
(>= v1-0 0)
(zero? (-> *game-info* hint-control v1-0 start-time))
(!= (-> *game-info* hint-control v1-0 num-attempts-before-playing) 1)
)
(set!
(-> *game-info* hint-control v1-0 start-time)
(-> *display* base-frame-counter)
)
0
(when (and
(>= v1-0 0)
(zero? (-> *game-info* hint-control v1-0 start-time))
(!= (-> *game-info* hint-control v1-0 num-attempts-before-playing) 1)
)
(set! (-> *game-info* hint-control v1-0 start-time) (-> *display* base-frame-counter))
0
)
)
)
0
(none)
)
@@ -395,14 +258,13 @@
;; INFO: Return type mismatch int vs none.
(defun increment-success-for-hint ((arg0 game-text-id))
(let ((gp-0 (find-hint-control-index arg0)))
(when (>= gp-0 0)
(set!
(-> *game-info* hint-control gp-0 num-success)
(seekl (-> *game-info* hint-control gp-0 num-success) 127 1)
)
0
(when (>= gp-0 0)
(set! (-> *game-info* hint-control gp-0 num-success)
(seekl (-> *game-info* hint-control gp-0 num-success) 127 1)
)
0
)
)
)
0
(none)
)
@@ -411,128 +273,104 @@
;; WARN: disable def twice: 139. This may happen when a cond (no else) is nested inside of another conditional, but it should be rare.
(defun can-hint-be-played? ((arg0 game-text-id) (arg1 entity) (arg2 string))
(let ((v1-0 (not (str-is-playing?))))
(if (and v1-0 (nonzero? arg0))
(set! v1-0 (not (seen-text? *game-info* arg0)))
)
(when v1-0
(when *hint-semaphore*
(set!
v1-0
(dummy-15 (the-as level-hint (ppointer->process *hint-semaphore*)))
)
0
)
(when
(and
v1-0
(<
(- (-> *display* base-frame-counter) (-> *game-info* hint-play-time))
30
)
)
(set! v1-0 #f)
0
)
(set!
v1-0
(and
v1-0
(not (-> *setting-control* current talking))
(not (-> *setting-control* current spooling))
(not (-> *setting-control* current hint))
(not (-> *setting-control* current ambient))
(>= (-> *display* base-frame-counter) (-> *game-info* blackout-time))
)
)
0
)
(cond
(v1-0
(let ((v1-16 (find-hint-control-index arg0)))
(cond
((< v1-16 0)
#t
(if (and v1-0 (nonzero? arg0))
(set! v1-0 (not (seen-text? *game-info* arg0)))
)
(else
(let ((gp-1 (-> *game-info* hint-control v1-16))
(a0-24
(-
(-> *display* base-frame-counter)
(-> *game-info* hint-control v1-16 last-time-called)
)
)
(v1-21 #t)
)
(if (and (= (-> gp-1 num-attempts-before-playing) 1) (< a0-24 30))
(+! (-> gp-1 start-time) a0-24)
)
(cond
((and
(!= (-> gp-1 num-attempts-before-playing) 1)
(nonzero? (-> gp-1 last-time-called))
(<
(- (-> *display* base-frame-counter) (-> gp-1 last-time-called))
150
)
(when v1-0
(when *hint-semaphore*
(set! v1-0 (dummy-15 (the-as level-hint (ppointer->process *hint-semaphore*))))
0
)
(when (and v1-0 (< (- (-> *display* base-frame-counter) (-> *game-info* hint-play-time)) 30))
(set! v1-0 #f)
0
)
(set! v1-0 (and
v1-0
(not (-> *setting-control* current talking))
(not (-> *setting-control* current spooling))
(not (-> *setting-control* current hint))
(not (-> *setting-control* current ambient))
(>= (-> *display* base-frame-counter) (-> *game-info* blackout-time))
)
)
(set! (-> gp-1 last-time-called) (-> *display* base-frame-counter))
#f
)
(else
(set! (-> gp-1 last-time-called) (-> *display* base-frame-counter))
(when (nonzero? (-> gp-1 delay-before-playing))
(if
(<
(-> gp-1 start-time)
(the-as int (-> gp-1 delay-before-playing))
)
(set! v1-21 #f)
)
0
)
(cond
(v1-21
(set! (-> gp-1 num-attempts) (seekl (-> gp-1 num-attempts) 127 1))
(and
(>= (-> gp-1 num-attempts) (-> gp-1 num-attempts-before-playing))
(or
(= (-> gp-1 num-success-before-killing) -1)
(< (-> gp-1 num-success) (-> gp-1 num-success-before-killing))
)
)
0
)
(cond
(v1-0
(let ((v1-16 (find-hint-control-index arg0)))
(cond
((< v1-16 0)
#t
)
(else
#f
)
(let ((gp-1 (-> *game-info* hint-control v1-16))
(a0-24 (- (-> *display* base-frame-counter) (-> *game-info* hint-control v1-16 last-time-called)))
(v1-21 #t)
)
(if (and (= (-> gp-1 num-attempts-before-playing) 1) (< a0-24 30))
(+! (-> gp-1 start-time) a0-24)
)
(cond
((and
(!= (-> gp-1 num-attempts-before-playing) 1)
(nonzero? (-> gp-1 last-time-called))
(< (- (-> *display* base-frame-counter) (-> gp-1 last-time-called)) 150)
)
(set! (-> gp-1 last-time-called) (-> *display* base-frame-counter))
#f
)
(else
(set! (-> gp-1 last-time-called) (-> *display* base-frame-counter))
(when (nonzero? (-> gp-1 delay-before-playing))
(if (< (-> gp-1 start-time) (the-as int (-> gp-1 delay-before-playing)))
(set! v1-21 #f)
)
0
)
(cond
(v1-21
(set! (-> gp-1 num-attempts) (seekl (-> gp-1 num-attempts) 127 1))
(and
(>= (-> gp-1 num-attempts) (-> gp-1 num-attempts-before-playing))
(or
(= (-> gp-1 num-success-before-killing) -1)
(< (-> gp-1 num-success) (-> gp-1 num-success-before-killing))
)
)
)
(else
#f
)
)
)
)
)
)
)
)
)
)
)
)
(else
#f
)
)
)
(else
#f
)
)
)
)
;; definition for function reset-all-hint-controls
;; INFO: Return type mismatch int vs none.
(defun reset-all-hint-controls ()
(let ((v1-2 (length (-> *game-info* hint-control))))
(dotimes (a0-1 v1-2)
(let ((a1-2 (-> *game-info* hint-control a0-1)))
(set! (-> a1-2 start-time) 0)
(set! (-> a1-2 last-time-called) 0)
(set! (-> a1-2 num-attempts) 0)
(set! (-> a1-2 num-success) 0)
)
0
(dotimes (a0-1 v1-2)
(let ((a1-2 (-> *game-info* hint-control a0-1)))
(set! (-> a1-2 start-time) 0)
(set! (-> a1-2 last-time-called) 0)
(set! (-> a1-2 num-attempts) 0)
(set! (-> a1-2 num-success) 0)
)
0
)
)
)
0
(none)
)
@@ -541,35 +379,32 @@
;; INFO: Return type mismatch int vs none.
(defun update-task-hints ()
(when *target*
(let ((a0-0 (+ (-> *target* current-level info index) -1))
(v1-7 (-> *game-info* task-hint-control))
)
(when (and (>= a0-0 0) (< a0-0 (-> *level-task-data-remap* length)))
(let ((a0-3 (-> *level-task-data-remap* a0-0)))
(when (< a0-3 (-> v1-7 length))
(let ((gp-0 (-> v1-7 a0-3 tasks)))
(when (and (!= gp-0 0) (nonzero? (-> gp-0 length)))
(let ((s5-0 (-> *game-info* in-level-time a0-3)))
(dotimes (s4-0 (-> gp-0 length))
(case (get-task-status (-> gp-0 s4-0 task))
(((task-status need-hint) (task-status unknown))
(if (< (the-as uint (-> gp-0 s4-0 delay)) (the-as uint s5-0))
(close-specific-task!
(-> gp-0 s4-0 task)
(task-status need-hint)
(let ((a0-0 (+ (-> *target* current-level info index) -1))
(v1-7 (-> *game-info* task-hint-control))
)
(when (and (>= a0-0 0) (< a0-0 (-> *level-task-data-remap* length)))
(let ((a0-3 (-> *level-task-data-remap* a0-0)))
(when (< a0-3 (-> v1-7 length))
(let ((gp-0 (-> v1-7 a0-3 tasks)))
(when (and (!= gp-0 0) (nonzero? (-> gp-0 length)))
(let ((s5-0 (-> *game-info* in-level-time a0-3)))
(dotimes (s4-0 (-> gp-0 length))
(case (get-task-status (-> gp-0 s4-0 task))
(((task-status need-hint) (task-status unknown))
(if (< (the-as uint (-> gp-0 s4-0 delay)) (the-as uint s5-0))
(close-specific-task! (-> gp-0 s4-0 task) (task-status need-hint))
)
)
)
)
)
)
)
)
)
)
)
)
)
)
)
)
)
)
0
(none)
)
File diff suppressed because it is too large Load Diff
+3 -7
View File
@@ -160,15 +160,11 @@
;; definition for method 3 of type process-taskable
(defmethod inspect process-taskable ((obj process-taskable))
(let ((t9-0 (method-of-type process-drawable inspect)))
(t9-0 obj)
)
(t9-0 obj)
)
(format #t "~T~Ttasks: ~A~%" (-> obj tasks))
(format #t "~T~Tquery: #<gui-query @ #x~X>~%" (-> obj query))
(format
#t
"~T~Told-target-pos: #<transformq @ #x~X>~%"
(-> obj old-target-pos)
)
(format #t "~T~Told-target-pos: #<transformq @ #x~X>~%" (-> obj old-target-pos))
(format #t "~T~Tcell-for-task: ~D~%" (-> obj cell-for-task))
(format #t "~T~Tcell-x: ~D~%" (-> obj cell-x))
(format #t "~T~Tcam-joint-index: ~D~%" (-> obj cam-joint-index))
File diff suppressed because it is too large Load Diff
+28 -40
View File
@@ -4,8 +4,8 @@
;; definition for function set-video-mode
;; INFO: Return type mismatch int vs none.
(defun set-video-mode ((arg0 symbol))
(case arg0
(('ntsc)
(case arg0
(('ntsc)
(set! (-> *video-parms* screen-sy) 224)
(set! (-> *setting-control* default screenx) 0)
(set! (-> *setting-control* default screeny) 8)
@@ -17,45 +17,36 @@
(set! (-> *math-camera* y-clip) 448.0)
(set! (-> *shadow-data* texoffset y) 112.5)
)
(('pal)
(set! (-> *video-parms* screen-sy) 256)
(set! (-> *setting-control* default screenx) 0)
(set! (-> *setting-control* default screeny) 24)
(set! (-> *video-parms* screen-pages-high) 8)
(set! (-> *video-parms* relative-y-scale) 1.1428572)
(set! *ticks-per-frame* #x2dc6)
(set! (-> *math-camera* isometric vector 1 y) 0.4375)
(set! (-> *math-camera* y-pix) 128.0)
(set! (-> *math-camera* y-clip) 512.0)
(set! (-> *shadow-data* texoffset y) 128.5)
(('pal)
(set! (-> *video-parms* screen-sy) 256)
(set! (-> *setting-control* default screenx) 0)
(set! (-> *setting-control* default screeny) 24)
(set! (-> *video-parms* screen-pages-high) 8)
(set! (-> *video-parms* relative-y-scale) 1.1428572)
(set! *ticks-per-frame* #x2dc6)
(set! (-> *math-camera* isometric vector 1 y) 0.4375)
(set! (-> *math-camera* y-pix) 128.0)
(set! (-> *math-camera* y-clip) 512.0)
(set! (-> *shadow-data* texoffset y) 128.5)
)
)
)
(set-time-ratios *display* (-> *display* time-ratio))
(set! (-> *video-parms* reset-video-mode) #t)
(set! (-> *video-parms* screen-hy) (/ (-> *video-parms* screen-sy) 2))
(set! (-> *video-parms* screen-miny) (- 2048 (-> *video-parms* screen-hy)))
(set! (-> *video-parms* screen-maxy) (+ (-> *video-parms* screen-hy) 2048))
(set! (-> *video-parms* screen-masky) (+ (-> *video-parms* screen-sy) -1))
(set!
(-> *pause-context* origin y)
(the float (+ (-> *video-parms* screen-sy) -54))
)
(set! (-> *pause-context* origin y) (the float (+ (-> *video-parms* screen-sy) -54)))
(set! (-> *pause-context* height) (the float (-> *video-parms* screen-sy)))
(set!
(-> *font-default-matrix* vector 1 y)
(-> *video-parms* relative-y-scale)
)
(set!
(-> *font-default-matrix* vector 3 y)
(- (the float (-> *video-parms* screen-hy)))
)
(set! (-> *font-default-matrix* vector 1 y) (-> *video-parms* relative-y-scale))
(set! (-> *font-default-matrix* vector 3 y) (- (the float (-> *video-parms* screen-hy))))
(set! (-> *video-parms* relative-y-scale-reciprical) 1.0)
(set! *profile-y* (+ (-> *video-parms* screen-miny) 8))
(set! (-> *video-parms* set-video-mode) #t)
(set-hud-aspect-ratio (get-aspect-ratio) arg0)
(if *progress-process*
(adjust-ratios (-> *progress-process* 0) (get-aspect-ratio) arg0)
)
(adjust-ratios (-> *progress-process* 0) (get-aspect-ratio) arg0)
)
0
(none)
)
@@ -68,24 +59,21 @@
;; definition for function set-aspect-ratio
;; INFO: Return type mismatch int vs none.
(defun set-aspect-ratio ((arg0 symbol))
(case arg0
(('aspect4x3)
(case arg0
(('aspect4x3)
(set! (-> *video-parms* relative-x-scale) 1.0)
(set! (-> *video-parms* relative-x-scale-reciprical) 1.0)
)
(('aspect16x9)
(set! (-> *video-parms* relative-x-scale) 0.75)
(set! (-> *video-parms* relative-x-scale-reciprical) 1.3333334)
(('aspect16x9)
(set! (-> *video-parms* relative-x-scale) 0.75)
(set! (-> *video-parms* relative-x-scale-reciprical) 1.3333334)
)
)
)
(set!
(-> *font-default-matrix* vector 0 x)
(-> *video-parms* relative-x-scale)
)
(set! (-> *font-default-matrix* vector 0 x) (-> *video-parms* relative-x-scale))
(set-hud-aspect-ratio arg0 (get-video-mode))
(if *progress-process*
(adjust-ratios (-> *progress-process* 0) arg0 (get-video-mode))
)
(adjust-ratios (-> *progress-process* 0) arg0 (get-video-mode))
)
0
(none)
)
+72 -82
View File
@@ -4,32 +4,29 @@
;; definition for function box-vector-enside?
(defun box-vector-enside? ((box bounding-box) (pt vector))
(and
(< (-> box min x) (-> pt x))
(< (-> box min y) (-> pt y))
(< (-> box min z) (-> pt z))
(< (-> pt x) (-> box max x))
(< (-> pt y) (-> box max y))
(< (-> pt z) (-> box max z))
)
(< (-> box min x) (-> pt x))
(< (-> box min y) (-> pt y))
(< (-> box min z) (-> pt z))
(< (-> pt x) (-> box max x))
(< (-> pt y) (-> box max y))
(< (-> pt z) (-> box max z))
)
)
;; definition for function box-vector-inside?
(defun box-vector-inside? ((box bounding-box) (pt vector))
(and
(>= (-> pt x) (-> box min x))
(>= (-> pt y) (-> box min y))
(>= (-> pt z) (-> box min z))
(>= (-> box max x) (-> pt x))
(>= (-> box max y) (-> pt y))
(>= (-> box max z) (-> pt z))
)
(>= (-> pt x) (-> box min x))
(>= (-> pt y) (-> box min y))
(>= (-> pt z) (-> box min z))
(>= (-> box max x) (-> pt x))
(>= (-> box max y) (-> pt y))
(>= (-> box max z) (-> pt z))
)
)
;; definition for method 11 of type bounding-box
(defmethod
set-from-point-offset!
bounding-box
((obj bounding-box) (arg0 vector3s) (arg1 vector3s))
(defmethod set-from-point-offset! bounding-box ((obj bounding-box) (arg0 vector3s) (arg1 vector3s))
(rlet ((vf0 :class vf)
(vf1 :class vf)
(vf2 :class vf)
@@ -37,18 +34,18 @@
(vf4 :class vf)
(vf5 :class vf)
)
(init-vf0-vector)
(.lvf vf3 arg1)
(.lvf vf4 arg0)
(.add.vf vf5 vf4 vf3)
(.min.vf vf1 vf4 vf5)
(.max.vf vf2 vf4 vf5)
(.mov.vf vf1 vf0 :mask #b1000)
(.mov.vf vf2 vf0 :mask #b1000)
(.svf (&-> obj min quad) vf1)
(.svf (&-> obj max quad) vf2)
0
)
(init-vf0-vector)
(.lvf vf3 arg1)
(.lvf vf4 arg0)
(.add.vf vf5 vf4 vf3)
(.min.vf vf1 vf4 vf5)
(.max.vf vf2 vf4 vf5)
(.mov.vf vf1 vf0 :mask #b1000)
(.mov.vf vf2 vf0 :mask #b1000)
(.svf (&-> obj min quad) vf1)
(.svf (&-> obj max quad) vf2)
0
)
)
;; definition for method 10 of type bounding-box
@@ -57,15 +54,15 @@
(vf2 :class vf)
(vf3 :class vf)
)
(.lvf vf1 (&-> obj min quad))
(.lvf vf2 (&-> obj max quad))
(.lvf vf3 arg0)
(.min.vf vf1 vf1 vf3)
(.max.vf vf2 vf2 vf3)
(.svf (&-> obj min quad) vf1)
(.svf (&-> obj max quad) vf2)
0
)
(.lvf vf1 (&-> obj min quad))
(.lvf vf2 (&-> obj max quad))
(.lvf vf3 arg0)
(.min.vf vf1 vf1 vf3)
(.max.vf vf2 vf2 vf3)
(.svf (&-> obj min quad) vf1)
(.svf (&-> obj max quad) vf2)
0
)
)
;; definition for method 15 of type bounding-box
@@ -75,23 +72,20 @@
(vf3 :class vf)
(vf4 :class vf)
)
(.lvf vf1 (&-> obj min quad))
(.lvf vf2 (&-> obj max quad))
(.lvf vf3 (&-> arg0 min quad))
(.lvf vf4 (&-> arg0 max quad))
(.min.vf vf1 vf1 vf3)
(.max.vf vf2 vf2 vf4)
(.svf (&-> obj min quad) vf1)
(.svf (&-> obj max quad) vf2)
0
)
(.lvf vf1 (&-> obj min quad))
(.lvf vf2 (&-> obj max quad))
(.lvf vf3 (&-> arg0 min quad))
(.lvf vf4 (&-> arg0 max quad))
(.min.vf vf1 vf1 vf3)
(.max.vf vf2 vf2 vf4)
(.svf (&-> obj min quad) vf1)
(.svf (&-> obj max quad) vf2)
0
)
)
;; definition for method 12 of type bounding-box
(defmethod
set-from-point-offset-pad!
bounding-box
((obj bounding-box) (arg0 vector3s) (arg1 vector3s) (arg2 float))
(defmethod set-from-point-offset-pad! bounding-box ((obj bounding-box) (arg0 vector3s) (arg1 vector3s) (arg2 float))
(rlet ((vf0 :class vf)
(vf1 :class vf)
(vf2 :class vf)
@@ -100,21 +94,21 @@
(vf5 :class vf)
(vf6 :class vf)
)
(init-vf0-vector)
(.lvf vf4 arg1)
(.lvf vf5 arg0)
(.mov vf1 arg2)
(.add.vf vf6 vf5 vf4)
(.min.vf vf2 vf5 vf6)
(.max.vf vf3 vf5 vf6)
(.add.x.vf vf3 vf3 vf1 :mask #b111)
(.sub.x.vf vf2 vf2 vf1 :mask #b111)
(.mov.vf vf2 vf0 :mask #b1000)
(.mov.vf vf3 vf0 :mask #b1000)
(.svf (&-> obj min quad) vf2)
(.svf (&-> obj max quad) vf3)
0
)
(init-vf0-vector)
(.lvf vf4 arg1)
(.lvf vf5 arg0)
(.mov vf1 arg2)
(.add.vf vf6 vf5 vf4)
(.min.vf vf2 vf5 vf6)
(.max.vf vf3 vf5 vf6)
(.add.x.vf vf3 vf3 vf1 :mask #b111)
(.sub.x.vf vf2 vf2 vf1 :mask #b111)
(.mov.vf vf2 vf0 :mask #b1000)
(.mov.vf vf3 vf0 :mask #b1000)
(.svf (&-> obj min quad) vf2)
(.svf (&-> obj max quad) vf3)
0
)
)
;; definition for method 13 of type bounding-box
@@ -124,16 +118,16 @@
(vf2 :class vf)
(vf3 :class vf)
)
(init-vf0-vector)
(.lvf vf1 (&-> arg0 quad))
(.sub.w.vf vf2 vf1 vf1 :mask #b111)
(.add.w.vf vf3 vf1 vf1 :mask #b111)
(.mov.vf vf2 vf0 :mask #b1000)
(.mov.vf vf3 vf0 :mask #b1000)
(.svf (&-> obj min quad) vf2)
(.svf (&-> obj max quad) vf3)
0
)
(init-vf0-vector)
(.lvf vf1 (&-> arg0 quad))
(.sub.w.vf vf2 vf1 vf1 :mask #b111)
(.add.w.vf vf3 vf1 vf1 :mask #b111)
(.mov.vf vf2 vf0 :mask #b1000)
(.mov.vf vf3 vf0 :mask #b1000)
(.svf (&-> obj min quad) vf2)
(.svf (&-> obj max quad) vf3)
0
)
)
;; definition for method 14 of type bounding-box
@@ -141,7 +135,3 @@
;; definition for method 9 of type bounding-box
;; ERROR: function was not converted to expressions. Cannot decompile.
+210 -288
View File
@@ -2,55 +2,37 @@
(in-package goal)
;; definition for method 10 of type cylinder
(defmethod
ray-capsule-intersect
cylinder
((obj cylinder) (probe-origin vector) (probe-dir vector))
(defmethod ray-capsule-intersect cylinder ((obj cylinder) (probe-origin vector) (probe-dir vector))
(let ((t2-0 (new 'stack-no-clear 'vector))
(end-pt (new 'stack-no-clear 'vector))
)
0.0
0.0
(let
((result
(ray-cylinder-intersect
probe-origin
probe-dir
(-> obj origin)
(-> obj axis)
(-> obj radius)
(-> obj length)
t2-0
)
)
)
(let
((u-origin-sph
(ray-sphere-intersect
probe-origin
probe-dir
(-> obj origin)
(-> obj radius)
0.0
0.0
(let ((result (ray-cylinder-intersect
probe-origin
probe-dir
(-> obj origin)
(-> obj axis)
(-> obj radius)
(-> obj length)
t2-0
)
)
)
(let ((u-origin-sph (ray-sphere-intersect probe-origin probe-dir (-> obj origin) (-> obj radius))))
(if (and (>= u-origin-sph 0.0) (or (< result 0.0) (< u-origin-sph result)))
(set! result u-origin-sph)
)
)
)
(vector+float*! end-pt (-> obj origin) (-> obj axis) (-> obj length))
(let ((u-end-sphere (ray-sphere-intersect probe-origin probe-dir end-pt (-> obj radius))))
(if (and (>= u-end-sphere 0.0) (or (< result 0.0) (< u-end-sphere result)))
(set! result u-end-sphere)
)
)
result
)
(if (and (>= u-origin-sph 0.0) (or (< result 0.0) (< u-origin-sph result)))
(set! result u-origin-sph)
)
)
(vector+float*! end-pt (-> obj origin) (-> obj axis) (-> obj length))
(let
((u-end-sphere
(ray-sphere-intersect probe-origin probe-dir end-pt (-> obj radius))
)
)
(if (and (>= u-end-sphere 0.0) (or (< result 0.0) (< u-end-sphere result)))
(set! result u-end-sphere)
)
)
result
)
)
)
;; definition of type cylinder-verts
@@ -74,221 +56,171 @@
;; Used lq/sq
(defmethod debug-draw cylinder ((obj cylinder) (arg0 vector4w))
(local-vars
(sv-896 matrix)
(sv-912 int)
(sv-928 (function vector vector vector float vector))
(sv-944 vector)
(sv-960 vector)
(sv-976 vector)
(sv-992 (function vector vector vector float vector))
(sv-1008 vector)
(sv-1024 vector)
(sv-1040 vector)
(sv-1056 (function vector vector vector float vector))
(sv-1072 vector)
(sv-1088 vector)
(sv-1104 vector)
(sv-1120 (function vector vector vector float vector))
(sv-1136 vector)
(sv-1152 vector)
(sv-1168 vector)
)
(sv-896 matrix)
(sv-912 int)
(sv-928 (function vector vector vector float vector))
(sv-944 vector)
(sv-960 vector)
(sv-976 vector)
(sv-992 (function vector vector vector float vector))
(sv-1008 vector)
(sv-1024 vector)
(sv-1040 vector)
(sv-1056 (function vector vector vector float vector))
(sv-1072 vector)
(sv-1088 vector)
(sv-1104 vector)
(sv-1120 (function vector vector vector float vector))
(sv-1136 vector)
(sv-1152 vector)
(sv-1168 vector)
)
(rlet ((vf0 :class vf)
(vf4 :class vf)
(vf5 :class vf)
(vf6 :class vf)
)
(init-vf0-vector)
(let ((s1-0 (new 'stack-no-clear 'vector))
(s0-0 (new 'stack-no-clear 'vector))
)
(if (< 0.999 (fabs (-> obj axis y)))
(vector-cross! s1-0 (-> obj axis) (new 'static 'vector :z 1.0))
(vector-cross! s1-0 (-> obj axis) (new 'static 'vector :y 1.0))
)
(vector-normalize! s1-0 (-> obj radius))
(vector-float*! s0-0 (-> obj axis) (* 0.125 (-> obj length)))
(let ((s5-0 (new 'stack-no-clear 'cylinder-verts))
(s4-0 (new 'stack-no-clear 'cylinder-verts))
(s3-0 (new 'stack-no-clear 'matrix))
(init-vf0-vector)
(let ((s1-0 (new 'stack-no-clear 'vector))
(s0-0 (new 'stack-no-clear 'vector))
)
(matrix-axis-angle! s3-0 (-> obj axis) 4096.0)
(set! sv-896 (new 'stack-no-clear 'matrix))
(vector-matrix*! (the-as vector sv-896) (-> obj origin) s3-0)
(let ((v1-5 (-> s3-0 vector 3)))
(.lvf vf4 (&-> (-> obj origin) quad))
(.lvf vf5 (&-> sv-896 vector 0 quad))
(.mov.vf vf6 vf0 :mask #b1000)
(.sub.vf vf6 vf4 vf5 :mask #b111)
(.svf (&-> v1-5 quad) vf6)
)
(set! sv-912 0)
(while (< sv-912 8)
(vector+! (-> s5-0 vert (+ sv-912 8)) (-> obj origin) s1-0)
(vector+float*!
(-> s5-0 vert (+ sv-912 8))
(-> s5-0 vert (+ sv-912 8))
s0-0
(the float sv-912)
)
(set! sv-912 (+ sv-912 1))
)
(dotimes (s0-1 8)
(set! sv-928 vector+float*!)
(set! sv-944 (-> s5-0 vert s0-1))
(set! sv-960 (-> obj origin))
(set! sv-976 s1-0)
(let ((a3-1 (cos (* 2048.0 (the float (- 7 s0-1))))))
(sv-928 sv-944 sv-960 sv-976 a3-1)
)
(set! sv-992 vector+float*!)
(set! sv-1008 (-> s5-0 vert s0-1))
(set! sv-1024 (-> s5-0 vert s0-1))
(set! sv-1040 (-> obj axis))
(let
((a3-2 (* (- (-> obj radius)) (sin (* 2048.0 (the float (- 7 s0-1)))))))
(sv-992 sv-1008 sv-1024 sv-1040 a3-2)
)
(set! sv-1056 vector+float*!)
(set! sv-1072 (-> s5-0 vert (+ s0-1 16)))
(set! sv-1088 (-> obj origin))
(set! sv-1104 s1-0)
(let ((a3-3 (cos (* 2048.0 (the float s0-1)))))
(sv-1056 sv-1072 sv-1088 sv-1104 a3-3)
)
(set! sv-1120 vector+float*!)
(set! sv-1136 (-> s5-0 vert (+ s0-1 16)))
(set! sv-1152 (-> s5-0 vert (+ s0-1 16)))
(set! sv-1168 (-> obj axis))
(let
((a3-4
(+
(-> obj length)
(* (-> obj radius) (sin (* 2048.0 (the float s0-1))))
(if (< 0.999 (fabs (-> obj axis y)))
(vector-cross! s1-0 (-> obj axis) (new 'static 'vector :z 1.0))
(vector-cross! s1-0 (-> obj axis) (new 'static 'vector :y 1.0))
)
(vector-normalize! s1-0 (-> obj radius))
(vector-float*! s0-0 (-> obj axis) (* 0.125 (-> obj length)))
(let ((s5-0 (new 'stack-no-clear 'cylinder-verts))
(s4-0 (new 'stack-no-clear 'cylinder-verts))
(s3-0 (new 'stack-no-clear 'matrix))
)
(matrix-axis-angle! s3-0 (-> obj axis) 4096.0)
(set! sv-896 (new 'stack-no-clear 'matrix))
(vector-matrix*! (the-as vector sv-896) (-> obj origin) s3-0)
(let ((v1-5 (-> s3-0 vector 3)))
(.lvf vf4 (&-> (-> obj origin) quad))
(.lvf vf5 (&-> sv-896 vector 0 quad))
(.mov.vf vf6 vf0 :mask #b1000)
(.sub.vf vf6 vf4 vf5 :mask #b111)
(.svf (&-> v1-5 quad) vf6)
)
(set! sv-912 0)
(while (< sv-912 8)
(vector+! (-> s5-0 vert (+ sv-912 8)) (-> obj origin) s1-0)
(vector+float*! (-> s5-0 vert (+ sv-912 8)) (-> s5-0 vert (+ sv-912 8)) s0-0 (the float sv-912))
(set! sv-912 (+ sv-912 1))
)
(dotimes (s0-1 8)
(set! sv-928 vector+float*!)
(set! sv-944 (-> s5-0 vert s0-1))
(set! sv-960 (-> obj origin))
(set! sv-976 s1-0)
(let ((a3-1 (cos (* 2048.0 (the float (- 7 s0-1))))))
(sv-928 sv-944 sv-960 sv-976 a3-1)
)
(set! sv-992 vector+float*!)
(set! sv-1008 (-> s5-0 vert s0-1))
(set! sv-1024 (-> s5-0 vert s0-1))
(set! sv-1040 (-> obj axis))
(let ((a3-2 (* (- (-> obj radius)) (sin (* 2048.0 (the float (- 7 s0-1)))))))
(sv-992 sv-1008 sv-1024 sv-1040 a3-2)
)
(set! sv-1056 vector+float*!)
(set! sv-1072 (-> s5-0 vert (+ s0-1 16)))
(set! sv-1088 (-> obj origin))
(set! sv-1104 s1-0)
(let ((a3-3 (cos (* 2048.0 (the float s0-1)))))
(sv-1056 sv-1072 sv-1088 sv-1104 a3-3)
)
(set! sv-1120 vector+float*!)
(set! sv-1136 (-> s5-0 vert (+ s0-1 16)))
(set! sv-1152 (-> s5-0 vert (+ s0-1 16)))
(set! sv-1168 (-> obj axis))
(let ((a3-4 (+ (-> obj length) (* (-> obj radius) (sin (* 2048.0 (the float s0-1)))))))
(sv-1120 sv-1136 sv-1152 sv-1168 a3-4)
)
)
(dotimes (s2-1 16)
(dotimes (s1-1 24)
(vector-matrix*! (-> s4-0 vert s1-1) (-> s5-0 vert s1-1) s3-0)
(camera-line (-> s5-0 vert s1-1) (-> s4-0 vert s1-1) arg0)
(if (nonzero? s1-1)
(camera-line (-> s5-0 vert s1-1) (-> s5-0 vert (+ s1-1 -1)) arg0)
)
)
(let ((v1-77 s5-0))
(set! s5-0 s4-0)
(set! s4-0 v1-77)
)
)
)
)
(sv-1120 sv-1136 sv-1152 sv-1168 a3-4)
)
)
(dotimes (s2-1 16)
(dotimes (s1-1 24)
(vector-matrix*! (-> s4-0 vert s1-1) (-> s5-0 vert s1-1) s3-0)
(camera-line (-> s5-0 vert s1-1) (-> s4-0 vert s1-1) arg0)
(if (nonzero? s1-1)
(camera-line (-> s5-0 vert s1-1) (-> s5-0 vert (+ s1-1 -1)) arg0)
)
)
(let ((v1-77 s5-0))
(set! s5-0 s4-0)
(set! s4-0 v1-77)
)
)
)
0
(none)
)
0
(none)
)
)
;; definition for function ray-arbitrary-circle-intersect
(defun
ray-arbitrary-circle-intersect
((probe-origin vector)
(probe-dir vector)
(circle-origin vector)
(circle-normal vector)
(radius float)
)
(let*
((v1-1 (vector-! (new 'stack-no-clear 'vector) circle-origin probe-origin))
(f0-2
(/ (vector-dot v1-1 circle-normal) (vector-dot probe-dir circle-normal))
)
)
(cond
((or (< 1.0 f0-2) (< f0-2 0.0))
-100000000.0
)
((let ((a0-7 (new 'stack-no-clear 'vector)))
(vector-float*! a0-7 probe-dir f0-2)
(vector-! a0-7 a0-7 v1-1)
(< (vector-dot a0-7 a0-7) (* radius radius))
(defun ray-arbitrary-circle-intersect ((probe-origin vector) (probe-dir vector) (circle-origin vector) (circle-normal vector) (radius float))
(let* ((v1-1 (vector-! (new 'stack-no-clear 'vector) circle-origin probe-origin))
(f0-2 (/ (vector-dot v1-1 circle-normal) (vector-dot probe-dir circle-normal)))
)
(cond
((or (< 1.0 f0-2) (< f0-2 0.0))
-100000000.0
)
((let ((a0-7 (new 'stack-no-clear 'vector)))
(vector-float*! a0-7 probe-dir f0-2)
(vector-! a0-7 a0-7 v1-1)
(< (vector-dot a0-7 a0-7) (* radius radius))
)
f0-2
)
(else
-100000000.0
)
)
f0-2
)
(else
-100000000.0
)
)
)
)
;; definition for method 10 of type cylinder-flat
;; Used lq/sq
(defmethod
ray-flat-cyl-intersect
cylinder-flat
((obj cylinder-flat) (probe-origin vector) (probe-dir vector))
(defmethod ray-flat-cyl-intersect cylinder-flat ((obj cylinder-flat) (probe-origin vector) (probe-dir vector))
(let ((gp-0 (new 'stack-no-clear 'vector))
(end-pt (new 'stack-no-clear 'vector))
)
0.0
0.0
(let
((result
(ray-cylinder-intersect
probe-origin
probe-dir
(-> obj origin)
(-> obj axis)
(-> obj radius)
(-> obj length)
gp-0
)
)
)
(let
((u-origin-circle
(ray-arbitrary-circle-intersect
probe-origin
probe-dir
(-> obj origin)
(-> obj axis)
(-> obj radius)
0.0
0.0
(let ((result (ray-cylinder-intersect
probe-origin
probe-dir
(-> obj origin)
(-> obj axis)
(-> obj radius)
(-> obj length)
gp-0
)
)
)
(let ((u-origin-circle
(ray-arbitrary-circle-intersect probe-origin probe-dir (-> obj origin) (-> obj axis) (-> obj radius))
)
)
(when (and (>= u-origin-circle 0.0) (or (< result 0.0) (< u-origin-circle result)))
(set! result u-origin-circle)
(set! (-> gp-0 quad) (-> obj origin quad))
)
)
)
)
(when
(and
(>= u-origin-circle 0.0)
(or (< result 0.0) (< u-origin-circle result))
)
(set! result u-origin-circle)
(set! (-> gp-0 quad) (-> obj origin quad))
)
)
(vector+float*! end-pt (-> obj origin) (-> obj axis) (-> obj length))
(let
((u-end-circle
(ray-arbitrary-circle-intersect
probe-origin
probe-dir
end-pt
(-> obj axis)
(-> obj radius)
(vector+float*! end-pt (-> obj origin) (-> obj axis) (-> obj length))
(let ((u-end-circle (ray-arbitrary-circle-intersect probe-origin probe-dir end-pt (-> obj axis) (-> obj radius))))
(when (and (>= u-end-circle 0.0) (or (< result 0.0) (< u-end-circle result)))
(set! result u-end-circle)
(set! (-> gp-0 quad) (-> end-pt quad))
)
)
)
result
)
(when
(and (>= u-end-circle 0.0) (or (< result 0.0) (< u-end-circle result)))
(set! result u-end-circle)
(set! (-> gp-0 quad) (-> end-pt quad))
)
)
result
)
)
)
;; definition of type cylinder-flat-verts
@@ -317,64 +249,54 @@
(vf5 :class vf)
(vf6 :class vf)
)
(init-vf0-vector)
(let ((s1-0 (new 'stack-no-clear 'vector))
(s0-0 (new 'stack-no-clear 'vector))
)
(if (< 0.999 (fabs (-> obj axis y)))
(vector-cross! s1-0 (-> obj axis) (new 'static 'vector :z 1.0))
(vector-cross! s1-0 (-> obj axis) (new 'static 'vector :y 1.0))
)
(vector-normalize! s1-0 (-> obj radius))
(vector-float*! s0-0 (-> obj axis) (* 0.14285715 (-> obj length)))
(let ((s5-0 (new 'stack-no-clear 'cylinder-flat-verts))
(s4-0 (new 'stack-no-clear 'cylinder-flat-verts))
(s3-0 (new 'stack-no-clear 'matrix))
(init-vf0-vector)
(let ((s1-0 (new 'stack-no-clear 'vector))
(s0-0 (new 'stack-no-clear 'vector))
)
(if (< 0.999 (fabs (-> obj axis y)))
(vector-cross! s1-0 (-> obj axis) (new 'static 'vector :z 1.0))
(vector-cross! s1-0 (-> obj axis) (new 'static 'vector :y 1.0))
)
(vector-normalize! s1-0 (-> obj radius))
(vector-float*! s0-0 (-> obj axis) (* 0.14285715 (-> obj length)))
(let ((s5-0 (new 'stack-no-clear 'cylinder-flat-verts))
(s4-0 (new 'stack-no-clear 'cylinder-flat-verts))
(s3-0 (new 'stack-no-clear 'matrix))
)
(matrix-axis-angle! s3-0 (-> obj axis) 4096.0)
(set! sv-448 (new 'stack-no-clear 'vector))
(vector-matrix*! sv-448 (-> obj origin) s3-0)
(let ((v1-5 (-> s3-0 vector 3)))
(.lvf vf4 (&-> (-> obj origin) quad))
(.lvf vf5 (&-> sv-448 quad))
(.mov.vf vf6 vf0 :mask #b1000)
(.sub.vf vf6 vf4 vf5 :mask #b111)
(.svf (&-> v1-5 quad) vf6)
)
(set! sv-464 0)
(while (< sv-464 8)
(vector+! (-> s5-0 vert (+ sv-464 1)) (-> obj origin) s1-0)
(vector+float*! (-> s5-0 vert (+ sv-464 1)) (-> s5-0 vert (+ sv-464 1)) s0-0 (the float sv-464))
(set! sv-464 (+ sv-464 1))
)
(set! (-> s5-0 vert 0 quad) (-> obj origin quad))
(vector+float*! (-> s5-0 vert 9) (-> obj origin) (-> obj axis) (-> obj length))
(dotimes (s2-1 16)
(dotimes (s1-1 10)
(vector-matrix*! (-> s4-0 vert s1-1) (-> s5-0 vert s1-1) s3-0)
(camera-line (-> s5-0 vert s1-1) (-> s4-0 vert s1-1) arg0)
(if (nonzero? s1-1)
(camera-line (-> s5-0 vert s1-1) (-> s5-0 vert (+ s1-1 -1)) arg0)
)
)
(let ((v1-43 s5-0))
(set! s5-0 s4-0)
(set! s4-0 v1-43)
)
)
(matrix-axis-angle! s3-0 (-> obj axis) 4096.0)
(set! sv-448 (new 'stack-no-clear 'vector))
(vector-matrix*! sv-448 (-> obj origin) s3-0)
(let ((v1-5 (-> s3-0 vector 3)))
(.lvf vf4 (&-> (-> obj origin) quad))
(.lvf vf5 (&-> sv-448 quad))
(.mov.vf vf6 vf0 :mask #b1000)
(.sub.vf vf6 vf4 vf5 :mask #b111)
(.svf (&-> v1-5 quad) vf6)
)
(set! sv-464 0)
(while (< sv-464 8)
(vector+! (-> s5-0 vert (+ sv-464 1)) (-> obj origin) s1-0)
(vector+float*!
(-> s5-0 vert (+ sv-464 1))
(-> s5-0 vert (+ sv-464 1))
s0-0
(the float sv-464)
)
(set! sv-464 (+ sv-464 1))
)
(set! (-> s5-0 vert 0 quad) (-> obj origin quad))
(vector+float*!
(-> s5-0 vert 9)
(-> obj origin)
(-> obj axis)
(-> obj length)
)
(dotimes (s2-1 16)
(dotimes (s1-1 10)
(vector-matrix*! (-> s4-0 vert s1-1) (-> s5-0 vert s1-1) s3-0)
(camera-line (-> s5-0 vert s1-1) (-> s4-0 vert s1-1) arg0)
(if (nonzero? s1-1)
(camera-line (-> s5-0 vert s1-1) (-> s5-0 vert (+ s1-1 -1)) arg0)
)
)
(let ((v1-43 s5-0))
(set! s5-0 s4-0)
(set! s4-0 v1-43)
)
)
)
0
(none)
)
0
(none)
)
)
File diff suppressed because it is too large Load Diff
+45 -103
View File
@@ -74,119 +74,61 @@
;; definition for method 0 of type vol-control
;; INFO: Return type mismatch object vs vol-control.
;; Used lq/sq
(defmethod
new
vol-control
((allocation symbol) (type-to-make type) (arg0 process-drawable))
(let
((gp-0
(the-as
object
(object-new allocation type-to-make (the-as int (-> type-to-make size)))
(defmethod new vol-control ((allocation symbol) (type-to-make type) (arg0 process-drawable))
(let ((gp-0 (the-as object (object-new allocation type-to-make (the-as int (-> type-to-make size))))))
(when (zero? (the-as vol-control gp-0))
(go process-drawable-art-error "memory")
(set! gp-0 0)
(goto cfg-13)
)
)
)
(when (zero? (the-as vol-control gp-0))
(go process-drawable-art-error "memory")
(set! gp-0 0)
(goto cfg-13)
)
(set! (-> (the-as vol-control gp-0) process) arg0)
(let* ((s5-1 (the-as res-lump (-> (the-as vol-control gp-0) process entity)))
(s4-0
(->
((method-of-type res-lump lookup-tag-idx)
(the-as entity s5-1)
'vol
'exact
0.0
)
lo
(set! (-> (the-as vol-control gp-0) process) arg0)
(let* ((s5-1 (the-as res-lump (-> (the-as vol-control gp-0) process entity)))
(s4-0 (-> ((method-of-type res-lump lookup-tag-idx) (the-as entity s5-1) 'vol 'exact 0.0) lo))
)
(when (>= (the-as int s4-0) 0)
(let ((s3-0 (the-as uint s4-0))
(s2-0 (-> s5-1 tag s4-0))
)
0
(while (= (-> s2-0 name) (-> s5-1 tag s4-0 name))
(let ((v1-12 (make-property-data s5-1 0.0 (the-as res-tag-pair s3-0) (the-as pointer #f)))
(a0-8 (-> (the-as vol-control gp-0) pos-vol (-> (the-as vol-control gp-0) pos-vol-count)))
)
(set! (-> a0-8 num-planes) (the-as int (-> s2-0 elt-count)))
(set! (-> a0-8 plane) (the-as uint v1-12))
)
(+! (-> (the-as vol-control gp-0) pos-vol-count) 1)
(+! s3-0 1)
(set! s2-0 (-> s5-1 tag s3-0))
)
)
)
(when (>= (the-as int s4-0) 0)
(let ((s3-0 (the-as uint s4-0))
(s2-0 (-> s5-1 tag s4-0))
)
0
(while (= (-> s2-0 name) (-> s5-1 tag s4-0 name))
(let
((v1-12
(make-property-data
s5-1
0.0
(the-as res-tag-pair s3-0)
(the-as pointer #f)
)
)
(a0-8
(->
(the-as vol-control gp-0)
pos-vol
(-> (the-as vol-control gp-0) pos-vol-count)
)
)
)
(set! (-> a0-8 num-planes) (the-as int (-> s2-0 elt-count)))
(set! (-> a0-8 plane) (the-as uint v1-12))
)
(+! (-> (the-as vol-control gp-0) pos-vol-count) 1)
(+! s3-0 1)
(set! s2-0 (-> s5-1 tag s3-0))
)
)
)
)
(let* ((s5-2 (the-as res-lump (-> (the-as vol-control gp-0) process entity)))
(s4-1
(->
((method-of-type res-lump lookup-tag-idx)
(the-as entity s5-2)
'cutoutvol
'exact
0.0
)
lo
(let* ((s5-2 (the-as res-lump (-> (the-as vol-control gp-0) process entity)))
(s4-1 (-> ((method-of-type res-lump lookup-tag-idx) (the-as entity s5-2) 'cutoutvol 'exact 0.0) lo))
)
(when (>= (the-as int s4-1) 0)
(let ((s3-1 (the-as uint s4-1))
(s2-1 (-> s5-2 tag s4-1))
)
0
(while (= (-> s2-1 name) (-> s5-2 tag s4-1 name))
(let ((v1-31 (make-property-data s5-2 0.0 (the-as res-tag-pair s3-1) (the-as pointer #f)))
(a0-19 (-> (the-as vol-control gp-0) neg-vol (-> (the-as vol-control gp-0) neg-vol-count)))
)
(set! (-> a0-19 num-planes) (the-as int (-> s2-1 elt-count)))
(set! (-> a0-19 plane) (the-as uint v1-31))
)
(+! (-> (the-as vol-control gp-0) neg-vol-count) 1)
(+! s3-1 1)
(set! s2-1 (-> s5-2 tag s3-1))
)
)
)
(when (>= (the-as int s4-1) 0)
(let ((s3-1 (the-as uint s4-1))
(s2-1 (-> s5-2 tag s4-1))
)
0
(while (= (-> s2-1 name) (-> s5-2 tag s4-1 name))
(let
((v1-31
(make-property-data
s5-2
0.0
(the-as res-tag-pair s3-1)
(the-as pointer #f)
)
)
(a0-19
(->
(the-as vol-control gp-0)
neg-vol
(-> (the-as vol-control gp-0) neg-vol-count)
)
)
)
(set! (-> a0-19 num-planes) (the-as int (-> s2-1 elt-count)))
(set! (-> a0-19 plane) (the-as uint v1-31))
)
(+! (-> (the-as vol-control gp-0) neg-vol-count) 1)
(+! s3-1 1)
(set! s2-1 (-> s5-2 tag s3-1))
)
)
)
(label cfg-13)
(the-as vol-control gp-0)
)
(label cfg-13)
(the-as vol-control gp-0)
)
)
;; definition for method 11 of type vol-control
+3 -15
View File
@@ -53,21 +53,9 @@
(format #t "~Tlowres-tfrag-tree-count: ~D~%" (-> obj lowres-tfrag-tree-count))
(format #t "~Tlowres-tfrag-trees[8] @ #x~X~%" (-> obj lowres-tfrag-trees))
(format #t "~Tlowres-tfrag-levels[8] @ #x~X~%" (-> obj lowres-tfrag-levels))
(format
#t
"~Tlowres-trans-tfrag-tree-count: ~D~%"
(-> obj lowres-trans-tfrag-tree-count)
)
(format
#t
"~Tlowres-trans-tfrag-trees[8] @ #x~X~%"
(-> obj lowres-trans-tfrag-trees)
)
(format
#t
"~Tlowres-trans-tfrag-levels[8] @ #x~X~%"
(-> obj lowres-trans-tfrag-levels)
)
(format #t "~Tlowres-trans-tfrag-tree-count: ~D~%" (-> obj lowres-trans-tfrag-tree-count))
(format #t "~Tlowres-trans-tfrag-trees[8] @ #x~X~%" (-> obj lowres-trans-tfrag-trees))
(format #t "~Tlowres-trans-tfrag-levels[8] @ #x~X~%" (-> obj lowres-trans-tfrag-levels))
(format #t "~Tshrub-tree-count: ~D~%" (-> obj shrub-tree-count))
(format #t "~Tshrub-trees[8] @ #x~X~%" (-> obj shrub-trees))
(format #t "~Tshrub-levels[8] @ #x~X~%" (-> obj shrub-levels))

Some files were not shown because too many files have changed in this diff Show More