mirror of
https://github.com/open-goal/jak-project
synced 2026-08-29 01:02:14 -04:00
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:
@@ -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)
|
||||
|
||||
|
||||
@@ -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
|
||||
|
||||
@@ -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
|
||||
|
||||
@@ -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
|
||||
@@ -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
|
||||
@@ -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
|
||||
@@ -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
|
||||
@@ -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
@@ -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
File diff suppressed because it is too large
Load Diff
+2433
-2996
File diff suppressed because it is too large
Load Diff
+2051
-2891
File diff suppressed because it is too large
Load Diff
+755
-917
File diff suppressed because it is too large
Load Diff
+8
-15
@@ -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
@@ -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
@@ -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
File diff suppressed because it is too large
Load Diff
+9
-6
@@ -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
|
||||
)
|
||||
|
||||
|
||||
+421
-680
File diff suppressed because it is too large
Load Diff
+25
-25
@@ -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
@@ -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
File diff suppressed because it is too large
Load Diff
+762
-1193
File diff suppressed because it is too large
Load Diff
+21
-44
@@ -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)
|
||||
)
|
||||
|
||||
+439
-750
File diff suppressed because it is too large
Load Diff
+2616
-3746
File diff suppressed because it is too large
Load Diff
+2
-6
@@ -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)))
|
||||
|
||||
+434
-544
File diff suppressed because it is too large
Load Diff
+81
-157
@@ -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
File diff suppressed because it is too large
Load Diff
+2
-10
@@ -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
@@ -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
@@ -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
@@ -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
@@ -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
@@ -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
@@ -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
@@ -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
@@ -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
@@ -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
@@ -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
@@ -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
@@ -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
@@ -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
@@ -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
@@ -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
File diff suppressed because it is too large
Load Diff
+2272
-2931
File diff suppressed because it is too large
Load Diff
+4
-23
@@ -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
@@ -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
File diff suppressed because it is too large
Load Diff
+3892
-8336
File diff suppressed because it is too large
Load Diff
+440
-735
File diff suppressed because it is too large
Load Diff
+995
-1443
File diff suppressed because it is too large
Load Diff
+68
-95
@@ -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
@@ -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
@@ -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
@@ -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
@@ -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
File diff suppressed because it is too large
Load Diff
+152
-170
@@ -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
@@ -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
@@ -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
@@ -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
@@ -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
@@ -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
@@ -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
|
||||
|
||||
+777
-1056
File diff suppressed because it is too large
Load Diff
+190
-261
@@ -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
@@ -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
@@ -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
@@ -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
@@ -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
@@ -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))
|
||||
)
|
||||
|
||||
+3040
-3381
File diff suppressed because it is too large
Load Diff
+9
-16
@@ -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
|
||||
|
||||
+1086
-1273
File diff suppressed because it is too large
Load Diff
+105
-168
@@ -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
@@ -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
@@ -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
File diff suppressed because it is too large
Load Diff
+1470
-2224
File diff suppressed because it is too large
Load Diff
+14
-14
@@ -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
File diff suppressed because it is too large
Load Diff
+1276
-1536
File diff suppressed because it is too large
Load Diff
+6
-6
@@ -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
File diff suppressed because it is too large
Load Diff
+4
-14
@@ -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
@@ -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
@@ -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
@@ -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)
|
||||
)
|
||||
|
||||
+977
-1426
File diff suppressed because it is too large
Load Diff
+3
-7
@@ -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))
|
||||
|
||||
+4812
-5147
File diff suppressed because it is too large
Load Diff
+28
-40
@@ -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
@@ -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
@@ -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)
|
||||
)
|
||||
)
|
||||
|
||||
+776
-993
File diff suppressed because it is too large
Load Diff
+45
-103
@@ -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
@@ -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
Reference in New Issue
Block a user