From 2929a106aa633a6f1764d409c1245209b5b8193f Mon Sep 17 00:00:00 2001 From: water111 Date: Fri, 7 Aug 2026 20:58:40 -0400 Subject: [PATCH] first pass at cam cleanup --- decompiler/IR2/Env.cpp | 55 + decompiler/analysis/insert_lets.cpp | 94 +- goal_src/jak1/engine/camera/cam-combiner.gc | 375 +++-- goal_src/jak1/engine/camera/cam-debug-h.gc | 68 +- goal_src/jak1/engine/camera/cam-debug.gc | 1008 ++++++------ .../jak1/engine/camera/cam-interface-h.gc | 9 +- goal_src/jak1/engine/camera/cam-interface.gc | 24 +- goal_src/jak1/engine/camera/cam-layout.gc | 1363 ++++++++--------- goal_src/jak1/engine/camera/cam-master.gc | 751 ++++----- goal_src/jak1/engine/camera/cam-states-dbg.gc | 60 +- goal_src/jak1/engine/camera/cam-states.gc | 1192 +++++++------- goal_src/jak1/engine/camera/cam-update-h.gc | 9 +- goal_src/jak1/engine/camera/cam-update.gc | 79 +- goal_src/jak1/engine/camera/camera-h.gc | 157 +- goal_src/jak1/engine/camera/camera.gc | 488 +++--- 15 files changed, 2890 insertions(+), 2842 deletions(-) diff --git a/decompiler/IR2/Env.cpp b/decompiler/IR2/Env.cpp index d8b4fd1fc8..295c71473a 100644 --- a/decompiler/IR2/Env.cpp +++ b/decompiler/IR2/Env.cpp @@ -737,6 +737,7 @@ void Env::rebuild_stack_slot_use_def_info() { int next_var_id = 1; for (int offset : offsets) { + const int first_var_id = next_var_id; std::vector reads_before_write(block_count, false); std::vector writes(block_count, false); @@ -784,6 +785,7 @@ void Env::rebuild_stack_slot_use_def_info() { std::vector phi_var(block_count, -1); std::vector> phi_sources(block_count); + std::vector access_ops; for (int block_id = 0; block_id < block_count; block_id++) { if (live_in.at(block_id)) { phi_var.at(block_id) = next_var_id++; @@ -801,6 +803,7 @@ void Env::rebuild_stack_slot_use_def_info() { } ASSERT(current_var != -1); m_stack_slot_var_by_op[op_id] = current_var; + access_ops.push_back(op_id); auto& info = m_stack_slot_use_def_info[RegId(Register(Reg::GPR, Reg::SP), current_var)]; info.uses.push_back({op_id, block_id, AccessMode::READ, false}); info.ssa_vars.insert(current_var); @@ -810,6 +813,7 @@ void Env::rebuild_stack_slot_use_def_info() { } current_var = next_var_id++; m_stack_slot_var_by_op[op_id] = current_var; + access_ops.push_back(op_id); auto& info = m_stack_slot_use_def_info[RegId(Register(Reg::GPR, Reg::SP), current_var)]; info.defs.push_back({op_id, block_id, AccessMode::WRITE, false}); info.ssa_vars.insert(current_var); @@ -839,6 +843,57 @@ void Env::rebuild_stack_slot_use_def_info() { info.uses.push_back({first_op, block_id, AccessMode::READ, false}); } } + + // Match register variable analysis by merging every live stack-slot phi with its incoming + // definitions. Without this, a conditional store and the loads after its control-flow join + // receive different program-variable IDs even though they are one mutable source variable. + std::vector parent(next_var_id - first_var_id); + for (int i = 0; i < (int)parent.size(); i++) { + parent.at(i) = first_var_id + i; + } + auto find_root = [&](int var) { + int root = var; + while (parent.at(root - first_var_id) != root) { + root = parent.at(root - first_var_id); + } + while (parent.at(var - first_var_id) != var) { + const int next = parent.at(var - first_var_id); + parent.at(var - first_var_id) = root; + var = next; + } + return root; + }; + for (int block_id = 0; block_id < block_count; block_id++) { + if (phi_var.at(block_id) == -1) { + continue; + } + const int phi_root = find_root(phi_var.at(block_id)); + for (int src_var : phi_sources.at(block_id)) { + parent.at(find_root(src_var) - first_var_id) = phi_root; + } + } + + std::unordered_map merged_info; + for (int var = first_var_id; var < next_var_id; var++) { + const int root = find_root(var); + auto& merged = merged_info[root]; + merged.ssa_vars.insert(var); + + const RegId old_id(Register(Reg::GPR, Reg::SP), var); + auto old = m_stack_slot_use_def_info.find(old_id); + if (old != m_stack_slot_use_def_info.end()) { + merged.defs.insert(merged.defs.end(), old->second.defs.begin(), old->second.defs.end()); + merged.uses.insert(merged.uses.end(), old->second.uses.begin(), old->second.uses.end()); + merged.ssa_vars.insert(old->second.ssa_vars.begin(), old->second.ssa_vars.end()); + m_stack_slot_use_def_info.erase(old); + } + } + for (auto& [root, info] : merged_info) { + m_stack_slot_use_def_info.emplace(RegId(Register(Reg::GPR, Reg::SP), root), std::move(info)); + } + for (int op_id : access_ops) { + m_stack_slot_var_by_op.at(op_id) = find_root(m_stack_slot_var_by_op.at(op_id)); + } } } diff --git a/decompiler/analysis/insert_lets.cpp b/decompiler/analysis/insert_lets.cpp index 725c1e09d8..62336c30b4 100644 --- a/decompiler/analysis/insert_lets.cpp +++ b/decompiler/analysis/insert_lets.cpp @@ -185,40 +185,6 @@ FormElement* rewrite_as_dotimes(LetElement* in, const Env& env, FormPool& pool) return rewrite_as_dotimes(entry.dest, loop, env, pool); } -bool program_var_is_confined_to(const Form* top_level_form, - const RegId& var, - FormElement* init, - FormElement* loop, - const Env& env) { - RegAccessSet all_accesses; - top_level_form->collect_vars(all_accesses, true); - - RegAccessSet confined_accesses; - init->collect_vars(confined_accesses, true); - loop->collect_vars(confined_accesses, true); - - for (const auto& access : all_accesses) { - if (env.get_program_var_id(access) == var && !confined_accesses.count(access)) { - return false; - } - } - return true; -} - -bool program_var_shares_name(const Form* top_level_form, - const RegId& var, - const std::string& name, - const Env& env) { - RegAccessSet all_accesses; - top_level_form->collect_vars(all_accesses, true); - for (const auto& access : all_accesses) { - if (env.get_program_var_id(access) != var && env.get_variable_name(access) == name) { - return true; - } - } - return false; -} - std::tuple rewrite_shelled_return_form( const Matcher& matcher, FormElement* in, @@ -4245,47 +4211,9 @@ LetStats insert_lets(const Function& func, // } LetStats stats; - // A deliberately reused display name can cause otherwise independent program variables to be - // grouped together by let insertion. Recognize the unshelled expansion before inserting lets - // when the counter's complete lifetime is confined to the adjacent set!/while pair. Doing this - // here keeps a following co-named loop from being pulled into the first counter's let body, while - // preserving the existing behavior for co-named variables in every other situation. - top_level_form->apply_form([&](Form* f) { - auto& elts = f->elts(); - for (size_t i = 0; i + 1 < elts.size();) { - auto* init = dynamic_cast(elts.at(i)); - if (!init || !register_can_hold_var(init->dst().reg()) || - init->info().is_eliminated_coloring_move || !is_constant_int(init->src(), 0)) { - i++; - continue; - } - - const auto var = env.get_program_var_id(init->dst()); - const auto name = env.get_variable_name(init->dst()); - if (!program_var_shares_name(top_level_form, var, name, env) || - !program_var_is_confined_to(top_level_form, var, init, elts.at(i + 1), env)) { - i++; - continue; - } - - auto* dotimes = rewrite_as_dotimes(init->dst(), elts.at(i + 1), env, pool); - if (!dotimes) { - i++; - continue; - } - - dotimes->parent_form = f; - elts.at(i) = dotimes; - elts.erase(elts.begin() + i + 1); - env.set_defined_in_let(name); - let_rewrite_stats.dotimes++; - i++; - } - }); - // Stored per variable. struct PerVarInfo { - std::string unique_name; // displayed name used to join deliberately co-named SSA variables + std::string display_name; RegisterAccess access; std::unordered_set elts_using_var; // all FormElements using var Form* lca_form = nullptr; // the lowest common form that contains all the above elts @@ -4293,7 +4221,7 @@ LetStats insert_lets(const Function& func, int end_idx = -1; // in the above form, 1 + last FormElement using var's index }; - std::unordered_map var_info; + std::unordered_map var_info; // Part 1, figure out which forms reference each var top_level_form->apply([&](FormElement* elt) { @@ -4318,10 +4246,10 @@ LetStats insert_lets(const Function& func, // and add it. for (auto& access : reg_accesses) { if (register_can_hold_var(access.reg())) { - auto unique_name = env.get_variable_name(access); - var_info[unique_name].elts_using_var.insert(elt); - var_info[unique_name].unique_name = unique_name; - var_info[unique_name].access = access; + const auto var = env.get_program_var_id(access); + var_info[var].elts_using_var.insert(elt); + var_info[var].display_name = env.get_variable_name(access); + var_info[var].access = access; } } }); @@ -4336,7 +4264,7 @@ LetStats insert_lets(const Function& func, lca = lca_form(lca, fe->parent_form, env); } ASSERT(lca); - var_info[kv.first].lca_form = lca; + kv.second.lca_form = lca; } // Part 3, find the minimum range of FormElement's within the lca form that contain @@ -4353,7 +4281,7 @@ LetStats insert_lets(const Function& func, bool uses = false; for (auto& ra : ras) { if ((ra.reg().get_kind() == Reg::FPR || ra.reg().get_kind() == Reg::GPR) && - env.get_variable_name(ra) == kv.second.unique_name) { + env.get_program_var_id(ra) == kv.first) { uses = true; } } @@ -4399,7 +4327,7 @@ LetStats insert_lets(const Function& func, auto first_form = info.lca_form->at(info.start_idx); auto first_form_as_set = dynamic_cast(first_form); if (first_form_as_set && register_can_hold_var(first_form_as_set->dst().reg()) && - env.get_variable_name(first_form_as_set->dst()) == env.get_variable_name(info.access) && + env.get_program_var_id(first_form_as_set->dst()) == env.get_program_var_id(info.access) && !first_form_as_set->info().is_eliminated_coloring_move) { bool allowed = true; @@ -4422,12 +4350,12 @@ LetStats insert_lets(const Function& func, li.start_elt = info.start_idx; li.end_elt = info.end_idx; li.set_form = first_form_as_set; - li.name = info.unique_name; + li.name = info.display_name; possible_insertions[li.form].push_back(li); stats.vars_in_lets++; } } else { - // lg::print("fail for {} : {}\n", info.var_name, first_form->to_string(env)); + // lg::print("fail for {} : {}\n", info.display_name, first_form->to_string(env)); } } diff --git a/goal_src/jak1/engine/camera/cam-combiner.gc b/goal_src/jak1/engine/camera/cam-combiner.gc index b57cfe6012..0ce71a9acb 100644 --- a/goal_src/jak1/engine/camera/cam-combiner.gc +++ b/goal_src/jak1/engine/camera/cam-combiner.gc @@ -4,7 +4,6 @@ (require "engine/gfx/hw/display.gc") (require "engine/camera/camera.gc") -;; DECOMP BEGINS ;; Blend the active camera slaves into the single transform used for rendering. ;; The complexity here is around camera orientation. Orientations are interpolated @@ -25,10 +24,12 @@ ;; (copy-tracking (source camera-slave)) ;; Adopt source's tracking controls together with its current follow state and rotation, ;; avoiding a discontinuity when an already tracking slave is handed to the combiner. + +;; DECOMP BEGINS + (defstate cam-combiner-active (camera-combiner) :event (behavior ((proc process) (argc int) (message symbol) (block event-message-block)) - (local-vars (source-slave camera-slave)) (case message (('point-of-interest) (cond @@ -36,7 +37,9 @@ (set! (-> self tracking use-point-of-interest) #t) (set! (-> self tracking point-of-interest quad) (-> (the-as vector (-> block param 0)) quad)) (set! (-> self tracking point-of-interest-blend target) 1.0)) - (else (set! (-> self tracking use-point-of-interest) #f) (set! (-> self tracking point-of-interest-blend target) 0.0)))) + (else + (set! (-> self tracking use-point-of-interest) #f) + (set! (-> self tracking point-of-interest-blend target) 0.0)))) (('set-interpolation) (set! (-> self interp-val) 0.0) (set! (-> self interp-step) (/ 5.0 (the float (-> block param 0))))) @@ -48,7 +51,9 @@ (the-as cam-slave-options (-> self tracking-options)) (-> self fov) #f))) - (('stop-tracking) (set! (-> self tracking-status) (cam-track-status use-slave-tracking)) 0) + (('stop-tracking) + (set! (-> self tracking-status) (cam-track-status use-slave-tracking)) + 0) (('start-tracking) (cond ((< argc 1) @@ -59,21 +64,21 @@ (format 0 "ERROR : invalid type '~A' to *camera-combiner* start-tracking~%" (rtype-of (-> block param 0)))) ((= (-> self tracking-status) (cam-track-status use-slave-tracking)) (set! (-> self tracking-status) (cam-track-status track-at-combiner)) - (set! source-slave (the-as camera-slave (-> block param 0))) - (set! (-> self tracking-options) (the-as cam-slave-options-i (-> source-slave options))) - (set! (-> self tracking no-follow) (-> source-slave tracking no-follow)) - (copy-cam-float-seeker (-> self tracking tilt-adjust) (-> source-slave tracking tilt-adjust)) - (copy-cam-float-seeker (-> self tracking underwater-blend) (-> source-slave tracking underwater-blend)) - (set! (-> self tracking use-point-of-interest) (-> source-slave tracking use-point-of-interest)) - (vector-copy! (-> self tracking point-of-interest) (-> source-slave tracking point-of-interest)) - (copy-cam-float-seeker (-> self tracking point-of-interest-blend) (-> source-slave tracking point-of-interest-blend)) - (let ((source-position (-> source-slave trans))) - (cam-calc-follow! (-> self tracking) source-position #f) - (slave-set-rotation! (-> self tracking) - source-position - (the-as cam-slave-options (-> self tracking-options)) - (-> self fov) - #f))))) + (let ((source-slave (the-as camera-slave (-> block param 0)))) + (set! (-> self tracking-options) (the-as cam-slave-options-i (-> source-slave options))) + (set! (-> self tracking no-follow) (-> source-slave tracking no-follow)) + (copy-cam-float-seeker (-> self tracking tilt-adjust) (-> source-slave tracking tilt-adjust)) + (copy-cam-float-seeker (-> self tracking underwater-blend) (-> source-slave tracking underwater-blend)) + (set! (-> self tracking use-point-of-interest) (-> source-slave tracking use-point-of-interest)) + (vector-copy! (-> self tracking point-of-interest) (-> source-slave tracking point-of-interest)) + (copy-cam-float-seeker (-> self tracking point-of-interest-blend) (-> source-slave tracking point-of-interest-blend)) + (let ((source-position (-> source-slave trans))) + (cam-calc-follow! (-> self tracking) source-position #f) + (slave-set-rotation! (-> self tracking) + source-position + (the-as cam-slave-options (-> self tracking-options)) + (-> self fov) + #f)))))) (('copy-tracking) (cond ((< argc 1) @@ -85,17 +90,17 @@ ((nonzero? (-> self tracking-status)) #f) (else (set! (-> self tracking-status) (cam-track-status track-at-combiner)) - (set! source-slave (the-as camera-slave (-> block param 0))) - (set! (-> self tracking-options) (the-as cam-slave-options-i (-> source-slave options))) - (set! (-> self tracking no-follow) (-> source-slave tracking no-follow)) - (copy-cam-float-seeker (-> self tracking tilt-adjust) (-> source-slave tracking tilt-adjust)) - (copy-cam-float-seeker (-> self tracking underwater-blend) (-> source-slave tracking underwater-blend)) - (vector-copy! (-> self tracking follow-off) (-> source-slave tracking follow-off)) - (vector-copy! (-> self tracking follow-pt) (-> source-slave tracking follow-pt)) - (matrix-copy! (-> self tracking inv-mat) (-> source-slave tracking inv-mat)) - (set! (-> self tracking use-point-of-interest) (-> source-slave tracking use-point-of-interest)) - (vector-copy! (-> self tracking point-of-interest) (-> source-slave tracking point-of-interest)) - (copy-cam-float-seeker (-> self tracking point-of-interest-blend) (-> source-slave tracking point-of-interest-blend))))))) + (let ((source-slave (the-as camera-slave (-> block param 0)))) + (set! (-> self tracking-options) (the-as cam-slave-options-i (-> source-slave options))) + (set! (-> self tracking no-follow) (-> source-slave tracking no-follow)) + (copy-cam-float-seeker (-> self tracking tilt-adjust) (-> source-slave tracking tilt-adjust)) + (copy-cam-float-seeker (-> self tracking underwater-blend) (-> source-slave tracking underwater-blend)) + (vector-copy! (-> self tracking follow-off) (-> source-slave tracking follow-off)) + (vector-copy! (-> self tracking follow-pt) (-> source-slave tracking follow-pt)) + (matrix-copy! (-> self tracking inv-mat) (-> source-slave tracking inv-mat)) + (set! (-> self tracking use-point-of-interest) (-> source-slave tracking use-point-of-interest)) + (vector-copy! (-> self tracking point-of-interest) (-> source-slave tracking point-of-interest)) + (copy-cam-float-seeker (-> self tracking point-of-interest-blend) (-> source-slave tracking point-of-interest-blend)))))))) :code (behavior () (local-vars (output-matrix matrix)) @@ -119,176 +124,148 @@ (previous-position (new-stack-vector0))) (vector-copy! previous-position (-> self trans)) (if source-slave - (set! output-matrix - (cond - (destination-slave - ;; Position and FOV can be interpolated directly. Rotation is blended as - ;; an axis-angle below so that the resulting camera basis stays orthonormal. - (vector-lerp-clamp! (-> self trans) (-> source-slave 0 trans) (-> destination-slave 0 trans) blend) - (set! (-> self fov) (lerp-clamp (-> source-slave 0 fov) (-> destination-slave 0 fov) blend)) - (set! (-> self dist-from-src) (vector-vector-distance (-> self trans) (-> source-slave 0 trans))) - (set! (-> self dist-from-dest) (vector-vector-distance (-> self trans) (-> destination-slave 0 trans))) - (set! output-matrix - (cond - ((= (-> self tracking-status) (cam-track-status track-at-combiner)) - (cam-calc-follow! (-> self tracking) (-> self trans) #t) - (slave-set-rotation! (-> self tracking) - (-> self trans) - (the-as cam-slave-options (-> self tracking-options)) - (-> self fov) - #t) - (matrix-copy! (-> self inv-camera-rot) (-> self tracking inv-mat))) - (else - (let ((source-tracker (-> source-slave 0 tracking)) - (source-position (-> source-slave 0 trans)) - (destination-tracker (-> destination-slave 0 tracking)) - (destination-position (-> destination-slave 0 trans))) - (cond - ((= (-> self tracking-status) (cam-track-status track-at-src)) - (cam-calc-follow! (-> self tracking) source-position #t) - (slave-set-rotation! (-> self tracking) - source-position - (the-as cam-slave-options (-> self tracking-options)) - (-> self fov) - #t) - (set! source-tracker (-> self tracking)) - (set! source-position (-> self trans))) - ((= (-> self tracking-status) (cam-track-status track-at-dst)) - (cam-calc-follow! (-> self tracking) destination-position #t) - (slave-set-rotation! (-> self tracking) - destination-position - (the-as cam-slave-options (-> self tracking-options)) - (-> self fov) - #t) - (set! destination-tracker (-> self tracking)) - (set! destination-position (-> self trans)))) - ;; Corresponding rows of two rotation bases differ in directions - ;; perpendicular to their shared axis of rotation. Cross the two - ;; strongest row deltas, omitting the row which changed least, to - ;; recover a stable rotation axis. - (let ((rotation-work (new 'stack-no-clear 'matrix))) - (dotimes (i 3) - (set! (-> rotation-work vector i quad) (the-as uint128 0))) - 0.0 - 0.0 - 0.0 - (let ((rotation-axis (new-stack-vector0))) + (set! output-matrix + (cond + (destination-slave + (vector-lerp-clamp! (-> self trans) (-> source-slave 0 trans) (-> destination-slave 0 trans) blend) + (set! (-> self fov) (lerp-clamp (-> source-slave 0 fov) (-> destination-slave 0 fov) blend)) + (set! (-> self dist-from-src) (vector-vector-distance (-> self trans) (-> source-slave 0 trans))) + (set! (-> self dist-from-dest) (vector-vector-distance (-> self trans) (-> destination-slave 0 trans))) + (set! output-matrix + (cond + ((= (-> self tracking-status) (cam-track-status track-at-combiner)) + (cam-calc-follow! (-> self tracking) (-> self trans) #t) + (slave-set-rotation! (-> self tracking) + (-> self trans) + (the-as cam-slave-options (-> self tracking-options)) + (-> self fov) + #t) + (matrix-copy! (-> self inv-camera-rot) (-> self tracking inv-mat))) + (else + (let ((source-tracker (-> source-slave 0 tracking)) + (source-position (-> source-slave 0 trans)) + (destination-tracker (-> destination-slave 0 tracking)) + (destination-position (-> destination-slave 0 trans))) + (cond + ((= (-> self tracking-status) (cam-track-status track-at-src)) + (cam-calc-follow! (-> self tracking) source-position #t) + (slave-set-rotation! (-> self tracking) + source-position + (the-as cam-slave-options (-> self tracking-options)) + (-> self fov) + #t) + (set! source-tracker (-> self tracking)) + (set! source-position (-> self trans))) + ((= (-> self tracking-status) (cam-track-status track-at-dst)) + (cam-calc-follow! (-> self tracking) destination-position #t) + (slave-set-rotation! (-> self tracking) + destination-position + (the-as cam-slave-options (-> self tracking-options)) + (-> self fov) + #t) + (set! destination-tracker (-> self tracking)) + (set! destination-position (-> self trans)))) + (let ((rotation-work (new 'stack-no-clear 'matrix))) + (dotimes (i 3) + (set! (-> rotation-work vector i quad) (the-as uint128 0))) 0.0 - (let ((rotation-matrix (new-stack-matrix0))) - (vector-! (-> rotation-work vector 0) - (the-as vector (-> source-tracker inv-mat)) - (the-as vector (-> destination-tracker inv-mat))) - (vector-! (-> rotation-work vector 1) (-> source-tracker inv-mat vector 1) (-> destination-tracker inv-mat vector 1)) - (vector-! (-> rotation-work vector 2) (-> source-tracker inv-mat vector 2) (-> destination-tracker inv-mat vector 2)) - (let ((row-0-delta (vector-length (-> rotation-work vector 0))) - (row-1-delta (vector-length (-> rotation-work vector 1))) - (row-2-delta (vector-length (-> rotation-work vector 2)))) - (cond - ((and (< row-0-delta row-1-delta) (< row-0-delta row-2-delta)) - (vector-cross! rotation-axis (-> rotation-work vector 1) (-> rotation-work vector 2))) - ((and (< row-1-delta row-0-delta) (< row-1-delta row-2-delta)) - (vector-cross! rotation-axis (-> rotation-work vector 0) (-> rotation-work vector 2))) - (else (vector-cross! rotation-axis (-> rotation-work vector 0) (-> rotation-work vector 1))))) - (vector-normalize! rotation-axis 1.0) - ;; Choose the source basis row least parallel to the axis, - ;; then project that row and its destination counterpart into - ;; the plane normal to the axis. Their planar angle is the - ;; amount of rotation separating the two camera bases. - (let ((row-0-axis-dot (fabs (vector-dot (the-as vector (-> source-tracker inv-mat)) rotation-axis))) - (row-1-axis-dot (fabs (vector-dot (-> source-tracker inv-mat vector 1) rotation-axis))) - (row-2-axis-dot (fabs (vector-dot (-> source-tracker inv-mat vector 2) rotation-axis)))) - (cond - ((and (< row-0-axis-dot row-1-axis-dot) (< row-0-axis-dot row-2-axis-dot)) - (vector-flatten! (-> rotation-work vector 0) (the-as vector (-> source-tracker inv-mat)) rotation-axis) - (vector-flatten! (-> rotation-work vector 1) (the-as vector (-> destination-tracker inv-mat)) rotation-axis)) - ((< row-1-axis-dot row-2-axis-dot) - (vector-flatten! (-> rotation-work vector 0) (-> source-tracker inv-mat vector 1) rotation-axis) - (vector-flatten! (-> rotation-work vector 1) (-> destination-tracker inv-mat vector 1) rotation-axis)) - (else - (vector-flatten! (-> rotation-work vector 0) (-> source-tracker inv-mat vector 2) rotation-axis) - (vector-flatten! (-> rotation-work vector 1) (-> destination-tracker inv-mat vector 2) rotation-axis)))) - (vector-normalize! (-> rotation-work vector 0) 1.0) - (vector-normalize! (-> rotation-work vector 1) 1.0) - (vector-cross! (-> rotation-work vector 2) (-> rotation-work vector 0) (-> rotation-work vector 1)) - ;; Orient the otherwise sign-ambiguous axis to agree with the - ;; direction from the projected source row to destination row. - (if (< (vector-dot (-> rotation-work vector 2) rotation-axis) 0.0) (vector-negate! rotation-axis rotation-axis)) - (let ((rotation-angle (acos (vector-dot (-> rotation-work vector 0) (-> rotation-work vector 1))))) - (cond - ;; A newly activated slave starts a new arc decision, so - ;; discard both the one-shot marker and the previous flip. - ((logtest? (-> *camera* master-options) (cam-master-options set-combiner-axis)) - (logclear! (-> *camera* master-options) (cam-master-options set-combiner-axis flip-combiner)) - ;; Compare the target and destination directions in the - ;; local horizontal plane. The final test has no body in - ;; this version and therefore has no observable effect. - (when (and (< 8192.0 rotation-angle) (logtest? (-> *camera* master-options) (cam-master-options have-target))) - (vector-! (-> rotation-work vector 0) (-> *camera* tpos-curr) source-position) - (vector-! (-> rotation-work vector 1) destination-position source-position) - (vector-flatten! (-> rotation-work vector 0) (-> rotation-work vector 0) (-> *camera* local-down)) - (vector-flatten! (-> rotation-work vector 1) (-> rotation-work vector 1) (-> *camera* local-down)) - (when (and (< 4096.0 (vector-normalize-ret-len! (-> rotation-work vector 0) 1.0)) - (< 4096.0 (vector-normalize-ret-len! (-> rotation-work vector 1) 1.0))) - (vector-cross! (-> rotation-work vector 2) (-> rotation-work vector 1) (-> rotation-work vector 0)) - (when (< (vector-dot (-> rotation-work vector 2) rotation-axis) -0.01))))) - ;; For rotations over 90 degrees, keep the chosen axis - ;; continuous across frames by switching to the equivalent - ;; complementary axis-angle representation when necessary. - ((and (< 16384.0 rotation-angle) (< (vector-dot (-> self flip-control-axis) rotation-axis) 0.0)) - (logxor! (-> *camera* master-options) (cam-master-options flip-combiner)))) - (vector-copy! (-> self flip-control-axis) rotation-axis) - (when (logtest? (-> *camera* master-options) (cam-master-options flip-combiner)) - (set! rotation-angle (- 65536.0 rotation-angle)) - (vector-negate! rotation-axis rotation-axis)) - ;; Rotate backward from the destination basis by the portion - ;; still separating it from the source: the full angle at - ;; blend 0 and no correction at blend 1. - (let ((remaining-angle (* rotation-angle (- 1.0 blend)))) - (matrix-axis-sin-cos! rotation-matrix rotation-axis (sin remaining-angle) (cos remaining-angle)))) - (matrix*! (-> self inv-camera-rot) (-> destination-tracker inv-mat) rotation-matrix))))) - output-matrix))) - ;; Do not advance the blend while the outgoing slave is still reaching its - ;; authored exit point or while the game is paused. - (cond - ((and (< 0.0 (-> *camera* outro-t-step)) (< (-> *camera* outro-t) (-> *camera* outro-exit-value)))) - ((and (< (-> *camera* outro-t-step) 0.0) (< (-> *camera* outro-exit-value) (-> *camera* outro-t)))) - ((paused?)) - (else (+! (-> self interp-val) (* (-> self interp-step) (-> *display* time-adjust-ratio))))) - ;; Once the blend reaches its destination, retire the outgoing slave and - ;; promote the destination into slot 0. - (when (>= (-> self interp-val) 1.0) - (deactivate (-> *camera* slave 0 0)) - (set! (-> *camera* slave 0) (-> *camera* slave 1)) - (set! (-> *camera* slave 1) (the-as (pointer camera-slave) #f)) - (+! (-> *camera* num-slaves) -1)) - output-matrix) - (else - (set! (-> self dist-from-src) 409600.0) - (set! (-> self dist-from-dest) 0.0) - (vector-copy! (-> self trans) (-> source-slave 0 trans)) - (set! (-> self fov) (-> source-slave 0 fov)) - ;; Resolve the endpoint-only tracking modes after a transition has left just - ;; one slave: destination tracking becomes steady combiner tracking, while - ;; source tracking ends with the retired source. - (cond - ((= (-> self tracking-status) (cam-track-status track-at-dst)) - (set! (-> self tracking-status) (cam-track-status track-at-combiner))) - ((= (-> self tracking-status) (cam-track-status track-at-src)) - (set! (-> self tracking-status) (cam-track-status use-slave-tracking)) - 0)) - (cond - ((= (-> self tracking-status) (cam-track-status track-at-combiner)) - (cam-calc-follow! (-> self tracking) (-> self trans) #t) - (slave-set-rotation! (-> self tracking) - (-> self trans) - (the-as cam-slave-options (-> self tracking-options)) - (-> self fov) - #t) - (matrix-copy! (-> self inv-camera-rot) (-> self tracking inv-mat))) - (else (matrix-copy! (-> self inv-camera-rot) (-> source-slave 0 tracking inv-mat)))))))) + 0.0 + 0.0 + (let ((rotation-axis (new-stack-vector0))) + 0.0 + (let ((rotation-matrix (new-stack-matrix0))) + (vector-! (-> rotation-work vector 0) (-> source-tracker inv-mat vector 0) (-> destination-tracker inv-mat vector 0)) + (vector-! (-> rotation-work vector 1) (-> source-tracker inv-mat vector 1) (-> destination-tracker inv-mat vector 1)) + (vector-! (-> rotation-work vector 2) (-> source-tracker inv-mat vector 2) (-> destination-tracker inv-mat vector 2)) + (let ((row-0-delta (vector-length (-> rotation-work vector 0))) + (row-1-delta (vector-length (-> rotation-work vector 1))) + (row-2-delta (vector-length (-> rotation-work vector 2)))) + (cond + ((and (< row-0-delta row-1-delta) (< row-0-delta row-2-delta)) + (vector-cross! rotation-axis (-> rotation-work vector 1) (-> rotation-work vector 2))) + ((and (< row-1-delta row-0-delta) (< row-1-delta row-2-delta)) + (vector-cross! rotation-axis (-> rotation-work vector 0) (-> rotation-work vector 2))) + (else + (vector-cross! rotation-axis (-> rotation-work vector 0) (-> rotation-work vector 1))))) + (vector-normalize! rotation-axis 1.0) + (let ((row-0-axis-dot (fabs (vector-dot (-> source-tracker inv-mat vector 0) rotation-axis))) + (row-1-axis-dot (fabs (vector-dot (-> source-tracker inv-mat vector 1) rotation-axis))) + (row-2-axis-dot (fabs (vector-dot (-> source-tracker inv-mat vector 2) rotation-axis)))) + (cond + ((and (< row-0-axis-dot row-1-axis-dot) (< row-0-axis-dot row-2-axis-dot)) + (vector-flatten! (-> rotation-work vector 0) (-> source-tracker inv-mat vector 0) rotation-axis) + (vector-flatten! (-> rotation-work vector 1) (-> destination-tracker inv-mat vector 0) rotation-axis)) + ((< row-1-axis-dot row-2-axis-dot) + (vector-flatten! (-> rotation-work vector 0) (-> source-tracker inv-mat vector 1) rotation-axis) + (vector-flatten! (-> rotation-work vector 1) (-> destination-tracker inv-mat vector 1) rotation-axis)) + (else + (vector-flatten! (-> rotation-work vector 0) (-> source-tracker inv-mat vector 2) rotation-axis) + (vector-flatten! (-> rotation-work vector 1) (-> destination-tracker inv-mat vector 2) rotation-axis)))) + (vector-normalize! (-> rotation-work vector 0) 1.0) + (vector-normalize! (-> rotation-work vector 1) 1.0) + (vector-cross! (-> rotation-work vector 2) (-> rotation-work vector 0) (-> rotation-work vector 1)) + (if (< (vector-dot (-> rotation-work vector 2) rotation-axis) 0.0) + (vector-negate! rotation-axis rotation-axis)) + (let ((rotation-angle (acos (vector-dot (-> rotation-work vector 0) (-> rotation-work vector 1))))) + (cond + ((logtest? (-> *camera* master-options) (cam-master-options set-combiner-axis)) + (logclear! (-> *camera* master-options) (cam-master-options set-combiner-axis flip-combiner)) + (when (and (< 8192.0 rotation-angle) (logtest? (-> *camera* master-options) (cam-master-options have-target))) + (vector-! (-> rotation-work vector 0) (-> *camera* tpos-curr) source-position) + (vector-! (-> rotation-work vector 1) destination-position source-position) + (vector-flatten! (-> rotation-work vector 0) (-> rotation-work vector 0) (-> *camera* local-down)) + (vector-flatten! (-> rotation-work vector 1) (-> rotation-work vector 1) (-> *camera* local-down)) + (when (and (< 4096.0 (vector-normalize-ret-len! (-> rotation-work vector 0) 1.0)) + (< 4096.0 (vector-normalize-ret-len! (-> rotation-work vector 1) 1.0))) + (vector-cross! (-> rotation-work vector 2) (-> rotation-work vector 1) (-> rotation-work vector 0)) + (when (< (vector-dot (-> rotation-work vector 2) rotation-axis) -0.01))))) + ((and (< 16384.0 rotation-angle) (< (vector-dot (-> self flip-control-axis) rotation-axis) 0.0)) + (logxor! (-> *camera* master-options) (cam-master-options flip-combiner)))) + (vector-copy! (-> self flip-control-axis) rotation-axis) + (when (logtest? (-> *camera* master-options) (cam-master-options flip-combiner)) + (set! rotation-angle (- 65536.0 rotation-angle)) + (vector-negate! rotation-axis rotation-axis)) + (let ((remaining-angle (* rotation-angle (- 1.0 blend)))) + (matrix-axis-sin-cos! rotation-matrix rotation-axis (sin remaining-angle) (cos remaining-angle)))) + (matrix*! (-> self inv-camera-rot) (-> destination-tracker inv-mat) rotation-matrix))))) + output-matrix))) + (cond + ((and (< 0.0 (-> *camera* outro-t-step)) (< (-> *camera* outro-t) (-> *camera* outro-exit-value)))) + ((and (< (-> *camera* outro-t-step) 0.0) (< (-> *camera* outro-exit-value) (-> *camera* outro-t)))) + ((paused?)) + (else + (+! (-> self interp-val) (* (-> self interp-step) (-> *display* time-adjust-ratio))))) + (when (>= (-> self interp-val) 1.0) + (deactivate (-> *camera* slave 0 0)) + (set! (-> *camera* slave 0) (-> *camera* slave 1)) + (set! (-> *camera* slave 1) (the-as (pointer camera-slave) #f)) + (+! (-> *camera* num-slaves) -1)) + output-matrix) + (else + (set! (-> self dist-from-src) 409600.0) + (set! (-> self dist-from-dest) 0.0) + (vector-copy! (-> self trans) (-> source-slave 0 trans)) + (set! (-> self fov) (-> source-slave 0 fov)) + (cond + ((= (-> self tracking-status) (cam-track-status track-at-dst)) + (set! (-> self tracking-status) (cam-track-status track-at-combiner))) + ((= (-> self tracking-status) (cam-track-status track-at-src)) + (set! (-> self tracking-status) (cam-track-status use-slave-tracking)) + 0)) + (cond + ((= (-> self tracking-status) (cam-track-status track-at-combiner)) + (cam-calc-follow! (-> self tracking) (-> self trans) #t) + (slave-set-rotation! (-> self tracking) + (-> self trans) + (the-as cam-slave-options (-> self tracking-options)) + (-> self fov) + #t) + (matrix-copy! (-> self inv-camera-rot) (-> self tracking inv-mat))) + (else + (matrix-copy! (-> self inv-camera-rot) (-> source-slave 0 tracking inv-mat)))))))) (vector-! (-> self velocity) (-> self trans) previous-position))) (if (and *dproc* *debug-segment*) - (add-frame (-> *display* frames (-> *display* on-screen) frame profile-bar 0) 'camera (new 'static 'rgba :b #xff :a #x80))) + (add-frame (-> (current-frame) profile-bar 0) 'camera (new 'static 'rgba :b #xff :a #x80))) (suspend)))) (defbehavior cam-combiner-init camera-combiner () @@ -298,7 +275,9 @@ (set! *camera-combiner* self) (vector-reset! (-> self trans)) (matrix-identity! (-> self inv-camera-rot)) - (if *math-camera* (set! (-> self fov) (-> *math-camera* fov)) (set! (-> self fov) 11650.845)) + (if *math-camera* + (set! (-> self fov) (-> *math-camera* fov)) + (set! (-> self fov) 11650.845)) (set! (-> self interp-val) 0.0) (set! (-> self interp-step) 0.125) (set! (-> self tracking-status) (cam-track-status use-slave-tracking)) diff --git a/goal_src/jak1/engine/camera/cam-debug-h.gc b/goal_src/jak1/engine/camera/cam-debug-h.gc index b613ec7296..a4f431f16a 100644 --- a/goal_src/jak1/engine/camera/cam-debug-h.gc +++ b/goal_src/jak1/engine/camera/cam-debug-h.gc @@ -29,17 +29,6 @@ (define-extern slave-los-state->string (function slave-los-state string)) (define-extern cam-debug-reset-coll-tri (function none)) - -; (declare-type clm basic) -; (define-extern *clm* clm) -; (define-extern *clm-edit* clm) -; (define-extern *clm-focalpull-attr* clm) -; (define-extern *clm-index-attr* clm) -; (define-extern *clm-intro-attr* clm) -; (define-extern *clm-spline-attr* clm) -; (define-extern *clm-vol-attr* clm) -; (define-extern *clm-select* clm) - ;; DECOMP BEGINS ;; Debug-only rolling histories used by the camera plot display. Each color and @@ -51,8 +40,8 @@ (define *redline-index* 0) (defun float-save-redline ((value float)) - "Append value to the 400-sample red debug plot, overwriting the oldest sample - when the ring wraps." + "Append value to the 400-sample red debug + plot, overwriting the oldest sample when the ring wraps." (set! (-> *redline-table* *redline-index*) value) (set! *redline-index* (+ *redline-index* 1)) (when (>= *redline-index* 400) @@ -61,17 +50,18 @@ (none)) (defun float-lookup-redline ((position float)) - "Read the red debug plot at position in its wrapped drawing order: zero is - newest and one starts at the oldest sample." - (let ((index (mod (+ (the int position) -1 *redline-index*) 400))) (-> *redline-table* index))) + "Read the red debug plot at position in its + wrapped drawing order: zero is newest and one starts at the oldest sample." + (let ((index (mod (+ (the int position) -1 *redline-index*) 400))) + (-> *redline-table* index))) (define *blueline-table* (the-as (pointer float) (malloc 'debug 1600))) (define *blueline-index* 0) (defun float-save-blueline ((value float)) - "Append value to the 400-sample blue debug plot, overwriting the oldest - sample when the ring wraps." + "Append value to the 400-sample blue debug + plot, overwriting the oldest sample when the ring wraps." (set! (-> *blueline-table* *blueline-index*) value) (set! *blueline-index* (+ *blueline-index* 1)) (when (>= *blueline-index* 400) @@ -80,17 +70,18 @@ (none)) (defun float-lookup-blueline ((position float)) - "Read the blue debug plot at position in its wrapped drawing order: zero is - newest and one starts at the oldest sample." - (let ((index (mod (+ (the int position) -1 *blueline-index*) 400))) (-> *blueline-table* index))) + "Read the blue debug plot at position in + its wrapped drawing order: zero is newest and one starts at the oldest sample." + (let ((index (mod (+ (the int position) -1 *blueline-index*) 400))) + (-> *blueline-table* index))) (define *greenline-table* (the-as (pointer float) (malloc 'debug 1600))) (define *greenline-index* 0) (defun float-save-greenline ((value float)) - "Append value to the 400-sample green debug plot, overwriting the oldest - sample when the ring wraps." + "Append value to the 400-sample green debug + plot, overwriting the oldest sample when the ring wraps." (set! (-> *greenline-table* *greenline-index*) value) (set! *greenline-index* (+ *greenline-index* 1)) (when (>= *greenline-index* 400) @@ -99,17 +90,18 @@ (none)) (defun float-lookup-greenline ((position float)) - "Read the green debug plot at position in its wrapped drawing order: zero is - newest and one starts at the oldest sample." - (let ((index (mod (+ (the int position) -1 *greenline-index*) 400))) (-> *greenline-table* index))) + "Read the green debug plot at position in + its wrapped drawing order: zero is newest and one starts at the oldest sample." + (let ((index (mod (+ (the int position) -1 *greenline-index*) 400))) + (-> *greenline-table* index))) (define *yellowline-table* (the-as (pointer float) (malloc 'debug 1600))) (define *yellowline-index* 0) (defun float-save-yellowline ((value float)) - "Append value to the 400-sample yellow debug plot, overwriting the oldest - sample when the ring wraps." + "Append value to the 400-sample yellow + debug plot, overwriting the oldest sample when the ring wraps." (set! (-> *yellowline-table* *yellowline-index*) value) (set! *yellowline-index* (+ *yellowline-index* 1)) (when (>= *yellowline-index* 400) @@ -118,17 +110,18 @@ (none)) (defun float-lookup-yellowline ((position float)) - "Read the yellow debug plot at position in its wrapped drawing order: zero is - newest and one starts at the oldest sample." - (let ((index (mod (+ (the int position) -1 *yellowline-index*) 400))) (-> *yellowline-table* index))) + "Read the yellow debug plot at position + in its wrapped drawing order: zero is newest and one starts at the oldest sample." + (let ((index (mod (+ (the int position) -1 *yellowline-index*) 400))) + (-> *yellowline-table* index))) (define *timeplot-table* (the-as (pointer float) (malloc 'debug 1600))) (define *timeplot-index* 0) (defun float-save-timeplot ((value float)) - "Append value to the 400-sample time debug plot, overwriting the oldest - sample when the ring wraps." + "Append value to the 400-sample time debug + plot, overwriting the oldest sample when the ring wraps." (set! (-> *timeplot-table* *timeplot-index*) value) (set! *timeplot-index* (+ *timeplot-index* 1)) (when (>= *timeplot-index* 400) @@ -137,10 +130,9 @@ (none)) (defun float-lookup-timeplot ((position float)) - "Read the time debug plot at position in its wrapped drawing order: zero is - newest and one starts at the oldest sample." - (let ((index (mod (+ (the int position) -1 *timeplot-index*) 400))) (-> *timeplot-table* index))) + "Read the time debug plot at position in + its wrapped drawing order: zero is newest and one starts at the oldest sample." + (let ((index (mod (+ (the int position) -1 *timeplot-index*) 400))) + (-> *timeplot-table* index))) (define-perm *cam-layout* symbol #f) - -0 diff --git a/goal_src/jak1/engine/camera/cam-debug.gc b/goal_src/jak1/engine/camera/cam-debug.gc index 58d7bbb468..3e0c90ee7b 100644 --- a/goal_src/jak1/engine/camera/cam-debug.gc +++ b/goal_src/jak1/engine/camera/cam-debug.gc @@ -35,63 +35,73 @@ (define-perm *camera-old-stat-string-total* string (new 'global 'string 128 (the-as string #f))) (deftype cam-dbg-scratch (structure) - ((linevec4w vector4w 2 :inline :offset-assert 0) - (color vector :inline :offset-assert 32) - (plotvec vector4w 2 :inline :offset-assert 48) - (linevec vector4w 2 :inline :offset-assert 80) - (rel-vec vector :inline :offset-assert 112) - (sphere-v-start vector :inline :offset-assert 128) - (sphere-v-end vector :inline :offset-assert 144) - (sphere-v-down vector :inline :offset-assert 160) - (sphere-vec vector :inline :offset-assert 176) - (crossvec vector 3 :inline :offset-assert 192) - (bboxvec vector 6 :inline :offset-assert 240) - (fov-vv vector 4 :inline :offset-assert 336) - (fov-src vector :inline :offset-assert 400) - (fov-dest vector :inline :offset-assert 416) - (fov-vert vector :inline :offset-assert 432) - (fov-horz vector :inline :offset-assert 448)) - :method-count-assert 9 - :size-assert #x1d0 - :flag-assert #x9000001d0) + ((linevec4w vector4w 2 :inline) + (color vector :inline) + (plotvec vector4w 2 :inline) + (linevec vector 2 :inline) + (rel-vec vector :inline) + (sphere-v-start vector :inline) + (sphere-v-end vector :inline) + (sphere-v-down vector :inline) + (sphere-vec vector :inline) + (crossvec vector 3 :inline) + (bboxvec vector 6 :inline) + (fov-vv vector 4 :inline) + (fov-src vector :inline) + (fov-dest vector :inline) + (fov-vert vector :inline) + (fov-horz vector :inline))) + (defun cam-slave-options->string ((options cam-slave-options) (output object)) "Append the names of the enabled camera-slave option bits to output and return output as a string." - (if (= (logand (cam-slave-options AIR_EXIT) options) (cam-slave-options AIR_EXIT)) (format output "AIR_EXIT ")) - (if (= (logand (cam-slave-options STICKY_ANGLE) options) (cam-slave-options STICKY_ANGLE)) (format output "STICKY_ANGLE ")) - (if (= (logand options (cam-slave-options NO_ROTATE)) (cam-slave-options NO_ROTATE)) (format output "NO_ROTATE ")) - (if (= (logand options (cam-slave-options BIKE_MODE)) (cam-slave-options BIKE_MODE)) (format output "BIKE_MODE ")) + (if (= (logand (cam-slave-options AIR_EXIT) options) (cam-slave-options AIR_EXIT)) + (format output "AIR_EXIT ")) + (if (= (logand (cam-slave-options STICKY_ANGLE) options) (cam-slave-options STICKY_ANGLE)) + (format output "STICKY_ANGLE ")) + (if (= (logand options (cam-slave-options NO_ROTATE)) (cam-slave-options NO_ROTATE)) + (format output "NO_ROTATE ")) + (if (= (logand options (cam-slave-options BIKE_MODE)) (cam-slave-options BIKE_MODE)) + (format output "BIKE_MODE ")) (if (= (logand options (cam-slave-options BLOCK_SHIFT_BUTTONS)) (cam-slave-options BLOCK_SHIFT_BUTTONS)) - (format output "BLOCK_SHIFT_BUTTONS ")) + (format output "BLOCK_SHIFT_BUTTONS ")) (if (= (logand options (cam-slave-options GOTO_GOOD_POINT)) (cam-slave-options GOTO_GOOD_POINT)) - (format output "GOTO_GOOD_POINT ")) + (format output "GOTO_GOOD_POINT ")) (if (= (logand options (cam-slave-options SHRINK_MAX_ANGLE)) (cam-slave-options SHRINK_MAX_ANGLE)) - (format output "SHRINK_MAX_ANGLE ")) + (format output "SHRINK_MAX_ANGLE ")) (if (= (logand options (cam-slave-options MOVEMENT_BLOCKED)) (cam-slave-options MOVEMENT_BLOCKED)) - (format output "MOVEMENT_BLOCKED ")) + (format output "MOVEMENT_BLOCKED ")) (if (= (logand options (cam-slave-options LINE_OF_SIGHT)) (cam-slave-options LINE_OF_SIGHT)) - (format output "LINE_OF_SIGHT ")) + (format output "LINE_OF_SIGHT ")) (if (= (logand options (cam-slave-options PLAYER_MOVING_CAMERA)) (cam-slave-options PLAYER_MOVING_CAMERA)) - (format output "PLAYER_MOVING_CAMERA ")) - (if (= (logand options (cam-slave-options DRAG)) (cam-slave-options DRAG)) (format output "DRAG ")) + (format output "PLAYER_MOVING_CAMERA ")) + (if (= (logand options (cam-slave-options DRAG)) (cam-slave-options DRAG)) + (format output "DRAG ")) (if (= (logand options (cam-slave-options FIND_HIDDEN_TARGET)) (cam-slave-options FIND_HIDDEN_TARGET)) - (format output "FIND_HIDDEN_TARGET ")) - (if (= (logand options (cam-slave-options COLLIDE)) (cam-slave-options COLLIDE)) (format output "COLLIDE ")) - (if (= (logand options (cam-slave-options JUMP_PITCHES)) (cam-slave-options JUMP_PITCHES)) (format output "JUMP_PITCHES ")) - (if (= (logand options (cam-slave-options ALLOW_Z_ROT)) (cam-slave-options ALLOW_Z_ROT)) (format output "ALLOW_Z_ROT ")) + (format output "FIND_HIDDEN_TARGET ")) + (if (= (logand options (cam-slave-options COLLIDE)) (cam-slave-options COLLIDE)) + (format output "COLLIDE ")) + (if (= (logand options (cam-slave-options JUMP_PITCHES)) (cam-slave-options JUMP_PITCHES)) + (format output "JUMP_PITCHES ")) + (if (= (logand options (cam-slave-options ALLOW_Z_ROT)) (cam-slave-options ALLOW_Z_ROT)) + (format output "ALLOW_Z_ROT ")) (if (= (logand options (cam-slave-options MOVE_SPHERICAL)) (cam-slave-options MOVE_SPHERICAL)) - (format output "MOVE_SPHERICAL ")) - (if (= (logand options (cam-slave-options SAME_SIDE)) (cam-slave-options SAME_SIDE)) (format output "SAME_SIDE ")) - (if (= (logand options (cam-slave-options BUTT_CAM)) (cam-slave-options BUTT_CAM)) (format output "BUTT_CAM ")) + (format output "MOVE_SPHERICAL ")) + (if (= (logand options (cam-slave-options SAME_SIDE)) (cam-slave-options SAME_SIDE)) + (format output "SAME_SIDE ")) + (if (= (logand options (cam-slave-options BUTT_CAM)) (cam-slave-options BUTT_CAM)) + (format output "BUTT_CAM ")) (the-as string output)) (defun cam-index-options->string ((options cam-index-options) (output object)) "Append the historical labels for the enabled camera-index option bits to output. These strings are opposite the current SPHERICAL and RADIAL enum names." - (if (= (logand options (cam-index-options SPHERICAL)) (cam-index-options SPHERICAL)) (format output "RADIAL ")) - (if (= (logand options (cam-index-options RADIAL)) (cam-index-options RADIAL)) (format output "SPHERICAL ")) + (if (= (logand options (cam-index-options SPHERICAL)) (cam-index-options SPHERICAL)) + (format output "RADIAL ")) + (if (= (logand options (cam-index-options RADIAL)) (cam-index-options RADIAL)) + (format output "SPHERICAL ")) (the-as string output)) (defun slave-los-state->string ((los-state slave-los-state)) @@ -107,148 +117,123 @@ (defun cam-line-dma () "Append the current transformed debug-line endpoints and color to the no-depth-test debug DMA bucket." - (with-dma-buffer-add-bucket ((debug-buffer (-> *display* frames (-> *display* on-screen) frame debug-buf)) (bucket-id debug-no-zbuf)) :bucket-group (-> *display* frames (-> *display* on-screen) frame bucket-group) (let ((cnt-tag (the-as object (-> debug-buffer base)))) - (let* ((write-buffer debug-buffer) - (dma-header (the-as object (-> write-buffer base)))) - (set! (-> (the-as dma-packet dma-header) dma) (new 'static 'dma-tag :id (dma-tag-id cnt))) - (set! (-> (the-as dma-packet dma-header) vif0) (new 'static 'vif-tag)) - (set! (-> (the-as dma-packet dma-header) vif1) (new 'static 'vif-tag :cmd (vif-cmd direct) :msk #x1)) - (set! (-> write-buffer base) (&+ (the-as pointer dma-header) 16))) - (let* ((write-buffer debug-buffer) - (gif-header (the-as object (-> write-buffer base)))) - (set! (-> (the-as gs-gif-tag gif-header) tag) - (new 'static - 'gif-tag64 - :nloop #x1 - :eop #x1 - :pre #x1 - :prim - (new 'static 'gs-prim :prim (gs-prim-type line) :iip #x1 :abe #x1) - :nreg #x4)) - (set! (-> (the-as gs-gif-tag gif-header) regs) - (new 'static - 'gif-tag-regs - :regs0 (gif-reg-id rgbaq) - :regs1 (gif-reg-id xyzf2) - :regs2 (gif-reg-id rgbaq) - :regs3 (gif-reg-id xyzf2))) - (set! (-> write-buffer base) (&+ (the-as pointer gif-header) 16))) - (let* ((write-buffer debug-buffer) - (vertex-packet (-> write-buffer base))) - (set! (-> (the-as (pointer uint128) vertex-packet) 0) (-> (the-as vector (+ 32 (scratchpad-object int))) quad)) - (set! (-> (the-as (pointer uint128) vertex-packet) 1) - (-> (the-as vector (-> (scratchpad-object cam-dbg-scratch) linevec4w)) quad)) - (set! (-> write-buffer base) (&+ vertex-packet 32))) - (let* ((write-buffer debug-buffer) - (vertex-packet (-> write-buffer base))) - (set! (-> (the-as (pointer uint128) vertex-packet) 0) (-> (the-as vector (+ 32 (scratchpad-object int))) quad)) - (set! (-> (the-as (pointer uint128) vertex-packet) 1) (-> (the-as vector (+ 16 (scratchpad-object int))) quad)) - (set! (-> write-buffer base) (&+ vertex-packet 32))) - (let ((qwc (/ (the-as int (+ (- -16 (the-as int cnt-tag)) (the-as int (-> debug-buffer base)))) 16))) - (cond - ((nonzero? qwc) - (logior! (-> (the-as dma-packet cnt-tag) dma) (shr (shl qwc 48) 48)) - (logior! (-> (the-as (pointer uint64) cnt-tag) 1) (shl (shr (shl qwc 48) 48) 32))) - (else (set! (-> debug-buffer base) (the-as (pointer uint64) cnt-tag)))))))) + (slet (spad cam-dbg-scratch) + (with-dma-buffer-add-bucket ((dma-buf (-> (current-frame) debug-buf)) (bucket-id debug-no-zbuf)) + (with-cnt-vif-block (dma-buf) + (dma-buffer-add-gif-tag dma-buf + (new 'static + 'gif-tag64 + :nloop #x1 + :eop #x1 + :pre #x1 + :prim + (new 'static 'gs-prim :prim (gs-prim-type line) :iip #x1 :abe #x1) + :nreg #x4) + (gs-reg-list rgbaq xyzf2 rgbaq xyzf2)) + (dma-buffer-add-uint128 dma-buf (-> spad color quad) (-> spad linevec4w 0 quad)) + (dma-buffer-add-uint128 dma-buf (-> spad color quad) (-> spad linevec4w 1 quad)))))) (defun camera-line2d ((start vector4w) (end vector4w)) "Draw a line between two screen-space points. Convert pixels to GS 12.4 coordinates, invert Y, and place both endpoints at the far 24-bit depth." - (set! (-> (scratchpad-object cam-dbg-scratch) linevec4w 0 x) (* (+ (-> start x) 1792) 16)) - (set! (-> (scratchpad-object cam-dbg-scratch) linevec4w 0 y) (* (- (-> *video-parms* screen-maxy) (-> start y)) 16)) - (set! (-> (scratchpad-object cam-dbg-scratch) linevec4w 0 z) #x7fffff) - (set! (-> (scratchpad-object cam-dbg-scratch) linevec4w 1 x) (* (+ (-> end x) 1792) 16)) - (set! (-> (scratchpad-object cam-dbg-scratch) linevec4w 1 y) (* (- (-> *video-parms* screen-maxy) (-> end y)) 16)) - (set! (-> (scratchpad-object cam-dbg-scratch) linevec4w 1 z) #x7fffff) - (cam-line-dma)) + (slet (spad cam-dbg-scratch) + (set! (-> spad linevec4w 0 x) (* (+ (-> start x) 1792) 16)) + (set! (-> spad linevec4w 0 y) (* (- (-> *video-parms* screen-maxy) (-> start y)) 16)) + (set! (-> spad linevec4w 0 z) #x7fffff) + (set! (-> spad linevec4w 1 x) (* (+ (-> end x) 1792) 16)) + (set! (-> spad linevec4w 1 y) (* (- (-> *video-parms* screen-maxy) (-> end y)) 16)) + (set! (-> spad linevec4w 1 z) #x7fffff) + (cam-line-dma))) (defun camera-plot-float-func ((x-min float) (x-max float) (y-min float) (y-max float) (fn (function float float)) (color vector4w)) "Plot fn over [x-min, x-max] in a 400 by 200 pixel debug graph. Map [y-min, y-max] to the plot height, draw the axes and border at screen offset (20, 20), then connect one sample per horizontal pixel in color." - (let ((x-range (- x-max x-min)) - (y-range (- y-max y-min))) - 0.0 - 0.0 - (let ((y-scale (/ 200.0 y-range)) - (x-scale (/ 400.0 x-range))) - (set! (-> (scratchpad-object cam-dbg-scratch) color x) (the-as float 128)) - (set! (-> (scratchpad-object cam-dbg-scratch) color y) (the-as float 128)) - (set! (-> (scratchpad-object cam-dbg-scratch) color z) (the-as float 128)) - (set! (-> (scratchpad-object cam-dbg-scratch) color w) (the-as float 128)) - (when (and (< x-min 0.0) (< 0.0 x-max)) - (set! (-> (scratchpad-object cam-dbg-scratch) plotvec 0 x) (+ (the int (* x-scale x-range (/ (- x-min) x-range))) 20)) - (set! (-> (scratchpad-object cam-dbg-scratch) plotvec 0 y) 20) - (set! (-> (scratchpad-object cam-dbg-scratch) plotvec 1 x) (-> (scratchpad-object cam-dbg-scratch) plotvec 0 x)) - (set! (-> (scratchpad-object cam-dbg-scratch) plotvec 1 y) (+ (the int (* y-scale y-range)) 20)) - (camera-line2d (the-as vector4w (+ 48 (scratchpad-object int))) (the-as vector4w (+ 64 (scratchpad-object int))))) - (when (and (< y-min 0.0) (< 0.0 y-max)) - (set! (-> (scratchpad-object cam-dbg-scratch) plotvec 0 x) 20) - (set! (-> (scratchpad-object cam-dbg-scratch) plotvec 0 y) (+ (the int (* y-scale y-range (/ (- y-min) y-range))) 20)) - (set! (-> (scratchpad-object cam-dbg-scratch) plotvec 1 x) (+ (the int (* x-scale x-range)) 20)) - (set! (-> (scratchpad-object cam-dbg-scratch) plotvec 1 y) (-> (scratchpad-object cam-dbg-scratch) plotvec 0 y)) - (camera-line2d (the-as vector4w (+ 48 (scratchpad-object int))) (the-as vector4w (+ 64 (scratchpad-object int))))) - (set! (-> (scratchpad-object cam-dbg-scratch) plotvec 0 x) 20) - (set! (-> (scratchpad-object cam-dbg-scratch) plotvec 0 y) 20) - (set! (-> (scratchpad-object cam-dbg-scratch) plotvec 1 x) (+ (the int (* x-scale x-range)) 20)) - (set! (-> (scratchpad-object cam-dbg-scratch) plotvec 1 y) 20) - (camera-line2d (the-as vector4w (+ 48 (scratchpad-object int))) (the-as vector4w (+ 64 (scratchpad-object int)))) - (set! (-> (scratchpad-object cam-dbg-scratch) plotvec 0 x) 20) - (set! (-> (scratchpad-object cam-dbg-scratch) plotvec 0 y) (+ (the int (* y-scale y-range)) 20)) - (set! (-> (scratchpad-object cam-dbg-scratch) plotvec 1 x) (+ (the int (* x-scale x-range)) 20)) - (set! (-> (scratchpad-object cam-dbg-scratch) plotvec 1 y) (+ (the int (* y-scale y-range)) 20)) - (camera-line2d (the-as vector4w (+ 48 (scratchpad-object int))) (the-as vector4w (+ 64 (scratchpad-object int)))) - (set! (-> (scratchpad-object cam-dbg-scratch) plotvec 0 x) 20) - (set! (-> (scratchpad-object cam-dbg-scratch) plotvec 0 y) 20) - (set! (-> (scratchpad-object cam-dbg-scratch) plotvec 1 x) 20) - (set! (-> (scratchpad-object cam-dbg-scratch) plotvec 1 y) (+ (the int (* y-scale y-range)) 20)) - (camera-line2d (the-as vector4w (+ 48 (scratchpad-object int))) (the-as vector4w (+ 64 (scratchpad-object int)))) - (set! (-> (scratchpad-object cam-dbg-scratch) plotvec 0 x) (+ (the int (* x-scale x-range)) 20)) - (set! (-> (scratchpad-object cam-dbg-scratch) plotvec 0 y) 20) - (set! (-> (scratchpad-object cam-dbg-scratch) plotvec 1 x) (+ (the int (* x-scale x-range)) 20)) - (set! (-> (scratchpad-object cam-dbg-scratch) plotvec 1 y) (+ (the int (* y-scale y-range)) 20)) - (camera-line2d (the-as vector4w (+ 48 (scratchpad-object int))) (the-as vector4w (+ 64 (scratchpad-object int)))) - (let ((color-quad (-> color quad))) (set! (-> (scratchpad-object cam-dbg-scratch) color quad) color-quad)) - (set! (-> (scratchpad-object cam-dbg-scratch) plotvec 1 x) 20) - (set! (-> (scratchpad-object cam-dbg-scratch) plotvec 1 y) (+ (the int (* y-scale (- (fn x-min) y-min))) 20)) - (let ((x-pixel 1)) - (while (>= (the int (* x-scale x-range)) x-pixel) - (let ((previous-point-quad (-> (scratchpad-object cam-dbg-scratch) plotvec 1 quad))) - (set! (-> (scratchpad-object cam-dbg-scratch) plotvec 0 quad) previous-point-quad)) - (set! (-> (scratchpad-object cam-dbg-scratch) plotvec 1 x) (+ x-pixel 20)) - (set! (-> (scratchpad-object cam-dbg-scratch) plotvec 1 y) - (+ (the int (* y-scale (- (fn (+ x-min (* x-range (/ (the float x-pixel) (* x-scale x-range))))) y-min))) 20)) - (camera-line2d (the-as vector4w (+ 48 (scratchpad-object int))) (the-as vector4w (+ 64 (scratchpad-object int)))) - (+! x-pixel 1))))) - 0 - (none)) + (slet (spad cam-dbg-scratch) + (let ((x-range (- x-max x-min)) + (y-range (- y-max y-min))) + 0.0 + 0.0 + (let ((y-scale (/ 200.0 y-range)) + (x-scale (/ 400.0 x-range))) + (set! (-> spad color x) (the-as float 128)) + (set! (-> spad color y) (the-as float 128)) + (set! (-> spad color z) (the-as float 128)) + (set! (-> spad color w) (the-as float 128)) + (when (and (< x-min 0.0) (< 0.0 x-max)) + (set! (-> spad plotvec 0 x) (+ (the int (* x-scale x-range (/ (- x-min) x-range))) 20)) + (set! (-> spad plotvec 0 y) 20) + (set! (-> spad plotvec 1 x) (-> spad plotvec 0 x)) + (set! (-> spad plotvec 1 y) (+ (the int (* y-scale y-range)) 20)) + (camera-line2d (-> spad plotvec 0) (-> spad plotvec 1))) + (when (and (< y-min 0.0) (< 0.0 y-max)) + (set! (-> spad plotvec 0 x) 20) + (set! (-> spad plotvec 0 y) (+ (the int (* y-scale y-range (/ (- y-min) y-range))) 20)) + (set! (-> spad plotvec 1 x) (+ (the int (* x-scale x-range)) 20)) + (set! (-> spad plotvec 1 y) (-> spad plotvec 0 y)) + (camera-line2d (-> spad plotvec 0) (-> spad plotvec 1))) + (set! (-> spad plotvec 0 x) 20) + (set! (-> spad plotvec 0 y) 20) + (set! (-> spad plotvec 1 x) (+ (the int (* x-scale x-range)) 20)) + (set! (-> spad plotvec 1 y) 20) + (camera-line2d (-> spad plotvec 0) (-> spad plotvec 1)) + (set! (-> spad plotvec 0 x) 20) + (set! (-> spad plotvec 0 y) (+ (the int (* y-scale y-range)) 20)) + (set! (-> spad plotvec 1 x) (+ (the int (* x-scale x-range)) 20)) + (set! (-> spad plotvec 1 y) (+ (the int (* y-scale y-range)) 20)) + (camera-line2d (-> spad plotvec 0) (-> spad plotvec 1)) + (set! (-> spad plotvec 0 x) 20) + (set! (-> spad plotvec 0 y) 20) + (set! (-> spad plotvec 1 x) 20) + (set! (-> spad plotvec 1 y) (+ (the int (* y-scale y-range)) 20)) + (camera-line2d (-> spad plotvec 0) (-> spad plotvec 1)) + (set! (-> spad plotvec 0 x) (+ (the int (* x-scale x-range)) 20)) + (set! (-> spad plotvec 0 y) 20) + (set! (-> spad plotvec 1 x) (+ (the int (* x-scale x-range)) 20)) + (set! (-> spad plotvec 1 y) (+ (the int (* y-scale y-range)) 20)) + (camera-line2d (-> spad plotvec 0) (-> spad plotvec 1)) + (vector4w-copy! (-> spad color) color) + (set! (-> spad plotvec 1 x) 20) + (set! (-> spad plotvec 1 y) (+ (the int (* y-scale (- (fn x-min) y-min))) 20)) + (let ((x-pixel 1)) + (while (>= (the int (* x-scale x-range)) x-pixel) + (let ((previous-point-quad (-> spad plotvec 1 quad))) + (set! (-> spad plotvec 0 quad) previous-point-quad)) + (set! (-> spad plotvec 1 x) (+ x-pixel 20)) + (set! (-> spad plotvec 1 y) + (+ (the int (* y-scale (- (fn (+ x-min (* x-range (/ (the float x-pixel) (* x-scale x-range))))) y-min))) 20)) + (camera-line2d (-> spad plotvec 0) (-> spad plotvec 1)) + (+! x-pixel 1))))) + 0 + (none))) (defun camera-line-setup ((color vector4w)) "Select the color for subsequent camera-line-draw calls and initialize the identity world-to-screen transform." - (let ((color-quad (-> color quad))) (set! (-> (scratchpad-object cam-dbg-scratch) color quad) color-quad)) - (init-for-transform *identity-matrix*) - 0 - (none)) + (slet (spad cam-dbg-scratch) + (vector4w-copy! (-> spad color) color) + (init-for-transform *identity-matrix*) + 0 + (none))) +;; WARN: Function camera-line-draw has a return type of none, but the expression builder found a return statement. (defun camera-line-draw ((start vector) (end vector)) "Transform and draw one world-space line using the color selected by camera-line-setup. Reject either endpoint whose transformed depth is past the debug renderer's unsigned cutoff." - (set! (-> (the-as (pointer uint128) (+ 80 (scratchpad-object int)))) (-> start quad)) - (set! (-> (the-as (pointer uint128) (+ 96 (scratchpad-object int)))) (-> end quad)) - (set! (-> (scratchpad-object cam-dbg-scratch) linevec 0 w) (the-as int 1.0)) - (set! (-> (scratchpad-object cam-dbg-scratch) linevec 1 w) (the-as int 1.0)) - (transform-float-point (the-as vector (+ 80 (scratchpad-object int))) - (the-as vector4w (-> (scratchpad-object cam-dbg-scratch) linevec4w))) - (transform-float-point (the-as vector (+ 96 (scratchpad-object int))) (the-as vector4w (+ 16 (scratchpad-object int)))) - (cond - ((< (the-as uint #xe00000) (the-as uint (-> (scratchpad-object cam-dbg-scratch) linevec4w 0 z))) - (return (the-as symbol #f))) - ((< (the-as uint #xe00000) (the-as uint (-> (scratchpad-object cam-dbg-scratch) linevec4w 1 z))) - (return (the-as symbol #f)))) - (cam-line-dma) - (the-as symbol 0)) + (slet (spad cam-dbg-scratch) + (vector-copy! (-> spad linevec 0) start) + (vector-copy! (-> spad linevec 1) end) + (set! (-> spad linevec 0 w) 1.0) + (set! (-> spad linevec 1 w) 1.0) + (transform-float-point (-> spad linevec 0) (-> spad linevec4w 0)) + (transform-float-point (-> spad linevec 1) (-> spad linevec4w 1)) + (cond + ((< (the-as uint #xe00000) (the-as uint (-> spad linevec4w 0 z))) (return #f)) + ((< (the-as uint #xe00000) (the-as uint (-> spad linevec4w 1 z))) (return #f))) + (cam-line-dma) + 0 + (none))) (defun camera-line ((start vector) (end vector) (color vector4w)) "Draw one world-space line in color." @@ -259,111 +244,97 @@ (defun camera-line-rel ((start vector) (offset vector) (color vector4w)) "Draw a line from start to start plus offset." - (vector+! (the-as vector (+ 112 (scratchpad-object int))) start offset) - (camera-line start (the-as vector (+ 112 (scratchpad-object int))) color) - (none)) + (slet (spad cam-dbg-scratch) + (vector+! (-> spad rel-vec) start offset) + (camera-line start (-> spad rel-vec) color) + (none))) -(defun camera-line-rel-len ((start vector) (direction vector) (length float) (color vector4w)) - "Normalize direction to length and draw that displacement from start." - (vector-normalize-copy! (the-as vector (+ 112 (scratchpad-object int))) direction length) - (vector+! (the-as vector (+ 112 (scratchpad-object int))) (the-as vector (+ 112 (scratchpad-object int))) start) - (camera-line start (the-as vector (+ 112 (scratchpad-object int))) color) - (none)) +(defun camera-line-rel-len ((start vector) (direction vector) (length meters) (color vector4w)) + (slet (spad cam-dbg-scratch) + (vector-normalize-copy! (-> spad rel-vec) direction length) + (vector+! (-> spad rel-vec) (-> spad rel-vec) start) + (camera-line start (-> spad rel-vec) color) + (none))) -(defun camera-sphere ((center vector) (radius float) (color vector)) +(defun camera-sphere ((center vector) (radius meters) (color vector4w)) "Draw a sphere as a ten-by-ten latitude/longitude wireframe." - (camera-line-setup (the-as vector4w color)) - (dotimes (latitude 10) - (let ((ring-radius (* radius (sin (* 3276.8 (the float latitude))))) - (next-ring-radius (* radius (sin (* 3276.8 (the float (+ latitude 1))))))) - (set! (-> (scratchpad-object cam-dbg-scratch) sphere-v-start y) - (+ (-> center y) (* (cos (* 3276.8 (the float latitude))) radius))) - (set! (-> (scratchpad-object cam-dbg-scratch) sphere-v-end y) (-> (scratchpad-object cam-dbg-scratch) sphere-v-start y)) - (set! (-> (scratchpad-object cam-dbg-scratch) sphere-v-down y) - (+ (-> center y) (* (cos (* 3276.8 (the float (+ latitude 1)))) radius))) - (dotimes (longitude 10) - (set! (-> (scratchpad-object cam-dbg-scratch) sphere-v-start x) - (+ (-> center x) (* (cos (* 6553.6 (the float longitude))) ring-radius))) - (set! (-> (scratchpad-object cam-dbg-scratch) sphere-v-start z) - (+ (-> center z) (* (sin (* 6553.6 (the float longitude))) ring-radius))) - (set! (-> (scratchpad-object cam-dbg-scratch) sphere-v-end x) - (+ (-> center x) (* (cos (* 6553.6 (the float (+ longitude 1)))) ring-radius))) - (set! (-> (scratchpad-object cam-dbg-scratch) sphere-v-end z) - (+ (-> center z) (* (sin (* 6553.6 (the float (+ longitude 1)))) ring-radius))) - (set! (-> (scratchpad-object cam-dbg-scratch) sphere-v-down x) - (+ (-> center x) (* (cos (* 6553.6 (the float longitude))) next-ring-radius))) - (set! (-> (scratchpad-object cam-dbg-scratch) sphere-v-down z) - (+ (-> center z) (* (sin (* 6553.6 (the float longitude))) next-ring-radius))) - (camera-line-draw (the-as vector (+ 128 (scratchpad-object int))) (the-as vector (+ 144 (scratchpad-object int)))) - (camera-line-draw (the-as vector (+ 128 (scratchpad-object int))) (the-as vector (+ 160 (scratchpad-object int))))))) - 0 - (none)) + (slet (spad cam-dbg-scratch) + (camera-line-setup color) + (dotimes (latitude 10) + (let ((ring-radius (* radius (sin (* 3276.8 (the float latitude))))) + (next-ring-radius (* radius (sin (* 3276.8 (the float (+ latitude 1))))))) + (set! (-> spad sphere-v-start y) (+ (-> center y) (* (cos (* 3276.8 (the float latitude))) radius))) + (set! (-> spad sphere-v-end y) (-> spad sphere-v-start y)) + (set! (-> spad sphere-v-down y) (+ (-> center y) (* (cos (* 3276.8 (the float (+ latitude 1)))) radius))) + (dotimes (longitude 10) + (set! (-> spad sphere-v-start x) (+ (-> center x) (* (cos (* 6553.6 (the float longitude))) ring-radius))) + (set! (-> spad sphere-v-start z) (+ (-> center z) (* (sin (* 6553.6 (the float longitude))) ring-radius))) + (set! (-> spad sphere-v-end x) (+ (-> center x) (* (cos (* 6553.6 (the float (+ longitude 1)))) ring-radius))) + (set! (-> spad sphere-v-end z) (+ (-> center z) (* (sin (* 6553.6 (the float (+ longitude 1)))) ring-radius))) + (set! (-> spad sphere-v-down x) (+ (-> center x) (* (cos (* 6553.6 (the float longitude))) next-ring-radius))) + (set! (-> spad sphere-v-down z) (+ (-> center z) (* (sin (* 6553.6 (the float longitude))) next-ring-radius))) + (camera-line-draw (-> spad sphere-v-start) (-> spad sphere-v-end)) + (camera-line-draw (-> spad sphere-v-start) (-> spad sphere-v-down))))) + 0 + (none))) (defun camera-cross ((axis-a vector) (axis-b vector) (center vector) (color vector4w) (half-length meters)) "Draw three perpendicular diameter lines through center. The first axis is axis-a; the other two are formed by successive crosses with axis-b and axis-a. half-length is the distance from center to each endpoint." - (vector-normalize-copy! (the-as vector (+ 192 (scratchpad-object int))) axis-a half-length) - (vector+! (the-as vector (+ 208 (scratchpad-object int))) center (the-as vector (+ 192 (scratchpad-object int)))) - (vector-! (the-as vector (+ 224 (scratchpad-object int))) center (the-as vector (+ 192 (scratchpad-object int)))) - (camera-line (the-as vector (+ 208 (scratchpad-object int))) (the-as vector (+ 224 (scratchpad-object int))) color) - (vector-cross! (the-as vector (+ 192 (scratchpad-object int))) (the-as vector (+ 192 (scratchpad-object int))) axis-b) - (vector-normalize! (the-as vector (+ 192 (scratchpad-object int))) half-length) - (vector+! (the-as vector (+ 208 (scratchpad-object int))) center (the-as vector (+ 192 (scratchpad-object int)))) - (vector-! (the-as vector (+ 224 (scratchpad-object int))) center (the-as vector (+ 192 (scratchpad-object int)))) - (camera-line (the-as vector (+ 208 (scratchpad-object int))) (the-as vector (+ 224 (scratchpad-object int))) color) - (vector-cross! (the-as vector (+ 192 (scratchpad-object int))) (the-as vector (+ 192 (scratchpad-object int))) axis-a) - (vector-normalize! (the-as vector (+ 192 (scratchpad-object int))) half-length) - (vector+! (the-as vector (+ 208 (scratchpad-object int))) center (the-as vector (+ 192 (scratchpad-object int)))) - (vector-! (the-as vector (+ 224 (scratchpad-object int))) center (the-as vector (+ 192 (scratchpad-object int)))) - (the-as basic - (camera-line (the-as vector (+ 208 (scratchpad-object int))) (the-as vector (+ 224 (scratchpad-object int))) color))) + (slet (spad cam-dbg-scratch) + (vector-normalize-copy! (-> spad crossvec 0) axis-a half-length) + (vector+! (-> spad crossvec 1) center (-> spad crossvec 0)) + (vector-! (-> spad crossvec 2) center (-> spad crossvec 0)) + (camera-line (-> spad crossvec 1) (-> spad crossvec 2) color) + (vector-cross! (-> spad crossvec 0) (-> spad crossvec 0) axis-b) + (vector-normalize! (-> spad crossvec 0) half-length) + (vector+! (-> spad crossvec 1) center (-> spad crossvec 0)) + (vector-! (-> spad crossvec 2) center (-> spad crossvec 0)) + (camera-line (-> spad crossvec 1) (-> spad crossvec 2) color) + (vector-cross! (-> spad crossvec 0) (-> spad crossvec 0) axis-a) + (vector-normalize! (-> spad crossvec 0) half-length) + (vector+! (-> spad crossvec 1) center (-> spad crossvec 0)) + (vector-! (-> spad crossvec 2) center (-> spad crossvec 0)) + (camera-line (-> spad crossvec 1) (-> spad crossvec 2) color) + (none))) -(defun camera-bounding-box-draw ((bounds bounding-box) (unused-options basic) (unused-color rgba)) - "Draw the twelve edges of bounds in the original fixed gray. The two - trailing arguments are retained for compatibility but are not read." - (camera-line-setup (new 'static 'vector4w :x #x7f :y #x7f :z #x7f :w #x80)) - (set! (-> (the-as (pointer uint128) (+ 240 (scratchpad-object int)))) (-> bounds min quad)) - (set! (-> (scratchpad-object cam-dbg-scratch) bboxvec 0 x) (-> bounds max x)) - (set! (-> (the-as (pointer uint128) (+ 256 (scratchpad-object int)))) (-> bounds min quad)) - (set! (-> (scratchpad-object cam-dbg-scratch) bboxvec 1 y) (-> bounds max y)) - (set! (-> (the-as (pointer uint128) (+ 272 (scratchpad-object int)))) (-> bounds min quad)) - (set! (-> (scratchpad-object cam-dbg-scratch) bboxvec 2 z) (-> bounds max z)) - (set! (-> (the-as (pointer uint128) (+ 288 (scratchpad-object int)))) (-> bounds max quad)) - (set! (-> (scratchpad-object cam-dbg-scratch) bboxvec 3 x) (-> bounds min x)) - (set! (-> (the-as (pointer uint128) (+ 304 (scratchpad-object int)))) (-> bounds max quad)) - (set! (-> (scratchpad-object cam-dbg-scratch) bboxvec 4 y) (-> bounds min y)) - (set! (-> (the-as (pointer uint128) (+ 320 (scratchpad-object int)))) (-> bounds max quad)) - (set! (-> (scratchpad-object cam-dbg-scratch) bboxvec 5 z) (-> bounds min z)) - (camera-line-draw (-> bounds min) (the-as vector (+ 240 (scratchpad-object int)))) - (camera-line-draw (-> bounds min) (the-as vector (+ 256 (scratchpad-object int)))) - (camera-line-draw (-> bounds min) (the-as vector (+ 272 (scratchpad-object int)))) - (camera-line-draw (-> bounds max) (the-as vector (+ 288 (scratchpad-object int)))) - (camera-line-draw (-> bounds max) (the-as vector (+ 304 (scratchpad-object int)))) - (camera-line-draw (-> bounds max) (the-as vector (+ 320 (scratchpad-object int)))) - (camera-line-draw (the-as vector (+ 240 (scratchpad-object int))) (the-as vector (+ 304 (scratchpad-object int)))) - (camera-line-draw (the-as vector (+ 304 (scratchpad-object int))) (the-as vector (+ 272 (scratchpad-object int)))) - (camera-line-draw (the-as vector (+ 272 (scratchpad-object int))) (the-as vector (+ 288 (scratchpad-object int)))) - (camera-line-draw (the-as vector (+ 288 (scratchpad-object int))) (the-as vector (+ 256 (scratchpad-object int)))) - (camera-line-draw (the-as vector (+ 256 (scratchpad-object int))) (the-as vector (+ 320 (scratchpad-object int)))) - (camera-line-draw (the-as vector (+ 320 (scratchpad-object int))) (the-as vector (+ 240 (scratchpad-object int)))) - 0 - (none)) +(defun camera-bounding-box-draw ((bounds bounding-box)) + "Draw the twelve edges of bounds in the original fixed gray." + (slet (spad cam-dbg-scratch) + (camera-line-setup (new 'static 'vector4w :x #x7f :y #x7f :z #x7f :w #x80)) + (vector-copy! (-> spad bboxvec 0) (-> bounds min)) + (set! (-> spad bboxvec 0 x) (-> bounds max x)) + (vector-copy! (-> spad bboxvec 1) (-> bounds min)) + (set! (-> spad bboxvec 1 y) (-> bounds max y)) + (vector-copy! (-> spad bboxvec 2) (-> bounds min)) + (set! (-> spad bboxvec 2 z) (-> bounds max z)) + (vector-copy! (-> spad bboxvec 3) (-> bounds max)) + (set! (-> spad bboxvec 3 x) (-> bounds min x)) + (vector-copy! (-> spad bboxvec 4) (-> bounds max)) + (set! (-> spad bboxvec 4 y) (-> bounds min y)) + (vector-copy! (-> spad bboxvec 5) (-> bounds max)) + (set! (-> spad bboxvec 5 z) (-> bounds min z)) + (camera-line-draw (-> bounds min) (-> spad bboxvec 0)) + (camera-line-draw (-> bounds min) (-> spad bboxvec 1)) + (camera-line-draw (-> bounds min) (-> spad bboxvec 2)) + (camera-line-draw (-> bounds max) (-> spad bboxvec 3)) + (camera-line-draw (-> bounds max) (-> spad bboxvec 4)) + (camera-line-draw (-> bounds max) (-> spad bboxvec 5)) + (camera-line-draw (-> spad bboxvec 0) (-> spad bboxvec 4)) + (camera-line-draw (-> spad bboxvec 4) (-> spad bboxvec 2)) + (camera-line-draw (-> spad bboxvec 2) (-> spad bboxvec 3)) + (camera-line-draw (-> spad bboxvec 3) (-> spad bboxvec 1)) + (camera-line-draw (-> spad bboxvec 1) (-> spad bboxvec 5)) + (camera-line-draw (-> spad bboxvec 5) (-> spad bboxvec 0)) + 0 + (none))) (deftype cam-debug-tri (structure) - ((vertex vector 3 :inline :offset-assert 0) - (intersect vector :inline :offset-assert 48) - (color vector4w :offset-assert 64)) - :method-count-assert 9 - :size-assert #x44 - :flag-assert #x900000044) + ((vertex vector 3 :inline) + (intersect vector :inline) + (color vector4w))) -(defmethod inspect ((obj cam-debug-tri)) - (format #t "[~8x] ~A~%" obj 'cam-debug-tri) - (format #t "~Tvertex[3] @ #x~X~%" (-> obj vertex)) - (format #t "~Tintersect: #~%" (-> obj intersect)) - (format #t "~Tcolor: #~%" (-> obj color)) - obj) (define *cam-debug-los-tri-current* 0) @@ -380,98 +351,89 @@ 0 (none)) -(defun cam-debug-add-los-tri ((triangles (inline-array collide-cache-tri)) (intersection vector) (color vector)) +(defun cam-debug-add-los-tri ((triangles (inline-array collide-cache-tri)) (intersection vector) (color vector4w)) "Save the first collision-cache triangle, intersection, and color in the line-of-sight debug list. The list holds at most 460 entries." (cond ((>= *cam-debug-los-tri-current* 460)) (else (let ((saved-triangle (-> *cam-debug-los-tri* *cam-debug-los-tri-current*))) - (set! (-> saved-triangle vertex 0 quad) (-> triangles 0 vertex 0 quad)) - (set! (-> saved-triangle vertex 1 quad) (-> triangles 0 vertex 1 quad)) - (set! (-> saved-triangle vertex 2 quad) (-> triangles 0 vertex 2 quad)) - (set! (-> saved-triangle intersect quad) (-> intersection quad)) - (set! (-> saved-triangle color) (the-as vector4w color))) + (vector-copy! (-> saved-triangle vertex 0) (-> triangles 0 vertex 0)) + (vector-copy! (-> saved-triangle vertex 1) (-> triangles 0 vertex 1)) + (vector-copy! (-> saved-triangle vertex 2) (-> triangles 0 vertex 2)) + (vector-copy! (-> saved-triangle intersect) intersection) + (set! (-> saved-triangle color) color)) (set! *cam-debug-los-tri-current* (+ *cam-debug-los-tri-current* 1)) - (if (= *cam-debug-los-tri-current* 460) (format 0 "ERROR : cam-debug-add-los-tri overflow~%")))) + (if (= *cam-debug-los-tri-current* 460) + (format 0 "ERROR : cam-debug-add-los-tri overflow~%")))) 0 (none)) -(defun cam-debug-add-coll-tri ((triangle cam-debug-tri) (intersection vector) (color-data cam-debug-tri)) +(defun cam-debug-add-coll-tri ((triangle cam-debug-tri) (intersection vector) (color vector4w)) "Copy a camera debug triangle with a new intersection and color into the collision debug list. The list holds at most 460 entries." (cond ((>= *cam-debug-coll-tri-current* 460)) (else (let ((saved-triangle (-> *cam-debug-coll-tri* *cam-debug-coll-tri-current*))) - (set! (-> saved-triangle vertex 0 quad) (-> triangle vertex 0 quad)) - (set! (-> saved-triangle vertex 1 quad) (-> triangle vertex 1 quad)) - (set! (-> saved-triangle vertex 2 quad) (-> triangle vertex 2 quad)) - (set! (-> saved-triangle intersect quad) (-> intersection quad)) - (set! (-> saved-triangle color) (the-as vector4w color-data))) + (vector-copy! (-> saved-triangle vertex 0) (-> triangle vertex 0)) + (vector-copy! (-> saved-triangle vertex 1) (-> triangle vertex 1)) + (vector-copy! (-> saved-triangle vertex 2) (-> triangle vertex 2)) + (vector-copy! (-> saved-triangle intersect) intersection) + (set! (-> saved-triangle color) color)) (set! *cam-debug-coll-tri-current* (+ *cam-debug-coll-tri-current* 1)) - (if (>= *cam-debug-coll-tri-current* 460) (format 0 "ERROR : cam-debug-add-coll-tri overflow~%")))) + (if (>= *cam-debug-coll-tri-current* 460) + (format 0 "ERROR : cam-debug-add-coll-tri overflow~%")))) 0 (none)) (defun cam-debug-draw-tris () "Draw the recorded camera line-of-sight and collision triangles selected by the corresponding display flags, with a cross at each intersection." - (camera-line-setup (new 'stack 'vector4w)) - (when *display-cam-los-marks* - (dotimes (i *cam-debug-los-tri-current*) - (let ((color-quad (-> *cam-debug-los-tri* i color quad))) - (set! (-> (scratchpad-object cam-dbg-scratch) color quad) color-quad)) - (camera-line-draw (the-as vector (+ (the-as uint (-> *cam-debug-los-tri* 0)) (* 80 i))) - (the-as vector (+ (the-as uint (-> *cam-debug-los-tri* 0 vertex 1)) (* 80 i)))) - (camera-line-draw (the-as vector (+ (the-as uint (-> *cam-debug-los-tri* 0 vertex 1)) (* 80 i))) - (the-as vector (+ (the-as uint (-> *cam-debug-los-tri* 0 vertex 2)) (* 80 i)))) - (camera-line-draw (the-as vector (+ (the-as uint (-> *cam-debug-los-tri* 0 vertex 2)) (* 80 i))) - (the-as vector (+ (the-as uint (-> *cam-debug-los-tri* 0)) (* 80 i)))) - (camera-cross (new 'static 'vector :y 1024.0) - (new 'static 'vector :z 1024.0) - (-> *cam-debug-los-tri* i intersect) - (-> *cam-debug-los-tri* i color) - (meters 0.25)))) - (when *display-cam-coll-marks* - (dotimes (i *cam-debug-coll-tri-current*) - (let ((color-quad (-> *cam-debug-coll-tri* i color quad))) - (set! (-> (scratchpad-object cam-dbg-scratch) color quad) color-quad)) - (camera-line-draw (the-as vector (+ (the-as uint (-> *cam-debug-coll-tri* 0)) (* 80 i))) - (the-as vector (+ (the-as uint (-> *cam-debug-coll-tri* 0 vertex 1)) (* 80 i)))) - (camera-line-draw (the-as vector (+ (the-as uint (-> *cam-debug-coll-tri* 0 vertex 1)) (* 80 i))) - (the-as vector (+ (the-as uint (-> *cam-debug-coll-tri* 0 vertex 2)) (* 80 i)))) - (camera-line-draw (the-as vector (+ (the-as uint (-> *cam-debug-coll-tri* 0 vertex 2)) (* 80 i))) - (the-as vector (+ (the-as uint (-> *cam-debug-coll-tri* 0)) (* 80 i)))) - (camera-cross (new 'static 'vector :y 1024.0) - (new 'static 'vector :z 1024.0) - (-> *cam-debug-coll-tri* i intersect) - (-> *cam-debug-coll-tri* i color) - (meters 0.25))) - #f)) + (slet (spad cam-dbg-scratch) + (camera-line-setup (new 'stack 'vector4w)) + (when *display-cam-los-marks* + (dotimes (i *cam-debug-los-tri-current*) + (vector4w-copy! (-> spad color) (-> *cam-debug-los-tri* i color)) + (camera-line-draw (-> *cam-debug-los-tri* i vertex 0) (-> *cam-debug-los-tri* i vertex 1)) + (camera-line-draw (-> *cam-debug-los-tri* i vertex 1) (-> *cam-debug-los-tri* i vertex 2)) + (camera-line-draw (-> *cam-debug-los-tri* i vertex 2) (-> *cam-debug-los-tri* i vertex 0)) + (camera-cross (new 'static 'vector :y 1024.0) + (new 'static 'vector :z 1024.0) + (-> *cam-debug-los-tri* i intersect) + (-> *cam-debug-los-tri* i color) + (meters 0.25)))) + (when *display-cam-coll-marks* + (dotimes (i *cam-debug-coll-tri-current*) + (vector4w-copy! (-> spad color) (-> *cam-debug-coll-tri* i color)) + (camera-line-draw (-> *cam-debug-coll-tri* i vertex 0) (-> *cam-debug-coll-tri* i vertex 1)) + (camera-line-draw (-> *cam-debug-coll-tri* i vertex 1) (-> *cam-debug-coll-tri* i vertex 2)) + (camera-line-draw (-> *cam-debug-coll-tri* i vertex 2) (-> *cam-debug-coll-tri* i vertex 0)) + (camera-cross (new 'static 'vector :y 1024.0) + (new 'static 'vector :z 1024.0) + (-> *cam-debug-coll-tri* i intersect) + (-> *cam-debug-coll-tri* i color) + (meters 0.25))) + #f))) -(defun camera-fov-draw ((direction-a-address int) - (direction-b-address int) +(defun camera-fov-draw ((direction-a vector) + (direction-b vector) (origin vector) - (near-distance float) - (far-distance float) + (near-distance meters) + (far-distance meters) (color vector4w)) - "Draw one side of a camera frustum from two direction-vector addresses, + "Draw one side of a camera frustum from two direction vectors, origin, near distance, far distance, and color." - (vector+float*! (the-as vector (+ 336 (scratchpad-object int))) - origin - (the-as vector direction-b-address) - near-distance) - (vector+float*! (the-as vector (+ 352 (scratchpad-object int))) - origin - (the-as vector direction-a-address) - near-distance) - (vector+float*! (the-as vector (+ 368 (scratchpad-object int))) origin (the-as vector direction-a-address) far-distance) - (vector+float*! (the-as vector (+ 384 (scratchpad-object int))) origin (the-as vector direction-b-address) far-distance) - (camera-line-setup color) - (camera-line-draw (the-as vector (+ 336 (scratchpad-object int))) (the-as vector (+ 352 (scratchpad-object int)))) - (camera-line-draw (the-as vector (+ 352 (scratchpad-object int))) (the-as vector (+ 368 (scratchpad-object int)))) - (camera-line-draw (the-as vector (+ 368 (scratchpad-object int))) (the-as vector (+ 384 (scratchpad-object int))))) + (slet (spad cam-dbg-scratch) + (vector+float*! (-> spad fov-vv 0) origin direction-b near-distance) + (vector+float*! (-> spad fov-vv 1) origin direction-a near-distance) + (vector+float*! (-> spad fov-vv 2) origin direction-a far-distance) + (vector+float*! (-> spad fov-vv 3) origin direction-b far-distance) + (camera-line-setup color) + (camera-line-draw (-> spad fov-vv 0) (-> spad fov-vv 1)) + (camera-line-draw (-> spad fov-vv 1) (-> spad fov-vv 2)) + (camera-line-draw (-> spad fov-vv 2) (-> spad fov-vv 3)) + (none))) (defun camera-fov-frame ((inverse-rotation matrix) (origin vector) @@ -482,73 +444,58 @@ "Draw a camera frustum from its inverse rotation, origin, half field of view, vertical scale, horizontal scale, and color. The near and far outlines are 4096 and 20480 GOAL units from the origin." - (vector-float*! (the-as vector (+ 432 (scratchpad-object int))) - (-> inverse-rotation vector 1) - (* vertical-scale (tan half-fov))) - (vector-float*! (the-as vector (+ 448 (scratchpad-object int))) - (the-as vector (-> inverse-rotation vector)) - (* horizontal-scale (tan half-fov))) - (vector+! (the-as vector (+ 400 (scratchpad-object int))) - (-> inverse-rotation vector 2) - (vector+! (the-as vector (+ 400 (scratchpad-object int))) - (the-as vector (+ 432 (scratchpad-object int))) - (the-as vector (+ 448 (scratchpad-object int))))) - (vector-normalize! (the-as vector (+ 400 (scratchpad-object int))) 1.0) - (vector+! (the-as vector (+ 416 (scratchpad-object int))) - (-> inverse-rotation vector 2) - (vector-! (the-as vector (+ 416 (scratchpad-object int))) - (the-as vector (+ 432 (scratchpad-object int))) - (the-as vector (+ 448 (scratchpad-object int))))) - (vector-normalize! (the-as vector (+ 416 (scratchpad-object int))) 1.0) - (camera-fov-draw (+ 400 (scratchpad-object int)) (+ 416 (scratchpad-object int)) origin 4096.0 20480.0 color) - (set! (-> (the-as (pointer uint128) (+ 400 (scratchpad-object int)))) - (-> (the-as vector (+ 416 (scratchpad-object int))) quad)) - (vector-! (the-as vector (+ 416 (scratchpad-object int))) - (-> inverse-rotation vector 2) - (vector+! (the-as vector (+ 416 (scratchpad-object int))) - (the-as vector (+ 432 (scratchpad-object int))) - (the-as vector (+ 448 (scratchpad-object int))))) - (vector-normalize! (the-as vector (+ 416 (scratchpad-object int))) 1.0) - (camera-fov-draw (+ 400 (scratchpad-object int)) (+ 416 (scratchpad-object int)) origin 4096.0 20480.0 color) - (set! (-> (the-as (pointer uint128) (+ 400 (scratchpad-object int)))) - (-> (the-as vector (+ 416 (scratchpad-object int))) quad)) - (vector-! (the-as vector (+ 416 (scratchpad-object int))) - (-> inverse-rotation vector 2) - (vector-! (the-as vector (+ 416 (scratchpad-object int))) - (the-as vector (+ 432 (scratchpad-object int))) - (the-as vector (+ 448 (scratchpad-object int))))) - (vector-normalize! (the-as vector (+ 416 (scratchpad-object int))) 1.0) - (camera-fov-draw (+ 400 (scratchpad-object int)) (+ 416 (scratchpad-object int)) origin 4096.0 20480.0 color) - (set! (-> (the-as (pointer uint128) (+ 400 (scratchpad-object int)))) - (-> (the-as vector (+ 416 (scratchpad-object int))) quad)) - (vector+! (the-as vector (+ 416 (scratchpad-object int))) - (-> inverse-rotation vector 2) - (vector+! (the-as vector (+ 416 (scratchpad-object int))) - (the-as vector (+ 432 (scratchpad-object int))) - (the-as vector (+ 448 (scratchpad-object int))))) - (vector-normalize! (the-as vector (+ 416 (scratchpad-object int))) 1.0) - (camera-fov-draw (+ 400 (scratchpad-object int)) (+ 416 (scratchpad-object int)) origin 4096.0 20480.0 color) - (none)) + (slet (spad cam-dbg-scratch) + (vector-float*! (-> spad fov-vert) (-> inverse-rotation vector 1) (* vertical-scale (tan half-fov))) + (vector-float*! (-> spad fov-horz) (-> inverse-rotation vector 0) (* horizontal-scale (tan half-fov))) + (vector+! (-> spad fov-src) + (-> inverse-rotation vector 2) + (vector+! (-> spad fov-src) (-> spad fov-vert) (-> spad fov-horz))) + (vector-normalize! (-> spad fov-src) 1.0) + (vector+! (-> spad fov-dest) + (-> inverse-rotation vector 2) + (vector-! (-> spad fov-dest) (-> spad fov-vert) (-> spad fov-horz))) + (vector-normalize! (-> spad fov-dest) 1.0) + (camera-fov-draw (-> spad fov-src) (-> spad fov-dest) origin (meters 1) (meters 5) color) + (vector-copy! (-> spad fov-src) (-> spad fov-dest)) + (vector-! (-> spad fov-dest) + (-> inverse-rotation vector 2) + (vector+! (-> spad fov-dest) (-> spad fov-vert) (-> spad fov-horz))) + (vector-normalize! (-> spad fov-dest) 1.0) + (camera-fov-draw (-> spad fov-src) (-> spad fov-dest) origin (meters 1) (meters 5) color) + (vector-copy! (-> spad fov-src) (-> spad fov-dest)) + (vector-! (-> spad fov-dest) + (-> inverse-rotation vector 2) + (vector-! (-> spad fov-dest) (-> spad fov-vert) (-> spad fov-horz))) + (vector-normalize! (-> spad fov-dest) 1.0) + (camera-fov-draw (-> spad fov-src) (-> spad fov-dest) origin (meters 1) (meters 5) color) + (vector-copy! (-> spad fov-src) (-> spad fov-dest)) + (vector+! (-> spad fov-dest) + (-> inverse-rotation vector 2) + (vector+! (-> spad fov-dest) (-> spad fov-vert) (-> spad fov-horz))) + (vector-normalize! (-> spad fov-dest) 1.0) + (camera-fov-draw (-> spad fov-src) (-> spad fov-dest) origin (meters 1) (meters 5) color) + (none))) (defmethod print-nth-point ((this tracking-spline) (point-index int)) - "Print one breadcrumb with markers for the used head, next-to-last point, - and end point." + "Print one breadcrumb with markers for the used head, + next-to-last point, and end point." (if (= point-index (-> this used-point)) (format 0 "u") (format 0 " ")) (if (= point-index (-> this next-to-last-point)) (format 0 "n") (format 0 " ")) (if (= point-index (-> this end-point)) (format 0 "e") (format 0 " ")) (if (= point-index -134250495) - (format 0 " ~D~%" point-index) - (format 0 - " ~D ~M ~M ~M~%" - point-index - (-> this point point-index position x) - (-> this point point-index position y) - (-> this point point-index position z))) + (format 0 " ~D~%" point-index) + (format 0 + " ~D ~M ~M ~M~%" + point-index + (-> this point point-index position x) + (-> this point point-index position y) + (-> this point point-index position z))) 0 (none)) (defmethod print-all-points ((this tracking-spline)) - "Print every breadcrumb in the used chain, followed by the chain terminator." + "Print every breadcrumb in the used chain, followed by + the chain terminator." (let ((point-index (-> this used-point))) (while (!= point-index -134250495) (print-nth-point this point-index) @@ -590,38 +537,37 @@ 0 (none)) -(defun debug-euler ((scratch cam-dbg-scratch)) - "Interpret the matrix packed from scratch.sphere-vec.w onward, print its Euler - conversion and reconstruction, and report whether any component differs by - more than 0.001." +(defun debug-euler ((scratch camera-slave)) + "Convert the camera rotation matrix to euler angles and back and report whether + any component differs by more than 0.001." (let ((angles (new 'stack-no-clear 'euler-angles)) (reconstructed (new 'stack-no-clear 'matrix))) - (matrix->eul angles (the-as matrix (&-> scratch sphere-vec w)) 21) + (matrix->eul angles (-> scratch tracking inv-mat) 21) (format *stdcon* "euler angles x ~R y ~R z ~R~%" (-> angles x) (-> angles y) (-> angles z)) (format *stdcon* "~f ~f ~f ~f~%" - (-> scratch sphere-vec w) - (-> scratch crossvec 0 x) - (-> scratch crossvec 0 y) - (-> scratch crossvec 0 z)) + (-> scratch tracking inv-mat vector 0 x) + (-> scratch tracking inv-mat vector 0 y) + (-> scratch tracking inv-mat vector 0 z) + (-> scratch tracking inv-mat vector 0 w)) (format *stdcon* "~f ~f ~f ~f~%" - (-> scratch crossvec 0 w) - (-> scratch crossvec 1 x) - (-> scratch crossvec 1 y) - (-> scratch crossvec 1 z)) + (-> scratch tracking inv-mat vector 1 x) + (-> scratch tracking inv-mat vector 1 y) + (-> scratch tracking inv-mat vector 1 z) + (-> scratch tracking inv-mat vector 1 w)) (format *stdcon* "~f ~f ~f ~f~%" - (-> scratch crossvec 1 w) - (-> scratch crossvec 2 x) - (-> scratch crossvec 2 y) - (-> scratch crossvec 2 z)) + (-> scratch tracking inv-mat vector 2 x) + (-> scratch tracking inv-mat vector 2 y) + (-> scratch tracking inv-mat vector 2 z) + (-> scratch tracking inv-mat vector 2 w)) (format *stdcon* "~f ~f ~f ~f~%" - (-> scratch crossvec 2 w) - (-> scratch bboxvec 0 x) - (-> scratch bboxvec 0 y) - (-> scratch bboxvec 0 z)) + (-> scratch tracking inv-mat vector 3 x) + (-> scratch tracking inv-mat vector 3 y) + (-> scratch tracking inv-mat vector 3 z) + (-> scratch tracking inv-mat vector 3 w)) (eul->matrix reconstructed angles) (format *stdcon* "~f ~f ~f ~f~%" @@ -647,40 +593,41 @@ (-> reconstructed vector 3 y) (-> reconstructed vector 3 z) (-> reconstructed vector 3 w)) - (if (or (< 0.001 (fabs (- (-> scratch sphere-vec w) (-> reconstructed vector 0 x)))) - (< 0.001 (fabs (- (-> scratch crossvec 0 x) (-> reconstructed vector 0 y)))) - (< 0.001 (fabs (- (-> scratch crossvec 0 y) (-> reconstructed vector 0 z)))) - (< 0.001 (fabs (- (-> scratch crossvec 0 z) (-> reconstructed vector 0 w)))) - (< 0.001 (fabs (- (-> scratch crossvec 0 w) (-> reconstructed vector 1 x)))) - (< 0.001 (fabs (- (-> scratch crossvec 1 x) (-> reconstructed vector 1 y)))) - (< 0.001 (fabs (- (-> scratch crossvec 1 y) (-> reconstructed vector 1 z)))) - (< 0.001 (fabs (- (-> scratch crossvec 1 z) (-> reconstructed vector 1 w)))) - (< 0.001 (fabs (- (-> scratch crossvec 1 w) (-> reconstructed vector 2 x)))) - (< 0.001 (fabs (- (-> scratch crossvec 2 x) (-> reconstructed vector 2 y)))) - (< 0.001 (fabs (- (-> scratch crossvec 2 y) (-> reconstructed vector 2 z)))) - (< 0.001 (fabs (- (-> scratch crossvec 2 z) (-> reconstructed vector 2 w)))) - (< 0.001 (fabs (- (-> scratch crossvec 2 w) (-> reconstructed vector 3 x)))) - (< 0.001 (fabs (- (-> scratch bboxvec 0 x) (-> reconstructed vector 3 y)))) - (< 0.001 (fabs (- (-> scratch bboxvec 0 y) (-> reconstructed vector 3 z)))) - (< 0.001 (fabs (- (-> scratch bboxvec 0 z) (-> reconstructed vector 3 w))))) - (format *stdcon* "different~%") - (format *stdcon* "same~%")))) + (if (or (< 0.001 (fabs (- (-> scratch tracking inv-mat vector 0 x) (-> reconstructed vector 0 x)))) + (< 0.001 (fabs (- (-> scratch tracking inv-mat vector 0 y) (-> reconstructed vector 0 y)))) + (< 0.001 (fabs (- (-> scratch tracking inv-mat vector 0 z) (-> reconstructed vector 0 z)))) + (< 0.001 (fabs (- (-> scratch tracking inv-mat vector 0 w) (-> reconstructed vector 0 w)))) + (< 0.001 (fabs (- (-> scratch tracking inv-mat vector 1 x) (-> reconstructed vector 1 x)))) + (< 0.001 (fabs (- (-> scratch tracking inv-mat vector 1 y) (-> reconstructed vector 1 y)))) + (< 0.001 (fabs (- (-> scratch tracking inv-mat vector 1 z) (-> reconstructed vector 1 z)))) + (< 0.001 (fabs (- (-> scratch tracking inv-mat vector 1 w) (-> reconstructed vector 1 w)))) + (< 0.001 (fabs (- (-> scratch tracking inv-mat vector 2 x) (-> reconstructed vector 2 x)))) + (< 0.001 (fabs (- (-> scratch tracking inv-mat vector 2 y) (-> reconstructed vector 2 y)))) + (< 0.001 (fabs (- (-> scratch tracking inv-mat vector 2 z) (-> reconstructed vector 2 z)))) + (< 0.001 (fabs (- (-> scratch tracking inv-mat vector 2 w) (-> reconstructed vector 2 w)))) + (< 0.001 (fabs (- (-> scratch tracking inv-mat vector 3 x) (-> reconstructed vector 3 x)))) + (< 0.001 (fabs (- (-> scratch tracking inv-mat vector 3 y) (-> reconstructed vector 3 y)))) + (< 0.001 (fabs (- (-> scratch tracking inv-mat vector 3 z) (-> reconstructed vector 3 z)))) + (< 0.001 (fabs (- (-> scratch tracking inv-mat vector 3 w) (-> reconstructed vector 3 w))))) + (format *stdcon* "different~%") + (format *stdcon* "same~%"))) + (none)) -(defun bike-cam-limit ((input float)) +(defun bike-cam-limit ((input meters)) "Return a cosine camera limit that rises from zero to one as the nonnegative scaled input approaches 8192, and remains one beyond that range." (let* ((scaled-input (* 10012.444 input)) (clamped-input (fmax 0.0 scaled-input))) (if (< clamped-input 8192.0) - (* (/ 1.0 (- 1.0 (cos 21845.334))) (+ (- (cos 21845.334)) (cos (* 2.6666667 (- 8192.0 clamped-input))))) - 1.0))) + (* (/ 1.0 (- 1.0 (cos (degrees 120)))) (+ (- (cos (degrees 120))) (cos (* 2.6666667 (- 8192.0 clamped-input))))) + 1.0))) (defun camera-slave-debug ((slave camera-slave)) "Draw the active camera-slave frustum, tracking basis and follow point, target body spheres, spline trail, and state-specific string, circular, or authored-spline geometry when camera marks are enabled." (when *display-camera-marks* - (let ((half-fov (* 0.5 (-> *camera-combiner* fov)))) + (let ((half-fov (/ (-> *camera-combiner* fov) 2))) (camera-fov-frame (-> *camera-combiner* inv-camera-rot) (camera-pos) half-fov @@ -688,22 +635,17 @@ 1.0 (new 'static 'vector4w :z #xff :w #x80))) (cond - ((= (-> slave blend-to-type) 2) - (let ((half-fov (* 0.5 (-> slave fov)))) - (camera-fov-frame (the-as matrix (-> *camera-combiner* tracking)) + ((= (-> slave blend-to-type) (camera-blend-to-type combiner-tracked)) + (let ((half-fov (/ (-> slave fov) 2))) + (camera-fov-frame (-> *camera-combiner* tracking inv-mat) (-> slave trans) half-fov 0.75 1.0 (new 'static 'vector4w :y #xff :w #x80)))) (else - (let ((half-fov (* 0.5 (-> slave fov)))) - (camera-fov-frame (the-as matrix (-> slave tracking)) - (-> slave trans) - half-fov - 0.75 - 1.0 - (new 'static 'vector4w :y #xff :w #x80))))) + (let ((half-fov (/ (-> slave fov) 2))) + (camera-fov-frame (-> slave tracking inv-mat) (-> slave trans) half-fov 0.75 1.0 (new 'static 'vector4w :y #xff :w #x80))))) (debug-draw (-> slave position-spline)) (let ((line-end (new-stack-vector0))) (let ((line-start (new-stack-vector0))) @@ -714,79 +656,80 @@ (= (-> slave next-state name) 'cam-point-watch) (= (-> slave next-state name) 'cam-free-floating) (= (-> slave next-state name) 'cam-orbit))) - (vector+float*! line-end (-> slave trans) (-> *camera* local-down) 4096.0) + (vector+float*! line-end (-> slave trans) (-> *camera* local-down) (meters 1)) (camera-line (-> slave trans) line-end (new 'static 'vector4w :x #xff :y #xff :z #xff :w #x80))) - ((= (-> slave blend-to-type) 2) + ((= (-> slave blend-to-type) (camera-blend-to-type combiner-tracked)) (camera-line (-> *camera-combiner* tracking follow-pt) (-> slave trans) (new 'static 'vector4w :x #xff :y #xff :z #xff :w #x80)) - (vector+float*! line-end (-> *camera-combiner* tracking follow-pt) (-> *camera* local-down) 4096.0) + (vector+float*! line-end (-> *camera-combiner* tracking follow-pt) (-> *camera* local-down) (meters 1)) (camera-line (-> *camera-combiner* tracking follow-pt) line-end (new 'static 'vector4w :x #xff :y #xff :z #xff :w #x80))) (else (camera-line (-> slave tracking follow-pt) (-> slave trans) (new 'static 'vector4w :x #xff :y #xff :z #xff :w #x80)) - (vector+float*! line-end (-> slave tracking follow-pt) (-> *camera* local-down) 4096.0) + (vector+float*! line-end (-> slave tracking follow-pt) (-> *camera* local-down) (meters 1)) (camera-line (-> slave tracking follow-pt) line-end (new 'static 'vector4w :x #xff :y #xff :z #xff :w #x80)))) - (set! (-> line-start quad) (-> slave trans quad)) + (vector-copy! line-start (-> slave trans)) (cond - ((= (-> slave blend-to-type) 2) - (vector+float*! line-end line-start (the-as vector (-> *camera-combiner* tracking)) 2048.0) + ((= (-> slave blend-to-type) (camera-blend-to-type combiner-tracked)) + (vector+float*! line-end line-start (-> *camera-combiner* tracking inv-mat vector 0) (meters 0.5)) (camera-line line-start line-end (new 'static 'vector4w :x #xff :w #x80)) - (vector+float*! line-end line-start (-> *camera-combiner* tracking inv-mat vector 1) 2048.0) + (vector+float*! line-end line-start (-> *camera-combiner* tracking inv-mat vector 1) (meters 0.5)) (camera-line line-start line-end (new 'static 'vector4w :y #xff :w #x80)) - (vector+float*! line-end line-start (-> *camera-combiner* tracking inv-mat vector 2) 2048.0) + (vector+float*! line-end line-start (-> *camera-combiner* tracking inv-mat vector 2) (meters 0.5)) (camera-line line-start line-end (new 'static 'vector4w :z #xff :w #x80))) (else - (vector+float*! line-end line-start (the-as vector (-> slave tracking)) 2048.0) + (vector+float*! line-end line-start (-> slave tracking inv-mat vector 0) (meters 0.5)) (camera-line line-start line-end (new 'static 'vector4w :x #xff :w #x80)) - (vector+float*! line-end line-start (-> slave tracking inv-mat vector 1) 2048.0) + (vector+float*! line-end line-start (-> slave tracking inv-mat vector 1) (meters 0.5)) (camera-line line-start line-end (new 'static 'vector4w :y #xff :w #x80)) - (vector+float*! line-end line-start (-> slave tracking inv-mat vector 2) 2048.0) + (vector+float*! line-end line-start (-> slave tracking inv-mat vector 2) (meters 0.5)) (camera-line line-start line-end (new 'static 'vector4w :z #xff :w #x80))))) (vector--float*! line-end (-> *camera* tpos-curr) (-> *camera* local-down) (-> *camera* foot-offset)) - (camera-sphere line-end 512.0 (the-as vector (new 'static 'vector4w :y #xff :w #x80))) + (camera-sphere line-end (meters 0.125) (new 'static 'vector4w :y #xff :w #x80)) (vector--float*! line-end (-> *camera* tpos-curr) (-> *camera* local-down) (-> *camera* head-offset)) - (camera-sphere line-end 512.0 (the-as vector (new 'static 'vector4w :y #xff :w #x80)))) + (camera-sphere line-end (meters 0.125) (new 'static 'vector4w :y #xff :w #x80))) (cond ((= (-> slave next-state name) 'cam-string) - (camera-sphere (-> slave desired-pos) 512.0 (the-as vector (new 'static 'vector4w :z #xff :w #x80))) + (camera-sphere (-> slave desired-pos) (meters 0.125) (new 'static 'vector4w :z #xff :w #x80)) (camera-line-rel (-> *camera* tpos-curr-adj) (-> slave view-flat) (new 'static 'vector4w :z #xff :w #x80)) (camera-line (-> slave string-trans) - (the-as vector (+ (the-as uint (-> *camera* target-spline)) (* 48 (-> slave los-tgt-spline-pt)))) + (-> *camera* target-spline point (-> slave los-tgt-spline-pt) position) (new 'static 'vector4w :y #xff :w #x80)) (camera-line (-> slave los-last-pos) - (the-as vector (+ (the-as uint (-> *camera* target-spline)) (* 48 (-> slave los-tgt-spline-pt)))) + (-> *camera* target-spline point (-> slave los-tgt-spline-pt) position) (new 'static 'vector4w :x #xff :w #x80))) ((= (-> slave next-state name) 'cam-circular) (let ((pivot-axis-end (new-stack-vector0))) - (vector+float*! pivot-axis-end (-> slave pivot-pt) (-> *camera* local-down) 4096.0) + (vector+float*! pivot-axis-end (-> slave pivot-pt) (-> *camera* local-down) (meters 1)) (camera-line (-> slave pivot-pt) pivot-axis-end (new 'static 'vector4w :x #xff :y #xff :z #xff :w #x80))) (camera-line (-> slave pivot-pt) (-> slave trans) (new 'static 'vector4w :x #xff :y #xff :z #xff :w #x80))) ((= (-> slave next-state name) 'cam-spline) (let ((path-data (new 'stack 'curve)) - (path-offset (res-lump-struct (-> slave cam-entity) 'spline-offset structure))) - (if (not path-offset) (set! path-offset (new-stack-vector0))) + (path-offset (res-lump-struct (-> slave cam-entity) 'spline-offset vector))) + (if (not (the-as structure path-offset)) + (set! path-offset (new-stack-vector0))) (when (get-curve-data! (-> slave cam-entity) path-data 'campath 'campath-k -1000000000.0) (let ((previous-point (new-stack-vector0)) (current-point (new-stack-vector0)) (authored-line (res-lump-data (-> slave cam-entity) 'campoints pointer :time 1.0))) (curve-get-pos! current-point 0.0 path-data) - (vector+! current-point current-point (the-as vector path-offset)) + (vector+! current-point current-point path-offset) (dotimes (i 8) - (set! (-> previous-point quad) (-> current-point quad)) + (vector-copy! previous-point current-point) (curve-get-pos! current-point (* 0.125 (the float (+ i 1))) path-data) - (vector+! current-point current-point (the-as vector path-offset)) + (vector+! current-point current-point path-offset) (camera-line previous-point current-point (new 'static 'vector4w :x #xff :y #xff :w #x80))) (dotimes (i (-> path-data num-cverts)) - (vector+! previous-point (-> path-data cverts i) (the-as vector path-offset)) - (vector+! current-point (-> path-data cverts (mod (+ i 1) (-> path-data num-cverts))) (the-as vector path-offset)) + (vector+! previous-point (-> path-data cverts i) path-offset) + (vector+! current-point (-> path-data cverts (mod (+ i 1) (-> path-data num-cverts))) path-offset) (camera-line previous-point current-point (new 'static 'vector4w :y #xff :z #xff :w #x80))) (if authored-line - (camera-line (the-as vector (&+ authored-line 0)) - (the-as vector (&+ authored-line 16)) - (new 'static 'vector4w :x #xff :y #xff :z #xff :w #x80)) - (camera-line (-> path-data cverts 0) - (-> path-data cverts (+ (-> path-data num-cverts) -1)) - (new 'static 'vector4w :x #xff :y #xff :z #xff :w #x80))))))))) + (camera-line (the-as vector (&+ authored-line 0)) + (the-as vector (&+ authored-line 16)) + (new 'static 'vector4w :x #xff :y #xff :z #xff :w #x80)) + (camera-line (-> path-data cverts 0) + (-> path-data cverts (+ (-> path-data num-cverts) -1)) + (new 'static 'vector4w :x #xff :y #xff :z #xff :w #x80))))))))) 0 (none)) @@ -795,40 +738,33 @@ non-null, also draw its normalized direction in yellow." (let ((axis-end (new-stack-vector0)) (axis-origin (new-stack-vector0))) - (let ((rotation (new-stack-matrix0))) (set-vector! axis-end 0.0 8192.0 0.0 1.0) (matrix-rotate-yxz! rotation axis-end)) + (let ((rotation (new-stack-matrix0))) + (set-vector! axis-end 0.0 (meters 2) 0.0 1.0) + (matrix-rotate-yxz! rotation axis-end)) (vector+! axis-origin (-> *camera-combiner* trans) - (vector-normalize-copy! axis-origin (-> *camera-combiner* inv-camera-rot vector 2) 24576.0)) + (vector-normalize-copy! axis-origin (-> *camera-combiner* inv-camera-rot vector 2) (meters 6))) (let ((axis-destination axis-end) (origin-copy axis-origin) (axis-offset axis-end)) - (set! (-> axis-offset x) 4096.0) - (set! (-> axis-offset y) 0.0) - (set! (-> axis-offset z) 0.0) - (set! (-> axis-offset w) 1.0) + (set-vector! axis-offset (meters 1) 0.0 0.0 1.0) (vector+! axis-destination origin-copy axis-offset)) (add-debug-line #t (bucket-id debug-no-zbuf) axis-origin axis-end (new 'static 'rgba :r #xff :a #x80) #f (the-as rgba -1)) - (let ((axis-destination axis-end) - (origin-copy axis-origin) - (axis-offset axis-end)) - (set! (-> axis-offset x) 0.0) - (set! (-> axis-offset y) 4096.0) - (set! (-> axis-offset z) 0.0) - (set! (-> axis-offset w) 1.0) - (vector+! axis-destination origin-copy axis-offset)) + (let ((axis-destination2 axis-end) + (origin-copy2 axis-origin) + (axis-offset2 axis-end)) + (set-vector! axis-offset2 0.0 (meters 1) 0.0 1.0) + (vector+! axis-destination2 origin-copy2 axis-offset2)) (add-debug-line #t (bucket-id debug-no-zbuf) axis-origin axis-end (new 'static 'rgba :g #xff :a #x80) #f (the-as rgba -1)) - (let ((axis-destination axis-end) - (origin-copy axis-origin) - (axis-offset axis-end)) - (set! (-> axis-offset x) 0.0) - (set! (-> axis-offset y) 0.0) - (set! (-> axis-offset z) 4096.0) - (set! (-> axis-offset w) 1.0) - (vector+! axis-destination origin-copy axis-offset)) + (let ((axis-destination3 axis-end) + (origin-copy3 axis-origin) + (axis-offset3 axis-end)) + (set-vector! axis-offset3 0.0 0.0 (meters 1) 1.0) + (vector+! axis-destination3 origin-copy3 axis-offset3)) (add-debug-line #t (bucket-id debug-no-zbuf) axis-origin axis-end (new 'static 'rgba :b #xff :a #x80) #f (the-as rgba -1)) (when direction - (set! (-> axis-end quad) (-> direction quad)) - (vector-normalize! axis-end 4096.0) + (vector-copy! axis-end direction) + (vector-normalize! axis-end (meters 1)) (vector+! axis-end axis-origin axis-end) (add-debug-line #t (bucket-id debug-no-zbuf) @@ -841,30 +777,26 @@ (none)) (deftype cam-collision-record (structure) - ((pos vector :inline :offset-assert 0) - (vel vector :inline :offset-assert 16) - (desired-pos vector :inline :offset-assert 32) - (cam-tpos-cur vector :inline :offset-assert 48) - (cam-tpos-old vector :inline :offset-assert 64) - (view-flat vector :inline :offset-assert 80) - (string-min-val vector :inline :offset-assert 96) - (string-max-val vector :inline :offset-assert 112) - (view-off vector :inline :offset-assert 128) - (min-z-override float :offset-assert 144) - (string-push-z float :offset-assert 148) - (view-off-param float :offset-assert 152) - (frame int32 :offset-assert 156) - (iteration int32 :offset-assert 160) - (move-type symbol :offset-assert 164)) - :method-count-assert 9 - :size-assert #xa8 - :flag-assert #x9000000a8) + ((pos vector :inline) + (vel vector :inline) + (desired-pos vector :inline) + (cam-tpos-cur vector :inline) + (cam-tpos-old vector :inline) + (view-flat vector :inline) + (string-min-val vector :inline) + (string-max-val vector :inline) + (view-off vector :inline) + (min-z-override float) + (string-push-z float) + (view-off-param float) + (frame int32) + (iteration int32) + (move-type symbol))) + (deftype cam-collision-record-array (inline-array-class) - ((data cam-collision-record :dynamic :offset-assert 16)) - :method-count-assert 9 - :size-assert #x10 - :flag-assert #x900000010) + ((data cam-collision-record :inline :dynamic))) + (set! (-> cam-collision-record-array heap-base) (the-as uint 176)) @@ -881,7 +813,7 @@ attempt to the 600-entry ring, including collision parameters and the camera-slave state needed to reproduce and inspect the probe." (when *record-cam-collide-history* - (let ((record (the-as cam-collision-record (+ (+ (* 176 *cam-collision-record-last*) 12) (the-as int *cam-collision-record*))))) + (let ((record (-> *cam-collision-record* data *cam-collision-record-last*))) (vector-copy! (-> record pos) position) (vector-copy! (-> record vel) velocity) (vector-copy! (-> record view-flat) (-> slave view-flat)) @@ -891,7 +823,7 @@ (vector-copy! (-> record string-min-val) (-> slave string-min-val)) (vector-copy! (-> record string-max-val) (-> slave string-max-val)) (vector-copy! (-> record view-off) (-> slave view-off)) - (set! (-> record frame) (the-as int (-> *display* base-frame-counter))) + (set! (-> record frame) (the-as int (current-time))) (set! (-> record iteration) iteration) (set! (-> record move-type) move-kind) (set! (-> record min-z-override) (-> slave min-z-override)) @@ -922,24 +854,30 @@ state, repeat its line-sphere probe, and draw the movement, hit triangle, intersection direction, and normal." (cond - ((cpad-pressed? 0 down) (cam-collision-record-step 1)) - ((cpad-hold? 0 right) (cam-collision-record-step 1)) - ((cpad-pressed? 0 up) (cam-collision-record-step -1)) - ((cpad-hold? 0 left) (cam-collision-record-step -1))) - (let ((record (the-as cam-collision-record (+ (+ (* 176 *cam-collision-record-show*) 12) (the-as int *cam-collision-record*)))) + ((cpad-pressed? 0 down) + (cam-collision-record-step 1)) + ((cpad-hold? 0 right) + (cam-collision-record-step 1)) + ((cpad-pressed? 0 up) + (cam-collision-record-step -1)) + ((cpad-hold? 0 left) + (cam-collision-record-step -1))) + (let ((record (-> *cam-collision-record* data *cam-collision-record-show*)) (movement-color (new 'stack 'vector4w)) (collision-color (new 'stack 'vector4w))) (format *stdcon* "move-type ~A~%" (-> record move-type)) (cond - ((= (-> record move-type) 'normal) (set! (-> movement-color x) 255) (set! (-> movement-color y) 255)) - ((= (-> record move-type) 'jump) (set! (-> movement-color x) 255)) - ((= (-> record move-type) 'no-hit) (set! (-> movement-color y) 255)) - (else (set! (-> movement-color z) 255))) + ((= (-> record move-type) 'normal) + (set! (-> movement-color x) 255) + (set! (-> movement-color y) 255)) + ((= (-> record move-type) 'jump) + (set! (-> movement-color x) 255)) + ((= (-> record move-type) 'no-hit) + (set! (-> movement-color y) 255)) + (else + (set! (-> movement-color z) 255))) (set! (-> movement-color w) 128) - (set! (-> collision-color x) 127) - (set! (-> collision-color y) 127) - (set! (-> collision-color z) 127) - (set! (-> collision-color w) 128) + (set-vector! collision-color 127 127 127 128) (camera-line-rel-len (-> record pos) (-> record vel) (fmax 81.92 (vector-length (-> record vel))) movement-color) (let* ((hit (new 'stack-no-clear 'collide-tri-result)) (travel (fill-and-probe-using-line-sphere *collide-cache* @@ -975,9 +913,9 @@ (-> record string-max-val z)) (format *stdcon* "vof ~M ~M ~M~%" (-> record view-off x) (-> record view-off y) (-> record view-off z)) (when (>= travel 0.0) - (camera-line (the-as vector (-> hit vertex)) (-> hit vertex 1) movement-color) + (camera-line (-> hit vertex 0) (-> hit vertex 1) movement-color) (camera-line (-> hit vertex 1) (-> hit vertex 2) movement-color) - (camera-line (-> hit vertex 2) (the-as vector (-> hit vertex)) movement-color) + (camera-line (-> hit vertex 2) (-> hit vertex 0) movement-color) (vector-! toward-start (-> record pos) (-> hit intersect)) (vector-normalize! toward-start 1.0) (camera-line-rel-len (-> hit intersect) toward-start (-> *CAMERA-bank* collide-move-rad) collision-color) @@ -990,21 +928,22 @@ alternate-camera geometry, last attacker, saved performance statistics, collision history, target spline, coordinate axes, and collision triangles." (when *display-cam-other* - (let ((half-fov (* 0.5 (-> *camera-other-fov* data)))) + (let ((half-fov (/ (-> *camera-other-fov* data) 2))) (camera-fov-frame *camera-other-matrix* *camera-other-trans* half-fov 0.75 1.0 (new 'static 'vector4w :x #xff :w #x80))) (camera-line *camera-other-trans* *camera-other-root* (new 'static 'vector4w :x #xff :y #xff :z #xff :w #x80)) (let ((axis-end (new 'stack-no-clear 'vector)) (axis-origin *camera-other-trans*)) - (vector+float*! axis-end axis-origin (the-as vector (-> *camera-other-matrix* vector)) 2048.0) + (vector+float*! axis-end axis-origin (-> *camera-other-matrix* vector 0) (meters 0.5)) (camera-line axis-origin axis-end (new 'static 'vector4w :x #xff :w #x80)) - (vector+float*! axis-end axis-origin (-> *camera-other-matrix* vector 1) 2048.0) + (vector+float*! axis-end axis-origin (-> *camera-other-matrix* vector 1) (meters 0.5)) (camera-line axis-origin axis-end (new 'static 'vector4w :y #xff :w #x80)) - (vector+float*! axis-end axis-origin (-> *camera-other-matrix* vector 2) 2048.0) + (vector+float*! axis-end axis-origin (-> *camera-other-matrix* vector 2) (meters 0.5)) (camera-line axis-origin axis-end (new 'static 'vector4w :z #xff :w #x80)))) (when *display-camera-last-attacker* (format *stdcon* "last attacker '") (let ((last-attacker (handle->process (-> last-try-to-look-at-data who)))) - (if last-attacker (format *stdcon* "~S" (-> last-attacker name)))) + (if last-attacker + (format *stdcon* "~S" (-> last-attacker name)))) (format *stdcon* "'~%")) (when *display-camera-old-stats* (format *stdcon* @@ -1016,9 +955,12 @@ (format *stdcon* "~S~%" *camera-old-stat-string-tfrag-near*) (format *stdcon* "~S~%" *camera-old-stat-string-tfrag*) (format *stdcon* "~S~%" *camera-old-stat-string-total*)) - (if *display-cam-collide-history* (cam-collision-record-draw)) - (if *display-cam-master-marks* (debug-draw (-> cam-master target-spline))) - (if *display-xyz-axes* (master-draw-coordinates (the-as vector #f))) + (if *display-cam-collide-history* + (cam-collision-record-draw)) + (if *display-cam-master-marks* + (debug-draw (-> cam-master target-spline))) + (if *display-xyz-axes* + (master-draw-coordinates (the-as vector #f))) (cam-debug-draw-tris) 0 (none)) diff --git a/goal_src/jak1/engine/camera/cam-interface-h.gc b/goal_src/jak1/engine/camera/cam-interface-h.gc index 905976f50c..d0b7f0d58f 100644 --- a/goal_src/jak1/engine/camera/cam-interface-h.gc +++ b/goal_src/jak1/engine/camera/cam-interface-h.gc @@ -4,15 +4,11 @@ (require "engine/camera/camera-h.gc") (require "engine/math/matrix-h.gc") -;; NOTE - forward declaration needed for cam-interface -(define-extern *camera-dummy-vector* vector) - -(define-extern *camera* camera-master) ;; unknown type +;; DECOMP BEGINS ;; Input gates shared by normal and debug camera states. Camera-layout and ;; object editors disable these while they own the controls. (define *camera-read-analog* #t) - (define *camera-read-buttons* #t) ;; Allow the debug free camera's shoulder controls to move along camera z. @@ -25,13 +21,10 @@ ;; The persistent processes that coordinate camera selection and blend the ;; active camera behaviors. (define-perm *camera* camera-master #f) - (define-perm *camera-combiner* camera-combiner #f) ;; Optional drawable followed by the debug orbit camera. (define-perm *camera-orbit-target* (pointer process-drawable) #f) (define-extern position-in-front-of-camera! (function vector float float vector)) - -;; TODO - forward declaration for weather-part (define-extern matrix-local->world (function symbol symbol matrix)) diff --git a/goal_src/jak1/engine/camera/cam-interface.gc b/goal_src/jak1/engine/camera/cam-interface.gc index dd1d53b9a6..1f33013e35 100644 --- a/goal_src/jak1/engine/camera/cam-interface.gc +++ b/goal_src/jak1/engine/camera/cam-interface.gc @@ -8,6 +8,8 @@ (require "engine/entity/entity-h.gc") (require "engine/math/transformq-h.gc") +;; DECOMP BEGINS + (defun position-in-front-of-camera! ((out vector) (forward-distance float) (up-distance float)) "Place out at forward-distance along the camera's forward axis and up-distance along its up axis, measured from the current camera translation." @@ -20,7 +22,9 @@ "Return the camera local-to-world rotation. smooth? selects the smoothed inverse-camera matrix; the second argument is retained for the shared interface but is unused." - (if smooth? (-> *math-camera* inv-camera-rot-smooth) (-> *math-camera* inv-camera-rot))) + (if smooth? + (-> *math-camera* inv-camera-rot-smooth) + (-> *math-camera* inv-camera-rot))) (defun matrix-world->local () "Return the current world-to-camera rotation matrix." @@ -32,11 +36,13 @@ "Return the active camera position. Prefer the combiner output while a camera transition is active, otherwise use the renderer camera, with a zero-vector fallback before camera initialization." - (the-as vector - (cond - (*camera-combiner* (-> *camera-combiner* stack)) - (*math-camera* (-> *math-camera* trans)) - (else *camera-dummy-vector*)))) + (cond + (*camera-combiner* + (-> *camera-combiner* trans)) + (*math-camera* + (-> *math-camera* trans)) + (else + *camera-dummy-vector*))) (defun math-camera-pos () "Return the renderer's current camera translation." @@ -50,11 +56,9 @@ (atan right-z right-x))) (defbehavior camera-teleport-to-entity process ((start-entity entity-actor)) - "Build a unit-scale camera transform from start-entity's - orientation and the position stored in the scale vector of its extra transform, then send it to - the camera master as an immediate teleport." + "Teleport the camera to the entity position." (let ((teleport-transform (new 'stack 'transformq))) - (vector-copy! (-> teleport-transform trans) (-> (the-as transform (-> start-entity extra)) scale)) + (vector-copy! (-> teleport-transform trans) (-> start-entity extra trans)) (quaternion-copy! (-> teleport-transform quat) (-> start-entity quat)) (vector-identity! (-> teleport-transform scale)) (send-event *camera* 'teleport-to-transformq teleport-transform)) diff --git a/goal_src/jak1/engine/camera/cam-layout.gc b/goal_src/jak1/engine/camera/cam-layout.gc index 0266adec68..2edce7acdc 100644 --- a/goal_src/jak1/engine/camera/cam-layout.gc +++ b/goal_src/jak1/engine/camera/cam-layout.gc @@ -29,6 +29,7 @@ (debug-t float) (debug-step float))) + (define *CAM_LAYOUT-bank* (new 'static 'cam-layout-bank @@ -43,6 +44,7 @@ (deftype clm-basic (basic) ()) + (deftype clm-item-action (structure) ((button uint64) (options uint64) @@ -52,11 +54,13 @@ (parm1-basic basic :offset 24) (parm1 symbol :overlay-at parm1-basic))) + (deftype clm-item (clm-basic) ((description string) (button-symbol symbol) (action clm-item-action :inline))) + (deftype clm-list-item (basic) ((description string) (track-val symbol) @@ -67,15 +71,18 @@ (val-parm1 symbol :overlay-at val-parm1-basic) (actions (array clm-item-action)))) + (deftype clm-list (clm-basic) ((tracker symbol) (cur-list-item int32) (items (array clm-list-item)))) + (deftype clm (basic) ((title string) (items (array clm-basic)))) + (define *volume-point-current* 0) (define *volume-point* (new 'debug 'vector-array 1000)) @@ -87,6 +94,7 @@ (deftype volume-descriptor-array (inline-array-class) ((data plane-volume :inline :dynamic :offset 16))) + (set! (-> volume-descriptor-array heap-base) (the-as uint 24)) (define *volume-descriptor-current* 0) @@ -106,55 +114,30 @@ (:states cam-layout-active)) + (defun cam-layout-print ((x int) (y int) (text string)) "Draw debug text at screen coordinates x and y, terminate its DMA chain, and insert the result in the current frame's debug bucket." - (with-dma-buffer-add-bucket ((dma-buf (-> *display* frames (-> *display* on-screen) frame debug-buf)) (bucket-id debug)) :bucket-group (-> *display* frames (-> *display* on-screen) frame bucket-group) (draw-string-xy text dma-buf x y (font-color white) (font-flags shadow kerning)))) + (with-dma-buffer-add-bucket ((dma-buf (-> (current-frame) debug-buf)) (bucket-id debug)) + (draw-string-xy text dma-buf x y (font-color white) (font-flags shadow kerning)))) (defun cam-layout-intersect-dist ((plane vector) (point vector) (direction vector)) "Return the signed distance along direction from point to plane, or a large sentinel when the direction is nearly parallel to the plane." (let ((point-dot (vector-dot point plane)) (direction-dot (vector-dot direction plane))) - (the-as float (if (< 0.00001 (fabs direction-dot)) (/ (- (-> plane w) point-dot) direction-dot) 409600000.0)))) + (if (< 0.00001 (fabs direction-dot)) + (/ (- (-> plane w) point-dot) direction-dot) + 409600000.0))) (defbehavior cam-layout-entity-volume-info-create cam-layout ((camera entity-camera) (volume-type symbol)) "Read consecutive plane arrays of volume-type from camera, reconstruct each convex volume's clipped plane-intersection edges, and append its draw segments plus plane-centroid records to the fixed camera-layout preview buffers. Return false at the first missing property or full buffer." - ;; A plane stores dot(normal, point) in w. For each pair of planes, cross their normals to get the - ;; direction of the common line and solve for one point on that line. Every remaining plane clips - ;; the line to the convex volume. A surviving pair of clip boundaries becomes one wireframe - ;; segment; a 4096-unit tolerance admits points just outside a face. - ;; - ;; The segment endpoints for each primary plane are averaged as a point from which that plane's - ;; normal can be displayed. Ordered plane pairs may describe the same geometric edge twice, which - ;; is harmless for this debug wireframe. - (local-vars - (tag res-tag) - (segment-start vector) - (segment-distance float) - (clip-count int) - (clip-plane vector) - (point-on-plane vector) - (line-direction vector) - (in-plane-direction vector) - (candidate-point vector) - (points-added int) - (other-plane-index int) - (clip-plane-index int)) (let ((property-index 0)) (loop - (set! tag (new 'static 'res-tag)) - (let ((planes (the-as (inline-array vector) - ((method-of-type res-lump get-property-data) - camera - volume-type - 'exact - (the float property-index) - (the-as pointer #f) - (& tag) - *res-static-buf*)))) + (let* ((tag (new 'static 'res-tag)) + (planes (res-lump-data-exact camera volume-type (inline-array vector) :tag-ptr (& tag) :time (the float property-index)))) (cond (planes (when (>= *volume-descriptor-current* 100) @@ -163,99 +146,92 @@ (let ((descriptor (-> *volume-descriptor* pos-vol *volume-descriptor-current*))) (set! (-> descriptor volume-type) volume-type) (set! (-> descriptor point-count) 0) - (set! (-> descriptor first-point) (the-as (pointer vector) (-> *volume-point* data *volume-point-current*))) + (set! (-> descriptor first-point) (&-> *volume-point* data *volume-point-current*)) (set! (-> descriptor normal-count) 0) - (set! (-> descriptor first-normal) (the-as (pointer vector) (-> *volume-normal* data *volume-normal-current*))) + (set! (-> descriptor first-normal) (&-> *volume-normal* data *volume-normal-current*)) (set! *volume-descriptor-current* (+ *volume-descriptor-current* 1)) (+! (-> self num-volumes) 1) (dotimes (plane-index (the-as int (-> tag elt-count))) - (set! point-on-plane (new 'stack-no-clear 'vector)) - (set! (-> point-on-plane quad) (the-as uint128 0)) - (set! line-direction (new 'stack-no-clear 'vector)) - (set! (-> line-direction quad) (the-as uint128 0)) - (set! in-plane-direction (new 'stack-no-clear 'vector)) - (set! (-> in-plane-direction quad) (the-as uint128 0)) - (set! candidate-point (new 'stack-no-clear 'vector)) - (set! (-> candidate-point quad) (the-as uint128 0)) - 0.0 - 0.0 - 0.0 - (set! (-> (new 'stack-no-clear 'vector) quad) (the-as uint128 0)) - (let ((point-sum (new-stack-vector0))) - (set! points-added 0) - (set! other-plane-index 0) - (while (< other-plane-index (the-as int (-> tag elt-count))) - (when (!= plane-index other-plane-index) - (vector-float*! point-on-plane (-> planes other-plane-index) (-> planes other-plane-index w)) - (vector-cross! line-direction (-> planes other-plane-index) (-> planes plane-index)) - (vector-normalize! line-direction (the-as float 1.0)) - (vector-cross! in-plane-direction line-direction (-> planes other-plane-index)) - (vector-normalize! in-plane-direction (the-as float 1.0)) - (let ((line-distance (cam-layout-intersect-dist (-> planes plane-index) point-on-plane in-plane-direction))) - (when (!= line-distance 409600000.0) - (vector+float*! candidate-point point-on-plane in-plane-direction line-distance) - (set! segment-start (new-stack-vector0)) - (set! segment-distance 0.0) - (set! clip-count 0) - (set! clip-plane (new-stack-vector0)) - (vector-copy! segment-start candidate-point) - (set! clip-plane-index 0) - (while (< clip-plane-index (the-as int (-> tag elt-count))) - (when (and (!= clip-plane-index plane-index) (!= clip-plane-index other-plane-index)) - (let ((clip-distance (cam-layout-intersect-dist (-> planes clip-plane-index) segment-start line-direction))) + (let ((point-on-plane (new-stack-vector0)) + (line-direction (new-stack-vector0)) + (in-plane-direction (new-stack-vector0)) + (candidate-point (new-stack-vector0))) + 0.0 + 0.0 + 0.0 + (set! (-> (new 'stack-no-clear 'vector) quad) (the-as uint128 0)) + (let ((point-sum (new-stack-vector0)) + (points-added 0)) + (let ((other-plane-index 0)) + (while (< other-plane-index (the-as int (-> tag elt-count))) + (when (!= plane-index other-plane-index) + (vector-float*! point-on-plane (-> planes other-plane-index) (-> planes other-plane-index w)) + (vector-cross! line-direction (-> planes other-plane-index) (-> planes plane-index)) + (vector-normalize! line-direction 1.0) + (vector-cross! in-plane-direction line-direction (-> planes other-plane-index)) + (vector-normalize! in-plane-direction 1.0) + (let ((line-distance (cam-layout-intersect-dist (-> planes plane-index) point-on-plane in-plane-direction))) + (when (!= line-distance 409600000.0) + (vector+float*! candidate-point point-on-plane in-plane-direction line-distance) + (let ((segment-start (new-stack-vector0)) + (segment-distance 0.0) + (clip-count 0)) + (let ((clip-plane (new-stack-vector0))) + (set! (-> segment-start quad) (-> candidate-point quad)) + (let ((clip-plane-index 0)) + (while (< clip-plane-index (the-as int (-> tag elt-count))) + (when (and (!= clip-plane-index plane-index) (!= clip-plane-index other-plane-index)) + (let ((clip-distance (cam-layout-intersect-dist (-> planes clip-plane-index) segment-start line-direction))) + (cond + ((= clip-distance 409600000.0)) + ((zero? clip-count) + (vector+float*! segment-start segment-start line-direction clip-distance) + (set! (-> clip-plane quad) (-> planes clip-plane-index quad)) + (set! segment-distance 8192000.0) + (set! clip-count 1)) + ((begin (vector-float*! candidate-point line-direction clip-distance) (>= (vector-dot candidate-point clip-plane) 0.0))) + ((>= (vector-dot candidate-point (-> planes clip-plane-index)) 0.0) + (when (< (fabs clip-distance) (fabs segment-distance)) + (set! segment-distance clip-distance) + (+! clip-count 1))) + (else + (vector+float*! segment-start segment-start line-direction clip-distance) + (set! (-> clip-plane quad) (-> planes clip-plane-index quad)) + (+! clip-count 1) + (set! segment-distance (if (< (fabs clip-distance) (fabs segment-distance)) (- segment-distance clip-distance) 0.0)))))) + (+! clip-plane-index 1)))) (cond - ((= clip-distance 409600000.0)) - ((zero? clip-count) - (vector+float*! segment-start segment-start line-direction clip-distance) - (set! (-> clip-plane quad) (-> planes clip-plane-index quad)) - (set! segment-distance 8192000.0) - (set! clip-count 1)) - ((begin (vector-float*! candidate-point line-direction clip-distance) (>= (vector-dot candidate-point clip-plane) 0.0))) - ((>= (vector-dot candidate-point (-> planes clip-plane-index)) 0.0) - (when (< (fabs clip-distance) (fabs segment-distance)) - (set! segment-distance clip-distance) - (+! clip-count 1))) + ((zero? clip-count)) + ((= segment-distance 0.0)) (else - (vector+float*! segment-start segment-start line-direction clip-distance) - (set! (-> clip-plane quad) (-> planes clip-plane-index quad)) - (+! clip-count 1) - (set! segment-distance - (cond - ((< (fabs clip-distance) (fabs segment-distance)) - (set! segment-distance (- segment-distance clip-distance)) - segment-distance) - (else 0.0))))))) - (+! clip-plane-index 1)) - (cond - ((zero? clip-count)) - ((= segment-distance 0.0)) - (else - (dotimes (test-plane-index (the-as int (-> tag elt-count))) - (when (and (!= test-plane-index plane-index) (!= test-plane-index other-plane-index)) - (if (< 4096.0 (- (vector-dot segment-start (-> planes test-plane-index)) (-> planes test-plane-index w))) (goto cfg-47)))) - (vector+float*! candidate-point segment-start line-direction segment-distance) - (cond - ((>= *volume-point-current* 999) (format 0 "ERROR : camera editing out of volume points~%")) - (else - (set! (-> *volume-point* data *volume-point-current* quad) (-> segment-start quad)) - (set! (-> *volume-point* data (+ *volume-point-current* 1) quad) (-> candidate-point quad)) - (set! *volume-point-current* (+ *volume-point-current* 2)) - (+! (-> descriptor point-count) 2))) - (vector+! point-sum point-sum segment-start) - (vector+! point-sum point-sum candidate-point) - (+! points-added 2) - points-added))))) - (label cfg-47) - (+! other-plane-index 1)) - (when (nonzero? points-added) - (vector-float*! point-sum point-sum (/ 1.0 (the float points-added))) - (cond - ((>= *volume-normal-current* 599) (format 0 "ERROR : camera editing out of volume normals~%")) - (else - (set! (-> *volume-normal* data *volume-normal-current* quad) (-> point-sum quad)) - (set! (-> *volume-normal* data (+ *volume-normal-current* 1) quad) (-> planes plane-index quad)) - (set! *volume-normal-current* (+ *volume-normal-current* 2)) - (set! (-> descriptor normal-count) (+ (-> descriptor normal-count) 2))))))))) + (dotimes (test-plane-index (the-as int (-> tag elt-count))) + (when (and (!= test-plane-index plane-index) (!= test-plane-index other-plane-index)) + (if (< 4096.0 (- (vector-dot segment-start (-> planes test-plane-index)) (-> planes test-plane-index w))) (goto cfg-47)))) + (vector+float*! candidate-point segment-start line-direction segment-distance) + (cond + ((>= *volume-point-current* 999) + (format 0 "ERROR : camera editing out of volume points~%")) + (else + (set! (-> *volume-point* data *volume-point-current* quad) (-> segment-start quad)) + (set! (-> *volume-point* data (+ *volume-point-current* 1) quad) (-> candidate-point quad)) + (set! *volume-point-current* (+ *volume-point-current* 2)) + (+! (-> descriptor point-count) 2))) + (vector+! point-sum point-sum segment-start) + (vector+! point-sum point-sum candidate-point) + (+! points-added 2) + points-added)))))) + (label cfg-47) + (+! other-plane-index 1))) + (when (nonzero? points-added) + (vector-float*! point-sum point-sum (/ 1.0 (the float points-added))) + (cond + ((>= *volume-normal-current* 599) + (format 0 "ERROR : camera editing out of volume normals~%")) + (else + (vector-copy! (-> *volume-normal* data *volume-normal-current*) point-sum) + (vector-copy! (-> *volume-normal* data (+ *volume-normal-current* 1)) (-> planes plane-index)) + (set! *volume-normal-current* (+ *volume-normal-current* 2)) + (set! (-> descriptor normal-count) (+ (-> descriptor normal-count) 2)))))))))) (else (return #f)))) (+! property-index 1))) (the-as symbol #f)) @@ -272,14 +248,25 @@ (let ((descriptor (-> *volume-descriptor* pos-vol volume-index))) (let ((color (new 'static 'vector4w :w #x80))) (cond - ((= (-> descriptor volume-type) 'vol) (set! (-> color x) 0) (set! (-> color y) 192) (set! (-> color z) 0) 0) - ((= (-> descriptor volume-type) 'pvol) (set! (-> color x) 128) (set! (-> color y) 128) (set! (-> color z) 128)) - ((= (-> descriptor volume-type) 'cutoutvol) (set! (-> color x) 192) (set! (-> color y) 0) (set! (-> color z) 0) 0)) + ((= (-> descriptor volume-type) 'vol) + (set! (-> color x) 0) + (set! (-> color y) 192) + (set! (-> color z) 0) + 0) + ((= (-> descriptor volume-type) 'pvol) + (set! (-> color x) 128) + (set! (-> color y) 128) + (set! (-> color z) 128)) + ((= (-> descriptor volume-type) 'cutoutvol) + (set! (-> color x) 192) + (set! (-> color y) 0) + (set! (-> color z) 0) + 0)) (camera-line-setup color)) - (let ((segment (the-as object (-> descriptor first-point)))) + (let ((segment (-> descriptor first-point))) (dotimes (segment-index (/ (-> descriptor point-count) 2)) - (camera-line-draw (the-as vector segment) (&+ (the-as vector segment) 16)) - (set! segment (&-> (the-as (inline-array plane-volume) segment) 1 first-point)))))))) + (camera-line-draw (-> segment 0) (-> segment 1)) + (set! segment (&-> segment 2)))))))) #f) (defun v-slrp! ((dst vector) (from vector) (to vector) (t float)) @@ -294,10 +281,10 @@ 0.0 0.0 (cond - ((< 1.0 t) (set! t (the-as float 1.0))) - ((< t 0.0) (set! t (the-as float 0.0)))) - (vector-normalize-copy! from-unit from (the-as float 1.0)) - (vector-normalize-copy! to-unit to (the-as float 1.0)) + ((< 1.0 t) (set! t 1.0)) + ((< t 0.0) (set! t 0.0))) + (vector-normalize-copy! from-unit from 1.0) + (vector-normalize-copy! to-unit to 1.0) (vector-cross! cross from-unit to-unit) (let* ((sin-angle (vector-length cross)) (angle (asin sin-angle))) @@ -312,32 +299,34 @@ (axis vector) (disp string))) + (defun interp-test ((interpolator (function vector vector vector float vector float none)) (info interp-test-info)) "Draw ten segments sampled from interpolator, then draw and print the current debug-t sample." (let ((current (new-stack-vector0)) (previous (new-stack-vector0))) - (interpolator current (-> info from) (-> info to) (the-as float 0.0) (-> info axis) (the-as float 65536.0)) + (interpolator current (-> info from) (-> info to) 0.0 (-> info axis) 65536.0) (vector+! current current (-> info origin)) (dotimes (i 10) - (set! (-> previous quad) (-> current quad)) - (interpolator current (-> info from) (-> info to) (* 0.1 (+ 1.0 (the float i))) (-> info axis) (the-as float 65536.0)) + (vector-copy! previous current) + (interpolator current (-> info from) (-> info to) (* 0.1 (+ 1.0 (the float i))) (-> info axis) 65536.0) (vector+! current current (-> info origin)) (camera-line current previous (-> info color))) - (interpolator previous (-> info from) (-> info to) (-> *CAM_LAYOUT-bank* debug-t) (-> info axis) (the-as float 65536.0)) + (interpolator previous (-> info from) (-> info to) (-> *CAM_LAYOUT-bank* debug-t) (-> info axis) 65536.0) (format *stdcon* "~S ~f~%" (-> info disp) (vector-length previous)) (vector+! previous previous (-> info origin)) (camera-line (-> info origin) previous (-> info color)) - (camera-cross (new 'static 'vector :y 1024.0) (new 'static 'vector :z 1024.0) previous (-> info color) (meters 1)))) + (camera-cross (new 'static 'vector :y 1024.0) (new 'static 'vector :z 1024.0) previous (-> info color) (meters 1))) + (none)) (defun interp-test-deg ((interpolator (function vector vector vector vector float none)) (info interp-test-info)) "Draw ten eighteen-degree samples from an angle-based interpolator, then draw and print the current debug-t sample over 180 degrees." (let ((current (new-stack-vector0)) (previous (new-stack-vector0))) - (interpolator current (-> info from) (-> info to) (-> info axis) (the-as float 0.0)) + (interpolator current (-> info from) (-> info to) (-> info axis) 0.0) (vector+! current current (-> info origin)) (dotimes (i 10) - (set! (-> previous quad) (-> current quad)) + (vector-copy! previous current) (interpolator current (-> info from) (-> info to) (-> info axis) (* 182.04445 (* 18.0 (+ 1.0 (the float i))))) (vector+! current current (-> info origin)) (camera-line current previous (-> info color))) @@ -349,13 +338,16 @@ (format *stdcon* "~S ~f~%" (-> info disp) (vector-length previous)) (vector+! previous previous (-> info origin)) (camera-line (-> info origin) previous (-> info color)) - (camera-cross (new 'static 'vector :y 1024.0) (new 'static 'vector :z 1024.0) previous (-> info color) (meters 1)))) + (camera-cross (new 'static 'vector :y 1024.0) (new 'static 'vector :z 1024.0) previous (-> info color) (meters 1))) + (none)) -(defun cam-layout-entity-info ((camera entity-actor)) +;; WARN: rewrite_to_get_var got a none typed variable. Is there unreachable code? [OP: 2] +(defun cam-layout-entity-info ((camera entity-camera)) "Draw the selected camera's frustum, pivot, alignment and interest points, camera and intro splines, index points, and interpolation diagnostics. The selected item blinks off every eight frames." - (if (not camera) (return #f)) + (if (not camera) + (return (the-as basic #f))) (let ((camera-rotation (new-stack-matrix0)) (camera-position (new-stack-vector0))) (when (and (cam-slave-get-vector-with-offset camera camera-position 'trans) @@ -364,59 +356,50 @@ (camera-fov-frame camera-rotation camera-position (* 0.5 (cam-slave-get-fov camera)) - (the-as float 0.75) - (the-as float 1.0) + 0.75 + 1.0 (new 'static 'vector4w :z #xff :w #x80)))) (let ((pivot (new-stack-vector0))) (if (and (cam-slave-get-vector-with-offset camera pivot 'pivot) - (or (!= *camera-layout-blink* 'pivot) (logtest? (-> *display* real-actual-frame-counter) 8))) - (camera-cross (new 'static 'vector :y 1024.0) - (new 'static 'vector :z 1024.0) - pivot - (new 'static 'vector4w :x #x80 :w #x80) - (meters 1)))) + (or (!= *camera-layout-blink* 'pivot) (logtest? (-> *display* real-actual-frame-counter) 8))) + (camera-cross (new 'static 'vector :y 1024.0) + (new 'static 'vector :z 1024.0) + pivot + (new 'static 'vector4w :x #x80 :w #x80) + (meters 1)))) (let ((align (new-stack-vector0))) (if (and (cam-slave-get-vector-with-offset camera align 'align) - (or (!= *camera-layout-blink* 'align) (logtest? (-> *display* real-actual-frame-counter) 8))) - (camera-cross (new 'static 'vector :y 1024.0) - (new 'static 'vector :z 1024.0) - align - (new 'static 'vector4w :y #x80 :w #x80) - (meters 1)))) + (or (!= *camera-layout-blink* 'align) (logtest? (-> *display* real-actual-frame-counter) 8))) + (camera-cross (new 'static 'vector :y 1024.0) + (new 'static 'vector :z 1024.0) + align + (new 'static 'vector4w :y #x80 :w #x80) + (meters 1)))) (let ((interesting (new-stack-vector0))) (if (and (cam-slave-get-vector-with-offset camera interesting 'interesting) - (or (!= *camera-layout-blink* 'interesting) (logtest? (-> *display* real-actual-frame-counter) 8))) - (camera-cross (new 'static 'vector :y 1024.0) - (new 'static 'vector :z 1024.0) - interesting - (new 'static 'vector4w :x #x80 :z #x80 :w #x80) - (meters 1)))) + (or (!= *camera-layout-blink* 'interesting) (logtest? (-> *display* real-actual-frame-counter) 8))) + (camera-cross (new 'static 'vector :y 1024.0) + (new 'static 'vector :z 1024.0) + interesting + (new 'static 'vector4w :x #x80 :z #x80 :w #x80) + (meters 1)))) (let ((camera-curve (new 'stack 'curve)) (previous-point (new-stack-vector0)) (curve-point (new-stack-vector0)) (camera-curve-offset (new-stack-vector0))) - (when (and (get-curve-data! camera camera-curve 'campath 'campath-k (the-as float -1000000000.0)) + (when (and (get-curve-data! camera camera-curve 'campath 'campath-k -1000000000.0) (or (!= *camera-layout-blink* 'spline) (logtest? (-> *display* real-actual-frame-counter) 8))) (cond ((cam-slave-get-vector-with-offset camera camera-curve-offset 'pivot) - (curve-get-pos! curve-point (the-as float 0.0) camera-curve) + (curve-get-pos! curve-point 0.0 camera-curve) (vector-! camera-curve-offset camera-curve-offset curve-point)) (else (set! (-> camera-curve-offset quad) - (-> (the-as vector - ((method-of-type res-lump get-property-struct) - camera - 'spline-offset - 'interp - (the-as float -1000000000.0) - camera-curve-offset - (the-as (pointer res-tag) #f) - *res-static-buf*)) - quad)))) - (curve-get-pos! curve-point (the-as float 0.0) camera-curve) + (-> (res-lump-struct camera 'spline-offset vector :default camera-curve-offset) quad)))) + (curve-get-pos! curve-point 0.0 camera-curve) (vector+! curve-point curve-point camera-curve-offset) (dotimes (i 8) - (set! (-> previous-point quad) (-> curve-point quad)) + (vector-copy! previous-point curve-point) (curve-get-pos! curve-point (* 0.125 (the float (+ i 1))) camera-curve) (vector+! curve-point curve-point camera-curve-offset) (camera-line previous-point curve-point (new 'static 'vector4w :x #xff :y #xff :w #x80))) @@ -432,23 +415,23 @@ (curve-point (new-stack-vector0)) (intro-curve-offset (new-stack-vector0)) (camera-curve (new 'stack 'curve))) - (when (and (get-curve-data! camera intro-curve 'intro 'intro-k (the-as float -1000000000.0)) + (when (and (get-curve-data! camera intro-curve 'intro 'intro-k -1000000000.0) (or (!= *camera-layout-blink* 'intro) (logtest? (-> *display* real-actual-frame-counter) 8))) (cond ((cam-slave-get-vector-with-offset camera intro-curve-offset 'pivot) - (curve-get-pos! curve-point (the-as float 1.0) intro-curve) + (curve-get-pos! curve-point 1.0 intro-curve) (vector-! intro-curve-offset intro-curve-offset curve-point)) - ((get-curve-data! camera camera-curve 'campath 'campath-k (the-as float -1000000000.0)) - (curve-get-pos! intro-curve-offset (the-as float 0.0) camera-curve) - (curve-get-pos! curve-point (the-as float 1.0) intro-curve) + ((get-curve-data! camera camera-curve 'campath 'campath-k -1000000000.0) + (curve-get-pos! intro-curve-offset 0.0 camera-curve) + (curve-get-pos! curve-point 1.0 intro-curve) (vector-! intro-curve-offset intro-curve-offset curve-point)) ((cam-slave-get-vector-with-offset camera intro-curve-offset 'trans) - (curve-get-pos! curve-point (the-as float 1.0) intro-curve) + (curve-get-pos! curve-point 1.0 intro-curve) (vector-! intro-curve-offset intro-curve-offset curve-point))) - (curve-get-pos! curve-point (the-as float 0.0) intro-curve) + (curve-get-pos! curve-point 0.0 intro-curve) (vector+! curve-point curve-point intro-curve-offset) (dotimes (i 8) - (set! (-> previous-point quad) (-> curve-point quad)) + (vector-copy! previous-point curve-point) (curve-get-pos! curve-point (* 0.125 (the float (+ i 1))) intro-curve) (vector+! curve-point curve-point intro-curve-offset) (camera-line previous-point curve-point (new 'static 'vector4w :z #xff :w #x80))) @@ -459,15 +442,15 @@ curve-point (new 'static 'vector4w :z #xff :w #x80) (meters 1)) - (curve-get-pos! curve-point (cam-slave-get-float camera 'intro-exitValue (the-as float 0.0)) intro-curve) + (curve-get-pos! curve-point (cam-slave-get-float camera 'intro-exitValue 0.0) intro-curve) (vector+! curve-point curve-point intro-curve-offset) (camera-cross (new 'static 'vector :y 1024.0) (new 'static 'vector :z 1024.0) curve-point (new 'static 'vector4w :z #xff :w #x80) (meters 1)))) - (let ((camera-points (res-lump-data camera 'campoints pointer :time (the-as float 1.0))) - (camera-points-offset (res-lump-struct camera 'campoints-offset structure :time (the-as float -1000000000.0))) + (let ((camera-points (res-lump-data camera 'campoints pointer :time 1.0)) + (camera-points-offset (res-lump-struct camera 'campoints-offset structure)) (camera-point-a (new 'stack-no-clear 'vector)) (camera-point-b (new 'stack-no-clear 'vector)) (camera-point (new 'static 'vector))) @@ -486,7 +469,7 @@ camera-point (new 'static 'vector4w :x #xff :y #xff :w #x80) (meters 1)))) - (let ((focal-pull-points (res-lump-data camera 'focalpull pointer :time (the-as float 1.0))) + (let ((focal-pull-points (res-lump-data camera 'focalpull pointer :time 1.0)) (focal-pull-point (new 'static 'vector))) (when (and focal-pull-points (or (!= *camera-layout-blink* 'focalpull) (logtest? (-> *display* real-actual-frame-counter) 8))) (camera-line (the-as vector (&+ focal-pull-points 0)) @@ -503,40 +486,42 @@ (meters 1)))) (let ((test-info (new 'stack 'interp-test-info)) (test-axis (new-stack-vector0))) - (when (and (cam-slave-get-vector-with-offset camera (-> test-info origin) 'pivot) - (cam-slave-get-vector-with-offset camera (-> test-info to) 'align) - (cam-slave-get-vector-with-offset camera (-> test-info from) 'trans)) - (camera-line (-> test-info from) (-> test-info origin) (new 'static 'vector4w :x #x80 :y #x80 :z #x80 :w #x80)) - (camera-line (-> test-info to) (-> test-info origin) (new 'static 'vector4w :x #x80 :y #x80 :z #x80 :w #x80)) - (vector-! (-> test-info from) (-> test-info from) (-> test-info origin)) - (vector-! (-> test-info to) (-> test-info to) (-> test-info origin)) - (vector-cross! test-axis (-> test-info from) (-> test-info to)) - (vector-normalize! test-axis (the-as float 8192.0)) - (vector+! test-axis test-axis (-> test-info origin)) - (camera-line (-> test-info origin) test-axis (new 'static 'vector4w :x #x80 :y #x80 :z #x80 :w #x80)) - (when (not (paused?)) - (+! (-> *CAM_LAYOUT-bank* debug-t) (-> *CAM_LAYOUT-bank* debug-step)) - (if (< 1.0 (-> *CAM_LAYOUT-bank* debug-t)) (set! (-> *CAM_LAYOUT-bank* debug-t) 0.0))) - (set! (-> test-info axis) #f) - (set! (-> test-info disp) "li") - (set! (-> test-info color) (new 'static 'vector4w :x #xff :w #x80)) - (interp-test (the-as (function vector vector vector float vector float none) vector-lerp!) test-info) - (set! (-> test-info disp) "si") - (set! (-> test-info color) (new 'static 'vector4w :y #xff :w #x80)) - (interp-test (the-as (function vector vector vector float vector float none) v-slrp!) test-info) - (set! (-> test-info disp) "si2") - (set! (-> test-info color) (new 'static 'vector4w :z #xff :w #x80)) - (interp-test (the-as (function vector vector vector float vector float none) v-slrp2!) test-info) - (set! (-> test-info disp) "si3") - (set! (-> test-info color) (new 'static 'vector4w :x #xff :z #xff :w #x80)) - (interp-test-deg (the-as (function vector vector vector vector float none) v-slrp3!) test-info) - (set! (-> test-info axis) (-> *camera* local-down)) - (set! (-> test-info disp) "si2d") - (set! (-> test-info color) (new 'static 'vector4w :y #xff :z #xff :w #x80)) - (interp-test (the-as (function vector vector vector float vector float none) v-slrp2!) test-info) - (set! (-> test-info disp) "si3d") - (set! (-> test-info color) (new 'static 'vector4w :x #xff :y #xff :w #x80)) - (interp-test-deg (the-as (function vector vector vector vector float none) v-slrp3!) test-info)))) + (the-as basic + (when (and (cam-slave-get-vector-with-offset camera (-> test-info origin) 'pivot) + (cam-slave-get-vector-with-offset camera (-> test-info to) 'align) + (cam-slave-get-vector-with-offset camera (-> test-info from) 'trans)) + (camera-line (-> test-info from) (-> test-info origin) (new 'static 'vector4w :x #x80 :y #x80 :z #x80 :w #x80)) + (camera-line (-> test-info to) (-> test-info origin) (new 'static 'vector4w :x #x80 :y #x80 :z #x80 :w #x80)) + (vector-! (-> test-info from) (-> test-info from) (-> test-info origin)) + (vector-! (-> test-info to) (-> test-info to) (-> test-info origin)) + (vector-cross! test-axis (-> test-info from) (-> test-info to)) + (vector-normalize! test-axis (meters 2)) + (vector+! test-axis test-axis (-> test-info origin)) + (camera-line (-> test-info origin) test-axis (new 'static 'vector4w :x #x80 :y #x80 :z #x80 :w #x80)) + (when (not (paused?)) + (+! (-> *CAM_LAYOUT-bank* debug-t) (-> *CAM_LAYOUT-bank* debug-step)) + (if (< 1.0 (-> *CAM_LAYOUT-bank* debug-t)) + (set! (-> *CAM_LAYOUT-bank* debug-t) 0.0))) + (set! (-> test-info axis) #f) + (set! (-> test-info disp) "li") + (set! (-> test-info color) (new 'static 'vector4w :x #xff :w #x80)) + (interp-test (the-as (function vector vector vector float vector float none) vector-lerp!) test-info) + (set! (-> test-info disp) "si") + (set! (-> test-info color) (new 'static 'vector4w :y #xff :w #x80)) + (interp-test (the-as (function vector vector vector float vector float none) v-slrp!) test-info) + (set! (-> test-info disp) "si2") + (set! (-> test-info color) (new 'static 'vector4w :z #xff :w #x80)) + (interp-test (the-as (function vector vector vector float vector float none) v-slrp2!) test-info) + (set! (-> test-info disp) "si3") + (set! (-> test-info color) (new 'static 'vector4w :x #xff :z #xff :w #x80)) + (interp-test-deg (the-as (function vector vector vector vector float none) v-slrp3!) test-info) + (set! (-> test-info axis) (-> *camera* local-down)) + (set! (-> test-info disp) "si2d") + (set! (-> test-info color) (new 'static 'vector4w :y #xff :z #xff :w #x80)) + (interp-test (the-as (function vector vector vector float vector float none) v-slrp2!) test-info) + (set! (-> test-info disp) "si3d") + (set! (-> test-info color) (new 'static 'vector4w :x #xff :y #xff :w #x80)) + (interp-test-deg (the-as (function vector vector vector vector float none) v-slrp3!) test-info))))) (defun clmf-button-test () "Display the button-test message, consume analog camera input, and report that no menu action was @@ -568,33 +553,13 @@ (cond ((cpad-hold? pad-index l3) (set! (-> rotation-input z) - (- (-> rotation-input z) - (analog-input (the-as int (-> *cpad-list* cpads pad-index rightx)) - (the-as float 128.0) - (the-as float 48.0) - (the-as float 110.0) - (the-as float 1.0))))) + (- (-> rotation-input z) (analog-input (the-as int (-> *cpad-list* cpads pad-index rightx)) 128.0 48.0 110.0 1.0)))) (else (set! (-> rotation-input y) - (- (-> rotation-input y) - (analog-input (the-as int (-> *cpad-list* cpads pad-index rightx)) - (the-as float 128.0) - (the-as float 48.0) - (the-as float 110.0) - (the-as float 1.0)))) - (+! (-> rotation-input x) - (analog-input (the-as int (-> *cpad-list* cpads pad-index righty)) - (the-as float 128.0) - (the-as float 48.0) - (the-as float 110.0) - (the-as float 1.0))) + (- (-> rotation-input y) (analog-input (the-as int (-> *cpad-list* cpads pad-index rightx)) 128.0 48.0 110.0 1.0))) + (+! (-> rotation-input x) (analog-input (the-as int (-> *cpad-list* cpads pad-index righty)) 128.0 48.0 110.0 1.0)) (set! (-> translation-input x) - (- (-> translation-input x) - (analog-input (the-as int (-> *cpad-list* cpads pad-index leftx)) - (the-as float 128.0) - (the-as float 48.0) - (the-as float 110.0) - (the-as float 1.0)))) + (- (-> translation-input x) (analog-input (the-as int (-> *cpad-list* cpads pad-index leftx)) 128.0 48.0 110.0 1.0))) (when *camera-read-buttons* (if (cpad-hold? pad-index r1) (set! (-> translation-input y) @@ -616,12 +581,7 @@ (the-as float 230.0) (the-as float 0.5))))))) (set! (-> translation-input z) - (- (-> translation-input z) - (analog-input (the-as int (-> *cpad-list* cpads pad-index lefty)) - (the-as float 128.0) - (the-as float 48.0) - (the-as float 110.0) - (the-as float 1.0)))))) + (- (-> translation-input z) (analog-input (the-as int (-> *cpad-list* cpads pad-index lefty)) 128.0 48.0 110.0 1.0))))) (let ((camera-basis (new-stack-matrix0))) (let ((world-down (new-stack-vector0))) (set! (-> world-down y) -1.0) @@ -632,7 +592,7 @@ (defbehavior clmf-pos-rot cam-layout ((position-property symbol) (rotation-property symbol)) "Ensure the selected camera has the requested position and optional rotation offset resources, then edit them from controller zero in camera-relative translation and world rotation." - (local-vars (rotation structure) (position structure) (camera-rotation matrix)) + (local-vars (rotation structure) (position structure)) (cam-layout-print 16 *camera-layout-message-ypos* "x/z pos: left stick, down: l1, up: r1") (set! *camera-layout-message-ypos* (+ *camera-layout-message-ypos* 8)) (when (and rotation-property (nonzero? rotation-property)) @@ -646,11 +606,11 @@ (cond ((or (zero? position-property) (not position-property)) #f) (else - (if (not (res-lump-struct (-> self cam-entity) position-property structure :time (the-as float -1000000000.0))) - (add-data! (-> self cam-entity) - (new 'static 'res-tag :name position-property :key-frame -1000000000.0 :elt-count #x1 :inlined? #x1 :elt-type vector) - (the-as pointer (new 'static 'vector)))) - (set! position (res-lump-struct (-> self cam-entity) position-property structure :time (the-as float -1000000000.0))) + (if (not (res-lump-struct (-> self cam-entity) position-property structure)) + (add-data! (-> self cam-entity) + (new 'static 'res-tag :name position-property :key-frame -1000000000.0 :elt-count #x1 :inlined? #x1 :elt-type vector) + (the-as pointer (new 'static 'vector)))) + (set! position (res-lump-struct (-> self cam-entity) position-property structure)) (when (and (not position) (logtest? (-> *display* real-actual-frame-counter) 8)) (clear *temp-string*) (format *temp-string* "ERROR : can't add ~A" 'vector) @@ -660,38 +620,40 @@ (cond ((or (zero? rotation-property) (not rotation-property)) #f) (else - (if (not (res-lump-struct (-> self cam-entity) rotation-property structure :time (the-as float -1000000000.0))) - (add-data! (-> self cam-entity) - (new 'static 'res-tag :name rotation-property :key-frame -1000000000.0 :elt-count #x1 :inlined? #x1 :elt-type quaternion) - (the-as pointer (quaternion-identity! (new 'static 'quaternion))))) - (set! rotation (res-lump-struct (-> self cam-entity) rotation-property structure :time (the-as float -1000000000.0))) + (if (not (res-lump-struct (-> self cam-entity) rotation-property structure)) + (add-data! (-> self cam-entity) + (new 'static 'res-tag :name rotation-property :key-frame -1000000000.0 :elt-count #x1 :inlined? #x1 :elt-type quaternion) + (the-as pointer (quaternion-identity! (new 'static 'quaternion))))) + (set! rotation (res-lump-struct (-> self cam-entity) rotation-property structure)) (when (and (not rotation) (logtest? (-> *display* real-actual-frame-counter) 8)) (clear *temp-string*) (format *temp-string* "ERROR : can't add ~A" 'quaternion) (cam-layout-print 120 100 *temp-string*)) rotation))) - (let ((incremental-rotation (new 'stack-no-clear 'matrix))) - (set! camera-rotation (new 'stack-no-clear 'matrix)) - (let ((new-rotation (new 'stack-no-clear 'vector))) - (if (not position) (return #f)) - (clmf-input rotation-input translation-input 0) - (vector+float*! (the-as vector position) (the-as vector position) translation-input (the-as float 409.6)) - (cond - ((not rotation-property) (the-as quaternion #f)) - ((zero? rotation-property) (the-as quaternion #f)) - (else - (cam-slave-get-rot (the-as entity-actor (-> self cam-entity)) camera-rotation) - (vector-float*! rotation-input rotation-input 100.0) - (matrix-rotate-x! incremental-rotation (- (-> rotation-input x))) - (matrix*! camera-rotation incremental-rotation camera-rotation) - (matrix-rotate-y! incremental-rotation (-> rotation-input y)) - (matrix*! camera-rotation camera-rotation incremental-rotation) - (matrix-rotate-z! incremental-rotation (- (-> rotation-input z))) - (matrix*! camera-rotation incremental-rotation camera-rotation) - (matrix->quaternion (the-as quaternion new-rotation) camera-rotation) - (quaternion-inverse! (the-as quaternion rotation) (-> self cam-entity quat)) - (quaternion*! (the-as quaternion rotation) (the-as quaternion new-rotation) (the-as quaternion rotation)) - (quaternion-normalize! (the-as quaternion rotation))))))) + (let ((incremental-rotation (new 'stack-no-clear 'matrix)) + (camera-rotation (new 'stack-no-clear 'matrix)) + (new-rotation (new 'stack-no-clear 'vector))) + (if (not position) (return #f)) + (clmf-input rotation-input translation-input 0) + (vector+float*! (the-as vector position) (the-as vector position) translation-input (meters 0.1)) + (cond + ((not rotation-property) + (the-as quaternion #f)) + ((zero? rotation-property) + (the-as quaternion #f)) + (else + (cam-slave-get-rot (-> self cam-entity) camera-rotation) + (vector-float*! rotation-input rotation-input 100.0) + (matrix-rotate-x! incremental-rotation (- (-> rotation-input x))) + (matrix*! camera-rotation incremental-rotation camera-rotation) + (matrix-rotate-y! incremental-rotation (-> rotation-input y)) + (matrix*! camera-rotation camera-rotation incremental-rotation) + (matrix-rotate-z! incremental-rotation (- (-> rotation-input z))) + (matrix*! camera-rotation incremental-rotation camera-rotation) + (matrix->quaternion (the-as quaternion new-rotation) camera-rotation) + (quaternion-inverse! (the-as quaternion rotation) (-> self cam-entity quat)) + (quaternion*! (the-as quaternion rotation) (the-as quaternion new-rotation) (the-as quaternion rotation)) + (quaternion-normalize! (the-as quaternion rotation)))))) (set! *camera-read-analog* #f) #t) @@ -739,22 +701,25 @@ (while (< (-> self cur-entity) 0) (+! (-> self cur-entity) (-> self num-entities))) (set! *last-cur-entity* (-> self cur-entity)) - (let ((entities-left (-> self cur-entity))) (iterate-engine-connections (node *camera-engine*) (let ((camera (-> (the-as connection node) param1))) - (cond - ((zero? entities-left) - (set! (-> self cam-entity) (the-as entity-camera camera)) - (set! *volume-descriptor-current* 0) - (set! *volume-point-current* 0) - (set! *volume-normal-current* 0) - (set! (-> self num-volumes) 0) - (cam-layout-entity-volume-info-create (-> self cam-entity) 'vol) - (set! (-> self first-pvol) (-> self num-volumes)) - (cam-layout-entity-volume-info-create (-> self cam-entity) 'pvol) - (set! (-> self first-cutoutvol) (-> self num-volumes)) - (cam-layout-entity-volume-info-create (-> self cam-entity) 'cutoutvol) - (set! (-> *CAM_LAYOUT-bank* intro-step) (cam-slave-get-intro-step (-> self cam-entity))) - (return #f)) - (else (+! entities-left -1)))))) + (let ((entities-left (-> self cur-entity))) + (iterate-engine-connections (node *camera-engine*) + (let ((camera (-> node param1))) + (cond + ((zero? entities-left) + (set! (-> self cam-entity) (the-as entity-camera camera)) + (set! *volume-descriptor-current* 0) + (set! *volume-point-current* 0) + (set! *volume-normal-current* 0) + (set! (-> self num-volumes) 0) + (cam-layout-entity-volume-info-create (-> self cam-entity) 'vol) + (set! (-> self first-pvol) (-> self num-volumes)) + (cam-layout-entity-volume-info-create (-> self cam-entity) 'pvol) + (set! (-> self first-cutoutvol) (-> self num-volumes)) + (cam-layout-entity-volume-info-create (-> self cam-entity) 'cutoutvol) + (set! (-> *CAM_LAYOUT-bank* intro-step) (cam-slave-get-intro-step (-> self cam-entity))) + (return #f)) + (else + (+! entities-left -1)))))) #t) (defbehavior clmf-to-vol-attr cam-layout () @@ -799,9 +764,9 @@ "Copy the selected camera's field of view, position, and rotation into the alternate debug camera and enable it for ten frames." (set! (-> *camera-other-fov* data) (cam-slave-get-fov (-> self cam-entity))) - (cam-slave-get-vector-with-offset (the-as entity-actor (-> self cam-entity)) *camera-other-trans* 'trans) + (cam-slave-get-vector-with-offset (-> self cam-entity) *camera-other-trans* 'trans) (vector-copy! *camera-other-root* *camera-other-trans*) - (cam-slave-get-rot (the-as entity-actor (-> self cam-entity)) *camera-other-matrix*) + (cam-slave-get-rot (-> self cam-entity) *camera-other-matrix*) (set! *camera-look-through-other* 10) (set! *camera-read-analog* #f) #f) @@ -809,236 +774,201 @@ (defun fov->maya ((fov float)) "Convert a horizontal field-of-view angle to the Maya focal length used by the camera exporter. Return zero for a zero field of view." - (the-as float (if (= fov 0.0) 0.0 (/ 12.700255 (tan (/ fov 2)))))) + (if (= fov 0.0) + 0.0 + (/ 12.700255 (tan (/ fov 2))))) (defun cam-layout-save-cam-rot ((print? symbol) (output string) (camera entity-actor)) "Write the camera's rot-offset quaternion when present, optionally printing the setup rotation and offset." (let ((setup-rotation (-> camera quat)) - (rotation-offset (res-lump-struct camera 'rot-offset vector :time (the-as float -1000000000.0)))) + (rotation-offset (res-lump-struct camera 'rot-offset vector))) (if print? - (format #t - "setup rot ~f ~f ~f ~f~%" - (-> setup-rotation x) - (-> setup-rotation y) - (-> setup-rotation z) - (-> setup-rotation w))) - (the-as string - (when rotation-offset - (if print? - (format #t - "rot offset ~f ~f ~f ~f~%" - (-> rotation-offset x) - (-> rotation-offset y) - (-> rotation-offset z) - (-> rotation-offset w))) - (format output - " tag rot-offset ~f ~f ~f ~f // vector (quaternion)~%" - (-> rotation-offset x) - (-> rotation-offset y) - (-> rotation-offset z) - (-> rotation-offset w)))))) + (format #t + "setup rot ~f ~f ~f ~f~%" + (-> setup-rotation x) + (-> setup-rotation y) + (-> setup-rotation z) + (-> setup-rotation w))) + (when rotation-offset + (if print? + (format #t + "rot offset ~f ~f ~f ~f~%" + (-> rotation-offset x) + (-> rotation-offset y) + (-> rotation-offset z) + (-> rotation-offset w))) + (format output + " tag rot-offset ~f ~f ~f ~f // vector (quaternion)~%" + (-> rotation-offset x) + (-> rotation-offset y) + (-> rotation-offset z) + (-> rotation-offset w)))) + (none)) (defun cam-layout-save-cam-trans ((print? symbol) (output string) (camera entity-actor)) "Write trans-offset when present. Diagnostic output also shows the setup translation, the added offset, an optional subtracted translation_info level origin, and the resulting Maya position." (let ((setup-translation (-> camera trans)) - (get-property-struct (method-of-type res-lump get-property-struct)) - (property-owner camera)) - (format (clear *res-key-string*) "~S~S" 'trans '-offset) - (let ((translation-offset (the-as vector - (get-property-struct property-owner - (string->symbol *res-key-string*) - 'interp - (the-as float -1000000000.0) - #f - (the-as (pointer res-tag) #f) - *res-static-buf*)))) - (let ((level-translation (res-lump-struct camera 'translation_info vector :time (the-as float -1000000000.0))) - (final-translation (new-stack-vector0))) - (if print? + (translation-offset (res-lump-struct camera (string->symbol (format (clear *res-key-string*) "~S~S" 'trans '-offset)) vector))) + (let ((level-translation (res-lump-struct camera 'translation_info vector)) + (final-translation (new-stack-vector0))) + (if print? (format #t "setup trans ~M ~M ~M (maya)~%" (-> setup-translation x) (-> setup-translation y) (-> setup-translation z))) - (set! (-> final-translation quad) (-> setup-translation quad)) - (when (the-as structure translation-offset) - (if print? + (vector-copy! final-translation setup-translation) + (when (the-as structure translation-offset) + (if print? (format #t "offset ~M ~M ~M (added)~%" (-> translation-offset x) (-> translation-offset y) (-> translation-offset z))) - (vector+! final-translation final-translation translation-offset)) - (when level-translation - (if print? + (vector+! final-translation final-translation translation-offset)) + (when level-translation + (if print? (format #t "level-trans ~M ~M ~M (subtracted)~%" (-> level-translation x) (-> level-translation y) (-> level-translation z))) - (vector-! final-translation final-translation level-translation)) - (set! level-translation (the-as vector (or translation-offset level-translation))) - (set! print? (and (the-as symbol level-translation) print?)) - (if print? + (vector-! final-translation final-translation level-translation)) + (set! level-translation (the-as vector (or translation-offset level-translation))) + (set! print? (and (the-as symbol level-translation) print?)) + (if print? (format #t "final trans ~M ~M ~M (maya)~%" (-> final-translation x) (-> final-translation y) (-> final-translation z)))) - (the-as string - (if translation-offset - (format output - " tag trans-offset METERS(~M) METERS(~M) METERS(~M) 1.0 // vector~%" - (-> translation-offset x) - (-> translation-offset y) - (-> translation-offset z))))))) + (if translation-offset + (format output + " tag trans-offset METERS(~M) METERS(~M) METERS(~M) 1.0 // vector~%" + (-> translation-offset x) + (-> translation-offset y) + (-> translation-offset z)))) + (none)) (defun cam-layout-save-pivot ((print? symbol) (output string) (camera entity-actor)) "Write pivot-offset when both the base pivot and its offset are present, optionally printing the base, offset, and combined position." - (let ((base-position (res-lump-struct camera 'pivot vector :time (the-as float -1000000000.0))) - (get-property-struct (method-of-type res-lump get-property-struct))) - (format (clear *res-key-string*) "~S~S" 'pivot '-offset) - (let ((offset (the-as vector - (get-property-struct camera - (string->symbol *res-key-string*) - 'interp - (the-as float -1000000000.0) - #f - (the-as (pointer res-tag) #f) - *res-static-buf*))) - (final-position (new-stack-vector0))) - (the-as string - (when base-position - (if offset (vector+! final-position base-position offset) (set! (-> final-position quad) (-> base-position quad))) - (if print? (format #t "setup pivot ~M ~M ~M~%" (-> base-position x) (-> base-position y) (-> base-position z))) - (when offset - (when print? - (format #t "offset ~M ~M ~M~%" (-> offset x) (-> offset y) (-> offset z)) - (format #t "final pivot ~M ~M ~M~%" (-> final-position x) (-> final-position y) (-> final-position z))) - (format output - " tag pivot-offset METERS(~M) METERS(~M) METERS(~M) 1.0 // vector~%" - (-> offset x) - (-> offset y) - (-> offset z)))))))) + (let ((base-position (res-lump-struct camera 'pivot vector)) + (offset (res-lump-struct camera (string->symbol (format (clear *res-key-string*) "~S~S" 'pivot '-offset)) vector)) + (final-position (new-stack-vector0))) + (when base-position + (if offset + (vector+! final-position base-position offset) + (vector-copy! final-position base-position)) + (if print? + (format #t "setup pivot ~M ~M ~M~%" (-> base-position x) (-> base-position y) (-> base-position z))) + (when offset + (when print? + (format #t "offset ~M ~M ~M~%" (-> offset x) (-> offset y) (-> offset z)) + (format #t "final pivot ~M ~M ~M~%" (-> final-position x) (-> final-position y) (-> final-position z))) + (format output + " tag pivot-offset METERS(~M) METERS(~M) METERS(~M) 1.0 // vector~%" + (-> offset x) + (-> offset y) + (-> offset z))))) + (none)) (defun cam-layout-save-align ((print? symbol) (output string) (camera entity-actor)) "Write align-offset when both the base alignment point and its offset are present, optionally printing the base, offset, and combined position." - (let ((base-position (res-lump-struct camera 'align vector :time (the-as float -1000000000.0))) - (get-property-struct (method-of-type res-lump get-property-struct))) - (format (clear *res-key-string*) "~S~S" 'align '-offset) - (let ((offset (the-as vector - (get-property-struct camera - (string->symbol *res-key-string*) - 'interp - (the-as float -1000000000.0) - #f - (the-as (pointer res-tag) #f) - *res-static-buf*))) - (final-position (new-stack-vector0))) - (the-as string - (when base-position - (if offset (vector+! final-position base-position offset) (set! (-> final-position quad) (-> base-position quad))) - (if print? (format #t "setup align ~M ~M ~M~%" (-> base-position x) (-> base-position y) (-> base-position z))) - (when offset - (when print? - (format #t "offset ~M ~M ~M~%" (-> offset x) (-> offset y) (-> offset z)) - (format #t "final align ~M ~M ~M~%" (-> final-position x) (-> final-position y) (-> final-position z))) - (format output - " tag align-offset METERS(~M) METERS(~M) METERS(~M) 1.0 // vector~%" - (-> offset x) - (-> offset y) - (-> offset z)))))))) + (let ((base-position (res-lump-struct camera 'align vector)) + (offset (res-lump-struct camera (string->symbol (format (clear *res-key-string*) "~S~S" 'align '-offset)) vector)) + (final-position (new-stack-vector0))) + (when base-position + (if offset + (vector+! final-position base-position offset) + (vector-copy! final-position base-position)) + (if print? + (format #t "setup align ~M ~M ~M~%" (-> base-position x) (-> base-position y) (-> base-position z))) + (when offset + (when print? + (format #t "offset ~M ~M ~M~%" (-> offset x) (-> offset y) (-> offset z)) + (format #t "final align ~M ~M ~M~%" (-> final-position x) (-> final-position y) (-> final-position z))) + (format output + " tag align-offset METERS(~M) METERS(~M) METERS(~M) 1.0 // vector~%" + (-> offset x) + (-> offset y) + (-> offset z))))) + (none)) (defun cam-layout-save-interesting ((print? symbol) (output string) (camera entity-actor)) "Write interesting-offset when both the base interest point and its offset are present, optionally printing the base, offset, and combined position." - (let ((base-position (res-lump-struct camera 'interesting vector :time (the-as float -1000000000.0))) - (get-property-struct (method-of-type res-lump get-property-struct))) - (format (clear *res-key-string*) "~S~S" 'interesting '-offset) - (let ((offset (the-as vector - (get-property-struct camera - (string->symbol *res-key-string*) - 'interp - (the-as float -1000000000.0) - #f - (the-as (pointer res-tag) #f) - *res-static-buf*))) - (final-position (new-stack-vector0))) - (the-as string - (when base-position - (if offset (vector+! final-position base-position offset) (set! (-> final-position quad) (-> base-position quad))) - (if print? (format #t "setup interesting ~M ~M ~M~%" (-> base-position x) (-> base-position y) (-> base-position z))) - (when offset - (when print? - (format #t "offset ~M ~M ~M~%" (-> offset x) (-> offset y) (-> offset z)) - (format #t "final interesting ~M ~M ~M~%" (-> final-position x) (-> final-position y) (-> final-position z))) - (format output - " tag interesting-offset METERS(~M) METERS(~M) METERS(~M) 1.0 // vector~%" - (-> offset x) - (-> offset y) - (-> offset z)))))))) + (let ((base-position (res-lump-struct camera 'interesting vector)) + (offset (res-lump-struct camera (string->symbol (format (clear *res-key-string*) "~S~S" 'interesting '-offset)) vector)) + (final-position (new-stack-vector0))) + (when base-position + (if offset + (vector+! final-position base-position offset) + (vector-copy! final-position base-position)) + (if print? + (format #t "setup interesting ~M ~M ~M~%" (-> base-position x) (-> base-position y) (-> base-position z))) + (when offset + (when print? + (format #t "offset ~M ~M ~M~%" (-> offset x) (-> offset y) (-> offset z)) + (format #t "final interesting ~M ~M ~M~%" (-> final-position x) (-> final-position y) (-> final-position z))) + (format output + " tag interesting-offset METERS(~M) METERS(~M) METERS(~M) 1.0 // vector~%" + (-> offset x) + (-> offset y) + (-> offset z))))) + (none)) (defun cam-layout-save-fov ((print? symbol) (output string) (camera entity-actor)) "Write a nonzero fov-offset in degrees and optionally print the base, offset, combined field of view, and corresponding Maya focal length." - (let ((base-value ((method-of-type res-lump get-property-value-float) - camera - 'fov - 'interp - (the-as float -1000000000.0) - (the-as float 0.0) - (the-as (pointer res-tag) #f) - *res-static-buf*)) + (let ((base-value (res-lump-float camera 'fov)) (get-property-value-float (method-of-type res-lump get-property-value-float))) (format (clear *res-key-string*) "~S~S" 'fov '-offset) (let ((offset (get-property-value-float camera (string->symbol *res-key-string*) 'interp - (the-as float -1000000000.0) - (the-as float 0.0) + -1000000000.0 + 0.0 (the-as (pointer res-tag) #f) *res-static-buf*))) (cond - ((= base-value 0.0) (if print? (format #t "setup fov deg 0.0 (defaults to 64.0)~%")) (set! base-value 11650.845)) - (print? (format #t "setup fov deg ~R (~f in maya)~%" base-value (fov->maya base-value)))) - (the-as string - (when (!= offset 0.0) - (when print? - (format #t "offset ~R~%" offset) - (format #t "final ~R (~f in maya) ~%" (+ base-value offset) (fov->maya (+ base-value offset)))) - (format output " tag fov-offset DEG(~R) // float~%" offset)))))) + ((= base-value 0.0) + (if print? + (format #t "setup fov deg 0.0 (defaults to 64.0)~%")) + (set! base-value 11650.845)) + (print? + (format #t "setup fov deg ~R (~f in maya)~%" base-value (fov->maya base-value)))) + (when (!= offset 0.0) + (when print? + (format #t "offset ~R~%" offset) + (format #t "final ~R (~f in maya) ~%" (+ base-value offset) (fov->maya (+ base-value offset)))) + (format output " tag fov-offset DEG(~R) // float~%" offset)))) + (none)) (defun cam-layout-save-focalpull ((print? symbol) (output string) (camera entity-actor)) "Write a nonzero focalPull-offset in meters and optionally print the base, offset, and combined focal-pull distance." - (let ((base-value ((method-of-type res-lump get-property-value-float) - camera - 'focalPull - 'interp - (the-as float -1000000000.0) - (the-as float 0.0) - (the-as (pointer res-tag) #f) - *res-static-buf*)) + (let ((base-value (res-lump-float camera 'focalPull)) (get-property-value-float (method-of-type res-lump get-property-value-float))) (format (clear *res-key-string*) "~S~S" 'focalPull '-offset) (let ((offset (get-property-value-float camera (string->symbol *res-key-string*) 'interp - (the-as float -1000000000.0) - (the-as float 0.0) + -1000000000.0 + 0.0 (the-as (pointer res-tag) #f) *res-static-buf*))) - (if print? (format #t "setup focalPull deg ~R (~f in maya)~%" base-value (fov->maya base-value))) - (the-as string - (when (!= offset 0.0) - (when print? - (format #t "offset ~R~%" offset) - (format #t "final ~R (~f in maya) ~%" (+ base-value offset) (fov->maya (+ base-value offset)))) - (format output " tag focalPull-offset DEG(~R) // float~%" offset)))))) + (if print? + (format #t "setup focalPull deg ~R (~f in maya)~%" base-value (fov->maya base-value))) + (when (!= offset 0.0) + (when print? + (format #t "offset ~R~%" offset) + (format #t "final ~R (~f in maya) ~%" (+ base-value offset) (fov->maya (+ base-value offset)))) + (format output " tag focalPull-offset DEG(~R) // float~%" offset)))) + (none)) (defun cam-layout-save-flags ((print? symbol) (output string) (camera entity-actor)) "Write nonzero camera flag-on and flag-off override masks, optionally printing the base and effective masks." - (let ((s4-0 (res-lump-value camera 'flags uint128 :time (the-as float -1000000000.0))) + (let ((s4-0 (res-lump-value camera 'flags uint128)) (s5-0 (method-of-type res-lump get-property-value)) (s1-0 camera)) (format (clear *res-key-string*) "~S~S" 'flags '-on) (let ((s5-1 (s5-0 s1-0 (string->symbol *res-key-string*) 'interp - (the-as float -1000000000.0) + -1000000000.0 (the-as uint128 0) (the-as (pointer res-tag) #f) *res-static-buf*)) @@ -1047,7 +977,7 @@ (let ((s3-1 (s1-1 camera (string->symbol *res-key-string*) 'interp - (the-as float -1000000000.0) + -1000000000.0 (the-as uint128 0) (the-as (pointer res-tag) #f) *res-static-buf*))) @@ -1066,19 +996,20 @@ (cam-slave-options->string (the-as cam-slave-options s4-1) #t)) (format #t "~%")) (format output " tag flags-on 0x~X // int32~%" s5-1) - (the-as string (format output " tag flags-off 0x~X // int32~%" s3-1)))))) + (format output " tag flags-off 0x~X // int32~%" s3-1)))) + (none)) (defun cam-layout-save-focalpull-flags ((print? symbol) (output string) (camera entity-actor)) "Write nonzero focalpull-flags-on and focalpull-flags-off override masks, optionally printing the base and effective masks." - (let ((s4-0 (res-lump-value camera 'focalpull-flags uint128 :time (the-as float -1000000000.0))) + (let ((s4-0 (res-lump-value camera 'focalpull-flags uint128)) (s5-0 (method-of-type res-lump get-property-value)) (s1-0 camera)) (format (clear *res-key-string*) "~S~S" 'focalpull-flags '-on) (let ((s5-1 (s5-0 s1-0 (string->symbol *res-key-string*) 'interp - (the-as float -1000000000.0) + -1000000000.0 (the-as uint128 0) (the-as (pointer res-tag) #f) *res-static-buf*)) @@ -1087,7 +1018,7 @@ (let ((s3-1 (s1-1 camera (string->symbol *res-key-string*) 'interp - (the-as float -1000000000.0) + -1000000000.0 (the-as uint128 0) (the-as (pointer res-tag) #f) *res-static-buf*))) @@ -1106,20 +1037,20 @@ (cam-index-options->string (the-as cam-index-options s4-1) #t)) (format #t "~%")) (format output " tag focalpull-flags-on 0x~X // int32~%" s5-1) - (the-as string - (format output " tag focalpull-flags-off 0x~X // int32~%" s3-1)))))) + (format output " tag focalpull-flags-off 0x~X // int32~%" s3-1)))) + (none)) (defun cam-layout-save-campoints-flags ((print? symbol) (output string) (camera entity-actor)) "Write nonzero campoints-flags-on and campoints-flags-off override masks, optionally printing the base and effective masks." - (let ((s4-0 (res-lump-value camera 'campoints-flags uint128 :time (the-as float -1000000000.0))) + (let ((s4-0 (res-lump-value camera 'campoints-flags uint128)) (s5-0 (method-of-type res-lump get-property-value)) (s1-0 camera)) (format (clear *res-key-string*) "~S~S" 'campoints-flags '-on) (let ((s5-1 (s5-0 s1-0 (string->symbol *res-key-string*) 'interp - (the-as float -1000000000.0) + -1000000000.0 (the-as uint128 0) (the-as (pointer res-tag) #f) *res-static-buf*)) @@ -1128,7 +1059,7 @@ (let ((s3-1 (s1-1 camera (string->symbol *res-key-string*) 'interp - (the-as float -1000000000.0) + -1000000000.0 (the-as uint128 0) (the-as (pointer res-tag) #f) *res-static-buf*))) @@ -1147,360 +1078,286 @@ (cam-index-options->string (the-as cam-index-options s4-1) #t)) (format #t "~%")) (format output " tag campoints-flags-on 0x~X // int32~%" s5-1) - (the-as string - (format output " tag campoints-flags-off 0x~X // int32~%" s3-1)))))) + (format output " tag campoints-flags-off 0x~X // int32~%" s3-1)))) + (none)) (defun cam-layout-save-introsplinetime ((print? symbol) (output string) (camera entity-actor)) "Write a nonzero intro-time-offset in seconds. Diagnostic output treats a zero base value as the one-second default." - (let ((base-value ((method-of-type res-lump get-property-value-float) - camera - 'intro-time - 'interp - (the-as float -1000000000.0) - (the-as float 0.0) - (the-as (pointer res-tag) #f) - *res-static-buf*)) + (let ((base-value (res-lump-float camera 'intro-time)) (get-property-value-float (method-of-type res-lump get-property-value-float))) (format (clear *res-key-string*) "~S~S" 'intro-time '-offset) (let ((offset (get-property-value-float camera (string->symbol *res-key-string*) 'interp - (the-as float -1000000000.0) - (the-as float 0.0) + -1000000000.0 + 0.0 (the-as (pointer res-tag) #f) *res-static-buf*))) (cond - ((= base-value 0.0) (if print? (format #t "setup intro-time 0.0 (defaults to 1 sec)~%")) (set! base-value 1.0)) - (print? (format #t "setup intro-time ~f~%" base-value))) - (the-as string - (when (!= offset 0.0) - (when print? - (format #t "offset ~f~%" offset) - (format #t "final ~f~%" (+ base-value offset))) - (format output " tag intro-time-offset SECONDS(~f) // float~%" offset)))))) + ((= base-value 0.0) + (if print? + (format #t "setup intro-time 0.0 (defaults to 1 sec)~%")) + (set! base-value 1.0)) + (print? + (format #t "setup intro-time ~f~%" base-value))) + (when (!= offset 0.0) + (when print? + (format #t "offset ~f~%" offset) + (format #t "final ~f~%" (+ base-value offset))) + (format output " tag intro-time-offset SECONDS(~f) // float~%" offset)))) + (none)) (defun cam-layout-save-introsplineexitval ((print? symbol) (output string) (camera entity-actor)) "Write a nonzero intro-exitValue-offset. Diagnostic output notes that a zero base value uses the default exit value of 0.5." - (let ((base-value ((method-of-type res-lump get-property-value-float) - camera - 'intro-exitValue - 'interp - (the-as float -1000000000.0) - (the-as float 0.0) - (the-as (pointer res-tag) #f) - *res-static-buf*)) + (let ((base-value (res-lump-float camera 'intro-exitValue)) (get-property-value-float (method-of-type res-lump get-property-value-float))) (format (clear *res-key-string*) "~S~S" 'intro-exitValue '-offset) (let ((offset (get-property-value-float camera (string->symbol *res-key-string*) 'interp - (the-as float -1000000000.0) - (the-as float 0.0) + -1000000000.0 + 0.0 (the-as (pointer res-tag) #f) *res-static-buf*))) (when print? (if (= base-value 0.0) - (format #t "setup intro-exitValue 0.0 (defaults to 0.5)~%") - (format #t "setup intro-exitValue ~f~%" base-value))) - (the-as string - (when (!= offset 0.0) - (when print? - (format #t "offset ~f~%" offset) - (format #t "final ~f~%" (+ base-value offset))) - (format output " tag intro-exitValue-offset ~f // float~%" offset)))))) + (format #t "setup intro-exitValue 0.0 (defaults to 0.5)~%") + (format #t "setup intro-exitValue ~f~%" base-value))) + (when (!= offset 0.0) + (when print? + (format #t "offset ~f~%" offset) + (format #t "final ~f~%" (+ base-value offset))) + (format output " tag intro-exitValue-offset ~f // float~%" offset)))) + (none)) (defun cam-layout-save-interptime ((print? symbol) (output string) (camera entity-actor)) "Write a nonzero interpTime-offset in seconds, optionally printing the base, offset, and combined interpolation time." - (let ((base-value ((method-of-type res-lump get-property-value-float) - camera - 'interpTime - 'interp - (the-as float -1000000000.0) - (the-as float 0.0) - (the-as (pointer res-tag) #f) - *res-static-buf*)) + (let ((base-value (res-lump-float camera 'interpTime)) (get-property-value-float (method-of-type res-lump get-property-value-float))) (format (clear *res-key-string*) "~S~S" 'interpTime '-offset) (let ((offset (get-property-value-float camera (string->symbol *res-key-string*) 'interp - (the-as float -1000000000.0) - (the-as float 0.0) + -1000000000.0 + 0.0 (the-as (pointer res-tag) #f) *res-static-buf*))) - (if print? (format #t "setup interpTime ~f~%" base-value)) - (the-as string - (when (!= offset 0.0) - (when print? - (format #t "offset ~f~%" offset) - (format #t "final ~f~%" (+ base-value offset))) - (format output " tag interpTime-offset SECONDS(~f) // float~%" offset)))))) + (if print? + (format #t "setup interpTime ~f~%" base-value)) + (when (!= offset 0.0) + (when print? + (format #t "offset ~f~%" offset) + (format #t "final ~f~%" (+ base-value offset))) + (format output " tag interpTime-offset SECONDS(~f) // float~%" offset)))) + (none)) (defun cam-layout-save-splineoffset ((print? symbol) (output string) (camera entity-actor)) "Write spline-offset when a camera has no pivot and carries an explicit spline offset." - (the-as string - (when (and (not (res-lump-struct camera 'pivot structure :time (the-as float -1000000000.0))) - (res-lump-struct camera 'spline-offset structure :time (the-as float -1000000000.0))) - (let ((offset (res-lump-struct camera 'spline-offset vector :time (the-as float -1000000000.0)))) - (when offset - (if print? (format #t "spline offset ~M ~M ~M~%" (-> offset x) (-> offset y) (-> offset z))) - (format output - " tag spline-offset METERS(~M) METERS(~M) METERS(~M) 1.0 // vector~%" - (-> offset x) - (-> offset y) - (-> offset z))))))) + (when (and (not (res-lump-struct camera 'pivot structure)) (res-lump-struct camera 'spline-offset structure)) + (let ((offset (res-lump-struct camera 'spline-offset vector))) + (when offset + (if print? + (format #t "spline offset ~M ~M ~M~%" (-> offset x) (-> offset y) (-> offset z))) + (format output + " tag spline-offset METERS(~M) METERS(~M) METERS(~M) 1.0 // vector~%" + (-> offset x) + (-> offset y) + (-> offset z))))) + (none)) (defun cam-layout-save-spline-follow-dist-offset ((print? symbol) (output string) (camera entity-actor)) "Write spline-follow-dist-offset when a camera has no pivot and carries the distance offset." - (the-as string - (when (and (not (res-lump-struct camera 'pivot structure :time (the-as float -1000000000.0))) - ((method-of-type res-lump get-property-value-float) - camera - 'spline-follow-dist-offset - 'interp - (the-as float -1000000000.0) - (the-as float #f) - (the-as (pointer res-tag) #f) - *res-static-buf*)) - (let ((offset ((method-of-type res-lump get-property-value-float) - camera - 'spline-follow-dist-offset - 'interp - (the-as float -1000000000.0) - (the-as float 0.0) - (the-as (pointer res-tag) #f) - *res-static-buf*))) - (when (the int offset) - (if print? (format #t "spline follow dist offset ~M~%" offset)) - (format output " tag spline-follow-dist-offset METERS(~M)~%" offset)))))) + (when (and (not (res-lump-struct camera 'pivot structure)) + (res-lump-float camera 'spline-follow-dist-offset :default (the-as float #f))) + (let ((offset (res-lump-float camera 'spline-follow-dist-offset))) + (when (the int offset) + (if print? + (format #t "spline follow dist offset ~M~%" offset)) + (format output " tag spline-follow-dist-offset METERS(~M)~%" offset)))) + (none)) (defun cam-layout-save-campointsoffset ((print? symbol) (output string) (camera entity-actor)) "Write campoints-offset when present, optionally printing the three meter components." - (let ((offset (res-lump-struct camera 'campoints-offset vector :time (the-as float -1000000000.0)))) - (the-as string - (when offset - (if print? (format #t "index offset ~M ~M ~M~%" (-> offset x) (-> offset y) (-> offset z))) - (format output - " tag campoints-offset METERS(~M) METERS(~M) METERS(~M) 1.0 // vector~%" - (-> offset x) - (-> offset y) - (-> offset z)))))) + (let ((offset (res-lump-struct camera 'campoints-offset vector))) + (when offset + (if print? + (format #t "index offset ~M ~M ~M~%" (-> offset x) (-> offset y) (-> offset z))) + (format output + " tag campoints-offset METERS(~M) METERS(~M) METERS(~M) 1.0 // vector~%" + (-> offset x) + (-> offset y) + (-> offset z)))) + (none)) (defun cam-layout-save-tiltAdjust ((print? symbol) (output string) (camera entity-actor)) "Write a nonzero tiltAdjust-offset in degrees, optionally printing the base, offset, and combined adjustment." - (let ((base-value ((method-of-type res-lump get-property-value-float) - camera - 'tiltAdjust - 'interp - (the-as float -1000000000.0) - (the-as float 0.0) - (the-as (pointer res-tag) #f) - *res-static-buf*)) + (let ((base-value (res-lump-float camera 'tiltAdjust)) (get-property-value-float (method-of-type res-lump get-property-value-float))) (format (clear *res-key-string*) "~S~S" 'tiltAdjust '-offset) (let ((offset (get-property-value-float camera (string->symbol *res-key-string*) 'interp - (the-as float -1000000000.0) - (the-as float 0.0) + -1000000000.0 + 0.0 (the-as (pointer res-tag) #f) *res-static-buf*))) - (if print? (format #t "setup tiltAdjust deg ~R~%" base-value)) - (the-as string - (when (!= offset 0.0) - (when print? - (format #t "offset ~R~%" offset) - (format #t "final ~R~%" (+ base-value offset))) - (format output " tag tiltAdjust-offset DEG(~R) // float~%" offset)))))) + (if print? + (format #t "setup tiltAdjust deg ~R~%" base-value)) + (when (!= offset 0.0) + (when print? + (format #t "offset ~R~%" offset) + (format #t "final ~R~%" (+ base-value offset))) + (format output " tag tiltAdjust-offset DEG(~R) // float~%" offset)))) + (none)) (defun cam-layout-save-stringMinLength ((print? symbol) (output string) (camera entity-actor)) "Write a nonzero stringMinLength-offset in meters, optionally printing the base, offset, and combined value." - (let ((base-value ((method-of-type res-lump get-property-value-float) - camera - 'stringMinLength - 'interp - (the-as float -1000000000.0) - (the-as float 0.0) - (the-as (pointer res-tag) #f) - *res-static-buf*)) + (let ((base-value (res-lump-float camera 'stringMinLength)) (get-property-value-float (method-of-type res-lump get-property-value-float))) (format (clear *res-key-string*) "~S~S" 'stringMinLength '-offset) (let ((offset (get-property-value-float camera (string->symbol *res-key-string*) 'interp - (the-as float -1000000000.0) - (the-as float 0.0) + -1000000000.0 + 0.0 (the-as (pointer res-tag) #f) *res-static-buf*))) - (if print? (format #t "setup stringMinLength ~M~%" base-value)) - (the-as string - (when (!= offset 0.0) - (when print? - (format #t "offset ~M~%" offset) - (format #t "final ~M~%" (+ base-value offset))) - (format output " tag stringMinLength-offset METERS(~M) // float~%" offset)))))) + (if print? + (format #t "setup stringMinLength ~M~%" base-value)) + (when (!= offset 0.0) + (when print? + (format #t "offset ~M~%" offset) + (format #t "final ~M~%" (+ base-value offset))) + (format output " tag stringMinLength-offset METERS(~M) // float~%" offset)))) + (none)) (defun cam-layout-save-stringMaxLength ((print? symbol) (output string) (camera entity-actor)) "Write a nonzero stringMaxLength-offset in meters, optionally printing the base, offset, and combined value." - (let ((base-value ((method-of-type res-lump get-property-value-float) - camera - 'stringMaxLength - 'interp - (the-as float -1000000000.0) - (the-as float 0.0) - (the-as (pointer res-tag) #f) - *res-static-buf*)) + (let ((base-value (res-lump-float camera 'stringMaxLength)) (get-property-value-float (method-of-type res-lump get-property-value-float))) (format (clear *res-key-string*) "~S~S" 'stringMaxLength '-offset) (let ((offset (get-property-value-float camera (string->symbol *res-key-string*) 'interp - (the-as float -1000000000.0) - (the-as float 0.0) + -1000000000.0 + 0.0 (the-as (pointer res-tag) #f) *res-static-buf*))) - (if print? (format #t "setup stringMaxLength ~M~%" base-value)) - (the-as string - (when (!= offset 0.0) - (when print? - (format #t "offset ~M~%" offset) - (format #t "final ~M~%" (+ base-value offset))) - (format output " tag stringMaxLength-offset METERS(~M) // float~%" offset)))))) + (if print? + (format #t "setup stringMaxLength ~M~%" base-value)) + (when (!= offset 0.0) + (when print? + (format #t "offset ~M~%" offset) + (format #t "final ~M~%" (+ base-value offset))) + (format output " tag stringMaxLength-offset METERS(~M) // float~%" offset)))) + (none)) (defun cam-layout-save-stringMinHeight ((print? symbol) (output string) (camera entity-actor)) "Write a nonzero stringMinHeight-offset in meters, optionally printing the base, offset, and combined value." - (let ((base-value ((method-of-type res-lump get-property-value-float) - camera - 'stringMinHeight - 'interp - (the-as float -1000000000.0) - (the-as float 0.0) - (the-as (pointer res-tag) #f) - *res-static-buf*)) + (let ((base-value (res-lump-float camera 'stringMinHeight)) (get-property-value-float (method-of-type res-lump get-property-value-float))) (format (clear *res-key-string*) "~S~S" 'stringMinHeight '-offset) (let ((offset (get-property-value-float camera (string->symbol *res-key-string*) 'interp - (the-as float -1000000000.0) - (the-as float 0.0) + -1000000000.0 + 0.0 (the-as (pointer res-tag) #f) *res-static-buf*))) - (if print? (format #t "setup stringMinHeight ~M~%" base-value)) - (the-as string - (when (!= offset 0.0) - (when print? - (format #t "offset ~M~%" offset) - (format #t "final ~M~%" (+ base-value offset))) - (format output " tag stringMinHeight-offset METERS(~M) // float~%" offset)))))) + (if print? + (format #t "setup stringMinHeight ~M~%" base-value)) + (when (!= offset 0.0) + (when print? + (format #t "offset ~M~%" offset) + (format #t "final ~M~%" (+ base-value offset))) + (format output " tag stringMinHeight-offset METERS(~M) // float~%" offset)))) + (none)) (defun cam-layout-save-stringMaxHeight ((print? symbol) (output string) (camera entity-actor)) "Write a nonzero stringMaxHeight-offset in meters, optionally printing the base, offset, and combined value." - (let ((base-value ((method-of-type res-lump get-property-value-float) - camera - 'stringMaxHeight - 'interp - (the-as float -1000000000.0) - (the-as float 0.0) - (the-as (pointer res-tag) #f) - *res-static-buf*)) + (let ((base-value (res-lump-float camera 'stringMaxHeight)) (get-property-value-float (method-of-type res-lump get-property-value-float))) (format (clear *res-key-string*) "~S~S" 'stringMaxHeight '-offset) (let ((offset (get-property-value-float camera (string->symbol *res-key-string*) 'interp - (the-as float -1000000000.0) - (the-as float 0.0) + -1000000000.0 + 0.0 (the-as (pointer res-tag) #f) *res-static-buf*))) - (if print? (format #t "setup stringMaxHeight ~M~%" base-value)) - (the-as string - (when (!= offset 0.0) - (when print? - (format #t "offset ~M~%" offset) - (format #t "final ~M~%" (+ base-value offset))) - (format output " tag stringMaxHeight-offset METERS(~M) // float~%" offset)))))) + (if print? + (format #t "setup stringMaxHeight ~M~%" base-value)) + (when (!= offset 0.0) + (when print? + (format #t "offset ~M~%" offset) + (format #t "final ~M~%" (+ base-value offset))) + (format output " tag stringMaxHeight-offset METERS(~M) // float~%" offset)))) + (none)) (defun cam-layout-save-stringCliffHeight ((print? symbol) (output string) (camera entity-actor)) "Write a nonzero stringCliffHeight-offset in meters, optionally printing the base, offset, and combined value." - (let ((base-value ((method-of-type res-lump get-property-value-float) - camera - 'stringCliffHeight - 'interp - (the-as float -1000000000.0) - (the-as float 0.0) - (the-as (pointer res-tag) #f) - *res-static-buf*)) + (let ((base-value (res-lump-float camera 'stringCliffHeight)) (get-property-value-float (method-of-type res-lump get-property-value-float))) (format (clear *res-key-string*) "~S~S" 'stringCliffHeight '-offset) (let ((offset (get-property-value-float camera (string->symbol *res-key-string*) 'interp - (the-as float -1000000000.0) - (the-as float 0.0) + -1000000000.0 + 0.0 (the-as (pointer res-tag) #f) *res-static-buf*))) - (if print? (format #t "setup stringCliffHeight ~M~%" base-value)) - (the-as string - (when (!= offset 0.0) - (when print? - (format #t "offset ~M~%" offset) - (format #t "final ~M~%" (+ base-value offset))) - (format output " tag stringCliffHeight-offset METERS(~M) // float~%" offset)))))) + (if print? + (format #t "setup stringCliffHeight ~M~%" base-value)) + (when (!= offset 0.0) + (when print? + (format #t "offset ~M~%" offset) + (format #t "final ~M~%" (+ base-value offset))) + (format output " tag stringCliffHeight-offset METERS(~M) // float~%" offset)))) + (none)) (defun cam-layout-save-maxAngle ((print? symbol) (output string) (camera entity-actor)) "Write a nonzero maxAngle-offset in degrees, optionally printing the base, offset, and combined angle." - (let ((base-value ((method-of-type res-lump get-property-value-float) - camera - 'maxAngle - 'interp - (the-as float -1000000000.0) - (the-as float 0.0) - (the-as (pointer res-tag) #f) - *res-static-buf*)) + (let ((base-value (res-lump-float camera 'maxAngle)) (get-property-value-float (method-of-type res-lump get-property-value-float))) (format (clear *res-key-string*) "~S~S" 'maxAngle '-offset) (let ((offset (get-property-value-float camera (string->symbol *res-key-string*) 'interp - (the-as float -1000000000.0) - (the-as float 0.0) + -1000000000.0 + 0.0 (the-as (pointer res-tag) #f) *res-static-buf*))) - (if print? (format #t "setup maxAngle ~R~%" base-value)) - (the-as string - (when (!= offset 0.0) - (when print? - (format #t "offset ~R~%" offset) - (format #t "final ~R~%" (+ base-value offset))) - (format output " tag maxAngle-offset DEG(~R) // float~%" offset)))))) + (if print? + (format #t "setup maxAngle ~R~%" base-value)) + (when (!= offset 0.0) + (when print? + (format #t "offset ~R~%" offset) + (format #t "final ~R~%" (+ base-value offset))) + (format output " tag maxAngle-offset DEG(~R) // float~%" offset)))) + (none)) (defbehavior clmf-save-single cam-layout ((camera entity-camera) (print? symbol) (named-file? symbol)) "Write one camera definition and its editable offset tags. print? also describes effective values on the console; named-file? chooses the camera's .cam path instead of the garbage preview file." (clear *temp-string*) (if named-file? - (format *temp-string* - "dd_next/caminfo/~s.cam" - (res-lump-struct camera 'name structure :time (the-as float -1000000000.0))) - (format *temp-string* "dd_next/caminfo/garbage")) + (format *temp-string* "dd_next/caminfo/~s.cam" (res-lump-struct camera 'name structure)) + (format *temp-string* "dd_next/caminfo/garbage")) (let ((output (new 'stack 'file-stream *temp-string* 'write))) (if print? - (format #t - "---------camera '~S'------------~%" - (res-lump-struct camera 'name structure :time (the-as float -1000000000.0)))) + (format #t "---------camera '~S'------------~%" (res-lump-struct camera 'name structure))) (format output "#include /next/config_data/standard.m2d~%") - (format output "camera ~s {~%" (res-lump-struct camera 'name structure :time (the-as float -1000000000.0))) + (format output "camera ~s {~%" (res-lump-struct camera 'name structure)) (cam-layout-save-cam-rot print? (the-as string output) (the-as entity-actor camera)) (cam-layout-save-cam-trans print? (the-as string output) (the-as entity-actor camera)) (cam-layout-save-pivot print? (the-as string output) (the-as entity-actor camera)) @@ -1532,24 +1389,28 @@ camera file instead of the garbage preview file." (let ((print? (logtest? (the-as int options) 8)) (named-file? (logtest? (the-as int options) 16))) - (if print? (format #t "~%~%~%=================================~%")) + (if print? + (format #t "~%~%~%=================================~%")) (clmf-save-single (-> self cam-entity) print? named-file?) - (if print? (format #t "===============================~%~%~%~%")) + (if print? + (format #t "===============================~%~%~%~%")) (if named-file? - (format #t - "'~S' save completed~%" - (res-lump-struct (-> self cam-entity) 'name structure :time (the-as float -1000000000.0))))) + (format #t "'~S' save completed~%" (res-lump-struct (-> self cam-entity) 'name structure)))) #t) (defbehavior clmf-save-all cam-layout ((options symbol)) "Save every live camera. Options bit three prints diagnostics and bit four writes named files." (let ((print? (logtest? (the-as int options) 8)) (named-file? (logtest? (the-as int options) 16))) - (if print? (format #t "~%~%~%=================================~%")) - (iterate-engine-connections (node *camera-engine*) (let ((camera (-> (the-as connection node) param1))) - (clmf-save-single (the-as entity-camera camera) print? named-file?))) - (if print? (format #t "===============================~%~%~%~%")) - (if named-file? (format #t "camera save all completed~%"))) + (if print? + (format #t "~%~%~%=================================~%")) + (iterate-engine-connections (node *camera-engine*) + (let ((camera (-> node param1))) + (clmf-save-single (the-as entity-camera camera) print? named-file?))) + (if print? + (format #t "===============================~%~%~%~%")) + (if named-file? + (format #t "camera save all completed~%"))) #t) (deftype clmf-cam-flag-toggle-info (structure) @@ -1557,6 +1418,7 @@ (force-on int32) (force-off int32))) + (defbehavior clmf-cam-flag-toggle cam-layout ((scaled-bit-mask int) (property int)) "Divide scaled-bit-mask by eight, then cycle that camera flag through forced off, forced on, and inherited. Volume keys are translated into the corresponding vol, pvol, or cutoutvol property @@ -1684,7 +1546,8 @@ *res-static-buf*) bit)) (format text ": off(maya)")) - (else (format text ": on(maya)"))))) + (else + (format text ": on(maya)"))))) #t) (defbehavior clmf-cam-float-adjust cam-layout ((property symbol) (scale-pointer (pointer float))) @@ -1692,22 +1555,11 @@ value. A zero scale parameter means unit scale." (cam-layout-print 16 *camera-layout-message-ypos* "left stick adjusts value") (set! *camera-layout-message-ypos* (+ *camera-layout-message-ypos* 8)) - (let ((current-value ((method-of-type res-lump get-property-value-float) - (-> self cam-entity) - property - 'interp - (the-as float -1000000000.0) - (the-as float 0.0) - (the-as (pointer res-tag) #f) - *res-static-buf*)) + (let ((current-value (res-lump-float (-> self cam-entity) property)) (scale (-> scale-pointer 0))) - (if (= scale 0.0) (set! scale 1.0)) - (let ((new-value (+ current-value - (analog-input (the-as int (-> *cpad-list* cpads 0 leftx)) - (the-as float 128.0) - (the-as float 48.0) - (the-as float 110.0) - scale)))) + (if (= scale 0.0) + (set! scale 1.0)) + (let ((new-value (+ current-value (analog-input (the-as int (-> *cpad-list* cpads 0 leftx)) 128.0 48.0 110.0 scale)))) (add-32bit-data! (-> self cam-entity) (new 'static 'res-tag :name property :key-frame -1000000000.0 :elt-count #x1 :elt-type float) new-value))) @@ -1716,7 +1568,8 @@ (defbehavior clmf-cam-meters cam-layout ((text meters) (property symbol)) "Append a named camera float to text in meters." - (let ((value (cam-slave-get-float (-> self cam-entity) property (the-as float 0.0)))) (format text ": ~M" value)) + (let ((value (cam-slave-get-float (-> self cam-entity) property 0.0))) + (format text ": ~M" value)) #t) (defbehavior clmf-cam-fov cam-layout ((text degrees) (unused symbol)) @@ -1726,7 +1579,7 @@ (defbehavior clmf-cam-deg cam-layout ((text degrees) (property symbol)) "Append a named camera float to text in degrees." - (format text ": ~R" (cam-slave-get-float (-> self cam-entity) property (the-as float 0.0))) + (format text ": ~R" (cam-slave-get-float (-> self cam-entity) property 0.0)) #t) (defbehavior clmf-cam-intro-time cam-layout ((text float) (unused symbol)) @@ -1743,15 +1596,14 @@ (defbehavior clmf-cam-float cam-layout ((text float) (property symbol)) "Append a named camera float to text." - (format text ": ~f" (cam-slave-get-float (-> self cam-entity) property (the-as float 0.0))) + (format text ": ~f" (cam-slave-get-float (-> self cam-entity) property 0.0)) #t) (defbehavior clmf-cam-string cam-layout ((text string) (property symbol)) "Append every symbol in a named camera resource array to text." - (local-vars (tag res-tag)) (format text ":") - (set! tag (new 'static 'res-tag)) - (let ((values (res-lump-data (-> self cam-entity) property pointer :tag-ptr (& tag) :time (the-as float -1000000000.0)))) + (let* ((tag (new 'static 'res-tag)) + (values (res-lump-data (-> self cam-entity) property pointer :tag-ptr (& tag)))) (when values (dotimes (i (the-as int (-> tag elt-count))) (format text " ~S" (-> (the-as (pointer uint32) (&+ values (* i 4)))))))) @@ -2718,7 +2570,9 @@ #f) ((and (not (logtest? (-> action options) 13)) (not (logtest? (-> *cpad-list* cpads 0 button0-abs 0) (-> action button)))) #f) - ((type-type? (-> (the-as basic target) type) clm) (set! *clm* (the-as clm target)) #t) + ((type-type? (-> (the-as basic target) type) clm) + (set! *clm* (the-as clm target)) + #t) ((type-type? (-> (the-as basic target) type) function) ((the-as (function object symbol symbol) target) (-> action parm0) (the-as symbol (-> action parm1-basic))))))) @@ -2737,16 +2591,21 @@ actions from controller input, and move within list items with the d-pad." (set! *camera-layout-message-ypos* 30) (+! (-> *CAM_LAYOUT-bank* spline-t) (-> *CAM_LAYOUT-bank* spline-step)) - (if (< 1.01 (-> *CAM_LAYOUT-bank* spline-t)) (set! (-> *CAM_LAYOUT-bank* spline-t) -0.09)) + (if (< 1.01 (-> *CAM_LAYOUT-bank* spline-t)) + (set! (-> *CAM_LAYOUT-bank* spline-t) -0.09)) (+! (-> *CAM_LAYOUT-bank* intro-t) (-> *CAM_LAYOUT-bank* intro-step)) - (if (< 1.01 (-> *CAM_LAYOUT-bank* intro-t)) (set! (-> *CAM_LAYOUT-bank* intro-t) -0.09)) + (if (< 1.01 (-> *CAM_LAYOUT-bank* intro-t)) + (set! (-> *CAM_LAYOUT-bank* intro-t) -0.09)) (let ((camera-name-y 30)) (let ((camera-state (cam-state-from-entity (-> self cam-entity)))) (set! *camera-read-analog* #t) (let ((camera (-> self cam-entity))) (clear *temp-string*) - (if camera (format *temp-string* "\"~S\"~%" (res-lump-struct camera 'name structure :time (the-as float -1000000000.0))))) - (if (not camera-state) (format *temp-string* "no cameras in this level") (format *temp-string* "~S" (-> camera-state name)))) + (if camera + (format *temp-string* "\"~S\"~%" (res-lump-struct camera 'name structure)))) + (if (not camera-state) + (format *temp-string* "no cameras in this level") + (format *temp-string* "~S" (-> camera-state name)))) (cam-layout-print 320 camera-name-y *temp-string*) (let ((title-y (+ camera-name-y 16))) (clear *temp-string*) @@ -2786,8 +2645,8 @@ "~S: ~A~%" (-> (the-as clm-item item) description) (if (logtest? (-> (the-as clm-item (-> menu items item-index)) action options) 8) - 'default - (-> (the-as clm-item item) button-symbol)))) + 'default + (-> (the-as clm-item item) button-symbol)))) (cam-layout-print 320 item-y *temp-string*) (+! item-y 8))))))) (if (= *master-mode* 'menu) (goto cfg-65)) @@ -2797,11 +2656,11 @@ (let ((list (-> menu items item-index)) (delta 0)) (if (-> (the-as clm-list list) tracker) - (set! (-> (the-as clm-list list) tracker value) - (-> (the-as clm-list list) items (-> (the-as clm-list list) cur-list-item) track-val))) + (set! (-> (the-as clm-list list) tracker value) + (-> (the-as clm-list list) items (-> (the-as clm-list list) cur-list-item) track-val))) (dotimes (action-index (-> (the-as clm-list list) items (-> (the-as clm-list list) cur-list-item) actions length)) (if (cam-layout-do-action (-> (the-as clm-list list) items (-> (the-as clm-list list) cur-list-item) actions action-index)) - (goto cfg-65))) + (goto cfg-65))) (cond ((cpad-pressed? 0 down) (set! delta 1)) ((cpad-pressed? 0 right) (set! delta 1)) @@ -2821,7 +2680,7 @@ :code (behavior () (loop - (cam-layout-entity-info (the-as entity-actor (-> self cam-entity))) + (cam-layout-entity-info (-> self cam-entity)) (cam-layout-entity-volume-info) (cam-layout-do-menu *clm*) (suspend)))) @@ -2831,7 +2690,9 @@ and enter the active camera-layout state." (set! (-> self res-key) -1000000000.0) (set! (-> self num-entities) 0) - (iterate-engine-connections (node *camera-engine*) (-> (the-as connection node) param1) (+! (-> self num-entities) 1)) + (iterate-engine-connections (node *camera-engine*) + (-> node param1) + (+! (-> self num-entities) 1)) (set! (-> self cur-entity) *last-cur-entity*) (clmf-next-entity 0) (set! *clm* *clm-select*) @@ -2846,14 +2707,20 @@ (defun cam-layout-start () "Start the camera-layout editor unless it is already active. The editor process remains live during pause and menu modes." - (let ((a0-1 (new 'global 'file-stream "dd_next/caminfo/garbage" 'read))) (file-stream-close a0-1)) + (let ((a0-1 (new 'global 'file-stream "dd_next/caminfo/garbage" 'read))) + (file-stream-close a0-1)) (cond ((not *cam-layout*) (let ((v1-4 (process-spawn-function cam-layout cam-layout-init :from *camera-dead-pool*))) (cond - (v1-4 (logclear! (-> v1-4 0 mask) (process-mask pause menu)) (set! *cam-layout* #t) (set! *camera-layout-blink* #f)) - (else (format 0 "ERROR : no process available to start cam editing mode~%"))))) - (else (format 0 "ERROR : cam editing mode already started~%"))) + (v1-4 + (logclear! (-> v1-4 0 mask) (process-mask pause menu)) + (set! *cam-layout* #t) + (set! *camera-layout-blink* #f)) + (else + (format 0 "ERROR : no process available to start cam editing mode~%"))))) + (else + (format 0 "ERROR : cam editing mode already started~%"))) *cam-layout* (none)) diff --git a/goal_src/jak1/engine/camera/cam-master.gc b/goal_src/jak1/engine/camera/cam-master.gc index 207ceb3b25..001877f4a4 100644 --- a/goal_src/jak1/engine/camera/cam-master.gc +++ b/goal_src/jak1/engine/camera/cam-master.gc @@ -28,6 +28,7 @@ (down-move-to-pitch-on-ground float) (pitch-off-blend float))) + (define *CAMERA_MASTER-bank* (new 'static 'camera-master-bank @@ -43,7 +44,7 @@ (defbehavior reset-follow camera-master () "Reset the tracked player position and vertical speed without rebuilding the rest of the tracking state." - (vector-copy! (-> self tpos-old) (target-cam-pos)) + (set! (-> self tpos-old quad) (-> (target-cam-pos) quad)) (vector-copy! (-> self tpos-curr) (-> self tpos-old)) (vector-copy! (-> self tpos-old-adj) (-> self tpos-old)) (vector-copy! (-> self tpos-curr-adj) (-> self tpos-old)) @@ -54,7 +55,7 @@ "Reset all target tracking state from the player, including position and facing, attack-aware string limits, water state, vertical offsets, and the target trail." - (vector-copy! (-> self tpos-old) (target-cam-pos)) + (set! (-> self tpos-old quad) (-> (target-cam-pos) quad)) (vector-copy! (-> self tpos-curr) (-> self tpos-old)) (vector-copy! (-> self tpos-old-adj) (-> self tpos-old)) (vector-copy! (-> self tpos-curr-adj) (-> self tpos-old)) @@ -81,27 +82,30 @@ (else (set-time! (-> self attack-start)) (set! (-> self being-attacked) #t) - (when (and (not (logtest? (-> self master-options) 64)) + (when (and (not (logtest? (-> self master-options) (cam-master-options in-base-region))) (or (!= (-> last-try-to-look-at-data horz) 0.0) (!= (-> last-try-to-look-at-data vert) 0.0))) (set! (-> self string-max target y) (fmax (-> self string-max target y) (-> last-try-to-look-at-data vert))) (set! (-> self string-max target z) (fmax (-> self string-max target z) (-> last-try-to-look-at-data horz))) (set! (-> self string-push-z) (fmax (-> self string-push-z) (-> self string-max target z)))))) (cond - ((and (logtest? (-> *target* water flag) (water-flag under-water)) - (not (logtest? (-> *target* water flag) (water-flag swim-ground)))) + ((and (logtest? (-> *target* water flags) (water-flag under-water)) + (not (logtest? (-> *target* water flags) (water-flag swim-ground)))) (set! (-> self under-water) 2)) - (else (set! (-> self under-water) 0) 0)) + (else + (set! (-> self under-water) 0) + 0)) (let ((trail-point (new 'stack-no-clear 'vector))) (vector--float*! trail-point (-> self tpos-curr-adj) (-> self local-down) (-> self target-height)) - (the-as symbol (reset! (-> self target-spline) trail-point)))) + (reset! (-> self target-spline) trail-point)) + (none)) (defbehavior reset-drawable-follow camera-master () "Reset the tracked position from the selected drawable target and bone without rebuilding the rest of the tracking state." (let ((tracked-target (the-as target (-> self drawable-target process 0)))) (if (nonzero? (-> tracked-target node-list)) - (vector<-cspace! (-> self tpos-old) (-> tracked-target node-list data (-> self which-bone))) - (vector-copy! (-> self tpos-old) (-> tracked-target control trans)))) + (vector<-cspace! (-> self tpos-old) (-> tracked-target node-list data (-> self which-bone))) + (vector-copy! (-> self tpos-old) (-> tracked-target control trans)))) (vector-copy! (-> self tpos-curr) (-> self tpos-old)) (vector-copy! (-> self tpos-old-adj) (-> self tpos-old)) (vector-copy! (-> self tpos-curr-adj) (-> self tpos-old)) @@ -115,7 +119,7 @@ ((nonzero? (-> tracked-target node-list)) (vector<-cspace! (-> self tpos-old) (-> tracked-target node-list data (-> self which-bone))) (matrix-copy! (-> self tgt-rot-mat) (-> tracked-target node-list data (-> self which-bone) bone transform)) - (set! (-> self tgt-rot-mat vector 3 quad) (the-as uint128 0)) + (vector-zero! (-> self tgt-rot-mat vector 3)) (matrix-copy! (-> self tgt-face-mat) (-> self tgt-rot-mat))) (else (vector-copy! (-> self tpos-old) (-> tracked-target control trans)) @@ -139,29 +143,29 @@ (set! (-> self under-water) 0) (let ((trail-point (new 'stack-no-clear 'vector))) (vector--float*! trail-point (-> self tpos-curr-adj) (-> self local-down) (-> self target-height)) - (the-as symbol (reset! (-> self target-spline) trail-point)))) + (reset! (-> self target-spline) trail-point)) + (none)) (defbehavior master-track-target camera-master () "Update the camera master's tracked position and target - orientation. Handle ordinary and drawable targets, ground-to-air vertical smoothing, - edge-grab clearance, water height limits, pitch look-ahead, and the ten-meter target - breadcrumb trail." + orientation. Handle ordinary and drawable targets, ground-to-air vertical smoothing, edge-grab + clearance, water height limits, pitch look-ahead, and the ten-meter target breadcrumb trail." (cond - ((and (logtest? (-> self master-options) 2) + ((and (logtest? (-> self master-options) (cam-master-options have-target)) (!= (-> self drawable-target) #f) (not (handle->process (-> self drawable-target)))) - (logand! (-> self master-options) -3) + (logclear! (-> self master-options) (cam-master-options have-target)) (set! (-> self drawable-target) (the-as handle #f))) - ((and (logtest? (-> self master-options) 2) (handle->process (-> self drawable-target))) + ((and (logtest? (-> self master-options) (cam-master-options have-target)) (handle->process (-> self drawable-target))) (let ((tracked-target (-> self drawable-target process 0))) - (if (paused?) (return (the-as symbol #f))) + (if (paused?) (return #f)) (vector-copy! (-> self tpos-old) (-> self tpos-curr)) (vector-copy! (-> self tpos-old-adj) (-> self tpos-curr-adj)) (cond ((nonzero? (-> (the-as target tracked-target) node-list)) (matrix-copy! (-> self tgt-rot-mat) (-> (the-as target tracked-target) node-list data (-> self which-bone) bone transform)) - (set! (-> self tgt-rot-mat vector 3 quad) (the-as uint128 0)) + (vector-zero! (-> self tgt-rot-mat vector 3)) (matrix-copy! (-> self tgt-face-mat) (-> self tgt-rot-mat)) (vector<-cspace! (-> self tpos-curr) (-> (the-as target tracked-target) node-list data (-> self which-bone)))) (else @@ -172,173 +176,169 @@ (vector-! ground-adjust (-> self tpos-curr-adj) (-> self tpos-curr)) (let* ((vertical-delta (vector-dot ground-adjust (-> self local-down))) (ground-pitch-adjust (if (< 0.0 vertical-delta) - (* vertical-delta (-> *CAMERA_MASTER-bank* up-move-to-pitch-on-ground)) - (* vertical-delta (-> *CAMERA_MASTER-bank* down-move-to-pitch-on-ground))))) + (* vertical-delta (-> *CAMERA_MASTER-bank* up-move-to-pitch-on-ground)) + (* vertical-delta (-> *CAMERA_MASTER-bank* down-move-to-pitch-on-ground))))) (vector+float*! (-> self tpos-curr-adj) (-> self tpos-curr) (-> self local-down) ground-pitch-adjust))) (let ((trail-point (new 'stack-no-clear 'vector))) (vector--float*! trail-point (-> self tpos-curr-adj) (-> self local-down) (-> self target-height)) - (add-point! (-> self target-spline) trail-point 2048.0 0.0 #f)) - (trim-to-length! (-> self target-spline) 40960.0)) - ((handle->process (-> self drawable-target)) (logior! (-> self master-options) 2) (reset-drawable-tracking))) - (the-as symbol - (cond - ((handle->process (-> self drawable-target)) #f) - ((and *target* (logtest? (-> self master-options) 2)) - (if (paused?) (return (the-as symbol #f))) - (cond - ((time-elapsed? (the-as time-frame (if *target* (the-as int (-> *target* neck notice-time)) 0)) - (-> *CAMERA-bank* attack-timeout)) - (set! (-> self being-attacked) #f)) - (else - (if (not (-> self being-attacked)) (set-time! (-> self attack-start))) - (set! (-> self being-attacked) #t) - (when (and (not (logtest? (-> self master-options) 64)) - (or (!= (-> last-try-to-look-at-data horz) 0.0) (!= (-> last-try-to-look-at-data vert) 0.0))) - (set! (-> self string-max target y) (fmax (-> self string-max target y) (-> last-try-to-look-at-data vert))) - (set! (-> self string-max target z) (fmax (-> self string-max target z) (-> last-try-to-look-at-data horz))) - (set! (-> self string-push-z) (fmax (-> self string-push-z) (-> self string-max target z)))))) - (cond - ((and (logtest? (-> *target* water flag) (water-flag under-water)) - (not (logtest? (-> *target* water flag) (water-flag swim-ground)))) - (set! (-> self under-water) 2)) - ((> (-> self under-water) 0) (+! (-> self under-water) -1))) - (vector-copy! (-> self tpos-old) (-> self tpos-curr)) - (vector-copy! (-> self tpos-old-adj) (-> self tpos-curr-adj)) - (quaternion->matrix (-> self tgt-rot-mat) (-> *target* control dir-targ)) - (quaternion->matrix (-> self tgt-face-mat) (-> *target* control quat-for-control)) - ;; A newly selected target eases from its saved position. The optional destination - ;; makes the first ease explicit; otherwise the moving target remains the destination. - (cond - ((< (-> self ease-t) 1.0) - (new 'stack-no-clear 'vector) - (cond - ((logtest? (-> self master-options) 32) - (vector-lerp! (-> self tpos-curr) (-> self ease-from) (-> self ease-to) (parameter-ease-sin-clamp (-> self ease-t))) - (logand! (-> self master-options) -33)) - (else - (vector-lerp! (-> self tpos-curr) (-> self ease-from) (target-cam-pos) (parameter-ease-sin-clamp (-> self ease-t))))) - (+! (-> self ease-t) (-> self ease-step))) - (else (vector-copy! (-> self tpos-curr) (target-cam-pos)))) - ;; During an edge grab, sweep a broad sphere along the target-facing axis and back the - ;; tracked position away from any camera-blocking surface encountered before the end. - (when (logtest? (-> *target* control root-prim prim-core action) (collide-action edgegrab-cam)) - (if *display-cam-los-debug* (format *stdcon* "ride edge~%")) - (let ((probe-result (new 'stack-no-clear 'collide-tri-result)) - (probe-offset (new 'stack-no-clear 'vector)) - (probe-start (new 'stack-no-clear 'vector))) - (vector--float*! probe-start (-> self tpos-curr) (-> self local-down) (-> self target-height)) - (vector-float*! probe-offset (-> self tgt-rot-mat vector 2) 4915.2) - (vector-! probe-start probe-start probe-offset) - (let ((hit-fraction (fill-and-probe-using-line-sphere *collide-cache* - probe-start - probe-offset - 4300.8 - (collide-kind background) - (the-as process #f) - probe-result - (new 'static 'pat-surface :nocamera #x1 :nolineofsight #x1)))) - (if (and (< 0.0 hit-fraction) (< hit-fraction 1.0)) - (vector+float*! (-> self tpos-curr) (-> self tpos-curr) probe-offset (+ -1.0 hit-fraction)))))) - (set! (-> self on-ground) - (not (and (logtest? (-> *target* control mod-surface flags) (surface-flags jump)) - (not (logtest? (-> *target* control status) (collide-status on-surface)))))) - ;; Horizontal target motion follows immediately. While airborne, vertical motion is - ;; accumulated more slowly in tpos-tgt and upspeed, then projected into the adjusted - ;; aim point with separate upward and downward pitch ratios. Ground contact catches - ;; the vertical target up immediately and records only downward movement in upspeed. - (let ((tracking-delta (new-stack-vector0))) - 0.0 - (cond - ((and (and (logtest? (-> *target* control mod-surface flags) (surface-flags jump)) - (not (logtest? (-> *target* control status) (collide-status on-surface)))) - (!= (-> *target* control mod-surface name) 'launch-jump)) - (if *display-cam-los-debug* (format *stdcon* "air tracking~%")) - (vector+float*! (-> self tpos-curr-adj) (-> self tpos-curr-adj) (-> self local-down) (-> self upspeed)) - (vector+float*! (-> self tpos-tgt) (-> self tpos-tgt) (-> self local-down) (-> self upspeed)) - (vector-! tracking-delta (-> self tpos-curr) (-> self tpos-tgt)) - (let ((air-vertical-delta (vector-dot tracking-delta (-> self local-down)))) - (vector--float*! tracking-delta tracking-delta (-> self local-down) air-vertical-delta) - (if (< 0.0 air-vertical-delta) (set! (-> self upspeed) (/ (-> self upspeed) 2))) - (vector+! (-> self tpos-tgt) (-> self tpos-tgt) tracking-delta) - (let ((target-height-step (/ air-vertical-delta 20))) - (vector+float*! (-> self tpos-tgt) (-> self tpos-tgt) (-> self local-down) target-height-step))) - (vector-! tracking-delta (-> self tpos-curr-adj) (-> self tpos-tgt)) - (let* ((adjusted-vertical-delta (vector-dot tracking-delta (-> self local-down))) - (air-pitch-adjust (if (< 0.0 adjusted-vertical-delta) - (* adjusted-vertical-delta (-> *CAMERA_MASTER-bank* up-move-to-pitch-ratio-in-air)) - (* adjusted-vertical-delta (-> *CAMERA_MASTER-bank* down-move-to-pitch-ratio-in-air))))) - (vector+float*! (-> self tpos-curr-adj) (-> self tpos-tgt) (-> self local-down) air-pitch-adjust)) - (vector-! tracking-delta (-> *target* control shadow-pos) (-> self tpos-curr-adj)) - (let* ((shadow-vertical-delta (vector-dot tracking-delta (-> self local-down))) - (fall-speed-limit (* 0.03 shadow-vertical-delta))) - (if (and (< fall-speed-limit 0.0) (< fall-speed-limit (-> self upspeed))) (set! (-> self upspeed) fall-speed-limit)))) - (else - (if *display-cam-los-debug* (format *stdcon* "ground tracking~%")) - (vector-! tracking-delta (-> self tpos-curr) (-> self tpos-old)) - (let ((ground-vertical-delta (vector-dot tracking-delta (-> self local-down)))) - (cond - ((logtest? (-> *target* water flag) (water-flag touch-water)) (set! (-> self upspeed) 0.0)) - ((< 0.0 ground-vertical-delta) (set! (-> self upspeed) 0.0)) - (else (set! (-> self upspeed) ground-vertical-delta)))) - (vector-copy! (-> self tpos-tgt) (-> self tpos-curr)) - (vector-! tracking-delta (-> self tpos-curr-adj) (-> self tpos-curr)) - (let* ((ground-adjust-delta (vector-dot tracking-delta (-> self local-down))) - (ground-pitch-adjust (if (< 0.0 ground-adjust-delta) - (* ground-adjust-delta (-> *CAMERA_MASTER-bank* up-move-to-pitch-on-ground)) - (* ground-adjust-delta (-> *CAMERA_MASTER-bank* down-move-to-pitch-on-ground))))) - (vector+float*! (-> self tpos-curr-adj) (-> self tpos-curr) (-> self local-down) ground-pitch-adjust))))) - (if (not (logtest? (-> self slave-options) 16)) (reset-follow)) - (let ((water-flags (-> *target* water flag))) - (when (and (logtest? water-flags (water-flag touch-water)) (logtest? water-flags (water-flag swimming under-water))) - (let ((minimum-underwater-y (- (-> *target* water base-height) (-> self target-height)))) - (if (< (-> self tpos-curr-adj y) minimum-underwater-y) (set! (-> self tpos-curr-adj y) minimum-underwater-y))))) - ;; Carry half of the target's frame-to-frame displacement into the pitch look-ahead. - (vector+! (-> self pitch-off) (-> self pitch-off) (-> self tpos-curr)) - (vector-! (-> self pitch-off) (-> self pitch-off) (-> self tpos-old)) - (vector-float*! (-> self pitch-off) (-> self pitch-off) (-> *CAMERA_MASTER-bank* pitch-off-blend)) - ;; Breadcrumbs follow the adjusted aim point, remain at least one meter above the - ;; target's ground shadow, are spaced by at least half a meter, and retain ten meters. - (let ((trail-point (new 'stack-no-clear 'vector))) - (vector--float*! trail-point (-> self tpos-curr-adj) (-> self local-down) (-> self target-height)) - (let ((shadow-delta (new 'stack-no-clear 'vector))) - 0.0 - (vector-! shadow-delta (-> *target* control shadow-pos) trail-point) - (let* ((shadow-clearance (vector-dot shadow-delta (-> self local-down))) - (clearance-adjust (+ -4096.0 shadow-clearance))) - (if (< clearance-adjust 0.0) (vector+float*! trail-point trail-point (-> self local-down) clearance-adjust)))) - (add-point! (-> self target-spline) trail-point 2048.0 0.0 #f)) - (the-as symbol (trim-to-length! (-> self target-spline) 40960.0))) - (*target* (logior! (-> self master-options) 2) (reset-target-tracking)) - ((logtest? (-> self master-options) 2) - (let ((options-without-drawable (the-as symbol (logand -3 (-> self master-options))))) - (set! (-> self master-options) (the-as uint options-without-drawable)) - options-without-drawable))))) + (add-point! (-> self target-spline) trail-point (meters 0.5) (meters 0) #f)) + (trim-to-length! (-> self target-spline) (meters 10))) + ((handle->process (-> self drawable-target)) + (logior! (-> self master-options) (cam-master-options have-target)) + (reset-drawable-tracking))) + (cond + ((handle->process (-> self drawable-target))) + ((and *target* (logtest? (-> self master-options) (cam-master-options have-target))) + (if (paused?) (return #f)) + (cond + ((time-elapsed? (the-as time-frame (if *target* (the-as int (-> *target* neck notice-time)) 0)) + (-> *CAMERA-bank* attack-timeout)) + (set! (-> self being-attacked) #f)) + (else + (if (not (-> self being-attacked)) + (set-time! (-> self attack-start))) + (set! (-> self being-attacked) #t) + (when (and (not (logtest? (-> self master-options) (cam-master-options in-base-region))) + (or (!= (-> last-try-to-look-at-data horz) 0.0) (!= (-> last-try-to-look-at-data vert) 0.0))) + (set! (-> self string-max target y) (fmax (-> self string-max target y) (-> last-try-to-look-at-data vert))) + (set! (-> self string-max target z) (fmax (-> self string-max target z) (-> last-try-to-look-at-data horz))) + (set! (-> self string-push-z) (fmax (-> self string-push-z) (-> self string-max target z)))))) + (cond + ((and (logtest? (-> *target* water flags) (water-flag under-water)) + (not (logtest? (-> *target* water flags) (water-flag swim-ground)))) + (set! (-> self under-water) 2)) + ((> (-> self under-water) 0) + (+! (-> self under-water) -1))) + (vector-copy! (-> self tpos-old) (-> self tpos-curr)) + (vector-copy! (-> self tpos-old-adj) (-> self tpos-curr-adj)) + (quaternion->matrix (-> self tgt-rot-mat) (-> *target* control dir-targ)) + (quaternion->matrix (-> self tgt-face-mat) (-> *target* control quat-for-control)) + (cond + ((< (-> self ease-t) 1.0) + (new 'stack-no-clear 'vector) + (cond + ((logtest? (-> self master-options) (cam-master-options have-ease-to-pos)) + (vector-lerp! (-> self tpos-curr) (-> self ease-from) (-> self ease-to) (parameter-ease-sin-clamp (-> self ease-t))) + (logclear! (-> self master-options) (cam-master-options have-ease-to-pos))) + (else + (vector-lerp! (-> self tpos-curr) (-> self ease-from) (target-cam-pos) (parameter-ease-sin-clamp (-> self ease-t))))) + (+! (-> self ease-t) (-> self ease-step))) + (else + (set! (-> self tpos-curr quad) (-> (target-cam-pos) quad)))) + (when (logtest? (-> *target* control root-prim prim-core action) (collide-action edgegrab-cam)) + (if *display-cam-los-debug* + (format *stdcon* "ride edge~%")) + (let ((probe-result (new 'stack-no-clear 'collide-tri-result)) + (probe-offset (new 'stack-no-clear 'vector)) + (probe-start (new 'stack-no-clear 'vector))) + (vector--float*! probe-start (-> self tpos-curr) (-> self local-down) (-> self target-height)) + (vector-float*! probe-offset (-> self tgt-rot-mat vector 2) 4915.2) + (vector-! probe-start probe-start probe-offset) + (let ((hit-fraction (fill-and-probe-using-line-sphere *collide-cache* + probe-start + probe-offset + (meters 1.05) + (collide-kind background) + (the-as process #f) + probe-result + (new 'static 'pat-surface :nocamera #x1 :nolineofsight #x1)))) + (if (and (< 0.0 hit-fraction) (< hit-fraction 1.0)) + (vector+float*! (-> self tpos-curr) (-> self tpos-curr) probe-offset (+ -1.0 hit-fraction)))))) + (set! (-> self on-ground) + (not (and (logtest? (-> *target* control mod-surface flags) (surface-flags jump)) + (not (logtest? (-> *target* control status) (collide-status on-surface)))))) + (let ((tracking-delta (new-stack-vector0))) + 0.0 + (cond + ((and (and (logtest? (-> *target* control mod-surface flags) (surface-flags jump)) + (not (logtest? (-> *target* control status) (collide-status on-surface)))) + (!= (-> *target* control mod-surface name) 'launch-jump)) + (if *display-cam-los-debug* + (format *stdcon* "air tracking~%")) + (vector+float*! (-> self tpos-curr-adj) (-> self tpos-curr-adj) (-> self local-down) (-> self upspeed)) + (vector+float*! (-> self tpos-tgt) (-> self tpos-tgt) (-> self local-down) (-> self upspeed)) + (vector-! tracking-delta (-> self tpos-curr) (-> self tpos-tgt)) + (let ((air-vertical-delta (vector-dot tracking-delta (-> self local-down)))) + (vector--float*! tracking-delta tracking-delta (-> self local-down) air-vertical-delta) + (if (< 0.0 air-vertical-delta) + (set! (-> self upspeed) (/ (-> self upspeed) 2))) + (vector+! (-> self tpos-tgt) (-> self tpos-tgt) tracking-delta) + (let ((target-height-step (/ air-vertical-delta 20))) + (vector+float*! (-> self tpos-tgt) (-> self tpos-tgt) (-> self local-down) target-height-step))) + (vector-! tracking-delta (-> self tpos-curr-adj) (-> self tpos-tgt)) + (let* ((adjusted-vertical-delta (vector-dot tracking-delta (-> self local-down))) + (air-pitch-adjust (if (< 0.0 adjusted-vertical-delta) + (* adjusted-vertical-delta (-> *CAMERA_MASTER-bank* up-move-to-pitch-ratio-in-air)) + (* adjusted-vertical-delta (-> *CAMERA_MASTER-bank* down-move-to-pitch-ratio-in-air))))) + (vector+float*! (-> self tpos-curr-adj) (-> self tpos-tgt) (-> self local-down) air-pitch-adjust)) + (vector-! tracking-delta (-> *target* control shadow-pos) (-> self tpos-curr-adj)) + (let* ((shadow-vertical-delta (vector-dot tracking-delta (-> self local-down))) + (fall-speed-limit (* 0.03 shadow-vertical-delta))) + (if (and (< fall-speed-limit 0.0) (< fall-speed-limit (-> self upspeed))) + (set! (-> self upspeed) fall-speed-limit)))) + (else + (if *display-cam-los-debug* + (format *stdcon* "ground tracking~%")) + (vector-! tracking-delta (-> self tpos-curr) (-> self tpos-old)) + (let ((ground-vertical-delta (vector-dot tracking-delta (-> self local-down)))) + (cond + ((logtest? (-> *target* water flags) (water-flag touch-water)) + (set! (-> self upspeed) 0.0)) + ((< 0.0 ground-vertical-delta) + (set! (-> self upspeed) 0.0)) + (else + (set! (-> self upspeed) ground-vertical-delta)))) + (vector-copy! (-> self tpos-tgt) (-> self tpos-curr)) + (vector-! tracking-delta (-> self tpos-curr-adj) (-> self tpos-curr)) + (let* ((ground-adjust-delta (vector-dot tracking-delta (-> self local-down))) + (ground-pitch-adjust (if (< 0.0 ground-adjust-delta) + (* ground-adjust-delta (-> *CAMERA_MASTER-bank* up-move-to-pitch-on-ground)) + (* ground-adjust-delta (-> *CAMERA_MASTER-bank* down-move-to-pitch-on-ground))))) + (vector+float*! (-> self tpos-curr-adj) (-> self tpos-curr) (-> self local-down) ground-pitch-adjust))))) + (if (not (logtest? (-> self slave-options) (cam-slave-options JUMP_PITCHES))) (reset-follow)) + (let ((water-flags (-> *target* water flags))) + (when (and (logtest? water-flags (water-flag touch-water)) (logtest? water-flags (water-flag swimming under-water))) + (let ((minimum-underwater-y (- (-> *target* water base-height) (-> self target-height)))) + (if (< (-> self tpos-curr-adj y) minimum-underwater-y) + (set! (-> self tpos-curr-adj y) minimum-underwater-y))))) + (vector+! (-> self pitch-off) (-> self pitch-off) (-> self tpos-curr)) + (vector-! (-> self pitch-off) (-> self pitch-off) (-> self tpos-old)) + (vector-float*! (-> self pitch-off) (-> self pitch-off) (-> *CAMERA_MASTER-bank* pitch-off-blend)) + (let ((trail-point (new 'stack-no-clear 'vector))) + (vector--float*! trail-point (-> self tpos-curr-adj) (-> self local-down) (-> self target-height)) + (let ((shadow-delta (new 'stack-no-clear 'vector))) + 0.0 + (vector-! shadow-delta (-> *target* control shadow-pos) trail-point) + (let* ((shadow-clearance (vector-dot shadow-delta (-> self local-down))) + (clearance-adjust (+ -4096.0 shadow-clearance))) + (if (< clearance-adjust 0.0) + (vector+float*! trail-point trail-point (-> self local-down) clearance-adjust)))) + (add-point! (-> self target-spline) trail-point (meters 0.5) (meters 0) #f)) + (trim-to-length! (-> self target-spline) (meters 10))) + (*target* + (logior! (-> self master-options) (cam-master-options have-target)) + (reset-target-tracking)) + ((logtest? (-> self master-options) (cam-master-options have-target)) + (logclear! (-> self master-options) (cam-master-options have-target)))) + (none)) (defun in-cam-entity-volume? ((point vector) (source-entity entity) (margin float) (property-name symbol)) "Return true when point lies within any exact sample of - entity's convex volume property. Each sample is an array of half-space planes; margin - expands the accepted distance beyond every plane." - (local-vars (sample-tag res-tag)) + entity's convex volume property. Each sample is an array of half-space planes; margin expands the + accepted distance beyond every plane." (let ((sample-time 0)) (loop - (set! sample-tag (new 'static 'res-tag)) - (let ((plane-data (the-as object - ((method-of-type res-lump get-property-data) - source-entity - property-name - 'exact - (the float sample-time) - (the-as pointer #f) - (& sample-tag) - *res-static-buf*)))) + (let* ((sample-tag (new 'static 'res-tag)) + (plane-data (res-lump-data-exact source-entity + property-name + (inline-array vector) + :tag-ptr (& sample-tag) + :time (the float sample-time)))) (cond - ((not (the-as pointer plane-data)) (return #f)) + ((not plane-data) (return #f)) (else (dotimes (i (the-as int (-> sample-tag elt-count))) - (if (< margin - (- (vector-dot point (-> (the-as (inline-array vector) plane-data) i)) - (-> (the-as (inline-array vector) plane-data) i w))) - (goto cfg-12))) + (if (< margin (- (vector-dot point (-> plane-data i)) (-> plane-data i w))) (goto cfg-12))) (return #t)))) (label cfg-12) (+! sample-time 1))) @@ -350,7 +350,7 @@ base camera when necessary." (when (-> self cam-entity) (set! (-> self cam-entity) #f) - (logand! (-> self master-options) -65) + (logclear! (-> self master-options) (cam-master-options in-base-region)) (set! (-> self stringMinHeight) (-> *CAMERA-bank* default-string-min-y)) (set! (-> self stringMaxHeight) (-> *CAMERA-bank* default-string-max-y)) (set! (-> self stringMinLength) (-> *CAMERA-bank* default-string-min-z)) @@ -359,63 +359,59 @@ (send-event *camera* 'point-of-interest #f) (set! (-> *camera-combiner* tracking point-of-interest-blend target) 0.0) (if (not (send-event *camera* 'query-state *camera-base-mode*)) - (send-event *camera* 'change-state *camera-base-mode* (seconds 1.5))) + (send-event *camera* 'change-state *camera-base-mode* (seconds 1.5))) (set! (-> *camera-combiner* tracking tilt-adjust target) (-> *CAMERA-bank* default-tilt-adjust)) - (send-event *camera* 'clear-slave-option #x10000))) + (send-event *camera* 'clear-slave-option (cam-slave-options STICKY_ANGLE)))) -(defbehavior master-base-region camera-master ((region entity)) +(defbehavior master-base-region camera-master ((region entity-camera)) "Apply region's authored string-camera bounds, point of interest, cliff height, tilt, and options to the persistent base camera." - (logior! (-> self master-options) 64) + (logior! (-> self master-options) (cam-master-options in-base-region)) (set! (-> self stringMinHeight) (cam-slave-get-float region 'stringMinHeight (-> *CAMERA-bank* default-string-min-y))) (set! (-> self stringMaxHeight) (cam-slave-get-float region 'stringMaxHeight (-> *CAMERA-bank* default-string-max-y))) (set! (-> self stringMinLength) (cam-slave-get-float region 'stringMinLength (-> *CAMERA-bank* default-string-min-z))) (set! (-> self stringMaxLength) (cam-slave-get-float region 'stringMaxLength (-> *CAMERA-bank* default-string-max-z))) (let ((point-of-interest (new 'stack-no-clear 'vector))) - (if (cam-slave-get-vector-with-offset (the-as entity-actor region) point-of-interest 'interesting) - (send-event *camera* 'point-of-interest point-of-interest))) - (if (< 405504.0 (-> self stringMaxLength)) (set! (-> self stringMaxLength) (-> *CAMERA-bank* default-string-max-z))) + (if (cam-slave-get-vector-with-offset region point-of-interest 'interesting) + (send-event *camera* 'point-of-interest point-of-interest))) + (if (< 405504.0 (-> self stringMaxLength)) + (set! (-> self stringMaxLength) (-> *CAMERA-bank* default-string-max-z))) (set! (-> self stringCliffHeight) (cam-slave-get-float region 'stringCliffHeight 163840.0)) (if (not (send-event *camera* 'query-state *camera-base-mode*)) - (send-event *camera* 'change-state *camera-base-mode* (seconds 1.5))) - (if (logtest? #x10000 (cam-slave-get-flags (-> self cam-entity) 'flags)) (send-event *camera* 'set-slave-option #x10000)) + (send-event *camera* 'change-state *camera-base-mode* (seconds 1.5))) + (if (logtest? (cam-slave-options STICKY_ANGLE) (cam-slave-get-flags (-> self cam-entity) 'flags)) + (send-event *camera* 'set-slave-option (cam-slave-options STICKY_ANGLE))) (set! (-> *camera-combiner* tracking tilt-adjust target) (cam-slave-get-float region 'tiltAdjust (-> *CAMERA-bank* default-tilt-adjust)))) (defun setup-slave-for-hopefull ((candidate camera-slave)) "Prepare candidate's follow point and rotation when its blend-to mode requires tracking, so alternate-camera comparisons use its actual view." - (when (= (-> candidate blend-to-type) 2) + (when (= (-> candidate blend-to-type) (camera-blend-to-type combiner-tracked)) (cam-calc-follow! (-> candidate tracking) (-> candidate trans) #f) - (slave-set-rotation! (-> candidate tracking) - (-> candidate trans) - (the-as float (-> candidate options)) - (-> candidate fov) - #f)) + (slave-set-rotation! (-> candidate tracking) (-> candidate trans) (-> candidate options) (-> candidate fov) #f)) (none)) (defbehavior master-is-hopeful-better? camera-master ((current-best camera-slave) (new-candidate camera-slave)) "Return true when new-candidate's forward direction is closer than current-best's to the active combiner view." (if (not *camera-combiner*) - #f - (< (vector-dot (-> current-best tracking inv-mat vector 2) (-> *camera-combiner* inv-camera-rot vector 2)) - (vector-dot (-> new-candidate tracking inv-mat vector 2) (-> *camera-combiner* inv-camera-rot vector 2))))) + #f + (< (vector-dot (-> current-best tracking inv-mat vector 2) (-> *camera-combiner* inv-camera-rot vector 2)) + (vector-dot (-> new-candidate tracking inv-mat vector 2) (-> *camera-combiner* inv-camera-rot vector 2))))) (defbehavior master-switch-to-entity camera-master ((region entity)) "Activate region's camera state and any alternates. Keep the - candidate requiring the least change from the current view, then ask the camera master - to blend to it using the authored interpolation time." - (local-vars - (alternate-result object) - (best-slave (pointer process)) - (alternates-tag res-tag) - (alternate-process process)) + candidate requiring the least change from the current view, then ask the camera master to blend + to it using the authored interpolation time." + (local-vars (alternate-result object) (best-slave (pointer process))) (set! (-> self cam-entity) region) 10 (let ((region-state (cam-state-from-entity region))) (cond - ((= region-state *camera-base-mode*) (master-base-region region) (return #t)) + ((= region-state *camera-base-mode*) + (master-base-region (the-as entity-camera region)) + (return #t)) (region-state (let ((primary-process (get-process *camera-dead-pool* camera-slave #x4000))) (set! best-slave @@ -431,8 +427,8 @@ (else (format 0 "ERROR : camera region '~S' didn't produce a state~%" (res-lump-struct region 'name structure)) (return #f)))) - (set! alternates-tag (new 'static 'res-tag)) - (let ((alternate-names (res-lump-data region 'alternates (pointer string) :tag-ptr (& alternates-tag)))) + (let* ((alternates-tag (new 'static 'res-tag)) + (alternate-names (res-lump-data region 'alternates (pointer string) :tag-ptr (& alternates-tag)))) (when alternate-names (dotimes (i (the-as int (-> alternates-tag elt-count))) (let ((alternate-region (entity-by-name (-> alternate-names i)))) @@ -443,19 +439,19 @@ (cond ((= alternate-state *camera-base-mode*) (deactivate (-> best-slave 0)) - (master-base-region alternate-region) + (master-base-region (the-as entity-camera alternate-region)) (return #t) alternate-result) (alternate-state - (set! alternate-process (get-process *camera-dead-pool* camera-slave #x4000)) - (let ((alternate-slave (when alternate-process - ((method-of-type camera-slave activate) - (the-as camera-slave alternate-process) - self - 'camera-slave - (the-as pointer #x70004000)) - (run-now-in-process alternate-process cam-slave-init alternate-state alternate-region) - (-> alternate-process ppointer)))) + (let* ((alternate-process (get-process *camera-dead-pool* camera-slave #x4000)) + (alternate-slave (when alternate-process + ((method-of-type camera-slave activate) + (the-as camera-slave alternate-process) + self + 'camera-slave + (the-as pointer #x70004000)) + (run-now-in-process alternate-process cam-slave-init alternate-state alternate-region) + (-> alternate-process ppointer)))) (cond (alternate-slave (setup-slave-for-hopefull (the-as camera-slave (ppointer->process alternate-slave))) @@ -465,8 +461,10 @@ (deactivate (-> best-slave 0)) (set! best-slave alternate-slave) best-slave) - (else (deactivate (-> alternate-slave 0))))) - (else (format 0 "ERROR : alternate region activate failed~%"))))) + (else + (deactivate (-> alternate-slave 0))))) + (else + (format 0 "ERROR : alternate region activate failed~%"))))) (else (format 0 "ERROR : alternate camera region '~S' didn't produce a state~%" @@ -477,48 +475,37 @@ (-> alternate-names i) (res-lump-struct region 'name structure))))))))) (let ((blend-frames (the int (* 300.0 (cam-slave-get-interp-time (-> (the-as camera-slave (-> best-slave 0)) cam-entity)))))) - (if (nonzero? (-> self force-blend)) (set! blend-frames (min blend-frames (the-as int (-> self force-blend-time))))) + (if (nonzero? (-> self force-blend)) + (set! blend-frames (min blend-frames (the-as int (-> self force-blend-time))))) (send-event *camera* 'change-state (ppointer->process best-slave) blend-frames)) #t) (defbehavior master-check-regions camera-master () "Keep the current camera region while its padded volume still - contains the target, otherwise select the first active region whose volume contains it - and whose cutout does not. Fall back to the base camera when none qualifies." + contains the target, otherwise select the first active region whose volume contains it and whose + cutout does not. Fall back to the base camera when none qualifies." (cond ((send-event *camera* 'query-state cam-eye) #f) - ((or (not *target*) (logtest? (-> self master-options) 1)) (master-unset-region)) - ((and (logtest? (-> self master-options) 4) + ((or (not *target*) (logtest? (-> self master-options) (cam-master-options ignore-regions))) + (master-unset-region)) + ((and (logtest? (-> self master-options) (cam-master-options switch-only-on-ground)) (not (-> self on-ground)) - (or (not (-> self cam-entity)) (not (logtest? #x20000 (cam-slave-get-flags (-> self cam-entity) 'flags))))) + (or (not (-> self cam-entity)) + (not (logtest? (cam-slave-options AIR_EXIT) (cam-slave-get-flags (-> self cam-entity) 'flags))))) #f) ((and (-> self cam-entity) (not (in-cam-entity-volume? (target-pos 0) (-> self cam-entity) 0.0 'cutoutvol)) (or (in-cam-entity-volume? (target-pos 0) (-> self cam-entity) 1024.0 'pvol) (in-cam-entity-volume? (target-pos 0) (-> self cam-entity) 1024.0 'vol) - (and (not ((method-of-type res-lump get-property-data) - (-> self cam-entity) - 'pvol - 'exact - 0.0 - (the-as pointer #f) - (the-as (pointer res-tag) #f) - *res-static-buf*)) - (not ((method-of-type res-lump get-property-data) - (-> self cam-entity) - 'vol - 'exact - 0.0 - (the-as pointer #f) - (the-as (pointer res-tag) #f) - *res-static-buf*))))) + (and (not (res-lump-data-exact (-> self cam-entity) 'pvol pointer)) + (not (res-lump-data-exact (-> self cam-entity) 'vol pointer))))) #f) (else (iterate-engine-connections (connection *camera-engine*) - (let ((region (-> (the-as connection connection) param1))) - (when (and (not (in-cam-entity-volume? (target-pos 0) (the-as entity region) 1024.0 'cutoutvol)) - (in-cam-entity-volume? (target-pos 0) (the-as entity region) 0.0 'vol)) - (if (master-switch-to-entity (the-as entity region)) (return #t))))) + (let ((region (-> connection param1))) + (when (and (not (in-cam-entity-volume? (target-pos 0) (the-as entity region) 1024.0 'cutoutvol)) + (in-cam-entity-volume? (target-pos 0) (the-as entity region) 0.0 'vol)) + (if (master-switch-to-entity (the-as entity region)) (return #t))))) (master-unset-region)))) ;; The master owns at most two camera slaves. A change-state event may name a state to instantiate @@ -540,18 +527,24 @@ (cond ((not *camera-combiner*) 409600.0) ((= (-> *camera-combiner* interp-val) 0.0) 0.0) - (else (-> *camera-combiner* dist-from-src))))) + (else + (-> *camera-combiner* dist-from-src))))) ((= event-type 'dist-from-interp-dest) (set! result (cond ((not *camera-combiner*) 0.0) ((= (-> *camera-combiner* interp-val) 0.0) 409600.0) - (else (-> *camera-combiner* dist-from-dest))))) + (else + (-> *camera-combiner* dist-from-dest))))) ((= event-type 'level-deactivate) (set! result - (if (and (-> self cam-entity) (= (-> (get-level (-> self cam-entity)) name) (-> block param 0))) (master-unset-region)))) - ((= event-type 'clear-entity) (set! result (master-unset-region))) - ((= event-type 'no-intro) (set! result 3) (set! (-> self no-intro) (the-as uint result))) + (if (and (-> self cam-entity) (= (-> (get-level (-> self cam-entity)) name) (-> block param 0))) + (master-unset-region)))) + ((= event-type 'clear-entity) + (set! result (master-unset-region))) + ((= event-type 'no-intro) + (set! result 3) + (set! (-> self no-intro) (the-as uint result))) ((= event-type 'force-blend) (set! (-> self force-blend) (the-as uint 3)) (set! result (-> block param 0)) @@ -585,7 +578,7 @@ (when (> argc 0) (let ((start-position (the-as object (-> block param 0))) (aim-direction (new 'stack-no-clear 'vector))) - (vector-copy! (-> *camera-combiner* trans) (the-as vector start-position)) + (set! (-> *camera-combiner* trans quad) (-> (the-as vector start-position) quad)) (vector-! aim-direction (-> self tpos-curr-adj) (the-as vector start-position)) (vector-normalize! aim-direction 1.0) (forward-down->inv-matrix (-> *camera-combiner* inv-camera-rot) aim-direction (new 'static 'vector :y -1.0))) @@ -594,32 +587,42 @@ ((= event-type 'change-pov) (let ((pov-process (the-as object (-> block param 0)))) (cond - ((< argc 2) (set! (-> self pov-bone) 0) 0) - (else (set! (-> self pov-bone) (the-as int (-> block param 1))))) + ((< argc 2) + (set! (-> self pov-bone) 0) + 0) + (else + (set! (-> self pov-bone) (the-as int (-> block param 1))))) (set! result (cond - ((not (the-as process pov-process)) (set! (-> self pov-handle) (the-as handle #f)) #f) + ((not (the-as process pov-process)) + (set! (-> self pov-handle) (the-as handle #f)) + #f) (else (set! result (process->handle (the-as process pov-process))) (set! (-> self pov-handle) (the-as handle result)) result))))) - ((= event-type 'change-target-bone) (set! result (-> block param 0)) (set! (-> self which-bone) (the-as int result))) + ((= event-type 'change-target-bone) + (set! result (-> block param 0)) + (set! (-> self which-bone) (the-as int result))) ((= event-type 'change-target) (let ((new-target (the-as object (-> block param 0)))) (cond - ((< argc 2) (set! (-> self which-bone) 0) 0) - (else (set! (-> self which-bone) (the-as int (-> block param 1))))) + ((< argc 2) + (set! (-> self which-bone) 0) + 0) + (else + (set! (-> self which-bone) (the-as int (-> block param 1))))) (cond ((not (the-as process new-target)) (set! (-> self drawable-target) (the-as handle #f)) - (logand! (-> self master-options) -3)) + (logclear! (-> self master-options) (cam-master-options have-target))) ((= (the-as process new-target) *target*) (set! (-> self drawable-target) (the-as handle #f)) - (logior! (-> self master-options) 2) + (logior! (-> self master-options) (cam-master-options have-target)) (reset-target-tracking)) (else (set! (-> self drawable-target) (process->handle (the-as process new-target))) - (logior! (-> self master-options) 2) + (logior! (-> self master-options) (cam-master-options have-target)) (reset-drawable-tracking)))) (set! (-> *camera-combiner* tracking no-follow) #f) (set! result #f)) @@ -634,11 +637,13 @@ (dotimes (i (-> self num-slaves)) (set! (-> self slave i 0 fov) (the-as float (-> block param 0)))) (set! result #f)) - ((= event-type 'query-fov) (set! result (if (> (-> self num-slaves) 0) (-> self slave 0 0 fov) 11650.845))) + ((= event-type 'query-fov) + (set! result (if (> (-> self num-slaves) 0) (-> self slave 0 0 fov) 11650.845))) ((= event-type 'intro-done?) (set! result #t) (dotimes (i (-> self num-slaves)) - (if (< (-> self slave i 0 intro-t) 1.0) (set! result #f)))) + (if (< (-> self slave i 0 intro-t) 1.0) + (set! result #f)))) ((= event-type 'query-state) (let ((i (+ (-> self num-slaves) -1))) (while (not (or (< i 0) (= (-> self slave i 0 next-state) (-> block param 0)))) @@ -648,31 +653,24 @@ (let ((region (entity-by-name (the-as string (-> block param 0))))) (set! result (if region - (master-switch-to-entity region) - (format 0 "ERROR : camera entity '~S' not found for change-to-entity-by-name~%" (-> block param 0)))))) + (master-switch-to-entity region) + (format 0 "ERROR : camera entity '~S' not found for change-to-entity-by-name~%" (-> block param 0)))))) ((= event-type 'change-state) (let ((requested-state (the-as uint #f)) (new-slave (the-as (pointer process) #f)) (old-slave-to-deactivate (the-as (pointer camera-slave) #f))) (let ((old-slave-state (the-as object #f)) (old-slave (the-as (pointer camera-slave) #f))) - (let ((type-test-fn type-type?) - (requested-camera (-> block param 0))) - (cond - ((type-test-fn (rtype-of requested-camera) state) (set! requested-state (-> block param 0))) - ((let ((type-test-fn type-type?) - (requested-camera (-> block param 0))) - (type-test-fn (rtype-of requested-camera) camera-slave)) - (set! new-slave (process->ppointer (the-as process (-> block param 0))))) - (else - (let ((format-fn format) - (format-destination 0) - (error-format "ERROR : invalid type '~A' to *camera* change-state~%") - (requested-camera (-> block param 0))) - (format-fn format-destination error-format (rtype-of requested-camera)))))) + (cond + ((type-type? (rtype-of (-> block param 0)) state) + (set! requested-state (-> block param 0))) + ((type-type? (rtype-of (-> block param 0)) camera-slave) + (set! new-slave (process->ppointer (the-as process (-> block param 0))))) + (else + (format 0 "ERROR : invalid type '~A' to *camera* change-state~%" (rtype-of (-> block param 0))))) (if (and (> (-> self num-slaves) 0) - (or (= (-> self slave 0 0 next-state name) 'cam-stick) (= (-> self slave 0 0 next-state name) 'cam-string))) - (set! (-> self view-off-param-save) (-> self slave 0 0 view-off-param))) + (or (= (-> self slave 0 0 next-state name) 'cam-stick) (= (-> self slave 0 0 next-state name) 'cam-string))) + (set! (-> self view-off-param-save) (-> self slave 0 0 view-off-param))) (set! (-> self changer) (the-as uint (process->ppointer proc))) (cond ((<= (-> self num-slaves) 0) @@ -696,24 +694,26 @@ (-> allocated-slave ppointer)))) (cond (new-slave) - (else (format 0 "ERROR : replacement slave failed to activate~%"))))) + (else + (format 0 "ERROR : replacement slave failed to activate~%"))))) (when new-slave (send-event *camera-combiner* 'stop-tracking) - (if (= (-> (the-as camera-slave (-> new-slave 0)) blend-to-type) 2) - (send-event *camera-combiner* 'start-tracking (if new-slave (-> (the-as camera-slave (-> new-slave 0)) self)))))) + (if (= (-> (the-as camera-slave (-> new-slave 0)) blend-to-type) (camera-blend-to-type combiner-tracked)) + (send-event *camera-combiner* 'start-tracking (if new-slave (-> (the-as camera-slave (-> new-slave 0)) self)))))) ((zero? (-> block param 1)) - (if *math-camera* (set! (-> *math-camera* reset) 1)) + (if *math-camera* + (set! (-> *math-camera* reset) 1)) (when (< 1 (-> self num-slaves)) (if (= (-> self changer) (-> self slave 1)) - (set! old-slave-to-deactivate (-> self slave 1)) - (deactivate (-> self slave 1 0))) + (set! old-slave-to-deactivate (-> self slave 1)) + (deactivate (-> self slave 1 0))) (set! (-> self slave 1) (the-as (pointer camera-slave) #f)) (+! (-> self num-slaves) -1)) (cond (new-slave (if (= (-> self changer) (-> self slave 0)) - (set! old-slave-to-deactivate (-> self slave 0)) - (deactivate (-> self slave 0 0))) + (set! old-slave-to-deactivate (-> self slave 0)) + (deactivate (-> self slave 0 0))) (set! (-> self slave 0) (the-as (pointer camera-slave) #f)) (+! (-> self num-slaves) -1) (let ((activation-event (new 'stack-no-clear 'event-message-block))) @@ -731,7 +731,7 @@ (set! new-slave (-> self slave 0)))) (when new-slave (send-event *camera-combiner* 'stop-tracking) - (when (= (-> (the-as camera-slave (-> new-slave 0)) blend-to-type) 2) + (when (= (-> (the-as camera-slave (-> new-slave 0)) blend-to-type) (camera-blend-to-type combiner-tracked)) (let ((tracking-event (new 'stack-no-clear 'event-message-block))) (set! (-> tracking-event from) self) (set! (-> tracking-event num-params) 1) @@ -743,8 +743,8 @@ (else (when (< 1 (-> self num-slaves)) (if (= (-> self changer) (-> self slave 0)) - (set! old-slave-to-deactivate (-> self slave 0)) - (deactivate (-> self slave 0 0))) + (set! old-slave-to-deactivate (-> self slave 0)) + (deactivate (-> self slave 0 0))) (set! (-> self slave 0) (-> self slave 1)) (set! (-> self slave 1) (the-as (pointer camera-slave) #f)) (+! (-> self num-slaves) -1)) @@ -753,7 +753,8 @@ (set! (-> self outro-t-step) (/ -5.0 (the float (-> block param 1)))) (set! (-> self outro-exit-value) (-> self slave 0 0 outro-exit-value)) (curve-copy! (-> self outro-curve) (-> self slave 0 0 intro-curve))) - (if (nonzero? (-> self no-intro)) (set! (-> self outro-t) 0.0)) + (if (nonzero? (-> self no-intro)) + (set! (-> self outro-t) 0.0)) (when (not (and (= (-> self slave 0 0 next-state) *camera-base-mode*) (= (-> self slave 0 0 next-state) requested-state))) (cond (new-slave @@ -775,48 +776,69 @@ (-> allocated-slave ppointer)))) (cond (new-slave) - (else (format #t "ERROR : secondary slave activate failed~%"))))) + (else + (format #t "ERROR : secondary slave activate failed~%"))))) (when new-slave (send-event *camera-combiner* 'set-interpolation (-> block param 1)) (set! old-slave (-> self slave 0)) (cond - ((zero? (-> self slave 0 0 blend-from-type)) + ((= (-> self slave 0 0 blend-from-type) (camera-blend-to-type direct)) (send-event (ppointer->process (-> self slave 0)) 'change-state-no-go cam-fixed) (send-event *camera-combiner* 'stop-tracking) (set! old-slave-state cam-fixed)) - (else (send-event (ppointer->process (-> self slave 0)) 'change-state-no-go cam-decel) (set! old-slave-state cam-decel))) - (let ((tracking-status (-> *camera-combiner* tracking-status))) - (cond - ((zero? tracking-status) - (let ((destination-tracking-mode (-> (the-as camera-slave (-> new-slave 0)) blend-to-type))) - (cond - ((zero? destination-tracking-mode)) - ((= destination-tracking-mode 1)) - ((= destination-tracking-mode 2) - (if (= (-> self slave 0 0 blend-from-type) 1) - (send-event *camera-combiner* 'copy-tracking (ppointer->process (-> self slave 0))) - (send-event *camera-combiner* 'start-tracking (ppointer->process (-> self slave 0)))) - (set! (-> *camera-combiner* tracking-status) (the-as uint 2)))))) - ((= tracking-status 1) - (let ((destination-tracking-mode (-> (the-as camera-slave (-> new-slave 0)) blend-to-type))) - (cond - ((zero? destination-tracking-mode) (set! (-> *camera-combiner* tracking-status) (the-as uint 3))) - ((= destination-tracking-mode 1) (set! (-> *camera-combiner* tracking-status) (the-as uint 3))) - ((= destination-tracking-mode 2))))) - ((= tracking-status 2) - (let ((destination-tracking-mode (-> (the-as camera-slave (-> new-slave 0)) blend-to-type))) - (cond - ((zero? destination-tracking-mode) (set! (-> *camera-combiner* tracking-status) (the-as uint 0)) 0) - ((= destination-tracking-mode 1) (set! (-> *camera-combiner* tracking-status) (the-as uint 0)) 0) - ((= destination-tracking-mode 2))))) - ((= tracking-status 3) - (let ((destination-tracking-mode (-> (the-as camera-slave (-> new-slave 0)) blend-to-type))) - (cond - ((zero? destination-tracking-mode) (set! (-> *camera-combiner* tracking-status) (the-as uint 0)) 0) - ((= destination-tracking-mode 1) (set! (-> *camera-combiner* tracking-status) (the-as uint 0)) 0) - ((= destination-tracking-mode 2) (set! (-> *camera-combiner* tracking-status) (the-as uint 2)))))))))))) - (if old-slave (send-event (if old-slave (-> (the-as camera-slave (-> old-slave 0)) self)) 'go old-slave-state))) - (if old-slave-to-deactivate (deactivate (-> old-slave-to-deactivate 0)))) + (else + (send-event (ppointer->process (-> self slave 0)) 'change-state-no-go cam-decel) + (set! old-slave-state cam-decel))) + (case (-> + *camera-combiner* + tracking-status) + (((cam-track-status use-slave-tracking)) + (case (-> + (the-as camera-slave (-> new-slave 0)) + blend-to-type) + (((camera-blend-to-type direct))) + (((camera-blend-to-type slave-controlled))) + (((camera-blend-to-type combiner-tracked)) + (if (= (-> self slave 0 0 blend-from-type) (camera-blend-to-type slave-controlled)) + (send-event *camera-combiner* 'copy-tracking (ppointer->process (-> self slave 0))) + (send-event *camera-combiner* 'start-tracking (ppointer->process (-> self slave 0)))) + (set! (-> *camera-combiner* tracking-status) (cam-track-status track-at-dst))))) + (((cam-track-status track-at-combiner)) + (case (-> + (the-as camera-slave (-> new-slave 0)) + blend-to-type) + (((camera-blend-to-type direct)) + (set! (-> *camera-combiner* tracking-status) (cam-track-status track-at-src))) + (((camera-blend-to-type slave-controlled)) + (set! (-> *camera-combiner* tracking-status) (cam-track-status track-at-src))) + (((camera-blend-to-type combiner-tracked))))) + (((cam-track-status track-at-dst)) + (case (-> + (the-as camera-slave (-> new-slave 0)) + blend-to-type) + (((camera-blend-to-type direct)) + (set! (-> *camera-combiner* tracking-status) (cam-track-status use-slave-tracking)) + 0) + (((camera-blend-to-type slave-controlled)) + (set! (-> *camera-combiner* tracking-status) (cam-track-status use-slave-tracking)) + 0) + (((camera-blend-to-type combiner-tracked))))) + (((cam-track-status track-at-src)) + (case (-> + (the-as camera-slave (-> new-slave 0)) + blend-to-type) + (((camera-blend-to-type direct)) + (set! (-> *camera-combiner* tracking-status) (cam-track-status use-slave-tracking)) + 0) + (((camera-blend-to-type slave-controlled)) + (set! (-> *camera-combiner* tracking-status) (cam-track-status use-slave-tracking)) + 0) + (((camera-blend-to-type combiner-tracked)) + (set! (-> *camera-combiner* tracking-status) (cam-track-status track-at-dst)))))))))) + (if old-slave + (send-event (if old-slave (-> (the-as camera-slave (-> old-slave 0)) self)) 'go old-slave-state))) + (if old-slave-to-deactivate + (deactivate (-> old-slave-to-deactivate 0)))) (set! result #t)) ((= event-type 'slave-activated) (set! result @@ -825,31 +847,40 @@ (set! (-> self slave (-> self num-slaves)) (the-as (pointer camera-slave) (process->ppointer (the-as process (-> block param 0))))) (+! (-> self num-slaves) 1) - (logior! (-> self master-options) 8) + (logior! (-> self master-options) (cam-master-options set-combiner-axis)) (set! (-> *camera-combiner* tracking tilt-adjust target) (-> (the-as projectile (-> block param 0)) max-turn))) (else (format 0 "ERROR: ERROR : Exceeded maximum number of camera slaves!~%") (deactivate (the-as camera-slave (-> block param 0))))))) ((= event-type 'ease-in) (cond - ((< argc 1) (set! (-> self ease-t) 0.0) (logand! (-> self master-options) -33)) + ((< argc 1) + (set! (-> self ease-t) 0.0) + (logclear! (-> self master-options) (cam-master-options have-ease-to-pos))) ((< argc 2) - (if (< (the-as float (-> block param 0)) (-> self ease-t)) (set! (-> self ease-t) (the-as float (-> block param 0)))) - (logand! (-> self master-options) -33)) + (if (< (the-as float (-> block param 0)) (-> self ease-t)) + (set! (-> self ease-t) (the-as float (-> block param 0)))) + (logclear! (-> self master-options) (cam-master-options have-ease-to-pos))) (else - (if (< (the-as float (-> block param 0)) (-> self ease-t)) (set! (-> self ease-t) (the-as float (-> block param 0)))) - (vector-copy! (-> self ease-to) (the-as vector (-> block param 1))) - (logior! (-> self master-options) 32))) + (if (< (the-as float (-> block param 0)) (-> self ease-t)) + (set! (-> self ease-t) (the-as float (-> block param 0)))) + (set! (-> self ease-to quad) (-> (the-as vector (-> block param 1)) quad)) + (logior! (-> self master-options) (cam-master-options have-ease-to-pos)))) (set! (-> self ease-step) 0.033333335) (set! result (-> self ease-from)) - (vector-copy! (the-as vector result) (-> self tpos-curr-adj))) - ((= event-type 'damp-up) (let ((zero-speed 0.0)) (set! (-> self upspeed) zero-speed) (set! result zero-speed))) + (set! (-> (the-as vector result) quad) (-> self tpos-curr-adj quad))) + ((= event-type 'damp-up) + (let ((zero-speed 0.0)) + (set! (-> self upspeed) zero-speed) + (set! result zero-speed))) ((= event-type 'reset-follow) (set! result (if (handle->process (-> self drawable-target)) (reset-drawable-follow) (reset-follow)))) ((= event-type 'teleport) (cond - ((and (logtest? (-> self master-options) 2) (handle->process (-> self drawable-target))) (reset-drawable-tracking)) - ((and *target* (logtest? (-> self master-options) 2)) (reset-target-tracking))) + ((and (logtest? (-> self master-options) (cam-master-options have-target)) (handle->process (-> self drawable-target))) + (reset-drawable-tracking)) + ((and *target* (logtest? (-> self master-options) (cam-master-options have-target))) + (reset-target-tracking))) (countdown (i (-> self num-slaves)) (send-event (ppointer->process (-> self slave i)) message)) (let ((teleport-event (new 'stack-no-clear 'event-message-block))) @@ -858,29 +889,31 @@ (set! (-> teleport-event message) message) (set! result (send-event-function *camera-combiner* teleport-event)))) ((= event-type 'toggle-slave-option) - (logxor! (-> self slave-options) (-> block param 0)) + (logxor! (-> self slave-options) (the-as uint (-> block param 0))) (let ((first-slave (-> self slave 0)) (second-slave (-> self slave 1))) - (if first-slave (logxor! (-> first-slave 0 options) (-> block param 0))) + (if first-slave + (logxor! (-> first-slave 0 options) (the-as uint (-> block param 0)))) (set! result (when second-slave - (set! result (logxor (-> second-slave 0 options) (-> block param 0))) - (set! (-> second-slave 0 options) (the-as uint result)) + (set! result (logxor (-> second-slave 0 options) (the-as uint (-> block param 0)))) + (set! (-> second-slave 0 options) (the-as cam-slave-options result)) result)))) (else (set! result (cond ((= event-type 'slave-option?) - (if (nonzero? (-> self num-slaves)) (logtest? (-> self slave (+ (-> self num-slaves) -1) 0 options) (-> block param 0)))) + (if (nonzero? (-> self num-slaves)) + (logtest? (-> self slave (+ (-> self num-slaves) -1) 0 options) (-> block param 0)))) ((= event-type 'set-slave-option) (when (nonzero? (-> self num-slaves)) (set! result (logior (-> self slave (+ (-> self num-slaves) -1) 0 options) (-> block param 0))) - (set! (-> self slave (+ (-> self num-slaves) -1) 0 options) (the-as uint result)) + (set! (-> self slave (+ (-> self num-slaves) -1) 0 options) (the-as cam-slave-options result)) result)) ((= event-type 'clear-slave-option) (when (nonzero? (-> self num-slaves)) (set! result (logclear (-> self slave (+ (-> self num-slaves) -1) 0 options) (-> block param 0))) - (set! (-> self slave (+ (-> self num-slaves) -1) 0 options) (the-as uint result)) + (set! (-> self slave (+ (-> self num-slaves) -1) 0 options) (the-as cam-slave-options result)) result)) ((= event-type 'no-follow) (when (nonzero? (-> self num-slaves)) @@ -891,12 +924,13 @@ (.svf (&-> (the-as vector result) quad) vf0) result) ((= event-type 'yes-follow) - (if (nonzero? (-> self num-slaves)) (set! (-> self slave (+ (-> self num-slaves) -1) 0 tracking no-follow) #f)) + (if (nonzero? (-> self num-slaves)) + (set! (-> self slave (+ (-> self num-slaves) -1) 0 tracking no-follow) #f)) (set! (-> *camera-combiner* tracking no-follow) #f) #f) ((= event-type 'blend-from-as-fixed) (when (nonzero? (-> self num-slaves)) - (set! (-> self slave (+ (-> self num-slaves) -1) 0 blend-from-type) (the-as uint 0)) + (set! (-> self slave (+ (-> self num-slaves) -1) 0 blend-from-type) (camera-blend-to-type direct)) 0)) ((= event-type 'point-of-interest) (when (nonzero? (-> self num-slaves)) @@ -947,7 +981,7 @@ :enter (behavior () (if (and (nonzero? camera-master-debug) *debug-segment*) - (add-connection *debug-engine* self camera-master-debug self #f #f))) + (add-connection *debug-engine* self camera-master-debug self #f #f))) :trans (behavior () (when (not (paused?)) @@ -957,9 +991,7 @@ (behavior () (loop (if (and *dproc* *debug-segment*) - (add-frame (-> *display* frames (-> *display* on-screen) frame profile-bar 0) - 'camera - (new 'static 'rgba :r #x40 :b #x40 :a #x80))) + (add-frame (-> (current-frame) profile-bar 0) 'camera (new 'static 'rgba :r #x40 :b #x40 :a #x80))) (set! (-> self string-min target y) (-> self stringMinHeight)) (set! (-> self string-max target y) (-> self stringMaxHeight)) (set! (-> self string-min target z) (-> self stringMinLength)) @@ -978,8 +1010,10 @@ (set! (-> self string-min value x) (fmin (-> self string-min value x) (+ -4.096 (-> self string-max value x)))) (set! (-> self string-min value y) (fmin (-> self string-min value y) (+ -4.096 (-> self string-max value y)))) (set! (-> self string-min value z) (fmin (-> self string-min value z) (+ -4.096 (-> self string-max value z)))) - (if (nonzero? (-> self no-intro)) (+! (-> self no-intro) -1)) - (if (nonzero? (-> self force-blend)) (+! (-> self force-blend) -1)) + (if (nonzero? (-> self no-intro)) + (+! (-> self no-intro) -1)) + (if (nonzero? (-> self force-blend)) + (+! (-> self force-blend) -1)) (suspend)))) (deftype list-keeper (process) @@ -1003,16 +1037,16 @@ (defbehavior cam-master-init camera-master () "Initialize the camera master, its string seekers and target trail, - spawn the child-list keeper and initial free-floating slave, create the screen-drip - launcher, and enter the active state." + spawn the child-list keeper and initial free-floating slave, create the screen-drip launcher, and + enter the active state." (set! *camera* self) (stack-size-set! (-> self main-thread) 512) (logclear! (-> self mask) (process-mask menu)) - (set! (-> self master-options) (the-as uint 4)) + (set! (-> self master-options) (cam-master-options switch-only-on-ground)) (set! (-> self num-slaves) 0) (dotimes (i 2) (set! (-> self slave i) (the-as (pointer camera-slave) #f))) - (set! (-> self slave-options) (the-as uint 560)) + (set! (-> self slave-options) (cam-slave-options JUMP_PITCHES COLLIDE LINE_OF_SIGHT)) (set! (-> self view-off-param-save) 1.0) (set! (-> self changer) (the-as uint (process->ppointer self))) (set! (-> self cam-entity) #f) @@ -1034,15 +1068,18 @@ (set! (-> self outro-t-step) 0.0) (set! (-> self drawable-target) (the-as handle #f)) (set! (-> self which-bone) 0) - (let ((trail-point (new-stack-vector0))) (reset! (-> self target-spline) trail-point)) + (let ((trail-point (new-stack-vector0))) + (reset! (-> self target-spline) trail-point)) (set! (-> self pov-handle) (the-as handle #f)) (set! (-> self pov-bone) 0) (cond ((process-spawn-function list-keeper list-keeper-init :from *camera-dead-pool* :to self)) - (else (format 0 "ERROR : master camera list keeper failed to activate~%"))) + (else + (format 0 "ERROR : master camera list keeper failed to activate~%"))) (cond ((process-spawn-function camera-slave cam-slave-init cam-free-floating #f :from *camera-dead-pool* :to self)) - (else (format 0 "ERROR : first slave failed to activate~%"))) + (else + (format 0 "ERROR : first slave failed to activate~%"))) (set! (-> self water-drip) (create-launch-control group-rain-screend-drop self)) (set! (-> self water-drip-time) (seconds -60)) (go cam-master-active) diff --git a/goal_src/jak1/engine/camera/cam-states-dbg.gc b/goal_src/jak1/engine/camera/cam-states-dbg.gc index 728805b8c5..670942ef44 100644 --- a/goal_src/jak1/engine/camera/cam-states-dbg.gc +++ b/goal_src/jak1/engine/camera/cam-states-dbg.gc @@ -22,13 +22,14 @@ (behavior ((proc process) (argc int) (message symbol) (block event-message-block)) (case message (('teleport) #f) - (else (cam-standard-event-handler proc argc message block)))) + (else + (cam-standard-event-handler proc argc message block)))) :enter (behavior () (when (not (-> self enter-has-run)) (set! (-> self pivot-rad) 40960.0) - (set! (-> self blend-from-type) (the-as uint 1)) - (set! (-> self blend-to-type) (the-as uint 1)))) + (set! (-> self blend-from-type) (camera-blend-to-type slave-controlled)) + (set! (-> self blend-to-type) (camera-blend-to-type slave-controlled)))) :code (behavior () (loop @@ -52,13 +53,14 @@ (+! (-> translation-delta z) (* 2.0 (-> *CAM_POINT_WATCH-bank* speed) left-y-input))))) (let ((forward (new-stack-vector0))) (let ((rotation-matrix (new-stack-matrix0))) - (matrix-axis-angle! rotation-matrix (the-as vector (-> self tracking)) (- (-> rotation-delta x))) + (matrix-axis-angle! rotation-matrix (-> self tracking inv-mat vector 0) (- (-> rotation-delta x))) (vector-matrix*! forward (-> self tracking inv-mat vector 2) rotation-matrix) (matrix-axis-angle! rotation-matrix (-> *camera* local-down) (- (-> rotation-delta y))) (vector-matrix*! forward forward rotation-matrix)) (forward-down->inv-matrix (-> self tracking inv-mat) forward (-> *camera* local-down))) (set! (-> self pivot-rad) (- (-> self pivot-rad) (-> translation-delta z))) - (if (< (-> self pivot-rad) 4096.0) (set! (-> self pivot-rad) 4096.0)) + (if (< (-> self pivot-rad) 4096.0) + (set! (-> self pivot-rad) 4096.0)) (set-vector! translation-delta 0.0 0.0 (- (-> self pivot-rad)) 1.0) (vector-matrix*! (-> self trans) translation-delta (-> self tracking inv-mat)))) (suspend) @@ -276,8 +278,10 @@ Preserve the chosen up direction while yawing when one is supplied; otherwise allow unrestricted yaw. Pitch and roll are then applied in camera-local axes before the local translation is rotated into world space. Return false when the controller is invalid or menus own the camera." - (if (logtest? (-> *cpad-list* cpads controller-index valid) 128) (return (the-as vector #f))) - (if (= *master-mode* 'menu) (return (the-as vector #f))) + (if (logtest? (-> *cpad-list* cpads controller-index valid) 128) + (return (the-as vector #f))) + (if (= *master-mode* 'menu) + (return (the-as vector #f))) (let ((move-info (new 'stack 'camera-free-floating-move-info))) (cam-free-floating-input (-> move-info rv) (-> move-info tv) (not up) controller-index) (cond @@ -309,18 +313,20 @@ (behavior ((proc process) (argc int) (message symbol) (block event-message-block)) (case message (('teleport) #f) - (else (cam-standard-event-handler proc argc message block)))) + (else + (cam-standard-event-handler proc argc message block)))) :enter (behavior () (when (not (-> self enter-has-run)) - (set! (-> self blend-from-type) (the-as uint 1)) - (set! (-> self blend-to-type) (the-as uint 1)) + (set! (-> self blend-from-type) (camera-blend-to-type slave-controlled)) + (set! (-> self blend-to-type) (camera-blend-to-type slave-controlled)) (send-event *camera-combiner* 'stop-tracking))) :code (behavior () (loop (let ((up (-> *camera* local-down))) - (if (logtest? (-> self options) 8) (set! up (the-as vector #f))) + (if (logtest? (-> self options) (cam-slave-options ALLOW_Z_ROT)) + (set! up (the-as vector #f))) (cam-free-floating-move (-> self tracking inv-mat) (-> self trans) up (the-as int (-> *CAMERA-bank* joypad)))) (suspend)))) @@ -331,12 +337,14 @@ (orbit-off vector :inline) (radius-lerp float))) + (deftype CAM_ORBIT-bank (basic) ((RADIUS_MAX float) (RADIUS_MIN float) (TARGET_OFF_ADJUST float) (ORBIT_OFF_ADJUST float))) + (define *CAM_ORBIT-bank* (new 'static 'CAM_ORBIT-bank :RADIUS_MAX 61440.0 :RADIUS_MIN 409.6 :TARGET_OFF_ADJUST 81.92 :ORBIT_OFF_ADJUST 81.92)) @@ -359,23 +367,26 @@ (behavior ((proc process) (argc int) (message symbol) (block event-message-block)) (case message (('teleport) #f) - (else (cam-standard-event-handler proc argc message block)))) + (else + (cam-standard-event-handler proc argc message block)))) :enter (behavior () (when (not (-> self enter-has-run)) - (if (not *camera-orbit-target*) (cam-slave-go cam-free-floating)) + (if (not *camera-orbit-target*) + (cam-slave-go cam-free-floating)) (let ((target-to-camera (new-stack-vector0))) (vector-! target-to-camera (-> self trans) (-> *camera-orbit-target* 0 root trans)) (set! (-> *camera-orbit-info* rot) (atan (-> target-to-camera x) (-> target-to-camera z)))) - (set! (-> self blend-from-type) (the-as uint 1)) - (set! (-> self blend-to-type) (the-as uint 1)))) + (set! (-> self blend-from-type) (camera-blend-to-type slave-controlled)) + (set! (-> self blend-to-type) (camera-blend-to-type slave-controlled)))) :exit (behavior () '()) :code (behavior () (loop - (if (not *camera-orbit-target*) (cam-slave-go cam-free-floating)) + (if (not *camera-orbit-target*) + (cam-slave-go cam-free-floating)) (when *camera-read-analog* (let ((zoom-input (analog-input (the-as int (-> *cpad-list* cpads 0 righty)) 128.0 32.0 110.0 0.05))) (cond @@ -383,20 +394,23 @@ (+! (-> *camera-orbit-info* radius-lerp) (* 0.05 (- 1.0 (-> *camera-orbit-info* radius-lerp))))) ((< zoom-input (* 0.05 (- (-> *camera-orbit-info* radius-lerp)))) (+! (-> *camera-orbit-info* radius-lerp) (* 0.05 (- (-> *camera-orbit-info* radius-lerp))))) - (else (+! (-> *camera-orbit-info* radius-lerp) zoom-input)))) + (else + (+! (-> *camera-orbit-info* radius-lerp) zoom-input)))) (set! (-> *camera-orbit-info* radius) (lerp (-> *CAM_ORBIT-bank* RADIUS_MIN) (-> *CAM_ORBIT-bank* RADIUS_MAX) (-> *camera-orbit-info* radius-lerp)))) (cond ((cpad-hold? 0 l2) (if (cpad-hold? 0 l1) - (set! (-> *camera-orbit-info* target-off y) - (- (-> *camera-orbit-info* target-off y) (-> *CAM_ORBIT-bank* TARGET_OFF_ADJUST)))) - (if (cpad-hold? 0 r1) (+! (-> *camera-orbit-info* target-off y) (-> *CAM_ORBIT-bank* TARGET_OFF_ADJUST)))) + (set! (-> *camera-orbit-info* target-off y) + (- (-> *camera-orbit-info* target-off y) (-> *CAM_ORBIT-bank* TARGET_OFF_ADJUST)))) + (if (cpad-hold? 0 r1) + (+! (-> *camera-orbit-info* target-off y) (-> *CAM_ORBIT-bank* TARGET_OFF_ADJUST)))) (else (if (cpad-hold? 0 l1) - (set! (-> *camera-orbit-info* orbit-off y) - (- (-> *camera-orbit-info* orbit-off y) (-> *CAM_ORBIT-bank* ORBIT_OFF_ADJUST)))) - (if (cpad-hold? 0 r1) (+! (-> *camera-orbit-info* orbit-off y) (-> *CAM_ORBIT-bank* ORBIT_OFF_ADJUST))))) + (set! (-> *camera-orbit-info* orbit-off y) + (- (-> *camera-orbit-info* orbit-off y) (-> *CAM_ORBIT-bank* ORBIT_OFF_ADJUST)))) + (if (cpad-hold? 0 r1) + (+! (-> *camera-orbit-info* orbit-off y) (-> *CAM_ORBIT-bank* ORBIT_OFF_ADJUST))))) (when *camera-read-analog* (let ((orbit-input (analog-input (the-as int (-> *cpad-list* cpads 0 rightx)) 128.0 32.0 110.0 (* 21845.334 (seconds-per-frame))))) (set! (-> *camera-orbit-info* rot) (the float (sar (shl (the int (+ (-> *camera-orbit-info* rot) orbit-input)) 48) 48))))) diff --git a/goal_src/jak1/engine/camera/cam-states.gc b/goal_src/jak1/engine/camera/cam-states.gc index c93a9f3522..0806277a5c 100644 --- a/goal_src/jak1/engine/camera/cam-states.gc +++ b/goal_src/jak1/engine/camera/cam-states.gc @@ -20,13 +20,14 @@ (behavior ((proc process) (argc int) (message symbol) (block event-message-block)) (case message (('teleport) #f) - (else (cam-standard-event-handler proc argc message block)))) + (else + (cam-standard-event-handler proc argc message block)))) :enter (behavior () (when (not (-> self enter-has-run)) (vector-copy! (-> self saved-pt) (-> self trans)) - (set! (-> self blend-from-type) (the-as uint 1)) - (set! (-> self blend-to-type) (the-as uint 0)) + (set! (-> self blend-from-type) (camera-blend-to-type slave-controlled)) + (set! (-> self blend-to-type) (camera-blend-to-type direct)) 0)) :code (behavior () @@ -36,7 +37,7 @@ (vector-copy! (-> self trans) (-> self saved-pt)) (cam-curve-pos (-> self trans) curve-forward (the-as curve #f) #f) (when (!= (-> curve-forward w) 0.0) - (vector-normalize! curve-forward (the-as float 1.0)) + (vector-normalize! curve-forward 1.0) (forward-down->inv-matrix (-> self tracking inv-mat) curve-forward (-> *camera* local-down))))) (suspend)))) @@ -45,21 +46,23 @@ (behavior ((proc process) (argc int) (message symbol) (block event-message-block)) (case message (('teleport) #f) - (else (cam-standard-event-handler proc argc message block)))) + (else + (cam-standard-event-handler proc argc message block)))) :enter (behavior () (cond ((-> self enter-has-run)) ((-> self cam-entity) - (cam-slave-get-vector-with-offset (the-as entity-actor (-> self cam-entity)) (-> self trans) 'trans) - (cam-slave-get-rot (the-as entity-actor (-> self cam-entity)) (-> self tracking inv-mat)) + (cam-slave-get-vector-with-offset (-> self cam-entity) (-> self trans) 'trans) + (cam-slave-get-rot (-> self cam-entity) (-> self tracking inv-mat)) (set! (-> self fov) (cam-slave-get-fov (-> self cam-entity))) (cam-curve-setup (-> self trans)) ((-> cam-fixed enter))) - (else (format #t "ERROR : cam-fixed-read-entity enter without entity~%"))) + (else + (format #t "ERROR : cam-fixed-read-entity enter without entity~%"))) (let ((point-of-interest (new 'stack-no-clear 'vector))) - (if (cam-slave-get-vector-with-offset (the-as entity-actor (-> self cam-entity)) point-of-interest 'interesting) - (send-event *camera* 'point-of-interest point-of-interest))) + (if (cam-slave-get-vector-with-offset (-> self cam-entity) point-of-interest 'interesting) + (send-event *camera* 'point-of-interest point-of-interest))) (go cam-fixed)) :code (behavior () @@ -75,16 +78,17 @@ (behavior ((proc process) (argc int) (message symbol) (block event-message-block)) (case message (('teleport) #f) - (else (cam-standard-event-handler proc argc message block)))) + (else + (cam-standard-event-handler proc argc message block)))) :enter (behavior () (when (not (-> self enter-has-run)) - (set! (-> self blend-from-type) (the-as uint 1)) - (set! (-> self blend-to-type) (the-as uint 1)))) + (set! (-> self blend-from-type) (camera-blend-to-type slave-controlled)) + (set! (-> self blend-to-type) (camera-blend-to-type slave-controlled)))) :trans (behavior () (when (not (handle->process (-> *camera* pov-handle))) - (set! (-> self blend-from-type) (the-as uint 0)) + (set! (-> self blend-from-type) (camera-blend-to-type direct)) (cam-slave-go cam-fixed))) :code (behavior () @@ -92,9 +96,8 @@ (when (not (paused?)) (vector<-cspace! (-> self trans) (-> (the-as pov-camera (-> *camera* pov-handle process 0)) node-list data (-> *camera* pov-bone))) - (matrix-copy! - (-> self tracking inv-mat) - (-> (the-as pov-camera (-> *camera* pov-handle process 0)) node-list data (-> *camera* pov-bone) bone transform)) + (matrix-copy! (-> self tracking inv-mat) + (-> (the-as pov-camera (-> *camera* pov-handle process 0)) node-list data (-> *camera* pov-bone) bone transform)) (vector-reset! (-> self tracking inv-mat vector 3))) (suspend)))) @@ -103,16 +106,17 @@ (behavior ((proc process) (argc int) (message symbol) (block event-message-block)) (case message (('teleport) #f) - (else (cam-standard-event-handler proc argc message block)))) + (else + (cam-standard-event-handler proc argc message block)))) :enter (behavior () (when (not (-> self enter-has-run)) - (set! (-> self blend-from-type) (the-as uint 1)) - (set! (-> self blend-to-type) (the-as uint 1)))) + (set! (-> self blend-from-type) (camera-blend-to-type slave-controlled)) + (set! (-> self blend-to-type) (camera-blend-to-type slave-controlled)))) :trans (behavior () (when (not (handle->process (-> *camera* pov-handle))) - (set! (-> self blend-from-type) (the-as uint 0)) + (set! (-> self blend-from-type) (camera-blend-to-type direct)) (cam-slave-go cam-fixed))) :code (behavior () @@ -122,7 +126,7 @@ (vector<-cspace! previous-position (-> (the-as pov-camera (-> *camera* pov-handle process 0)) node-list data (-> *camera* pov-bone))) (let ((initial-transform (-> (the-as pov-camera (-> *camera* pov-handle process 0)) node-list data (-> *camera* pov-bone) bone transform))) - (vector-normalize-copy! previous-forward (-> initial-transform vector 2) (the-as float 1.0))) + (vector-normalize-copy! previous-forward (-> initial-transform vector 2) 1.0)) (loop (when (not (paused?)) (let ((bone-transform (-> (the-as pov-camera (-> *camera* pov-handle process 0)) node-list data (-> *camera* pov-bone) bone transform)) @@ -131,19 +135,20 @@ (let ((position (new 'stack-no-clear 'vector))) (vector<-cspace! position (-> (the-as pov-camera (-> *camera* pov-handle process 0)) node-list data (-> *camera* pov-bone))) - (vector-normalize-copy! forward (-> bone-transform vector 2) (the-as float 1.0)) + (vector-normalize-copy! forward (-> bone-transform vector 2) 1.0) (set! first-valid-frame? (cond ((and (< (vector-vector-distance position previous-position) 40960.0) - (< (cos (the-as float 3640.889)) (vector-dot previous-forward forward))) + (< (cos (degrees 20)) (vector-dot previous-forward forward))) (vector-copy! (-> self trans) position) - (vector-negate! (the-as vector (-> self tracking)) (-> bone-transform vector 0)) + (vector-negate! (-> self tracking inv-mat vector 0) (-> bone-transform vector 0)) (set! (-> self tracking inv-mat vector 1 quad) (-> bone-transform vector 1 quad)) (vector-negate! (-> self tracking inv-mat vector 2) (-> bone-transform vector 2)) - (set! (-> self fov) (* 2.0 (atan (/ 12.700255 (* 20.3 (-> bone-scale x))) (the-as float 1.0)))) - (vector-float*! (the-as vector (-> self tracking)) (the-as vector (-> self tracking)) (/ 1.0 (-> bone-scale x))) + (set! (-> self fov) (* 2.0 (atan (/ 12.700255 (* 20.3 (-> bone-scale x))) 1.0))) + (vector-float*! (-> self tracking inv-mat vector 0) (-> self tracking inv-mat vector 0) (/ 1.0 (-> bone-scale x))) (vector-reset! (-> self tracking inv-mat vector 3)) - (if first-valid-frame? (set! first-valid-frame? #f)) + (if first-valid-frame? + (set! first-valid-frame? #f)) first-valid-frame?) (else #t))) (vector-copy! previous-position position)) @@ -155,29 +160,30 @@ :enter (behavior () (when (not (-> self enter-has-run)) - (set! (-> self blend-from-type) (the-as uint 2)) - (set! (-> self blend-to-type) (the-as uint 2))) + (set! (-> self blend-from-type) (camera-blend-to-type combiner-tracked)) + (set! (-> self blend-to-type) (camera-blend-to-type combiner-tracked))) (let ((point-of-interest (new 'stack-no-clear 'vector))) - (if (cam-slave-get-vector-with-offset (the-as entity-actor (-> self cam-entity)) point-of-interest 'interesting) - (send-event *camera* 'point-of-interest point-of-interest)))) + (if (cam-slave-get-vector-with-offset (-> self cam-entity) point-of-interest 'interesting) + (send-event *camera* 'point-of-interest point-of-interest)))) :trans (behavior () - (if (or (not (handle->process (-> *camera* pov-handle))) (not (logtest? (-> *camera* master-options) 2))) - (cam-slave-go cam-free-floating))) + (if (or (not (handle->process (-> *camera* pov-handle))) + (not (logtest? (-> *camera* master-options) (cam-master-options have-target)))) + (cam-slave-go cam-free-floating))) :code (behavior () (loop (if (not (paused?)) - (vector<-cspace! (-> self trans) - (-> (the-as pov-camera (-> *camera* pov-handle process 0)) node-list data (-> *camera* pov-bone)))) + (vector<-cspace! (-> self trans) + (-> (the-as pov-camera (-> *camera* pov-handle process 0)) node-list data (-> *camera* pov-bone)))) (suspend)))) (defbehavior cam-standoff-calc-trans camera-slave () "Place the camera at its standoff offset from the current target position and return the resulting translation." (if (-> self tracking no-follow) - (vector+! (-> self trans) (-> *camera* tpos-curr-adj) (-> self pivot-pt)) - (vector+! (-> self trans) (-> self tracking follow-pt) (-> self pivot-pt)))) + (vector+! (-> self trans) (-> *camera* tpos-curr-adj) (-> self pivot-pt)) + (vector+! (-> self trans) (-> self tracking follow-pt) (-> self pivot-pt)))) ;; Keep a fixed authored offset from the follow point. The no-follow option anchors the offset to ;; the raw target position, while #x8000 also keeps the authored orientation fixed. @@ -185,26 +191,32 @@ :event (behavior ((proc process) (argc int) (message symbol) (block event-message-block)) (case message - (('set-standoff-dist) (vector-normalize! (-> self pivot-pt) (the-as float (-> block param 0))) (cam-standoff-calc-trans)) + (('set-standoff-dist) + (vector-normalize! (-> self pivot-pt) (the-as float (-> block param 0))) + (cam-standoff-calc-trans)) (('set-standoff-height) (vector-flatten! (-> self pivot-pt) (-> self pivot-pt) (-> *camera* local-down)) (vector--float*! (-> self pivot-pt) (-> self pivot-pt) (-> *camera* local-down) (the-as float (-> block param 0))) (cam-standoff-calc-trans)) - (else (cam-standard-event-handler proc argc message block)))) + (else + (cam-standard-event-handler proc argc message block)))) :enter (behavior () (when (not (-> self enter-has-run)) (vector-! (-> self pivot-pt) (-> self trans) (-> *camera* tpos-curr-adj)) (cond - ((logtest? (-> self options) #x8000) - (set! (-> self blend-from-type) (the-as uint 0)) - (set! (-> self blend-to-type) (the-as uint 0)) + ((logtest? (-> self options) (cam-slave-options NO_ROTATE)) + (set! (-> self blend-from-type) (camera-blend-to-type direct)) + (set! (-> self blend-to-type) (camera-blend-to-type direct)) 0) - (else (set! (-> self blend-from-type) (the-as uint 2)) (set! (-> self blend-to-type) (the-as uint 2))))) + (else + (set! (-> self blend-from-type) (camera-blend-to-type combiner-tracked)) + (set! (-> self blend-to-type) (camera-blend-to-type combiner-tracked))))) (cam-calc-follow! (-> self tracking) (-> self trans) #f)) :trans (behavior () - (if (not (logtest? (-> *camera* master-options) 2)) (cam-slave-go cam-free-floating))) + (if (not (logtest? (-> *camera* master-options) (cam-master-options have-target))) + (cam-slave-go cam-free-floating))) :code (behavior () (loop @@ -222,21 +234,22 @@ ((-> self cam-entity) (let ((authored-position (new-stack-vector0)) (authored-align (new-stack-vector0))) - (cam-slave-get-vector-with-offset (the-as entity-actor (-> self cam-entity)) authored-position 'trans) - (cam-slave-get-vector-with-offset (the-as entity-actor (-> self cam-entity)) authored-align 'align) + (cam-slave-get-vector-with-offset (-> self cam-entity) authored-position 'trans) + (cam-slave-get-vector-with-offset (-> self cam-entity) authored-align 'align) (vector-! (-> self pivot-pt) authored-position authored-align)) (vector+! (-> self trans) (-> *camera* tpos-curr-adj) (-> self pivot-pt)) (set! (-> self fov) (cam-slave-get-fov (-> self cam-entity))) (logior! (-> self options) (cam-slave-get-flags (-> self cam-entity) 'flags)) - (if (logtest? (-> self options) #x8000) - (cam-slave-get-rot (the-as entity-actor (-> self cam-entity)) (-> self tracking inv-mat)) - (set! (-> self tracking tilt-adjust target) - (cam-slave-get-float (-> self cam-entity) 'tiltAdjust (-> *CAMERA-bank* default-tilt-adjust)))) + (if (logtest? (-> self options) (cam-slave-options NO_ROTATE)) + (cam-slave-get-rot (-> self cam-entity) (-> self tracking inv-mat)) + (set! (-> self tracking tilt-adjust target) + (cam-slave-get-float (-> self cam-entity) 'tiltAdjust (-> *CAMERA-bank* default-tilt-adjust)))) ((-> cam-standoff enter))) - (else (format #t "ERROR : cam-standoff-read-entity enter without entity~%"))) + (else + (format #t "ERROR : cam-standoff-read-entity enter without entity~%"))) (let ((point-of-interest (new 'stack-no-clear 'vector))) - (if (cam-slave-get-vector-with-offset (the-as entity-actor (-> self cam-entity)) point-of-interest 'interesting) - (send-event *camera* 'point-of-interest point-of-interest))) + (if (cam-slave-get-vector-with-offset (-> self cam-entity) point-of-interest 'interesting) + (send-event *camera* 'point-of-interest point-of-interest))) (go cam-standoff)) :code (behavior () @@ -260,25 +273,27 @@ (behavior ((proc process) (argc int) (message symbol) (block event-message-block)) (case message (('teleport) #f) - (else (cam-standard-event-handler proc argc message block)))) + (else + (cam-standard-event-handler proc argc message block)))) :enter (behavior () (when (not (-> self enter-has-run)) (let ((camera-offset (vector-float*! (new-stack-vector0) (-> *camera* local-down) (+ 1024.0 (-> *camera* target-height))))) (vector-! (-> self trans) (-> *camera* tpos-curr) camera-offset)) - (set! (-> self blend-from-type) (the-as uint 0)) - (set! (-> self blend-to-type) (the-as uint 0)) + (set! (-> self blend-from-type) (camera-blend-to-type direct)) + (set! (-> self blend-to-type) (camera-blend-to-type direct)) 0) (set! (-> self fov) 11650.845)) :exit (behavior () (if (and *target* - (logtest? (-> *camera* master-options) 2) - (logtest? (-> *target* state-flags) (state-flags first-person-mode))) - (send-event *target* 'end-mode))) + (logtest? (-> *camera* master-options) (cam-master-options have-target)) + (logtest? (-> *target* state-flags) (state-flags first-person-mode))) + (send-event *target* 'end-mode))) :trans (behavior () - (if (not (logtest? (-> *camera* master-options) 2)) (go cam-free-floating))) + (if (not (logtest? (-> *camera* master-options) (cam-master-options have-target))) + (go cam-free-floating))) :code (behavior () (let ((last-input-time (current-time))) @@ -314,21 +329,22 @@ ((< (-> rotation-step y) (- (* (-> *display* time-adjust-ratio) (-> *CAM_EYE-bank* rot-speed)))) ;; og:preserve-this changed for high fps (set! (-> rotation-step y) (- (* (-> *display* time-adjust-ratio) (-> *CAM_EYE-bank* rot-speed)))))) ;; og:preserve-this changed for high fps (cond - ((and (= (-> rotation-step x) 0.0) (= (-> rotation-step y) 0.0)) (set! last-input-time (current-time))) + ((and (= (-> rotation-step x) 0.0) (= (-> rotation-step y) 0.0)) + (set! last-input-time (current-time))) (else (let ((input-ramp (min 10 (max 1 (- (current-time) last-input-time))))) (vector-float*! rotation-step rotation-step (* 0.1 (the float input-ramp)))))) (matrix-axis-angle! rotation (-> *camera* local-down) (-> rotation-step y)) (matrix*! (-> self tracking inv-mat) (-> self tracking inv-mat) rotation) - (when (not (logtest? (-> self options) 8)) + (when (not (logtest? (-> self options) (cam-slave-options ALLOW_Z_ROT))) (if (< (vector-dot (-> self tracking inv-mat vector 1) (-> *camera* local-down)) 0.0) - (forward-down->inv-matrix (-> self tracking inv-mat) (-> self tracking inv-mat vector 2) (-> *camera* local-down)) - (forward-down->inv-matrix (-> self tracking inv-mat) - (-> self tracking inv-mat vector 2) - (vector-negate! (new-stack-vector0) (-> *camera* local-down))))) - (matrix-axis-angle! rotation (the-as vector (-> self tracking)) (- (-> rotation-step x))) + (forward-down->inv-matrix (-> self tracking inv-mat) (-> self tracking inv-mat vector 2) (-> *camera* local-down)) + (forward-down->inv-matrix (-> self tracking inv-mat) + (-> self tracking inv-mat vector 2) + (vector-negate! (new-stack-vector0) (-> *camera* local-down))))) + (matrix-axis-angle! rotation (-> self tracking inv-mat vector 0) (- (-> rotation-step x))) (matrix*! (-> self tracking inv-mat) (-> self tracking inv-mat) rotation)) - (when (not (logtest? (-> self options) 8)) + (when (not (logtest? (-> self options) (cam-slave-options ALLOW_Z_ROT))) (let ((vertical-forward-component (vector-dot (-> *camera* local-down) (-> self tracking inv-mat vector 2)))) (set! (-> (new 'stack-no-clear 'vector) quad) (the-as uint128 0)) (when (< (sin (-> *CAM_EYE-bank* max-degrees)) (fabs vertical-forward-component)) @@ -338,17 +354,17 @@ vertical-forward-component) (vector-normalize! (-> self tracking inv-mat vector 2) (cos (-> *CAM_EYE-bank* max-degrees))) (if (< vertical-forward-component 0.0) - (vector--float*! (-> self tracking inv-mat vector 2) - (-> self tracking inv-mat vector 2) - (-> *camera* local-down) - (sin (-> *CAM_EYE-bank* max-degrees))) - (vector+float*! (-> self tracking inv-mat vector 2) - (-> self tracking inv-mat vector 2) - (-> *camera* local-down) - (sin (-> *CAM_EYE-bank* max-degrees)))) + (vector--float*! (-> self tracking inv-mat vector 2) + (-> self tracking inv-mat vector 2) + (-> *camera* local-down) + (sin (-> *CAM_EYE-bank* max-degrees))) + (vector+float*! (-> self tracking inv-mat vector 2) + (-> self tracking inv-mat vector 2) + (-> *camera* local-down) + (sin (-> *CAM_EYE-bank* max-degrees)))) (vector-cross! (-> self tracking inv-mat vector 1) (-> self tracking inv-mat vector 2) - (the-as vector (-> self tracking))) + (-> self tracking inv-mat vector 0)) (set! (-> self tracking inv-mat vector 1 w) 0.0))))) (let ((camera-offset (vector-float*! (new-stack-vector0) (-> *camera* local-down) (+ 1024.0 (-> *camera* target-height))))) (vector-! (-> self trans) (-> *camera* tpos-curr) camera-offset)) @@ -358,6 +374,7 @@ ((rot-speed float) (tilt-degrees float))) + (define *CAM_BILLY-bank* (new 'static 'cam-billy-bank :rot-speed 364.0889 :tilt-degrees -1820.4445)) (defstate cam-billy (camera-slave) @@ -365,23 +382,25 @@ (behavior ((proc process) (argc int) (message symbol) (block event-message-block)) (case message (('teleport) #f) - (else (cam-standard-event-handler proc argc message block)))) + (else + (cam-standard-event-handler proc argc message block)))) :enter (behavior () (when (not (-> self enter-has-run)) (let ((camera-offset (vector-float*! (new-stack-vector0) (-> *camera* local-down) (-> *camera* target-height)))) (vector-! (-> self trans) (-> *camera* tpos-curr) camera-offset)) - (set! (-> self blend-from-type) (the-as uint 0)) - (set! (-> self blend-to-type) (the-as uint 0)) + (set! (-> self blend-from-type) (camera-blend-to-type direct)) + (set! (-> self blend-to-type) (camera-blend-to-type direct)) 0) (set! (-> self fov) 9830.4) - (matrix-rotate-y! (-> self tracking inv-mat) (the-as float -32768.0))) + (matrix-rotate-y! (-> self tracking inv-mat) -32768.0)) :exit (behavior () '()) :trans (behavior () - (if (not (logtest? (-> *camera* master-options) 2)) (go cam-free-floating))) + (if (not (logtest? (-> *camera* master-options) (cam-master-options have-target))) + (go cam-free-floating))) :code (behavior () (loop @@ -402,18 +421,19 @@ (set! (-> yaw-step y) (- (-> yaw-step y) (* (- horizontal-input) (* (-> *display* time-adjust-ratio) (-> *CAM_BILLY-bank* rot-speed))))))) ;; og:preserve-this changed for high fps (cond - ((< (* (-> *display* time-adjust-ratio) (-> *CAM_BILLY-bank* rot-speed)) (-> yaw-step y)) ;; og:preserve-this changed for high fps - (set! (-> yaw-step y) (* (-> *display* time-adjust-ratio) (-> *CAM_BILLY-bank* rot-speed)))) ;; og:preserve-this changed for high fps - ((< (-> yaw-step y) (- (* (-> *display* time-adjust-ratio) (-> *CAM_BILLY-bank* rot-speed)))) ;; og:preserve-this changed for high fps - (set! (-> yaw-step y) (- (* (-> *display* time-adjust-ratio) (-> *CAM_BILLY-bank* rot-speed)))))) ;; og:preserve-this changed for high fps - (set! (-> limit-forward x) (sin (the-as float 37319.11))) - (set! (-> limit-forward z) (cos (the-as float 37319.11))) + ((< (-> *CAM_BILLY-bank* rot-speed) (-> yaw-step y)) + (set! (-> yaw-step y) (-> *CAM_BILLY-bank* rot-speed))) + ((< (-> yaw-step y) (- (-> *CAM_BILLY-bank* rot-speed))) + (set! (-> yaw-step y) (- (-> *CAM_BILLY-bank* rot-speed))))) + (set! (-> limit-forward x) (sin 37319.11)) + (set! (-> limit-forward z) (cos 37319.11)) (set! (-> limit-side x) (-> limit-forward z)) (set! (-> limit-side z) (- (-> limit-forward x))) (vector-flatten! flat-forward (-> self tracking inv-mat vector 2) (-> *camera* local-down)) - (vector-normalize! flat-forward (the-as float 1.0)) + (vector-normalize! flat-forward 1.0) (let ((yaw-from-limit (acos (vector-dot (-> self tracking inv-mat vector 2) limit-forward)))) - (if (< (vector-dot (-> self tracking inv-mat vector 2) limit-side) 0.0) (set! yaw-from-limit (- yaw-from-limit))) + (if (< (vector-dot (-> self tracking inv-mat vector 2) limit-side) 0.0) + (set! yaw-from-limit (- yaw-from-limit))) (let ((clamped-yaw-step (cond ((and (< 0.0 yaw-from-limit) (< 0.0 (-> yaw-step y))) (fmin (-> yaw-step y) (fmax 0.0 (* 0.5 (- 10922.667 yaw-from-limit))))) @@ -425,11 +445,11 @@ (set! (-> self tracking inv-mat vector 2 y) 0.0) (vector-normalize! (-> self tracking inv-mat vector 2) (cos (-> *CAM_BILLY-bank* tilt-degrees))) (set! (-> self tracking inv-mat vector 2 y) (sin (-> *CAM_BILLY-bank* tilt-degrees))) - (vector-cross! (the-as vector (-> self tracking)) (-> self tracking inv-mat vector 2) (-> *camera* local-down)) - (vector-normalize! (the-as vector (-> self tracking)) (the-as float 1.0)) + (vector-cross! (-> self tracking inv-mat vector 0) (-> self tracking inv-mat vector 2) (-> *camera* local-down)) + (vector-normalize! (-> self tracking inv-mat vector 0) 1.0) (vector-cross! (-> self tracking inv-mat vector 1) (-> self tracking inv-mat vector 2) - (the-as vector (-> self tracking)))) + (-> self tracking inv-mat vector 0))) (vector--float*! (-> self trans) (-> *camera* tpos-curr) (-> *camera* local-down) (-> *camera* target-height)) (suspend)))) @@ -447,49 +467,50 @@ (let ((authored-position (new-stack-vector0))) (set! (-> self fov) (cam-slave-get-fov (-> self cam-entity))) (logior! (-> self options) (cam-slave-get-flags (-> self cam-entity) 'flags)) - (if (logtest? (-> self options) #x8000) - (cam-slave-get-rot (the-as entity-actor (-> self cam-entity)) (-> self tracking inv-mat)) - (set! (-> self tracking tilt-adjust target) - (cam-slave-get-float (-> self cam-entity) 'tiltAdjust (-> *CAMERA-bank* default-tilt-adjust)))) - (cam-slave-get-vector-with-offset (the-as entity-actor (-> self cam-entity)) authored-position 'trans) + (if (logtest? (-> self options) (cam-slave-options NO_ROTATE)) + (cam-slave-get-rot (-> self cam-entity) (-> self tracking inv-mat)) + (set! (-> self tracking tilt-adjust target) + (cam-slave-get-float (-> self cam-entity) 'tiltAdjust (-> *CAMERA-bank* default-tilt-adjust)))) + (cam-slave-get-vector-with-offset (-> self cam-entity) authored-position 'trans) (cam-curve-setup authored-position)) (vector-negate! (-> self saved-pt) (-> self spline-offset)) - (let ((spline-offset-data (res-lump-struct (-> self cam-entity) 'spline-offset structure :time (the-as float -1000000000.0)))) - (if spline-offset-data (vector+! (-> self spline-offset) (-> self spline-offset) (the-as vector spline-offset-data)))) + (let ((spline-offset-data (res-lump-struct (-> self cam-entity) 'spline-offset structure))) + (if spline-offset-data + (vector+! (-> self spline-offset) (-> self spline-offset) (the-as vector spline-offset-data)))) (vector-copy! (-> self trans) (-> self saved-pt)) (cam-calc-follow! (-> self tracking) (-> self trans) #f) - (set! (-> self spline-follow-dist) (cam-slave-get-float (-> self cam-entity) 'spline-follow-dist (the-as float 0.0))) + (set! (-> self spline-follow-dist) (cam-slave-get-float (-> self cam-entity) 'spline-follow-dist 0.0)) (cond ((< 0.0 (-> self spline-follow-dist)) (let ((curve-start (new 'stack-no-clear 'vector)) (curve-end (new 'stack-no-clear 'vector))) - (curve-get-pos! curve-start (the-as float 0.0) (-> self spline-curve)) - (curve-get-pos! curve-end (the-as float 1.0) (-> self spline-curve)) + (curve-get-pos! curve-start 0.0 (-> self spline-curve)) + (curve-get-pos! curve-end 1.0 (-> self spline-curve)) (if (< (vector-vector-distance-squared curve-start (-> self tracking follow-pt)) - (vector-vector-distance-squared curve-end (-> self tracking follow-pt))) - (set! (-> self spline-follow-dist) (- (-> self spline-follow-dist))))) + (vector-vector-distance-squared curve-end (-> self tracking follow-pt))) + (set! (-> self spline-follow-dist) (- (-> self spline-follow-dist))))) (set! (-> self spline-tt) - (curve-closest-point (-> self spline-curve) - (-> self tracking follow-pt) - (the-as float 0.5) - (the-as float -4096.0) - 10 - (-> self spline-follow-dist)))) - (else (set! (-> self spline-follow-dist) 0.0))) + (curve-closest-point (-> self spline-curve) (-> self tracking follow-pt) 0.5 -4096.0 10 (-> self spline-follow-dist)))) + (else + (set! (-> self spline-follow-dist) 0.0))) (cam-curve-pos (-> self trans) (the-as vector #f) (the-as curve #f) #t) (cond - ((logtest? (-> self options) #x8000) - (set! (-> self blend-from-type) (the-as uint 0)) - (set! (-> self blend-to-type) (the-as uint 0)) + ((logtest? (-> self options) (cam-slave-options NO_ROTATE)) + (set! (-> self blend-from-type) (camera-blend-to-type direct)) + (set! (-> self blend-to-type) (camera-blend-to-type direct)) 0) - (else (set! (-> self blend-from-type) (the-as uint 2)) (set! (-> self blend-to-type) (the-as uint 2))))) - (else (format #t "ERROR : cam-spline enter without entity~%"))) + (else + (set! (-> self blend-from-type) (camera-blend-to-type combiner-tracked)) + (set! (-> self blend-to-type) (camera-blend-to-type combiner-tracked))))) + (else + (format #t "ERROR : cam-spline enter without entity~%"))) (let ((point-of-interest (new 'stack-no-clear 'vector))) - (if (cam-slave-get-vector-with-offset (the-as entity-actor (-> self cam-entity)) point-of-interest 'interesting) - (send-event *camera* 'point-of-interest point-of-interest)))) + (if (cam-slave-get-vector-with-offset (-> self cam-entity) point-of-interest 'interesting) + (send-event *camera* 'point-of-interest point-of-interest)))) :trans (behavior () - (if (not (logtest? (-> *camera* master-options) 2)) (cam-slave-go cam-free-floating))) + (if (not (logtest? (-> *camera* master-options) (cam-master-options have-target))) + (cam-slave-go cam-free-floating))) :code (behavior () (loop @@ -507,10 +528,12 @@ (behavior ((proc process) (argc int) (message symbol) (block event-message-block)) (case message (('teleport) #f) - (else (cam-standard-event-handler proc argc message block)))) + (else + (cam-standard-event-handler proc argc message block)))) :enter (behavior () - (if (not (-> self enter-has-run)) (vector-copy! (-> self saved-pt) (-> self trans)))) + (if (not (-> self enter-has-run)) + (vector-copy! (-> self saved-pt) (-> self trans)))) :code (behavior () (loop @@ -529,7 +552,8 @@ (set! (-> *camera* outro-t-step) 0.0) (vector+! (-> self velocity) (-> self velocity) next-outro-position) (send-event *camera* 'outro-done)) - (else (vector+! (-> self trans) (-> self trans) next-outro-position))))) + (else + (vector+! (-> self trans) (-> self trans) next-outro-position))))) (vector-float*! (-> self velocity) (-> self velocity) 0.9) (vector+! (-> self trans) (-> self trans) (-> self velocity))) (suspend)))) @@ -539,12 +563,13 @@ (behavior ((proc process) (argc int) (message symbol) (block event-message-block)) (case message (('teleport) #f) - (else (cam-standard-event-handler proc argc message block)))) + (else + (cam-standard-event-handler proc argc message block)))) :enter (behavior () (when (not (-> self enter-has-run)) - (set! (-> self blend-from-type) (the-as uint 2)) - (set! (-> self blend-to-type) (the-as uint 2)))) + (set! (-> self blend-from-type) (camera-blend-to-type combiner-tracked)) + (set! (-> self blend-to-type) (camera-blend-to-type combiner-tracked)))) :code (behavior () (let ((horizontal-seeker (new 'stack-no-clear 'cam-vector-seeker)) @@ -555,11 +580,7 @@ (set! (-> horizontal-position y) 0.0) (vector-copy! horizontal-velocity (-> self velocity)) (set! (-> horizontal-velocity y) 0.0) - (init! horizontal-seeker - horizontal-position - (the-as float 81.92) - (fmax 819.2 (vector-length horizontal-velocity)) - (the-as float 0.75)) + (init! horizontal-seeker horizontal-position 81.92 (fmax 819.2 (vector-length horizontal-velocity)) 0.75) (vector-copy! (-> horizontal-seeker vel) horizontal-velocity)) (loop (when (not (paused?)) @@ -568,7 +589,8 @@ (update! horizontal-seeker (the-as vector #f)) (when (< 819.2 (-> horizontal-seeker max-vel)) (set! (-> horizontal-seeker max-vel) (* 0.9 (-> horizontal-seeker max-vel))) - (if (< (-> horizontal-seeker max-vel) 819.2) (set! (-> horizontal-seeker max-vel) 819.2))) + (if (< (-> horizontal-seeker max-vel) 819.2) + (set! (-> horizontal-seeker max-vel) 819.2))) (set! vertical-speed (* 0.9 vertical-speed)) (+! (-> self trans y) vertical-speed) (set! (-> self trans x) (-> horizontal-seeker value x)) @@ -579,8 +601,8 @@ "Constrain current-direction to the orbit radius and permitted angle from ideal-direction. Apply optional analog orbit input and approach the boundary by approach-scale without overshooting." - (let* ((current-length (vector-normalize-ret-len! current-direction (the-as float 1.0))) - (ideal-length (vector-normalize-ret-len! ideal-direction (the-as float 1.0))) + (let* ((current-length (vector-normalize-ret-len! current-direction 1.0)) + (ideal-length (vector-normalize-ret-len! ideal-direction 1.0)) (direction-dot (vector-dot current-direction ideal-direction)) (angle (acos direction-dot)) (rotation (new 'stack-no-clear 'matrix))) @@ -600,21 +622,29 @@ (input-rotation (new-stack-matrix0))) (let ((side-cross (new 'stack-no-clear 'vector))) 0.0 - (if (< (-> self pivot-rad) current-length) (set! horizontal-input (- horizontal-input))) + (if (< (-> self pivot-rad) current-length) + (set! horizontal-input (- horizontal-input))) (vector-cross! side-cross ideal-direction current-direction) (let ((side (vector-dot side-cross (-> *camera* local-down)))) - (if (< vertical-input 0.0) (set! vertical-input (fmax vertical-input (* -0.15 angle)))) - (if (< side 0.0) (set! vertical-input (- vertical-input))) + (if (< vertical-input 0.0) + (set! vertical-input (fmax vertical-input (* -0.15 angle)))) + (if (< side 0.0) + (set! vertical-input (- vertical-input))) (let* ((requested-orbit (+ horizontal-input vertical-input)) (orbit-step (fmin (* 8192.0 (seconds-per-frame)) (fmax (* -8192.0 (seconds-per-frame)) requested-orbit)))) (cond - ((and (< 0.0 orbit-step) (< 0.0 side) (< (-> self max-angle-curr) angle)) (set! orbit-step 0.0)) - ((and (< 0.0 orbit-step) (< 0.0 side)) (set! orbit-step (fmin orbit-step (* 0.15 (- (-> self max-angle-curr) angle))))) - ((and (< orbit-step 0.0) (< side 0.0) (< (-> self max-angle-curr) angle)) (set! orbit-step 0.0)) - ((and (< orbit-step 0.0) (< side 0.0)) (set! orbit-step (fmax orbit-step (* 0.15 (- angle (-> self max-angle-curr))))))) + ((and (< 0.0 orbit-step) (< 0.0 side) (< (-> self max-angle-curr) angle)) + (set! orbit-step 0.0)) + ((and (< 0.0 orbit-step) (< 0.0 side)) + (set! orbit-step (fmin orbit-step (* 0.15 (- (-> self max-angle-curr) angle))))) + ((and (< orbit-step 0.0) (< side 0.0) (< (-> self max-angle-curr) angle)) + (set! orbit-step 0.0)) + ((and (< orbit-step 0.0) (< side 0.0)) + (set! orbit-step (fmax orbit-step (* 0.15 (- angle (-> self max-angle-curr))))))) (matrix-axis-angle! input-rotation (-> *camera* local-down) orbit-step)))) (vector-matrix*! ideal-direction ideal-direction input-rotation)) - (let ((updated-dot (vector-dot current-direction ideal-direction))) (set! angle (acos updated-dot)))) + (let ((updated-dot (vector-dot current-direction ideal-direction))) + (set! angle (acos updated-dot)))) (cond ((< (-> self max-angle-curr) angle) (matrix-from-two-vectors-max-angle! rotation @@ -622,19 +652,20 @@ current-direction (* (fmin 1.0 (* approach-scale (-> *display* time-adjust-ratio))) (- angle (-> self max-angle-curr)))) (vector-matrix*! current-direction ideal-direction rotation)) - ((and (logtest? (-> self options) 2) + ((and (logtest? (-> self options) (cam-slave-options SAME_SIDE)) (or (and (>= ideal-length (+ -8192.0 current-length)) (>= current-length (+ -8192.0 (-> self pivot-rad)))) (and (>= (+ 8192.0 current-length) ideal-length) (>= (+ 8192.0 (-> self pivot-rad)) current-length)))) (let ((rotation-axis (new 'stack-no-clear 'vector))) (vector-cross! rotation-axis ideal-direction current-direction) - (vector-normalize! rotation-axis (the-as float 1.0)) + (vector-normalize! rotation-axis 1.0) (matrix-axis-angle! rotation rotation-axis (* (fmin 1.0 (* approach-scale (-> *display* time-adjust-ratio))) (- (-> self max-angle-curr) angle)))) (vector-matrix*! current-direction ideal-direction rotation)) (else (vector-copy! current-direction ideal-direction) - (if (logtest? (-> self options) 2048) (set! (-> self max-angle-curr) angle))))) + (if (logtest? (-> self options) (cam-slave-options SHRINK_MAX_ANGLE)) + (set! (-> self max-angle-curr) angle))))) (vector-normalize! current-direction (-> self pivot-rad))) (defbehavior cam-circular-position camera-slave ((approach-slowly? symbol)) @@ -642,21 +673,24 @@ true, move gently toward the angular limit; otherwise establish the orbit immediately." (let ((orbit-direction (new 'stack-no-clear 'vector))) (let ((current-direction (new 'stack-no-clear 'vector))) - (if (logtest? (-> self options) 130) - (vector-! orbit-direction (-> self circular-follow) (-> self pivot-pt)) - (vector-! orbit-direction (-> self pivot-pt) (-> self circular-follow))) + (if (logtest? (-> self options) (cam-slave-options SAME_SIDE DRAG)) + (vector-! orbit-direction (-> self circular-follow) (-> self pivot-pt)) + (vector-! orbit-direction (-> self pivot-pt) (-> self circular-follow))) (vector-! current-direction (-> self trans) (-> self pivot-pt)) - (when (not (logtest? (-> self options) 4)) + (when (not (logtest? (-> self options) (cam-slave-options MOVE_SPHERICAL))) (vector-flatten! orbit-direction orbit-direction (-> *camera* local-down)) (vector-flatten! current-direction current-direction (-> *camera* local-down))) (cond - ((logtest? (-> self options) 128) + ((logtest? (-> self options) (cam-slave-options DRAG)) (let ((radius-error (- (vector-length orbit-direction) (-> self pivot-rad)))) - (if (>= 0.0 radius-error) (vector-reset! orbit-direction) (vector-normalize! orbit-direction radius-error)))) + (if (>= 0.0 radius-error) + (vector-reset! orbit-direction) + (vector-normalize! orbit-direction radius-error)))) ((not approach-slowly?) (set! (-> self max-angle-curr) (-> self max-angle-offset)) - (cam-circular-position-into-max-angle orbit-direction current-direction (the-as float 1.0))) - (else (cam-circular-position-into-max-angle orbit-direction current-direction (the-as float 0.05))))) + (cam-circular-position-into-max-angle orbit-direction current-direction 1.0)) + (else + (cam-circular-position-into-max-angle orbit-direction current-direction 0.05)))) (vector+! (-> self trans) orbit-direction (-> self pivot-pt)))) (defbehavior cam-circular-code camera-slave () @@ -667,24 +701,24 @@ (let ((target-from-pivot (new-stack-vector0))) (vector-! target-from-pivot (-> *camera* tpos-curr-adj) (-> self pivot-pt)) (vector-! (-> self circular-follow) (-> self circular-follow) (-> self pivot-pt)) - (if (logtest? (-> self options) 4) - (v-slrp3! (-> self circular-follow) - (-> self circular-follow) - target-from-pivot - (the-as vector #f) - (* 182.04445 (-> *display* time-adjust-ratio))) - (v-slrp3! (-> self circular-follow) - (-> self circular-follow) - target-from-pivot - (-> *camera* local-down) - (* 182.04445 (-> *display* time-adjust-ratio))))) + (if (logtest? (-> self options) (cam-slave-options MOVE_SPHERICAL)) + (v-slrp3! (-> self circular-follow) + (-> self circular-follow) + target-from-pivot + (the-as vector #f) + (* 182.04445 (-> *display* time-adjust-ratio))) + (v-slrp3! (-> self circular-follow) + (-> self circular-follow) + target-from-pivot + (-> *camera* local-down) + (* 182.04445 (-> *display* time-adjust-ratio))))) (vector+! (-> self circular-follow) (-> self circular-follow) (-> self pivot-pt)) (cam-circular-position #t) (if (!= (-> self fov1) 0.0) - (set! (-> self fov) - (lerp-clamp (-> self fov0) - (-> self fov1) - (parameter-ease-sin-clamp (point->parameter (-> self fov-index) (-> *camera* tpos-curr-adj))))))) + (set! (-> self fov) + (lerp-clamp (-> self fov0) + (-> self fov1) + (parameter-ease-sin-clamp (point->parameter (-> self fov-index) (-> *camera* tpos-curr-adj))))))) ;; Orbit an authored or derived pivot while staying within max-angle-curr of the target-relative ;; direction. The pivot may itself move on a curve, and focalPull can drive FOV from target @@ -694,8 +728,11 @@ (behavior ((proc process) (argc int) (message symbol) (block event-message-block)) (case message (('teleport) #f) - (('outro-done) (vector-copy! (-> self trans) (-> *camera-combiner* trans)) (cam-circular-position #f)) - (else (cam-standard-event-handler proc argc message block)))) + (('outro-done) + (vector-copy! (-> self trans) (-> *camera-combiner* trans)) + (cam-circular-position #f)) + (else + (cam-standard-event-handler proc argc message block)))) :enter (behavior () (cond @@ -708,27 +745,29 @@ (set! (-> self max-angle-offset) 0.0) (cond ((-> self cam-entity) - (cam-slave-get-vector-with-offset (the-as entity-actor (-> self cam-entity)) (-> self saved-pt) 'pivot) - (cam-slave-get-vector-with-offset (the-as entity-actor (-> self cam-entity)) authored-offset 'trans) + (cam-slave-get-vector-with-offset (-> self cam-entity) (-> self saved-pt) 'pivot) + (cam-slave-get-vector-with-offset (-> self cam-entity) authored-offset 'trans) (set! (-> self pivot-rad) (vector-length (vector-! authored-offset authored-offset (-> self saved-pt)))) (logior! (-> self options) (cam-slave-get-flags (-> self cam-entity) 'flags)) (set! (-> self fov) (cam-slave-get-fov (-> self cam-entity))) (set! (-> self tracking tilt-adjust target) (cam-slave-get-float (-> self cam-entity) 'tiltAdjust (-> *CAMERA-bank* default-tilt-adjust))) - (set! (-> self max-angle-offset) (cam-slave-get-float (-> self cam-entity) 'maxAngle (the-as float 0.0))) - (if (< (-> self max-angle-offset) 0.0) (set! (-> self max-angle-offset) 0.0)) - (set! (-> self fov1) (cam-slave-get-float (-> self cam-entity) 'focalPull (the-as float 0.0))) + (set! (-> self max-angle-offset) (cam-slave-get-float (-> self cam-entity) 'maxAngle 0.0)) + (if (< (-> self max-angle-offset) 0.0) + (set! (-> self max-angle-offset) 0.0)) + (set! (-> self fov1) (cam-slave-get-float (-> self cam-entity) 'focalPull 0.0)) (cond ((and (!= (-> self fov1) 0.0) (setup-from-entity! (-> self fov-index) 'focalpull (-> self cam-entity) (-> self saved-pt) (the-as curve #f))) (set! (-> self fov0) (-> self fov)) (set! (-> self fov) (lerp-clamp (-> self fov0) (-> self fov1) (point->parameter (-> self fov-index) (-> *camera* tpos-curr-adj))))) - (else (set! (-> self fov1) 0.0))) + (else + (set! (-> self fov1) 0.0))) (cam-curve-setup (-> self saved-pt)) (vector-copy! (-> self pivot-pt) (-> self saved-pt)) (cam-curve-pos (-> self pivot-pt) (the-as vector #f) (the-as curve #f) #f)) - ((logtest? (-> self options) 128) + ((logtest? (-> self options) (cam-slave-options DRAG)) (vector-! (-> self pivot-pt) (-> *camera* tpos-curr-adj) (-> self trans)) (vector-flatten! (-> self pivot-pt) (-> self pivot-pt) (-> *camera* local-down)) (set! (-> self pivot-rad) (vector-length (-> self pivot-pt))) @@ -742,18 +781,20 @@ (vector+! (-> self pivot-pt) (-> self trans) (-> self pivot-pt)) (vector-copy! (-> self saved-pt) (-> self pivot-pt))))) (cam-circular-position #f) - (set! (-> self blend-from-type) (the-as uint 2)) - (set! (-> self blend-to-type) (the-as uint 2)))) + (set! (-> self blend-from-type) (camera-blend-to-type combiner-tracked)) + (set! (-> self blend-to-type) (camera-blend-to-type combiner-tracked)))) (let ((point-of-interest (new 'stack-no-clear 'vector))) - (if (cam-slave-get-vector-with-offset (the-as entity-actor (-> self cam-entity)) point-of-interest 'interesting) - (send-event *camera* 'point-of-interest point-of-interest)))) + (if (cam-slave-get-vector-with-offset (-> self cam-entity) point-of-interest 'interesting) + (send-event *camera* 'point-of-interest point-of-interest)))) :trans (behavior () - (if (not (logtest? (-> *camera* master-options) 2)) (cam-slave-go cam-free-floating))) + (if (not (logtest? (-> *camera* master-options) (cam-master-options have-target))) + (cam-slave-go cam-free-floating))) :code (behavior () (loop - (if (not (paused?)) (cam-circular-code)) + (if (not (paused?)) + (cam-circular-code)) (suspend)))) (defstate cam-lookat (camera-slave) @@ -761,11 +802,12 @@ :enter (behavior () (when (not (-> self enter-has-run)) - (set! (-> self blend-from-type) (the-as uint 2)) - (set! (-> self blend-to-type) (the-as uint 2)))) + (set! (-> self blend-from-type) (camera-blend-to-type combiner-tracked)) + (set! (-> self blend-to-type) (camera-blend-to-type combiner-tracked)))) :trans (behavior () - (if (not (logtest? (-> *camera* master-options) 2)) (cam-slave-go cam-free-floating))) + (if (not (logtest? (-> *camera* master-options) (cam-master-options have-target))) + (cam-slave-go cam-free-floating))) :code (behavior () (loop @@ -777,6 +819,7 @@ ;; The live camera uses a one-meter sphere to find occluders and room to slide. Breadcrumb ;; visibility uses the tighter half-meter sphere, allowing a recovery point closer to geometry. + (define *CAM_STRING-bank* (new 'static 'cam-string-bank :los-coll-rad (meters 1) :los-coll-rad2 (meters 0.5))) (defun cam-string-find-position-rel! ((out-offset vector)) @@ -790,21 +833,21 @@ (rotation (new 'stack-no-clear 'matrix))) (vector-flatten! default-offset (-> *camera-combiner* inv-camera-rot vector 2) (-> *camera* local-down)) (if (= (vector-normalize-ret-len! default-offset (- (+ 1024.0 (-> *CAMERA-bank* default-string-min-z)))) 0.0) - (set! (-> default-offset z) (+ 1024.0 (-> *CAMERA-bank* default-string-min-z)))) + (set! (-> default-offset z) (+ 1024.0 (-> *CAMERA-bank* default-string-min-z)))) (vector--float*! default-offset default-offset (-> *camera* local-down) (-> *CAMERA-bank* default-string-min-y)) (vector-copy! out-offset default-offset) (loop (vector--float*! target-offset out-offset (-> *camera* local-down) (-> *camera* target-height)) (if (< (fill-and-probe-using-line-sphere *collide-cache* - (-> *camera* tpos-curr-adj) - out-offset - (the-as float 409.6) - (collide-kind background cak-3 wall-object ground-object cak-14) - (the-as process #f) - probe-result - (new 'static 'pat-surface :nocamera #x1)) - 0.0) - (return #t)) + (-> *camera* tpos-curr-adj) + out-offset + (meters 0.1) + (collide-kind background hit-by-others wall-object ground-object cak-14) + (the-as process #f) + probe-result + (new 'static 'pat-surface :nocamera #x1)) + 0.0) + (return #t)) (set! search-angle (cond ((>= -32768.0 search-angle) @@ -812,8 +855,10 @@ (vector-copy! out-offset default-offset) (return #f) search-angle) - ((< 0.0 search-angle) (- search-angle)) - (else (- 5461.3335 search-angle)))) + ((< 0.0 search-angle) + (- search-angle)) + (else + (- 5461.3335 search-angle)))) (matrix-axis-angle! rotation (-> *camera* local-down) search-angle) (vector-matrix*! out-offset default-offset rotation))) (the-as symbol #f)) @@ -827,13 +872,12 @@ (vector-copy! (-> self string-trans) (-> self desired-pos)) (reset! (-> self position-spline) (-> self desired-pos)) (vector-reset! (-> self velocity)) - (let ((options-without-jump (logand -4097 (-> self options)))) - (set! (-> self options) options-without-jump) - (the-as int options-without-jump))) + (logclear! (-> self options) (cam-slave-options GOTO_GOOD_POINT)) + (none)) (defun string-push-help () "Return the string camera's fixed 0.1-meter collision push." - (the-as float 409.6)) + 409.6) (defun-debug cam-draw-collide-cache ((cache collide-cache)) "Draw every cached collision triangle without depth testing." @@ -842,11 +886,11 @@ (let ((color #x40000080)) (add-debug-flat-triangle #t (bucket-id debug-no-zbuf) - (the-as vector (-> triangles 0)) + (-> triangles 0 vertex 0) (-> triangles 0 vertex 1) (-> triangles 0 vertex 2) (the-as rgba color))) - (set! triangles (the-as (inline-array collide-cache-tri) (-> triangles 1))))) + (set! triangles (&-> triangles 1)))) 0 (none)) @@ -866,6 +910,7 @@ (lat-dist float) (vert-dist float))) + (deftype collide-los-dist-info (structure) ((min-par float) (max-par float) @@ -877,6 +922,7 @@ (max-vn float) (count int32))) + (defun dist-info-init ((info collide-los-dist-info)) "Mark an obstruction extent summary empty and reset its sample count." (set! (-> info min-par) 1.0) @@ -895,17 +941,25 @@ lateral, and signed-side vertical coordinates." (cond ((dist-info-valid? info) - (if (< (-> point x) (-> info min-par)) (set! (-> info min-par) (-> point x))) - (if (< (-> info max-par) (-> point x)) (set! (-> info max-par) (-> point x))) - (if (< (-> point y) (-> info min-lat)) (set! (-> info min-lat) (-> point y))) - (if (< (-> info max-lat) (-> point y)) (set! (-> info max-lat) (-> point y))) + (if (< (-> point x) (-> info min-par)) + (set! (-> info min-par) (-> point x))) + (if (< (-> info max-par) (-> point x)) + (set! (-> info max-par) (-> point x))) + (if (< (-> point y) (-> info min-lat)) + (set! (-> info min-lat) (-> point y))) + (if (< (-> info max-lat) (-> point y)) + (set! (-> info max-lat) (-> point y))) (cond ((< (-> point y) 0.0) - (if (< (-> point z) (-> info min-vn)) (set! (-> info min-vn) (-> point z))) - (if (< (-> info max-vn) (-> point z)) (set! (-> info max-vn) (-> point z)))) + (if (< (-> point z) (-> info min-vn)) + (set! (-> info min-vn) (-> point z))) + (if (< (-> info max-vn) (-> point z)) + (set! (-> info max-vn) (-> point z)))) (else - (if (< (-> point z) (-> info min-vp)) (set! (-> info min-vp) (-> point z))) - (if (< (-> info max-vp) (-> point z)) (set! (-> info max-vp) (-> point z)))))) + (if (< (-> point z) (-> info min-vp)) + (set! (-> info min-vp) (-> point z))) + (if (< (-> info max-vp) (-> point z)) + (set! (-> info max-vp) (-> point z)))))) (else (set! (-> info min-par) (-> point x)) (set! (-> info max-par) (-> point x)) @@ -916,8 +970,12 @@ (set! (-> info min-vn) 0.0) (set! (-> info max-vn) 0.0) (cond - ((< (-> point y) 0.0) (set! (-> info min-vn) (-> point z)) (set! (-> info max-vn) (-> point z))) - (else (set! (-> info min-vp) (-> point z)) (set! (-> info max-vp) (-> point z)))))) + ((< (-> point y) 0.0) + (set! (-> info min-vn) (-> point z)) + (set! (-> info max-vn) (-> point z))) + (else + (set! (-> info min-vp) (-> point z)) + (set! (-> info max-vp) (-> point z)))))) (+! (-> info count) 1) (none)) @@ -940,7 +998,8 @@ (-> info max-vp) (-> info min-vn) (-> info max-vn))) - (else (format *stdcon* "~S invalid~%" label)))) + (else + (format *stdcon* "~S invalid~%" label)))) (deftype collide-los-result (structure) ((lateral vector :inline) @@ -959,67 +1018,63 @@ "Project one blocking triangle and its contact point into the sightline frame, classify it as clockwise, counter-clockwise, or straddling the line, and append its extents to the corresponding result bucket." - (local-vars - (saved-flat-length float) - (saved-hit-position vector) - (point-delta vector) - (side-cross vector) - (lateral-delta vector) - (i int)) (with-pp - (set! saved-flat-length flat-sightline-length) - (let ((result obstruction-result)) - (set! saved-hit-position hit-position) - (let ((saved-tight-hit tight-hit-fraction)) - (set! point-delta (new 'stack-no-clear 'vector)) - (set! side-cross (new 'stack-no-clear 'vector)) - (let ((projected-points (new 'stack-no-clear 'matrix))) - (set! lateral-delta (new 'stack-no-clear 'vector)) - (let ((previous-side 0.0) - (straddles? #f)) - (set! i 0) - (while (< i 4) - (cond - ((= i 3) - (vector-! point-delta saved-hit-position (the-as vector (&-> pp stack 368))) - (set! (-> projected-points vector i z) 0.0)) - (else - (vector-! point-delta saved-hit-position (-> triangle 0 vertex i)) - (set! (-> projected-points vector i z) (vector-dot point-delta (-> *camera* local-down))) - (vector-! point-delta (-> triangle 0 vertex i) (the-as vector (&-> pp stack 368))))) - (vector-flatten! point-delta point-delta (-> *camera* local-down)) - (vector-cross! side-cross point-delta flat-sightline-direction) - (let ((side (vector-dot side-cross (-> *camera* local-down)))) - (cond - ((< (* side previous-side) 0.0) (set! straddles? #t)) - ((!= side 0.0) (set! previous-side side))) - (set! (-> projected-points vector i x) (vector-dot point-delta flat-sightline-direction)) - (cond - ((= i 3) - (vector-! lateral-delta saved-hit-position (the-as vector (&-> pp stack 368))) - (vector-flatten! lateral-delta lateral-delta sightline-direction)) - (else (vector--float*! lateral-delta point-delta flat-sightline-direction (-> projected-points vector i x)))) - (if (< side 0.0) - (set! (-> projected-points vector i y) (- (vector-length lateral-delta))) - (set! (-> projected-points vector i y) (vector-length lateral-delta)))) - (set! (-> projected-points vector i x) (- saved-flat-length (-> projected-points vector i x))) - (+! i 1)) + (let ((saved-flat-length flat-sightline-length) + (result obstruction-result) + (saved-hit-position hit-position) + (saved-tight-hit tight-hit-fraction) + (point-delta (new 'stack-no-clear 'vector)) + (side-cross (new 'stack-no-clear 'vector)) + (projected-points (new 'stack-no-clear 'matrix)) + (lateral-delta (new 'stack-no-clear 'vector)) + (previous-side 0.0) + (straddles? #f)) + (let ((i 0)) + (while (< i 4) + (cond + ((= i 3) + (vector-! point-delta saved-hit-position (the-as vector (&-> pp stack 368))) + (set! (-> projected-points vector i z) 0.0)) + (else + (vector-! point-delta saved-hit-position (-> triangle 0 vertex i)) + (set! (-> projected-points vector i z) (vector-dot point-delta (-> *camera* local-down))) + (vector-! point-delta (-> triangle 0 vertex i) (the-as vector (&-> pp stack 368))))) + (vector-flatten! point-delta point-delta (-> *camera* local-down)) + (vector-cross! side-cross point-delta flat-sightline-direction) + (let ((side (vector-dot side-cross (-> *camera* local-down)))) (cond - ((and straddles? (!= saved-tight-hit -100000000.0)) - (dotimes (i 4) - (dist-info-append (-> result straddle) (the-as vector (+ (the-as uint projected-points) (* i 16))))) - #f) - ((< (-> projected-points vector 3 y) 0.0) - (dotimes (i 4) - (when (>= (-> projected-points vector 3 y) (-> projected-points vector i y)) - (set! (-> projected-points vector i y) (- (-> projected-points vector i y))) - (dist-info-append (-> result ccw) (the-as vector (+ (the-as uint projected-points) (* i 16)))))) - #f) + ((< (* side previous-side) 0.0) + (set! straddles? #t)) + ((!= side 0.0) + (set! previous-side side))) + (set! (-> projected-points vector i x) (vector-dot point-delta flat-sightline-direction)) + (cond + ((= i 3) + (vector-! lateral-delta saved-hit-position (the-as vector (&-> pp stack 368))) + (vector-flatten! lateral-delta lateral-delta sightline-direction)) (else - (dotimes (i 4) - (if (>= (-> projected-points vector i y) (-> projected-points vector 3 y)) - (dist-info-append (-> result cw) (the-as vector (+ (the-as uint projected-points) (* i 16)))))) - #f)))))))) + (vector--float*! lateral-delta point-delta flat-sightline-direction (-> projected-points vector i x)))) + (if (< side 0.0) + (set! (-> projected-points vector i y) (- (vector-length lateral-delta))) + (set! (-> projected-points vector i y) (vector-length lateral-delta)))) + (set! (-> projected-points vector i x) (- saved-flat-length (-> projected-points vector i x))) + (+! i 1))) + (cond + ((and straddles? (!= saved-tight-hit -100000000.0)) + (dotimes (i 4) + (dist-info-append (-> result straddle) (the-as vector (+ (the-as uint projected-points) (* i 16))))) + #f) + ((< (-> projected-points vector 3 y) 0.0) + (dotimes (i 4) + (when (>= (-> projected-points vector 3 y) (-> projected-points vector i y)) + (set! (-> projected-points vector i y) (- (-> projected-points vector i y))) + (dist-info-append (-> result ccw) (the-as vector (+ (the-as uint projected-points) (* i 16)))))) + #f) + (else + (dotimes (i 4) + (if (>= (-> projected-points vector i y) (-> projected-points vector 3 y)) + (dist-info-append (-> result cw) (the-as vector (+ (the-as uint projected-points) (* i 16)))))) + #f))))) (defun cam-los-spline-collide ((trail-point vector) (camera-position vector) (surface-filter pat-surface)) "Sphere-cast from a target breadcrumb toward the camera with @@ -1034,7 +1089,7 @@ trail-point displacement (-> *CAM_STRING-bank* los-coll-rad2) - (collide-kind background cak-3 wall-object ground-object cak-14) + (collide-kind background hit-by-others wall-object ground-object cak-14) (the-as process-drawable #f) surface-filter) (let* ((segment-length (vector-length displacement)) @@ -1056,9 +1111,11 @@ normal))) (cond ((or (< hit-fraction 0.0) (< maximum-hit-fraction hit-fraction))) - ((< hit-fraction earliest-hit) (set! earliest-hit hit-fraction)))) - (set! triangles (the-as (inline-array collide-cache-tri) (-> triangles 1))))) - (if (= earliest-hit 2.0) (set! earliest-hit -1.0)) + ((< hit-fraction earliest-hit) + (set! earliest-hit hit-fraction)))) + (set! triangles (&-> triangles 1)))) + (if (= earliest-hit 2.0) + (set! earliest-hit -1.0)) earliest-hit)) (defbehavior cam-los-setup-lateral camera-slave ((obstruction-result collide-los-result) (lateral-move vector) (sightline vector)) @@ -1070,15 +1127,17 @@ (let ((clockwise-edge (-> obstruction-result straddle min-lat)) (counterclockwise-edge (-> obstruction-result straddle max-lat))) (if (dist-info-valid? (-> obstruction-result cw)) - (set! counterclockwise-edge (fmax counterclockwise-edge (-> obstruction-result cw max-lat)))) + (set! counterclockwise-edge (fmax counterclockwise-edge (-> obstruction-result cw max-lat)))) (if (dist-info-valid? (-> obstruction-result ccw)) - (set! clockwise-edge (fmin clockwise-edge (- (-> obstruction-result ccw max-lat))))) + (set! clockwise-edge (fmin clockwise-edge (- (-> obstruction-result ccw max-lat))))) (cond ((= (-> self los-state) (slave-los-state ccw)) - (if *display-cam-los-debug* (format *stdcon* "straddle stick ccw~%")) + (if *display-cam-los-debug* + (format *stdcon* "straddle stick ccw~%")) (vector-normalize! lateral-move (+ counterclockwise-edge (-> *CAM_STRING-bank* los-coll-rad)))) ((= (-> self los-state) (slave-los-state cw)) - (if *display-cam-los-debug* (format *stdcon* "straddle stick cw~%")) + (if *display-cam-los-debug* + (format *stdcon* "straddle stick cw~%")) (vector-normalize! lateral-move (- clockwise-edge (-> *CAM_STRING-bank* los-coll-rad)))) ((and (or (< 0.01 (-> obstruction-result straddle max-vp)) (and (dist-info-valid? (-> obstruction-result ccw)) (< 0.01 (-> obstruction-result ccw max-vp)))) @@ -1087,8 +1146,10 @@ (and (dist-info-valid? (-> obstruction-result cw)) (or (< (-> obstruction-result cw max-vp) 0.01) (< -0.01 (-> obstruction-result cw min-vp))))) (when (not (dist-info-valid? (-> obstruction-result ccw)))) - (if (not (dist-info-valid? (-> obstruction-result cw))) (format #t "s diag ccw invalid cw~%")) - (if *display-cam-los-debug* (format *stdcon* "straddle diagonal ccw~%")) + (if (not (dist-info-valid? (-> obstruction-result cw))) + (format #t "s diag ccw invalid cw~%")) + (if *display-cam-los-debug* + (format *stdcon* "straddle diagonal ccw~%")) (set! (-> self los-state) (slave-los-state ccw)) (vector-normalize! lateral-move (+ counterclockwise-edge (-> *CAM_STRING-bank* los-coll-rad)))) ((and (or (< 0.01 (-> obstruction-result straddle max-vn)) @@ -1097,17 +1158,21 @@ (and (dist-info-valid? (-> obstruction-result cw)) (< (-> obstruction-result cw min-vp) -0.01))) (and (dist-info-valid? (-> obstruction-result ccw)) (or (< (-> obstruction-result ccw max-vp) 0.01) (< -0.01 (-> obstruction-result ccw min-vp))))) - (if (not (dist-info-valid? (-> obstruction-result ccw))) (format #t "s diag cw invalid ccw~%")) + (if (not (dist-info-valid? (-> obstruction-result ccw))) + (format #t "s diag cw invalid ccw~%")) (when (not (dist-info-valid? (-> obstruction-result cw)))) - (if *display-cam-los-debug* (format *stdcon* "straddle diagonal cw~%")) + (if *display-cam-los-debug* + (format *stdcon* "straddle diagonal cw~%")) (set! (-> self los-state) (slave-los-state cw)) (vector-normalize! lateral-move (- clockwise-edge (-> *CAM_STRING-bank* los-coll-rad)))) ((< counterclockwise-edge (- clockwise-edge)) - (if *display-cam-los-debug* (format *stdcon* "straddle ccw~%")) + (if *display-cam-los-debug* + (format *stdcon* "straddle ccw~%")) (set! (-> self los-state) (slave-los-state ccw)) (vector-normalize! lateral-move (+ counterclockwise-edge (-> *CAM_STRING-bank* los-coll-rad)))) (else - (if *display-cam-los-debug* (format *stdcon* "straddle cw~%")) + (if *display-cam-los-debug* + (format *stdcon* "straddle cw~%")) (set! (-> self los-state) (slave-los-state cw)) (vector-normalize! lateral-move (- clockwise-edge (-> *CAM_STRING-bank* los-coll-rad))))))) ((and (dist-info-valid? (-> obstruction-result cw)) @@ -1115,7 +1180,8 @@ (< 0.01 (-> obstruction-result ccw max-vp)) (< (-> obstruction-result ccw min-vp) -0.01) (or (< (-> obstruction-result cw max-vp) 0.01) (< -0.01 (-> obstruction-result cw min-vp)))) - (if *display-cam-los-debug* (format *stdcon* "diagonal ccw~%")) + (if *display-cam-los-debug* + (format *stdcon* "diagonal ccw~%")) (set! (-> self los-state) (slave-los-state ccw)) (vector-normalize! lateral-move (- (-> *CAM_STRING-bank* los-coll-rad) (-> obstruction-result ccw min-lat)))) ((and (dist-info-valid? (-> obstruction-result cw)) @@ -1123,68 +1189,80 @@ (< 0.01 (-> obstruction-result cw max-vp)) (< (-> obstruction-result cw min-vp) -0.01) (or (< (-> obstruction-result ccw max-vp) 0.01) (< -0.01 (-> obstruction-result ccw min-vp)))) - (if *display-cam-los-debug* (format *stdcon* "diagonal cw~%")) + (if *display-cam-los-debug* + (format *stdcon* "diagonal cw~%")) (set! (-> self los-state) (slave-los-state cw)) (vector-normalize! lateral-move (- (-> obstruction-result cw min-lat) (-> *CAM_STRING-bank* los-coll-rad)))) ((and (dist-info-valid? (-> obstruction-result cw)) (dist-info-valid? (-> obstruction-result ccw))) (set! (-> self los-state) (slave-los-state between)) - (vector-normalize! lateral-move (the-as float 0.0001))) + (vector-normalize! lateral-move 0.0001)) ((dist-info-valid? (-> obstruction-result cw)) - (if *display-cam-los-debug* (format *stdcon* "regular cw~%")) + (if *display-cam-los-debug* + (format *stdcon* "regular cw~%")) (set! (-> self los-state) (slave-los-state cw)) (vector-normalize! lateral-move (- (-> obstruction-result cw min-lat) (-> *CAM_STRING-bank* los-coll-rad)))) ((dist-info-valid? (-> obstruction-result ccw)) - (if *display-cam-los-debug* (format *stdcon* "regular ccw~%")) + (if *display-cam-los-debug* + (format *stdcon* "regular ccw~%")) (set! (-> self los-state) (slave-los-state ccw)) (vector-normalize! lateral-move (- (-> *CAM_STRING-bank* los-coll-rad) (-> obstruction-result ccw min-lat)))) - (else (set! (-> self los-state) (slave-los-state none)) (vector-reset! lateral-move))) + (else + (set! (-> self los-state) (slave-los-state none)) + (vector-reset! lateral-move))) (cond - ((= (vector-length lateral-move) 0.0) (set! (-> obstruction-result lateral-valid) #f) #f) + ((= (vector-length lateral-move) 0.0) + (set! (-> obstruction-result lateral-valid) #f) + #f) (else (vector-! (-> obstruction-result lateral) lateral-move sightline) - (vector-normalize! (-> obstruction-result lateral) (the-as float 1.0)) - (let ((lateral-valid #t)) (set! (-> obstruction-result lateral-valid) lateral-valid) lateral-valid)))) + (vector-normalize! (-> obstruction-result lateral) 1.0) + (let ((lateral-valid #t)) + (set! (-> obstruction-result lateral-valid) lateral-valid) + lateral-valid)))) (defbehavior cam-los-collide camera-slave ((camera-position vector) (sightline vector) (obstruction-result collide-los-result) (surface-filter pat-surface)) "Classify geometry blocking the camera-to-target sightline, choose a lateral escape, and search the target breadcrumb trail for a recoverable clear view when direct sliding is insufficient." - (local-vars (last-clear-index int) (trail-index int) (normal-dot float) (hit-normal vector) (hit-position vector)) + (local-vars (last-clear-index int) (trail-index int) (normal-dot float)) (dist-info-init (-> obstruction-result cw)) (dist-info-init (-> obstruction-result ccw)) (dist-info-init (-> obstruction-result straddle)) (let ((flat-sightline (new 'stack-no-clear 'vector)) (sightline-direction (new 'stack-no-clear 'vector))) - (vector-normalize-copy! sightline-direction sightline (the-as float 1.0)) + (vector-normalize-copy! sightline-direction sightline 1.0) (vector-flatten! flat-sightline sightline (-> *camera* local-down)) (let ((cache *collide-cache*) (sightline-length (vector-length sightline)) - (flat-sightline-length (vector-normalize-ret-len! flat-sightline (the-as float 1.0)))) + (flat-sightline-length (vector-normalize-ret-len! flat-sightline 1.0))) (fill-using-line-sphere cache camera-position sightline (-> *CAM_STRING-bank* los-coll-rad) - (collide-kind background cak-3 wall-object ground-object cak-14) + (collide-kind background hit-by-others wall-object ground-object cak-14) (the-as process-drawable #f) surface-filter) (let ((triangles (-> cache tris)) (near-threshold (/ 2048.0 sightline-length)) (far-threshold (/ (+ -8192.0 sightline-length) sightline-length))) - (if (< far-threshold 0.0) (set! far-threshold 0.0)) - (if (< 1.0 near-threshold) (set! near-threshold 1.0)) + (if (< far-threshold 0.0) + (set! far-threshold 0.0)) + (if (< 1.0 near-threshold) + (set! near-threshold 1.0)) (countdown (i (-> cache num-tris)) - (set! hit-position (new 'stack-no-clear 'vector)) - (set! hit-normal (new 'stack-no-clear 'vector)) - (let ((hit-fraction (moving-sphere-triangle-intersect camera-position - sightline - (-> *CAM_STRING-bank* los-coll-rad) - (-> triangles 0) - hit-position - hit-normal))) + (let* ((hit-position (new 'stack-no-clear 'vector)) + (hit-normal (new 'stack-no-clear 'vector)) + (hit-fraction (moving-sphere-triangle-intersect camera-position + sightline + (-> *CAM_STRING-bank* los-coll-rad) + (-> triangles 0) + hit-position + hit-normal))) (cond ((or (< hit-fraction 0.0) (< 1.0 hit-fraction))) ((let ((zero 0.0)) - (let* ((sightline-copy sightline)) (set! normal-dot (vector-dot sightline-copy hit-normal))) + (let* ((sightline-copy sightline)) + (set! normal-dot (vector-dot sightline-copy hit-normal))) (< zero normal-dot)) (when (< near-threshold hit-fraction) (let* ((tight-normal (new 'stack-no-clear 'vector)) @@ -1204,10 +1282,12 @@ tight-hit-fraction) (when *debug-segment* (if (= tight-hit-fraction -100000000.0) - (cam-debug-add-los-tri triangles hit-position (new 'static 'vector :x (the-as float #x80) :w (the-as float #x80))) - (cam-debug-add-los-tri triangles - hit-position - (new 'static 'vector :x (the-as float #x80) :y (the-as float #x80) :w (the-as float #x80)))))))) + (cam-debug-add-los-tri triangles + hit-position + (the-as vector4w (new 'static 'vector :x (the-as float #x80) :w (the-as float #x80)))) + (cam-debug-add-los-tri triangles + hit-position + (the-as vector4w (new 'static 'vector :x (the-as float #x80) :y (the-as float #x80) :w (the-as float #x80))))))))) ((< hit-fraction far-threshold) (let* ((tight-normal (new 'stack-no-clear 'vector)) (tight-position (new 'stack-no-clear 'vector)) @@ -1226,9 +1306,13 @@ tight-hit-fraction) (when *debug-segment* (if (= tight-hit-fraction -100000000.0) - (cam-debug-add-los-tri triangles hit-position (new 'static 'vector :y (the-as float #x80) :w (the-as float #x80))) - (cam-debug-add-los-tri triangles hit-position (new 'static 'vector :z (the-as float #x80) :w (the-as float #x80))))))))) - (set! triangles (the-as (inline-array collide-cache-tri) (-> triangles 1))))))) + (cam-debug-add-los-tri triangles + hit-position + (the-as vector4w (new 'static 'vector :y (the-as float #x80) :w (the-as float #x80)))) + (cam-debug-add-los-tri triangles + hit-position + (the-as vector4w (new 'static 'vector :z (the-as float #x80) :w (the-as float #x80)))))))))) + (set! triangles (&-> triangles 1)))))) (let ((lateral-move (new 'stack-no-clear 'vector))) 0.0 (vector-cross! lateral-move sightline (-> *camera* local-down)) @@ -1239,7 +1323,7 @@ (format 0 "emergency point jump~%")) (set! (-> self los-tgt-spline-pt) (-> *camera* target-spline used-point)) (set! (-> self los-tgt-spline-pt-incarnation) (-> *camera* target-spline point (-> self los-tgt-spline-pt) incarnation)) - (logior! (-> self options) 4096) + (logior! (-> self options) (cam-slave-options GOTO_GOOD_POINT)) (vector-copy! (-> self good-point) (-> *camera* target-spline point (-> *camera* target-spline used-point) position)) (vector-copy! (-> self los-last-pos) (-> self good-point)) (when *debug-segment* @@ -1252,30 +1336,32 @@ (vector-flatten! (-> self view-flat) (-> self view-flat) (-> *camera* local-down)) (vector-reset! (-> self velocity)) (let ((view-length (vector-length (-> self view-flat)))) - (if (< view-length (-> self min-z-override)) (set! (-> self min-z-override) view-length)))) + (if (< view-length (-> self min-z-override)) + (set! (-> self min-z-override) view-length)))) (else - (let ((trail-hit-fraction (cam-los-spline-collide (the-as vector (+ (the-as uint (-> *camera* target-spline)) (* 48 (-> *camera* target-spline end-point)))) + (let ((trail-hit-fraction (cam-los-spline-collide (-> *camera* target-spline point (-> *camera* target-spline end-point) position) camera-position (new 'static 'pat-surface :nocamera #x1 :nolineofsight #x1)))) (cond ((< trail-hit-fraction 0.0) - (if *display-cam-los-debug* (format *stdcon* "good ~f~%" trail-hit-fraction)) + (if *display-cam-los-debug* + (format *stdcon* "good ~f~%" trail-hit-fraction)) (set! (-> self los-tgt-spline-pt) (-> *camera* target-spline end-point)) (set! (-> self los-tgt-spline-pt-incarnation) (-> *camera* target-spline point (-> self los-tgt-spline-pt) incarnation)) (vector-copy! (-> self los-last-pos) camera-position)) ((begin (if *display-cam-los-debug* - (format *stdcon* - "looking vel ~M u ~f pt ~D" - (vector-length (-> self velocity)) - trail-hit-fraction - (-> self los-tgt-spline-pt))) + (format *stdcon* + "looking vel ~M u ~f pt ~D" + (vector-length (-> self velocity)) + trail-hit-fraction + (-> self los-tgt-spline-pt))) (set! trail-index (-> self los-tgt-spline-pt)) (set! last-clear-index -134250495) (while (and (!= trail-index -134250495) (begin (set! trail-hit-fraction - (cam-los-spline-collide (the-as vector (+ (the-as uint (-> *camera* target-spline)) (* 48 trail-index))) + (cam-los-spline-collide (-> *camera* target-spline point trail-index position) camera-position (new 'static 'pat-surface :nocamera #x1 :nolineofsight #x1))) (< trail-hit-fraction 0.0))) @@ -1288,7 +1374,7 @@ (format *stdcon* " at used point~%")) (set! (-> self los-tgt-spline-pt) (-> *camera* target-spline point trail-index next)) (set! (-> self los-tgt-spline-pt-incarnation) (-> *camera* target-spline point (-> self los-tgt-spline-pt) incarnation)) - (logior! (-> self options) 4096) + (logior! (-> self options) (cam-slave-options GOTO_GOOD_POINT)) (vector-copy! (-> self good-point) (-> *camera* target-spline point trail-index position)) (vector-copy! (-> self los-last-pos) (-> self good-point)) (when *debug-segment* @@ -1301,36 +1387,39 @@ (vector-flatten! (-> self view-flat) (-> self view-flat) (-> *camera* local-down)) (vector-reset! (-> self velocity)) (let ((view-length (vector-length (-> self view-flat)))) - (if (< view-length (-> self min-z-override)) (set! (-> self min-z-override) view-length)))) + (if (< view-length (-> self min-z-override)) + (set! (-> self min-z-override) view-length)))) ((!= last-clear-index -134250495) - (if *display-cam-los-debug* (format *stdcon* " ok~%")) + (if *display-cam-los-debug* + (format *stdcon* " ok~%")) (set! (-> self los-tgt-spline-pt) last-clear-index) (set! (-> self los-tgt-spline-pt-incarnation) (-> *camera* target-spline point (-> self los-tgt-spline-pt) incarnation)) (vector-copy! (-> self los-last-pos) camera-position)) (else (if *display-cam-los-debug* - (format *stdcon* - "~%failed u ~f cur ~D seen ~D tgt-pt ~D~%" - trail-hit-fraction - trail-index - last-clear-index - (-> self los-tgt-spline-pt))) + (format *stdcon* + "~%failed u ~f cur ~D seen ~D tgt-pt ~D~%" + trail-hit-fraction + trail-index + last-clear-index + (-> self los-tgt-spline-pt))) (let ((trail-segment (new 'stack-no-clear 'vector))) 0.0 - (vector-! trail-segment - (-> self los-last-pos) - (the-as vector (+ (the-as uint (-> *camera* target-spline)) (* 48 (-> self los-tgt-spline-pt))))) + (vector-! trail-segment (-> self los-last-pos) (-> *camera* target-spline point (-> self los-tgt-spline-pt) position)) (let ((trail-segment-length (vector-length trail-segment))) - (if (= trail-segment-length 0.0) (set! trail-segment-length 0.4096)) + (if (= trail-segment-length 0.0) + (set! trail-segment-length 0.4096)) (let ((recovery-fraction (cond ((and (= (-> self string-vel-dir) 6) (< (-> *CAMERA-bank* min-detectable-velocity) (vector-length (-> self velocity)))) (fmin 1.0 (+ 0.001 trail-hit-fraction))) - ((= (-> self string-vel-dir) 6) (fmin 0.9999 trail-hit-fraction)) - (else (fmax 0.001 (+ -0.001 trail-hit-fraction)))))) + ((= (-> self string-vel-dir) 6) + (fmin 0.9999 trail-hit-fraction)) + (else + (fmax 0.001 (+ -0.001 trail-hit-fraction)))))) (let ((target-to-trail (new 'stack-no-clear 'vector))) (vector-! target-to-trail (-> *camera* tpos-curr-adj) - (the-as vector (+ (the-as uint (-> *camera* target-spline)) (* 48 (-> self los-tgt-spline-pt))))) + (-> *camera* target-spline point (-> self los-tgt-spline-pt) position)) (vector-flatten! target-to-trail target-to-trail (-> *camera* local-down)) (cond ((and (< (fabs (- (-> self desired-pos y) (-> self trans y))) 8192.0) @@ -1344,34 +1433,41 @@ (vector-! trail-segment (-> *camera* tpos-curr) (-> *camera* tpos-old)) (vector-! (-> self good-point) (-> self los-last-pos) - (the-as vector (+ (the-as uint (-> *camera* target-spline)) (* 48 (-> self los-tgt-spline-pt))))) + (-> *camera* target-spline point (-> self los-tgt-spline-pt) position)) (vector-float*! (-> self good-point) (-> self good-point) recovery-fraction) (vector+! (-> self good-point) (-> self good-point) - (the-as vector (+ (the-as uint (-> *camera* target-spline)) (* 48 (-> self los-tgt-spline-pt))))) + (-> *camera* target-spline point (-> self los-tgt-spline-pt) position)) (vector-copy! (-> self los-last-pos) (-> self good-point)) (when *display-cam-los-debug* (format 0 "going because u(~f) > 0 frame ~D~%" recovery-fraction (current-time)) (format *stdcon* " going because u(~f) > 0 frame ~D~%" recovery-fraction (current-time))) - (logior! (-> self options) 4096)))))))))) + (logior! (-> self options) (cam-slave-options GOTO_GOOD_POINT))))))))))) (if *display-cam-los-debug* - (format *stdcon* "los-last ~M ~M ~M~%" (-> self los-last-pos x) (-> self los-last-pos y) (-> self los-last-pos z))) + (format *stdcon* "los-last ~M ~M ~M~%" (-> self los-last-pos x) (-> self los-last-pos y) (-> self los-last-pos z))) (cam-los-setup-lateral obstruction-result lateral-move sightline)) (cond - ((not (logtest? (-> self options) 1024))) + ((not (logtest? (-> self options) (cam-slave-options MOVEMENT_BLOCKED)))) ((= (-> self string-vel-dir) 5)) ((and (= (-> self string-vel-dir) 2) (= (-> self los-state) (slave-los-state cw)))) ((and (= (-> self string-vel-dir) 1) (= (-> self los-state) (slave-los-state ccw))))) (when *display-cam-los-debug* (format *stdcon* "state ~S" (slave-los-state->string (-> self los-state))) (cond - ((zero? (-> self string-vel-dir)) (format *stdcon* " vzero")) - ((= (-> self string-vel-dir) 2) (format *stdcon* " vcw")) - ((= (-> self string-vel-dir) 1) (format *stdcon* " vccw")) - ((= (-> self string-vel-dir) 3) (format *stdcon* " up")) - ((= (-> self string-vel-dir) 4) (format *stdcon* " down")) - ((= (-> self string-vel-dir) 6) (format *stdcon* " long")) - ((= (-> self string-vel-dir) 5) (format *stdcon* " short"))) + ((zero? (-> self string-vel-dir)) + (format *stdcon* " vzero")) + ((= (-> self string-vel-dir) 2) + (format *stdcon* " vcw")) + ((= (-> self string-vel-dir) 1) + (format *stdcon* " vccw")) + ((= (-> self string-vel-dir) 3) + (format *stdcon* " up")) + ((= (-> self string-vel-dir) 4) + (format *stdcon* " down")) + ((= (-> self string-vel-dir) 6) + (format *stdcon* " long")) + ((= (-> self string-vel-dir) 5) + (format *stdcon* " short"))) (format *stdcon* "~%")) (when *display-cam-los-info* (dist-info-print (-> obstruction-result cw) "cw ") @@ -1384,15 +1480,15 @@ enforce its current length limits, and adjust field of view and distance for the long-string mode." (let ((previous-length (vector-length (-> self view-flat)))) (cond - ((logtest? #x10000 (-> self options)) + ((logtest? (cam-slave-options STICKY_ANGLE) (-> self options)) (let ((lateral-target-motion (new 'stack-no-clear 'vector))) (let ((string-side (new 'stack-no-clear 'vector))) (vector-cross! string-side (-> self view-flat) (-> *camera* local-down)) - (vector-normalize! string-side (the-as float 1.0)) + (vector-normalize! string-side 1.0) (vector-! lateral-target-motion (-> *camera* tpos-curr-adj) (-> *camera* tpos-old-adj)) (vector-flatten! lateral-target-motion lateral-target-motion string-side)) (if (< (vector-dot lateral-target-motion (-> self view-flat)) 0.0) - (vector-! (-> self view-flat) (-> self view-flat) lateral-target-motion)))) + (vector-! (-> self view-flat) (-> self view-flat) lateral-target-motion)))) (else (let ((target-motion (new 'stack-no-clear 'vector))) (vector-! target-motion (-> *camera* tpos-curr-adj) (-> *camera* tpos-old-adj)) @@ -1403,20 +1499,19 @@ (maximum-length (-> self view-off z)) (minimum-length (fmin pushed-length (-> self min-z-override)))) (cond - ((logtest? (-> self options) #x4000) + ((logtest? (-> self options) (cam-slave-options BIKE_MODE)) (let ((target-motion (new-stack-vector0))) 0.0 (vector-! target-motion (-> *camera* tpos-curr-adj) (-> *camera* tpos-old-adj)) (let ((target-speed (vector-length target-motion))) - (set! minimum-length - (lerp-clamp (the-as float 28672.0) - (the-as float 32768.0) - (parameter-ease-sin-clamp (* 0.00081380206 (+ -409.6 target-speed))))))) + (set! minimum-length (lerp-clamp 28672.0 32768.0 (parameter-ease-sin-clamp (* 0.00081380206 (+ -409.6 target-speed))))))) (set! maximum-length minimum-length) (+! (-> self fov) (fmax -91.022224 (fmin 91.022224 (* 0.1 (- 17294.223 (-> self fov))))))) - (else (+! (-> self fov) (fmax -182.04445 (fmin 182.04445 (* 0.1 (- 11650.845 (-> self fov)))))))) + (else + (+! (-> self fov) (fmax -182.04445 (fmin 182.04445 (* 0.1 (- 11650.845 (-> self fov)))))))) (cond - ((< current-length minimum-length) (vector-normalize! (-> self view-flat) minimum-length)) + ((< current-length minimum-length) + (vector-normalize! (-> self view-flat) minimum-length)) ((and (< previous-length current-length) (or (= (-> self los-state) (slave-los-state ccw)) (= (-> self los-state) (slave-los-state cw)))) (vector-normalize! (-> self view-flat) previous-length)) @@ -1424,7 +1519,9 @@ (vector-normalize! (-> self view-flat) maximum-length) (set! (-> self min-z-override) maximum-length) maximum-length) - (else (set! (-> self min-z-override) current-length) current-length))))) + (else + (set! (-> self min-z-override) current-length) + current-length))))) (defbehavior cam-string-line-of-sight camera-slave () "Run the line-of-sight solver and rotate the horizontal @@ -1444,26 +1541,23 @@ (let ((target-motion (new 'stack-no-clear 'vector))) (vector-! target-motion (-> *camera* tpos-curr) (-> *camera* tpos-old)) (if (and (< (-> self string-min-val z) string-length) - (< (-> *CAMERA-bank* min-detectable-velocity) (vector-length target-motion))) - (set! string-length (+ -204.8 string-length))))) + (< (-> *CAMERA-bank* min-detectable-velocity) (vector-length target-motion))) + (set! string-length (+ -204.8 string-length))))) (if (< string-length (fmin (-> self string-min-val z) (-> self min-z-override))) - (set! string-length (fmin (-> self string-min-val z) (-> self min-z-override)))) - (if (< string-length (-> self min-z-override)) (set! (-> self min-z-override) string-length)) + (set! string-length (fmin (-> self string-min-val z) (-> self min-z-override)))) + (if (< string-length (-> self min-z-override)) + (set! (-> self min-z-override) string-length)) (let ((escape-direction (new 'stack-no-clear 'vector)) (current-direction (new 'stack-no-clear 'vector)) (rotation (new 'stack-no-clear 'matrix))) 0.0 (vector-flatten! escape-direction (-> obstruction-result lateral) (-> *camera* local-down)) - (vector-normalize! escape-direction (the-as float 1.0)) - (vector-normalize-copy! current-direction (-> self view-flat) (the-as float 1.0)) - (let ((maximum-angle (lerp-clamp (the-as float 418.7022) - (the-as float 364.0889) + (vector-normalize! escape-direction 1.0) + (vector-normalize-copy! current-direction (-> self view-flat) 1.0) + (let ((maximum-angle (lerp-clamp 418.7022 + 364.0889 (/ (- string-length (-> self string-min-val z)) (- (-> self string-max-val z) (-> self string-min-val z)))))) - (matrix-from-two-vectors-max-angle-partial! rotation - current-direction - escape-direction - maximum-angle - (the-as float 0.5))) + (matrix-from-two-vectors-max-angle-partial! rotation current-direction escape-direction maximum-angle 0.5)) (vector-matrix*! (-> self view-flat) (-> self view-flat) rotation)) (vector-normalize! (-> self view-flat) string-length))))) @@ -1480,15 +1574,17 @@ (defbehavior cam-string-joystick camera-slave () "Apply manual string length and orbit input. Couple height to distance, respect the current line-of-sight side, and otherwise recenter toward target facing." - (logand! (-> self options) -257) - (let ((distance-input (cam-dist-analog-input (the-as int (-> *cpad-list* cpads 0 righty)) (the-as float 0.05))) + (logclear! (-> self options) (cam-slave-options PLAYER_MOVING_CAMERA)) + (let ((distance-input (cam-dist-analog-input (the-as int (-> *cpad-list* cpads 0 righty)) 0.05)) (distance-parameter (/ (- (vector-length (-> self view-flat)) (-> self string-min-val z)) (- (-> self string-max-val z) (-> self string-min-val z)))) (saved-view-parameter (-> self view-off-param))) - (if (-> self have-phony-joystick) (set! distance-input (/ (-> self phony-joystick-y) 20))) + (if (-> self have-phony-joystick) + (set! distance-input (/ (-> self phony-joystick-y) 20))) (if (and (-> *camera* being-attacked) (not (time-elapsed? (-> *camera* attack-start) (seconds 0.25)))) - (set! distance-input 0.05)) - (if (!= distance-input 0.0) (logior! (-> self options) 256)) + (set! distance-input 0.05)) + (if (!= distance-input 0.0) + (logior! (-> self options) (cam-slave-options PLAYER_MOVING_CAMERA))) (let ((clamped-distance-parameter (fmin 1.0 distance-parameter))) (let ((height-parameter clamped-distance-parameter)) (when (< clamped-distance-parameter 0.0) @@ -1504,7 +1600,7 @@ (set! (-> self view-off y) (fmin (-> *camera* stringCliffHeight) (fmax camera-height (-> self view-off y))))))) (let ((nonnegative-distance-parameter (fmax 0.0 clamped-distance-parameter))) (cond - ((logtest? (-> self options) #x4000)) + ((logtest? (-> self options) (cam-slave-options BIKE_MODE))) ((not *camera-read-analog*)) ((and (>= 0.0 distance-input) (>= 0.0 nonnegative-distance-parameter))) ((and (>= distance-input 0.0) (>= nonnegative-distance-parameter 1.0))) @@ -1524,19 +1620,17 @@ ((< distance-input 0.0) (set! (-> self view-off-param) (+ nonnegative-distance-parameter (* distance-input (-> *display* time-adjust-ratio)))))))) (if (= distance-input 0.0) - (set! (-> self view-off z) (-> self string-max-val z)) - (set! (-> self view-off z) (lerp (-> self string-min-val z) (-> self string-max-val z) (-> self view-off-param)))) - (if (-> *camera* being-attacked) (set! (-> self view-off-param) saved-view-parameter))) + (set! (-> self view-off z) (-> self string-max-val z)) + (set! (-> self view-off z) (lerp (-> self string-min-val z) (-> self string-max-val z) (-> self view-off-param)))) + (if (-> *camera* being-attacked) + (set! (-> self view-off-param) saved-view-parameter))) (when *camera-read-analog* - (let ((orbit-input (analog-input (the-as int (-> *cpad-list* cpads 0 rightx)) - (the-as float 128.0) - (the-as float 32.0) - (the-as float 110.0) - (* 21845.334 (seconds-per-frame)))) + (let ((orbit-input (analog-input (the-as int (-> *cpad-list* cpads 0 rightx)) 128.0 32.0 110.0 (* 21845.334 (seconds-per-frame)))) (rotation (new-stack-matrix0)) (current-direction (new-stack-vector0)) (target-backward (new-stack-vector0))) - (if (-> self have-phony-joystick) (set! orbit-input (* 21845.334 (-> self phony-joystick-x) (seconds-per-frame)))) + (if (-> self have-phony-joystick) + (set! orbit-input (* 21845.334 (-> self phony-joystick-x) (seconds-per-frame)))) (cond ((and (= (-> self los-state) (slave-los-state ccw)) (< 0.0 orbit-input)) (let ((current-distance (fmax (-> self string-min-val z) (fmin (-> self string-max-val z) (vector-length (-> self view-flat)))))) @@ -1546,23 +1640,23 @@ (set! orbit-input (* -21845.334 (+ 0.1 (/ (-> self string-min-val z) current-distance)) (seconds-per-frame)))))) (cond ((!= orbit-input 0.0) - (logior! (-> self options) 256) + (logior! (-> self options) (cam-slave-options PLAYER_MOVING_CAMERA)) (matrix-axis-angle! rotation (-> *camera* local-down) orbit-input) (vector-matrix*! (-> self view-flat) (-> self view-flat) rotation)) - ((logtest? (-> self options) 1) - (vector-normalize-copy! current-direction (-> self view-flat) (the-as float 1.0)) + ((logtest? (-> self options) (cam-slave-options BUTT_CAM)) + (vector-normalize-copy! current-direction (-> self view-flat) 1.0) (vector-flatten! target-backward (-> *camera* tgt-rot-mat vector 2) (-> *camera* local-down)) - (vector-normalize! target-backward (the-as float -1.0)) + (vector-normalize! target-backward -1.0) (matrix-from-two-vectors-max-angle-partial! rotation current-direction target-backward (* 10922.667 (seconds-per-frame)) - (the-as float 0.05)) + 0.05) (vector-matrix*! (-> self view-flat) (-> self view-flat) rotation))) - (when (logtest? (-> self options) #x4000) - (vector-normalize-copy! current-direction (-> self view-flat) (the-as float 1.0)) + (when (logtest? (-> self options) (cam-slave-options BIKE_MODE)) + (vector-normalize-copy! current-direction (-> self view-flat) 1.0) (vector-flatten! target-backward (-> *camera* tgt-rot-mat vector 2) (-> *camera* local-down)) - (vector-normalize! target-backward (the-as float -1.0)) + (vector-normalize! target-backward -1.0) (let ((facing-angle (acos (vector-dot target-backward current-direction)))) (when (and (< 8192.0 facing-angle) (< facing-angle 32585.955)) (matrix-from-two-vectors-max-angle! rotation @@ -1583,20 +1677,24 @@ ((< (fill-and-probe-using-line-sphere *collide-cache* (-> self string-trans) sightline - (the-as float 40.96) - (collide-kind background cak-3 wall-object ground-object cak-14) + (meters 0.01) + (collide-kind background hit-by-others wall-object ground-object cak-14) (the-as process #f) probe-result (new 'static 'pat-surface :nocamera #x1)) 0.0) (set! (-> self time-dist-too-far) (the-as uint 0)) 0) - ((< (-> self time-dist-too-far) (the-as uint 600)) (+! (-> self time-dist-too-far) 1)) + ((< (-> self time-dist-too-far) (the-as uint 600)) + (+! (-> self time-dist-too-far) 1)) ((cam-string-find-position-rel! clear-offset) (cam-string-set-position-rel! clear-offset) (set! (-> self time-dist-too-far) (the-as uint 0)) 0) - (else (format 0 "camera position search failed~%") (set! (-> self time-dist-too-far) (the-as uint 0)) 0))) + (else + (format 0 "camera position search failed~%") + (set! (-> self time-dist-too-far) (the-as uint 0)) + 0))) (none)) (defbehavior cam-string-move camera-slave () @@ -1604,31 +1702,34 @@ sphere-cast collision slides. Classify the requested motion for line-of-sight steering and shorten the string when geometry blocks the move." (vector-! (-> self velocity) (-> self desired-pos) (-> self string-trans)) - (if *display-cam-los-debug* (format *stdcon* "vel ~M~%" (vector-length (-> self velocity)))) + (if *display-cam-los-debug* + (format *stdcon* "vel ~M~%" (vector-length (-> self velocity)))) (let ((motion-direction (new 'stack-no-clear 'vector)) (string-direction (new 'stack-no-clear 'vector)) (motion-cross (new 'stack-no-clear 'vector)) (target-motion (new 'stack-no-clear 'vector))) (vector-! target-motion (-> *camera* tpos-curr-adj) (-> *camera* tpos-old-adj)) - (vector+float*! motion-direction (-> self velocity) target-motion (the-as float 0.5)) - (vector-normalize! motion-direction (the-as float 1.0)) - (vector-normalize-copy! string-direction (-> self view-flat) (the-as float 1.0)) + (vector+float*! motion-direction (-> self velocity) target-motion 0.5) + (vector-normalize! motion-direction 1.0) + (vector-normalize-copy! string-direction (-> self view-flat) 1.0) (vector-cross! motion-cross string-direction motion-direction) (cond ((and (< (vector-length (-> self velocity)) (-> *CAMERA-bank* min-detectable-velocity)) (< (vector-length target-motion) (-> *CAMERA-bank* min-detectable-velocity))) (set! (-> self string-vel-dir) (the-as uint 0)) 0) - ((< (cos (the-as float 5461.3335)) (vector-dot (-> *camera* local-down) motion-direction)) + ((< (cos (degrees 30)) (vector-dot (-> *camera* local-down) motion-direction)) (set! (-> self string-vel-dir) (the-as uint 4))) - ((< (vector-dot (-> *camera* local-down) motion-direction) (- (cos (the-as float 5461.3335)))) + ((< (vector-dot (-> *camera* local-down) motion-direction) (- (cos (degrees 30)))) (set! (-> self string-vel-dir) (the-as uint 3))) - ((< (cos (the-as float 5461.3335)) (vector-dot string-direction motion-direction)) + ((< (cos (degrees 30)) (vector-dot string-direction motion-direction)) (set! (-> self string-vel-dir) (the-as uint 6))) - ((< (vector-dot string-direction motion-direction) (- (cos (the-as float 5461.3335)))) + ((< (vector-dot string-direction motion-direction) (- (cos (degrees 30)))) (set! (-> self string-vel-dir) (the-as uint 5))) - ((< (vector-dot (-> *camera* local-down) motion-cross) 0.0) (set! (-> self string-vel-dir) (the-as uint 1))) - (else (set! (-> self string-vel-dir) (the-as uint 2))))) + ((< (vector-dot (-> *camera* local-down) motion-cross) 0.0) + (set! (-> self string-vel-dir) (the-as uint 1))) + (else + (set! (-> self string-vel-dir) (the-as uint 2))))) 0.0 (let ((remaining-fraction 1.0) (step (new-stack-vector0)) @@ -1637,46 +1738,51 @@ (surface-normal (new 'stack-no-clear 'vector))) (when *debug-segment* (if (>= (-> *CAMERA-bank* min-detectable-velocity) (vector-length (-> self velocity))) - (cam-collision-record-save (-> self string-trans) (-> self velocity) -1 'no-hit self))) + (cam-collision-record-save (-> self string-trans) (-> self velocity) -1 'no-hit self))) (while (and (< 0.01 remaining-fraction) (and (< (-> *CAMERA-bank* min-detectable-velocity) (vector-length (-> self velocity))) (< collision-count 4))) (vector-float*! step (-> self velocity) remaining-fraction) - (if *debug-segment* (cam-collision-record-save (-> self string-trans) step collision-count 'normal self)) - (let ((hit-fraction (if (logtest? (-> self options) 32) - (fill-and-probe-using-line-sphere *collide-cache* - (-> self string-trans) - step - (-> *CAMERA-bank* collide-move-rad) - (collide-kind background cak-3 wall-object ground-object cak-14) - (the-as process #f) - probe-result - (new 'static 'pat-surface :nocamera #x1)) - -100000000.0))) + (if *debug-segment* + (cam-collision-record-save (-> self string-trans) step collision-count 'normal self)) + (let ((hit-fraction (if (logtest? (-> self options) (cam-slave-options COLLIDE)) + (fill-and-probe-using-line-sphere *collide-cache* + (-> self string-trans) + step + (-> *CAMERA-bank* collide-move-rad) + (collide-kind background hit-by-others wall-object ground-object cak-14) + (the-as process #f) + probe-result + (new 'static 'pat-surface :nocamera #x1)) + -100000000.0))) (if *display-cam-los-debug* - (format *stdcon* - "vp ~f vr ~f r ~f ta ~f~%" - (vector-length step) - remaining-fraction - (/ (vector-length step) remaining-fraction) - hit-fraction)) + (format *stdcon* + "vp ~f vr ~f r ~f ta ~f~%" + (vector-length step) + remaining-fraction + (/ (vector-length step) remaining-fraction) + hit-fraction)) (cond ((>= hit-fraction 0.0) (let* ((backoff-fraction (fmax 0.01 (/ 40.96 (vector-length step)))) (advance-fraction (fmax 0.0 (- hit-fraction backoff-fraction)))) (vector+float*! (-> self string-trans) (-> self string-trans) step advance-fraction)) (vector-! surface-normal (-> self string-trans) (-> probe-result intersect)) - (vector-normalize! surface-normal (the-as float 1.0)) + (vector-normalize! surface-normal 1.0) (vector-flatten! (-> self velocity) (-> self velocity) surface-normal) (set! remaining-fraction (- remaining-fraction (* remaining-fraction hit-fraction))) (+! collision-count 1)) - (else (vector+! (-> self string-trans) (-> self string-trans) step) (set! remaining-fraction 0.0)))))) + (else + (vector+! (-> self string-trans) (-> self string-trans) step) + (set! remaining-fraction 0.0)))))) (cond ((zero? collision-count) - (logand! (-> self options) -1025) - (if *display-cam-los-debug* (format *stdcon* "not blocked~%"))) + (logclear! (-> self options) (cam-slave-options MOVEMENT_BLOCKED)) + (if *display-cam-los-debug* + (format *stdcon* "not blocked~%"))) (else - (logior! (-> self options) 1024) - (if *display-cam-los-debug* (format *stdcon* "blocked ~D ~f~%" collision-count remaining-fraction)) + (logior! (-> self options) (cam-slave-options MOVEMENT_BLOCKED)) + (if *display-cam-los-debug* + (format *stdcon* "blocked ~D ~f~%" collision-count remaining-fraction)) (let ((camera-from-target (new-stack-vector0)) (old-string-length (vector-length (-> self view-flat)))) (vector-! camera-from-target (-> self string-trans) (-> *camera* tpos-curr-adj)) @@ -1687,7 +1793,8 @@ (vector-normalize-copy! (-> self view-flat) camera-from-target blocked-string-length) (set! (-> self min-z-override) blocked-string-length) blocked-string-length) - (else (vector-normalize-copy! (-> self view-flat) camera-from-target old-string-length)))))))) + (else + (vector-normalize-copy! (-> self view-flat) camera-from-target old-string-length)))))))) (when *display-cam-los-debug* (let ((remaining-motion (new-stack-vector0))) (vector-! remaining-motion (-> self desired-pos) (-> self string-trans)) @@ -1696,40 +1803,48 @@ (defbehavior cam-string-code camera-slave () "Run the string camera's follow, line-of-sight, joystick, hidden target, collision movement, and final position-spline smoothing stages for one frame." - (if *debug-segment* (cam-debug-reset-coll-tri)) + (if *debug-segment* + (cam-debug-reset-coll-tri)) (cam-string-follow) - (if (logtest? (-> self options) 512) (cam-string-line-of-sight)) - (if (not (paused?)) (cam-string-joystick)) + (if (logtest? (-> self options) (cam-slave-options LINE_OF_SIGHT)) + (cam-string-line-of-sight)) + (if (not (paused?)) + (cam-string-joystick)) (let ((camera-offset (new-stack-vector0))) (vector--float*! camera-offset (-> self view-flat) (-> *camera* local-down) (+ (-> *camera* target-height) (-> self view-off y))) (vector+! (-> self desired-pos) (-> *camera* tpos-curr-adj) camera-offset)) - (if (logtest? (-> self options) 64) (cam-string-find-hidden)) + (if (logtest? (-> self options) (cam-slave-options FIND_HIDDEN_TARGET)) + (cam-string-find-hidden)) (cond - ((logtest? (-> self options) 4096) + ((logtest? (-> self options) (cam-slave-options GOTO_GOOD_POINT)) (when *debug-segment* (let ((jump-displacement (new 'stack-no-clear 'vector))) (vector-! jump-displacement (-> self good-point) (-> self string-trans)) (cam-collision-record-save (-> self string-trans) jump-displacement -2 'jump self))) - (logand! (-> self options) -4097) + (logclear! (-> self options) (cam-slave-options GOTO_GOOD_POINT)) (vector-copy! (-> self desired-pos) (-> self good-point)) (cam-string-move) (vector-! (-> self view-flat) (-> self string-trans) (-> *camera* tpos-curr-adj)) (vector-flatten! (-> self view-flat) (-> self view-flat) (-> *camera* local-down)) (let ((jump-string-length (vector-length (-> self view-flat)))) - (if (< jump-string-length (-> self min-z-override)) (set! (-> self min-z-override) jump-string-length)))) - (else (cam-string-move))) - (add-point! (-> self position-spline) (-> self string-trans) (the-as float 0.04096) (the-as float 4096.0) #t) + (if (< jump-string-length (-> self min-z-override)) + (set! (-> self min-z-override) jump-string-length)))) + (else + (cam-string-move))) + (add-point! (-> self position-spline) (-> self string-trans) (meters 0.00001) (meters 1) #t) (cond - ((and (logtest? (-> self options) #x4000) (logtest? (-> self options) 256)) - (follow-update! (-> self position-spline) (-> self trans) (the-as float 102.4) (the-as float 4096.0))) - ((logtest? (-> self options) #x4000) - (follow-update! (-> self position-spline) (-> self trans) (the-as float 40.96) (the-as float 4096.0))) - ((logtest? (-> self options) 256) - (follow-update! (-> self position-spline) (-> self trans) (the-as float 102.4) (the-as float 2457.6))) - (else (follow-update! (-> self position-spline) (-> self trans) (the-as float 20.48) (the-as float 2457.6))))) + ((and (logtest? (-> self options) (cam-slave-options BIKE_MODE)) + (logtest? (-> self options) (cam-slave-options PLAYER_MOVING_CAMERA))) + (follow-update! (-> self position-spline) (-> self trans) (meters 0.025) (meters 1))) + ((logtest? (-> self options) (cam-slave-options BIKE_MODE)) + (follow-update! (-> self position-spline) (-> self trans) (meters 0.01) (meters 1))) + ((logtest? (-> self options) (cam-slave-options PLAYER_MOVING_CAMERA)) + (follow-update! (-> self position-spline) (-> self trans) (meters 0.025) (meters 0.6))) + (else + (follow-update! (-> self position-spline) (-> self trans) (meters 0.005) (meters 0.6))))) (defbehavior set-string-parms camera-slave () "Refresh the string camera's minimum and maximum offset vectors @@ -1756,19 +1871,25 @@ (('joystick) (set! (-> self phony-joystick-x) (the-as float (-> block param 0))) (set! (-> self phony-joystick-y) (the-as float (-> block param 1))) - (let ((enabled (the-as object #t))) (set! (-> self have-phony-joystick) (the-as symbol enabled)) enabled)) + (let ((enabled (the-as object #t))) + (set! (-> self have-phony-joystick) (the-as symbol enabled)) + enabled)) (('set-dist) (cond ((-> block param 0) (set! (-> self string-val-locked) #t) - (vector-copy! (-> self string-min-val) (the-as vector (-> block param 0))) - (vector-copy! (-> self string-max-val) (the-as vector (-> block param 1))) + (set! (-> self string-min-val quad) (-> (the-as vector (-> block param 0)) quad)) + (set! (-> self string-max-val quad) (-> (the-as vector (-> block param 1)) quad)) (set! (-> self string-max-val x) (fmax (-> self string-max-val x) (-> self string-min-val x))) (set! (-> self string-max-val y) (fmax (-> self string-max-val y) (-> self string-min-val y))) (set! (-> self string-max-val z) (fmax (-> self string-max-val z) (-> self string-min-val z)))) - (else (set! (-> self string-val-locked) #f) #f))) - (('blocked-side?) (-> self los-state)) - (else (cam-standard-event-handler proc argc message block)))) + (else + (set! (-> self string-val-locked) #f) + #f))) + (('blocked-side?) + (-> self los-state)) + (else + (cam-standard-event-handler proc argc message block)))) :enter (behavior () (when (not (-> self enter-has-run)) @@ -1779,7 +1900,8 @@ (set! (-> self los-tgt-spline-pt) (-> *camera* target-spline end-point)) (set! (-> self los-tgt-spline-pt-incarnation) (-> *camera* target-spline point (-> self los-tgt-spline-pt) incarnation)) (set! (-> self min-z-override) (-> self string-max-val z)) - (if (!= (-> *camera* outro-t-step) 0.0) (set! (-> self min-z-override) (-> self string-min-val z))) + (if (!= (-> *camera* outro-t-step) 0.0) + (set! (-> self min-z-override) (-> self string-min-val z))) (let ((initial-offset (new-stack-vector0))) 0.0 (set! (-> self view-off-param) (-> *camera* view-off-param-save)) @@ -1801,12 +1923,16 @@ (let ((minimum-string-length (fmin (-> *camera* string-push-z) (-> self min-z-override))) (maximum-string-length (-> self view-off z))) (cond - ((< initial-string-length minimum-string-length) (set! initial-string-length minimum-string-length)) - ((< maximum-string-length initial-string-length) (set! initial-string-length maximum-string-length)))) + ((< initial-string-length minimum-string-length) + (set! initial-string-length minimum-string-length)) + ((< maximum-string-length initial-string-length) + (set! initial-string-length maximum-string-length)))) (vector-normalize! (-> self view-flat) initial-string-length) (let ((distance-parameter (/ (- initial-string-length (-> self string-min-val z)) (- (-> self string-max-val z) (-> self string-min-val z))))) - (if (< 1.0 distance-parameter) (set! distance-parameter 1.0)) - (if (< distance-parameter 0.0) (set! distance-parameter 0.0)) + (if (< 1.0 distance-parameter) + (set! distance-parameter 1.0)) + (if (< distance-parameter 0.0) + (set! distance-parameter 0.0)) (let ((minimum-height (-> self string-min-val y)) (maximum-height (-> self string-max-val y))) (set! (-> self view-off y) (lerp minimum-height maximum-height distance-parameter))) @@ -1827,7 +1953,7 @@ target-head camera-offset (-> *CAMERA-bank* collide-move-rad) - (collide-kind background cak-3 wall-object ground-object cak-14) + (collide-kind background hit-by-others wall-object ground-object cak-14) (the-as process #f) probe-result (new 'static 'pat-surface :nocamera #x1 :nolineofsight #x1)))) @@ -1841,10 +1967,13 @@ (cam-string-find-position-rel! clear-offset) (cam-string-set-position-rel! clear-offset))) (else - (if (< clear-string-length (-> self min-z-override)) (set! (-> self min-z-override) clear-string-length)) + (if (< clear-string-length (-> self min-z-override)) + (set! (-> self min-z-override) clear-string-length)) (let ((distance-parameter (/ (- clear-string-length (-> self string-min-val z)) (- (-> self string-max-val z) (-> self string-min-val z))))) - (if (< 1.0 distance-parameter) (set! distance-parameter 1.0)) - (if (< distance-parameter 0.0) (set! distance-parameter 0.0)) + (if (< 1.0 distance-parameter) + (set! distance-parameter 1.0)) + (if (< distance-parameter 0.0) + (set! distance-parameter 0.0)) (let ((minimum-height (-> self string-min-val y)) (maximum-height (-> self string-max-val y))) (set! (-> self view-off y) (lerp minimum-height maximum-height distance-parameter))) @@ -1859,11 +1988,12 @@ (vector-copy! (-> self trans) (-> self string-trans)) (vector-copy! (-> self los-last-pos) (-> self string-trans)) (reset! (-> self position-spline) (-> self string-trans)) - (set! (-> self blend-from-type) (the-as uint 2)) - (set! (-> self blend-to-type) (the-as uint 2)))) + (set! (-> self blend-from-type) (camera-blend-to-type combiner-tracked)) + (set! (-> self blend-to-type) (camera-blend-to-type combiner-tracked)))) :trans (behavior () - (if (not (logtest? (-> *camera* master-options) 2)) (cam-slave-go cam-free-floating))) + (if (not (logtest? (-> *camera* master-options) (cam-master-options have-target))) + (cam-slave-go cam-free-floating))) :code (behavior () (loop @@ -1880,6 +2010,7 @@ (max-y meters) (min-y meters))) + (define *CAM_STICK-bank* (new 'static 'cam-stick-bank :max-z (meters 30) :min-z (meters 5) :max-y (meters 15) :min-y (meters 2))) @@ -1899,7 +2030,8 @@ (vector-! spring-step (-> self desired-pos) (-> self trans)) (vector-float*! spring-step spring-step 0.2) (vector-! acceleration spring-step (-> self velocity)) - (if (< 409.6 (vector-length acceleration)) (vector-normalize! acceleration (the-as float 409.6))) + (if (< 409.6 (vector-length acceleration)) + (vector-normalize! acceleration (meters 0.1))) (vector+! (-> self velocity) (-> self velocity) acceleration)) 0.0 (let ((remaining-fraction 1.0) @@ -1912,24 +2044,26 @@ (and (< (-> *CAMERA-bank* min-detectable-velocity) (vector-length (-> self velocity))) (> iterations-left 0))) (+! iterations-left -1) (vector-float*! step (-> self velocity) remaining-fraction) - (let ((hit-fraction (if (logtest? (-> self options) 32) - (fill-and-probe-using-line-sphere *collide-cache* - (-> self trans) - step - (-> *CAMERA-bank* collide-move-rad) - (collide-kind background cak-3 wall-object ground-object cak-14) - (the-as process #f) - probe-result - (new 'static 'pat-surface :nocamera #x1)) - -100000000.0))) + (let ((hit-fraction (if (logtest? (-> self options) (cam-slave-options COLLIDE)) + (fill-and-probe-using-line-sphere *collide-cache* + (-> self trans) + step + (-> *CAMERA-bank* collide-move-rad) + (collide-kind background hit-by-others wall-object ground-object cak-14) + (the-as process #f) + probe-result + (new 'static 'pat-surface :nocamera #x1)) + -100000000.0))) (cond ((>= hit-fraction 0.0) (vector+float*! (-> self trans) (-> self trans) step hit-fraction) - (set! (-> surface-normal quad) (-> probe-result normal quad)) + (vector-copy! surface-normal (-> probe-result normal)) (vector-flatten! (-> self velocity) (-> self velocity) surface-normal) (set! remaining-fraction (- remaining-fraction (* remaining-fraction hit-fraction))) (set! blocked? 1)) - (else (vector+! (-> self trans) (-> self trans) step) (set! remaining-fraction 0.0)))))) + (else + (vector+! (-> self trans) (-> self trans) step) + (set! remaining-fraction 0.0)))))) (when (nonzero? blocked?) 0 (let ((camera-from-target (new-stack-vector0))) @@ -1939,14 +2073,16 @@ (let ((blocked-distance-parameter (/ (- (vector-length camera-from-target) (-> *CAM_STICK-bank* min-z)) (- (-> *CAM_STICK-bank* max-z) (-> *CAM_STICK-bank* min-z))))) (cond - ((< blocked-distance-parameter 0.0) (set! blocked-distance-parameter 0.0)) - ((< 1.0 blocked-distance-parameter) (set! blocked-distance-parameter 1.0))) + ((< blocked-distance-parameter 0.0) + (set! blocked-distance-parameter 0.0)) + ((< 1.0 blocked-distance-parameter) + (set! blocked-distance-parameter 1.0))) (cond ((< (- blocked-distance-parameter (-> self view-off-param)) -0.001) (set! (-> self view-off-param) blocked-distance-parameter)) ((< 0.001 (- blocked-distance-parameter (-> self view-off-param))) (vector-normalize-copy! (-> self view-flat) camera-from-target (-> self view-off z)))))))) - (slave-set-rotation! (-> self tracking) (-> self trans) (the-as float (-> self options)) (-> self fov) #t) + (slave-set-rotation! (-> self tracking) (-> self trans) (-> self options) (-> self fov) #t) (none)) ;; Direct orbit camera used by debug and vehicle controls. The stick selects distance, height, and @@ -1969,12 +2105,13 @@ (vector+! (-> self desired-pos) (-> self desired-pos) (-> self tracking follow-pt)) (vector-copy! (-> self trans) (-> self desired-pos)) (vector-reset! (-> self velocity)) - (set! (-> self blend-from-type) (the-as uint 2)) - (set! (-> self blend-to-type) (the-as uint 2)) - (slave-set-rotation! (-> self tracking) (-> self trans) (the-as float (-> self options)) (-> self fov) #f))) + (set! (-> self blend-from-type) (camera-blend-to-type combiner-tracked)) + (set! (-> self blend-to-type) (camera-blend-to-type combiner-tracked)) + (slave-set-rotation! (-> self tracking) (-> self trans) (-> self options) (-> self fov) #f))) :trans (behavior () - (if (not (logtest? (-> *camera* master-options) 2)) (cam-slave-go cam-free-floating)) + (if (not (logtest? (-> *camera* master-options) (cam-master-options have-target))) + (cam-slave-go cam-free-floating)) (when (not (paused?)) (when *camera-read-analog* (let ((distance-input (analog-input-vertical-third ;; og:preserve-this changed for pc port @@ -1988,7 +2125,8 @@ (+! (-> self view-off-param) (* 0.05 (- 1.0 (-> self view-off-param))))) ((< distance-input (* 0.05 (- (-> self view-off-param)))) (+! (-> self view-off-param) (* 0.05 (- (-> self view-off-param))))) - (else (+! (-> self view-off-param) distance-input))))) + (else + (+! (-> self view-off-param) distance-input))))) (set! (-> self view-off y) (lerp (-> *CAM_STICK-bank* min-y) (-> *CAM_STICK-bank* max-y) (-> self view-off-param))) (set! (-> self view-off z) (lerp (-> *CAM_STICK-bank* min-z) (-> *CAM_STICK-bank* max-z) (-> self view-off-param))) (when *camera-read-analog* @@ -2006,24 +2144,25 @@ ((!= orbit-input 0.0) (matrix-axis-angle! rotation (-> *camera* local-down) orbit-input) (vector-matrix*! (-> self view-flat) (-> self view-flat) rotation)) - ((logtest? (-> self options) 1) + ((logtest? (-> self options) (cam-slave-options BUTT_CAM)) (set-vector! current-direction 0.0 0.0 1.0 1.0) - (vector-normalize-copy! current-direction (-> self view-flat) (the-as float 1.0)) + (vector-normalize-copy! current-direction (-> self view-flat) 1.0) (set! (-> target-backward quad) (-> *camera* tgt-rot-mat vector 2 quad)) (vector-flatten! target-backward target-backward (-> *camera* local-down)) (vector-negate! target-backward target-backward) - (set! (-> desired-direction quad) (-> current-direction quad)) - (vector-normalize-copy! desired-direction target-backward (the-as float 1.0)) + (vector-copy! desired-direction current-direction) + (vector-normalize-copy! desired-direction target-backward 1.0) (matrix-from-two-vectors-max-angle-partial! rotation current-direction desired-direction (* 10922.667 (seconds-per-frame)) - (the-as float 0.05)) + 0.05) (vector-matrix*! (-> self view-flat) (-> self view-flat) rotation))))))) :code (behavior () (loop - (if (not (paused?)) (cam-stick-code)) + (if (not (paused?)) + (cam-stick-code)) (suspend)))) (deftype cam-bike-bank (basic) @@ -2032,6 +2171,7 @@ (max-y meters) (min-y meters))) + (define *CAM_BIKE-bank* (new 'static 'cam-bike-bank :max-z (meters 6) :min-z (meters 10) :max-y (meters 3) :min-y (meters 5))) @@ -2052,10 +2192,10 @@ (let ((steering-rotation (new-stack-matrix0))) (let ((current-direction (new-stack-vector0)) (target-backward (new-stack-vector0))) - (vector-normalize-copy! current-direction (-> self view-flat) (the-as float 1.0)) + (vector-normalize-copy! current-direction (-> self view-flat) 1.0) (vector-flatten! target-backward (-> *camera* tgt-rot-mat vector 2) (-> *camera* local-down)) - (vector-normalize! target-backward (the-as float -1.0)) - (matrix-from-two-vectors-partial-linear! steering-rotation current-direction target-backward (the-as float 0.2))) + (vector-normalize! target-backward -1.0) + (matrix-from-two-vectors-partial-linear! steering-rotation current-direction target-backward 0.2)) (vector-matrix*! (-> self view-flat) (-> self view-flat) steering-rotation)) (let ((camera-offset (new-stack-vector0))) 0.0 @@ -2080,7 +2220,8 @@ (vector-! spring-step (-> self desired-pos) (-> self trans)) (vector-float*! spring-step spring-step 0.2) (vector-! acceleration spring-step (-> self velocity)) - (if (< 409.6 (vector-length acceleration)) (vector-normalize! acceleration (the-as float 409.6))) + (if (< 409.6 (vector-length acceleration)) + (vector-normalize! acceleration (meters 0.1))) (vector+! (-> self velocity) (-> self velocity) acceleration)) 0.0 (let ((remaining-fraction 1.0) @@ -2091,16 +2232,16 @@ (and (< (-> *CAMERA-bank* min-detectable-velocity) (vector-length (-> self velocity))) (> iterations-left 0))) (+! iterations-left -1) (vector-float*! step (-> self velocity) remaining-fraction) - (let ((hit-fraction (if (logtest? (-> self options) 32) - (fill-and-probe-using-line-sphere *collide-cache* - (-> self trans) - step - (the-as float 4096.0) - (collide-kind background cak-3 wall-object ground-object cak-14) - (the-as process #f) - probe-result - (new 'static 'pat-surface :nocamera #x1)) - -100000000.0))) + (let ((hit-fraction (if (logtest? (-> self options) (cam-slave-options COLLIDE)) + (fill-and-probe-using-line-sphere *collide-cache* + (-> self trans) + step + (meters 1) + (collide-kind background hit-by-others wall-object ground-object cak-14) + (the-as process #f) + probe-result + (new 'static 'pat-surface :nocamera #x1)) + -100000000.0))) (cond ((>= hit-fraction 0.0) (vector+float*! (-> self trans) (-> self trans) step hit-fraction) @@ -2110,9 +2251,11 @@ (vector-! camera-from-target (-> self trans) (-> *camera* tpos-curr-adj)) (vector-flatten! camera-from-target camera-from-target (-> *camera* local-down)) (vector-normalize-copy! (-> self view-flat) camera-from-target (-> self view-off z)))) - (else (vector+! (-> self trans) (-> self trans) step) (set! remaining-fraction 0.0)))))) + (else + (vector+! (-> self trans) (-> self trans) step) + (set! remaining-fraction 0.0)))))) (cam-calc-bike-follow! (-> self tracking) (-> self trans) #t) - (slave-set-rotation! (-> self tracking) (-> self trans) (the-as float (-> self options)) (-> self fov) #t) + (slave-set-rotation! (-> self tracking) (-> self trans) (-> self options) (-> self fov) #t) (none)) ;; High-speed follow camera. Target speed expands both distance and height, facing steers the @@ -2134,13 +2277,14 @@ (vector+! (-> self desired-pos) (-> self desired-pos) (-> *camera* tpos-curr-adj)) (vector-copy! (-> self trans) (-> self desired-pos)) (vector-reset! (-> self velocity)) - (set! (-> self blend-from-type) (the-as uint 0)) - (set! (-> self blend-to-type) (the-as uint 1)) + (set! (-> self blend-from-type) (camera-blend-to-type direct)) + (set! (-> self blend-to-type) (camera-blend-to-type slave-controlled)) (cam-calc-bike-follow! (-> self tracking) (-> self trans) #f) - (slave-set-rotation! (-> self tracking) (-> self trans) (the-as float (-> self options)) (-> self fov) #f))) + (slave-set-rotation! (-> self tracking) (-> self trans) (-> self options) (-> self fov) #f))) :trans (behavior () - (if (not (logtest? (-> *camera* master-options) 2)) (cam-slave-go cam-free-floating))) + (if (not (logtest? (-> *camera* master-options) (cam-master-options have-target))) + (cam-slave-go cam-free-floating))) :code (behavior () (loop diff --git a/goal_src/jak1/engine/camera/cam-update-h.gc b/goal_src/jak1/engine/camera/cam-update-h.gc index 93609b4aff..6653aeb1c5 100644 --- a/goal_src/jak1/engine/camera/cam-update-h.gc +++ b/goal_src/jak1/engine/camera/cam-update-h.gc @@ -9,6 +9,7 @@ :bitfield #t (allow-z 0)) +;; DECOMP BEGINS (define *external-cam-options* (external-cam-option)) ;; False for the gameplay camera, or the controller/debug mode that directly @@ -23,17 +24,9 @@ ;; Alternate field of view, position, inverse rotation, and debug target used ;; while *camera-look-through-other* is active. (define-perm *camera-other-fov* bfloat (new 'static 'bfloat :data 11650.845)) - (define-perm *camera-other-trans* vector (vector-reset! (new 'global 'vector))) - (define-perm *camera-other-matrix* matrix (matrix-identity! (new 'global 'matrix))) ;; Vertical camera impulse shared by the gameplay and alternate-camera paths. (define-perm *camera-smush-control* smush-control (set-zero! (new 'global 'smush-control))) - (define-perm *camera-other-root* vector (vector-reset! (new 'global 'vector))) - -;; TODO - actually defined in cam-states-dbg -(define-extern cam-free-floating-move (function matrix vector vector int vector)) - -(define-extern cam-free-floating-input (function vector vector symbol int vector)) diff --git a/goal_src/jak1/engine/camera/cam-update.gc b/goal_src/jak1/engine/camera/cam-update.gc index 160206103c..18c47d36ae 100644 --- a/goal_src/jak1/engine/camera/cam-update.gc +++ b/goal_src/jak1/engine/camera/cam-update.gc @@ -36,10 +36,7 @@ (defun set-point ((point vector) (x float) (y float) (z float)) "Set point's xyz coordinates and set w to one." - (set! (-> point x) x) - (set! (-> point y) y) - (set! (-> point z) z) - (set! (-> point w) 1.0) + (set-vector! point x y z 1.0) (none)) (defun update-view-planes ((camera math-camera) (planes (inline-array plane)) (scale float)) @@ -78,8 +75,7 @@ (far-bottom-left-ray (new-stack-vector0)) (far-bottom-right-ray (new-stack-vector0))) (set! (-> (new 'stack-no-clear 'vector) quad) (the-as uint128 0)) - (let ((camera-position (new 'stack-no-clear 'vector))) - (set! (-> camera-position quad) (the-as uint128 0)) + (let ((camera-position (new-stack-vector0))) (set! (-> camera-position quad) (-> camera inv-camera-rot vector 3 quad)) (vector-! far-top-left-ray (-> frustum yon-top-left) camera-position) (vector-! far-top-right-ray (-> frustum yon-top-right) camera-position) @@ -136,22 +132,26 @@ (set! use-adjacent? (logtest? (vis-info-flag using-this-as-only-vis) (-> adjacent-vis flags))) (if (< (-> adjacent-vis length) (-> adjacent-vis from-bsp current-leaf-idx)) (set! use-adjacent? #f))) use-self?)) - (if (!= (-> active-level all-visible?) 'loading) (set! (-> active-level all-visible?) #f)) + (if (!= (-> active-level all-visible?) 'loading) + (set! (-> active-level all-visible?) #f)) (when (update-vis! active-level self-vis (-> self-vis ramdisk) (-> self-vis string-block)) ;; A successful update makes every other cached string stale. (countdown (i 8) (let ((vis-info (-> active-level vis-info i))) (when vis-info - (if (!= vis-info self-vis) (set! (-> vis-info current-vis-string) (the-as uint -1)))))) + (if (!= vis-info self-vis) + (set! (-> vis-info current-vis-string) (the-as uint -1)))))) (set! (-> active-level all-visible?) #f))) (use-adjacent? - (if (!= (-> active-level all-visible?) 'loading) (set! (-> active-level all-visible?) #f)) + (if (!= (-> active-level all-visible?) 'loading) + (set! (-> active-level all-visible?) #f)) (when (update-vis! active-level adjacent-vis (-> adjacent-vis ramdisk) (-> adjacent-vis string-block)) ;; The adjacent string follows the same cache rules. (countdown (i 8) (let ((vis-info (-> active-level vis-info i))) (when vis-info - (if (!= vis-info adjacent-vis) (set! (-> vis-info current-vis-string) (the-as uint -1)))))) + (if (!= vis-info adjacent-vis) + (set! (-> vis-info current-vis-string) (the-as uint -1)))))) (set! (-> active-level all-visible?) #f))) ;; Keep the old visibility bits while the next string loads ;; during play, avoiding an all-visible flash between strings. @@ -176,14 +176,18 @@ (controller-index 0)) (cond ((= mode 'locked) (set! mode #f)) - ((= mode 'pad-1) (set! controller-index 1)) - ((not *camera-combiner*) (set! mode 'pad-0))) + ((= mode 'pad-1) + (set! controller-index 1)) + ((not *camera-combiner*) + (set! mode 'pad-0))) (when mode ;; Gravity supplies the camera's down direction. Passing #f for up ;; allows a fully free orientation, including roll. (let ((up (vector-negate-in-place! (vector-normalize-copy! (new-stack-vector0) (-> *standard-dynamics* gravity) 1.0)))) - (if (= (vector-length up) 0.0) (set! (-> up y) -1.0)) - (if (logtest? *external-cam-options* (external-cam-option allow-z)) (set! up (the-as vector #f))) + (if (= (vector-length up) 0.0) + (set! (-> up y) -1.0)) + (if (logtest? *external-cam-options* (external-cam-option allow-z)) + (set! up (the-as vector #f))) (cam-free-floating-move *save-camera-inv-rot* (-> camera trans) up controller-index)))) (matrix-copy! (-> *math-camera* inv-camera-rot) *save-camera-inv-rot*) camera) @@ -242,7 +246,8 @@ (-> *target* control trans z)) (format #t "Dist = ~F~%" (* 0.00024414062 (vector-vector-xz-distance (-> *target* control trans) *start-pos*))) (set! *start-timer* (the-as int #f))) - (if (< 179 *timer-value*) (format *stdcon* "~%~%Time = ~D~%" *timer-value*)) + (if (< 179 *timer-value*) + (format *stdcon* "~%~%Time = ~D~%" *timer-value*)) (set! *timer-value* (+ *timer-value* 1))) (when (not *start-timer*) (set! *timer-value* 0) @@ -272,13 +277,14 @@ (update! *camera-smush-control*) (cond ((or (= *master-mode* 'pause) (= *master-mode* 'progress) *progress-process*)) - ((>= *camera-look-through-other* 2) (set! *camera-look-through-other* 1)) - ((and (= *camera-look-through-other* 1) (!= *master-mode* 'menu)) (set! *camera-look-through-other* 0) 0)) - ;; Priority is external control, the alternate/debug camera, the gameplay - ;; combiner, then the controller fallback. Alternate and gameplay poses - ;; also refresh the saved external orientation to avoid a jump on entry. + ((>= *camera-look-through-other* 2) + (set! *camera-look-through-other* 1)) + ((and (= *camera-look-through-other* 1) (!= *master-mode* 'menu)) + (set! *camera-look-through-other* 0) + 0)) (cond - (*external-cam-mode* (move-camera-from-pad *math-camera*)) + (*external-cam-mode* + (move-camera-from-pad *math-camera*)) ((nonzero? *camera-look-through-other*) (set! (-> *math-camera* fov) (-> *camera-other-fov* data)) (vector-copy! (-> *math-camera* trans) *camera-other-trans*) @@ -297,14 +303,15 @@ ;; reduce the mip factor so zoomed views do not choose overly coarse mips; ;; wider views are capped at one. (cond - (*camera-no-mip-correction* (set! (-> *math-camera* fov-correction-factor) 1.0)) + (*camera-no-mip-correction* + (set! (-> *math-camera* fov-correction-factor) 1.0)) (else (let ((mip-fov (fmin 11650.845 (-> *math-camera* fov)))) (set! (-> *math-camera* fov-correction-factor) (* 0.00008583069 mip-fov))))) ;; Blend from the saved orientation toward the current pose while smooth-t ;; decays. Once complete, keep an exact copy of the current orientation. (if (< 0.0 (-> *math-camera* smooth-t)) - (set! (-> *math-camera* smooth-t) (- (-> *math-camera* smooth-t) (-> *math-camera* smooth-step)))) + (set! (-> *math-camera* smooth-t) (- (-> *math-camera* smooth-t) (-> *math-camera* smooth-step)))) (cond ((< 0.0 (-> *math-camera* smooth-t)) (let ((smooth-rotation (new-stack-quaternion0))) @@ -317,11 +324,9 @@ (else (matrix-copy! (-> *math-camera* inv-camera-rot-smooth) (-> *math-camera* inv-camera-rot)))) (if (and (!= *master-mode* 'menu) *display-camera-info*) - (format *stdcon* "cam pos ~M ~M ~M~%" (-> *math-camera* trans x) (-> *math-camera* trans y) (-> *math-camera* trans z))) - ;; Preserve the old view-projection before rebuilding it. A reset instead - ;; copies the new matrix afterward, suppressing one frame of camera motion. - (when (zero? (-> *math-camera* reset)) - (matrix-copy! (-> *math-camera* prev-camera-temp) (-> *math-camera* camera-temp))) + (format *stdcon* "cam pos ~M ~M ~M~%" (-> *math-camera* trans x) (-> *math-camera* trans y) (-> *math-camera* trans z))) + (if (zero? (-> *math-camera* reset)) + (matrix-copy! (-> *math-camera* prev-camera-temp) (-> *math-camera* camera-temp))) (let ((view-projection (-> *math-camera* camera-temp)) (view-matrix (-> *math-camera* camera-rot)) (inverse-view-matrix (-> *math-camera* inv-camera-rot)) @@ -329,10 +334,11 @@ ;; Rigid inverse translation is -C transformed by the transposed ;; orientation. The inverse view keeps C directly in its fourth row. (let ((negative-camera-position (new-stack-vector0))) - (set! (-> negative-camera-position x) (- (-> camera-position x))) - (set! (-> negative-camera-position y) (- (-> camera-position y))) - (set! (-> negative-camera-position z) (- (-> camera-position z))) - (set! (-> negative-camera-position w) 1.0) + (set-vector! negative-camera-position + (- (-> camera-position x)) + (- (-> camera-position y)) + (- (-> camera-position z)) + 1.0) (vector-matrix*! negative-camera-position negative-camera-position view-matrix) (set! (-> view-matrix vector 3 quad) (-> negative-camera-position quad))) (matrix*! view-projection view-matrix (-> *math-camera* perspective)) @@ -350,7 +356,7 @@ (set! (-> *instance-tie-work* hmge-d y) fog-max) (set! (-> *instance-tie-work* hmge-d z) (* 32.0 near-distance)) (set! (-> *instance-tie-work* hmge-d w) (* near-distance (-> *math-camera* hmge-scale w))) - (let ((hvdf-offset (-> *math-camera* hvdf-off quad))) (set! (-> *instance-tie-work* hvdf-offset quad) hvdf-offset)) + (vector-copy! (-> *instance-tie-work* hvdf-offset) (-> *math-camera* hvdf-off)) (set! (-> *instance-shrub-work* hmge-d x) fog-min) (set! (-> *instance-shrub-work* hmge-d y) fog-max) (set! (-> *instance-shrub-work* hmge-d z) (* 3.0 near-distance)) @@ -362,9 +368,7 @@ (set! (-> *instance-shrub-work* billboard-const z) fog-min) (set! (-> *instance-shrub-work* billboard-const w) fog-max)) (set! (-> *instance-shrub-work* constants w) (the-as float (-> *math-camera* vis-gifs 0 fog0))) - (let ((hvdf-offset (-> *math-camera* hvdf-off quad))) (set! (-> *instance-shrub-work* hvdf-offset quad) hvdf-offset)) - ;; The ordinary side planes cull the view frustum. The four-times-wider - ;; guard planes give TIE and shrub generation room around the visible area. + (vector-copy! (-> *instance-shrub-work* hvdf-offset) (-> *math-camera* hvdf-off)) (update-view-planes *math-camera* (-> *math-camera* plane) 1.0) (update-view-planes *math-camera* (-> *math-camera* guard-plane) 4.0) (vector-copy! (-> *instance-shrub-work* guard-plane 0) (-> *math-camera* guard-plane 0)) @@ -376,5 +380,6 @@ (vector-copy! (-> *instance-tie-work* guard-plane 2) (-> *math-camera* guard-plane 2)) (vector-copy! (-> *instance-tie-work* guard-plane 3) (-> *math-camera* guard-plane 3)) (update-visible *math-camera*) - (if (not (paused?)) (update-wind *wind-work* *wind-scales*)) + (if (not (paused?)) + (update-wind *wind-work* *wind-scales*)) #f) diff --git a/goal_src/jak1/engine/camera/camera-h.gc b/goal_src/jak1/engine/camera/camera-h.gc index 2f2f9142be..c8b02b6280 100644 --- a/goal_src/jak1/engine/camera/camera-h.gc +++ b/goal_src/jak1/engine/camera/camera-h.gc @@ -4,35 +4,6 @@ (require "engine/math/vector-h.gc") (require "engine/gfx/hw/display-h.gc") -;; TODO - for cam-layout -(define-extern v-slrp2! (function vector vector vector float vector float vector)) - -(define-extern v-slrp3! (function vector vector vector vector float vector)) - -(declare-type camera-slave process) - -(declare-type camera-master process) - -(declare-type tracking-point structure) - -(declare-type cam-rotation-tracker structure) - -(declare-type camera-combiner process) - -;; TODO - for cam-master -;; TODO - for camera -(define-extern camera-line-rel-len (function vector vector float vector4w none)) - -(define-extern cam-calc-follow! (function cam-rotation-tracker vector symbol vector)) - -(define-extern slave-set-rotation! (function cam-rotation-tracker vector float float symbol none)) - -;; TODO - for cam-combiner -(define-extern paused? (function symbol)) - -;; TODO - for cam-start -(define-extern cam-master-init (function none :behavior camera-master)) - (defenum cam-slave-options :bitfield #t (BUTT_CAM) @@ -54,6 +25,28 @@ (STICKY_ANGLE) (AIR_EXIT)) +(defenum cam-slave-options-i + :bitfield #t + :type int32 + (BUTT_CAM) + (SAME_SIDE) + (MOVE_SPHERICAL) + (ALLOW_Z_ROT) + (JUMP_PITCHES) + (COLLIDE) + (FIND_HIDDEN_TARGET) + (DRAG) + (PLAYER_MOVING_CAMERA) + (LINE_OF_SIGHT) + (MOVEMENT_BLOCKED) + (SHRINK_MAX_ANGLE) + (GOTO_GOOD_POINT) + (BLOCK_SHIFT_BUTTONS) + (BIKE_MODE) + (NO_ROTATE) + (STICKY_ANGLE) + (AIR_EXIT)) + (defenum cam-index-options :type uint32 :bitfield #t @@ -67,6 +60,31 @@ (ccw 2) (between 3)) +(defenum cam-track-status + :type uint64 + (use-slave-tracking 0) + (track-at-combiner 1) + (track-at-dst 2) + (track-at-src 3)) + + +(defenum camera-blend-to-type + :type uint64 + (direct 0) + (slave-controlled 1) + (combiner-tracked 2)) + +(defenum cam-master-options + :type uint32 + :bitfield #t + (ignore-regions 0) + (have-target 1) + (switch-only-on-ground 2) + (set-combiner-axis 3) + (flip-combiner 4) + (have-ease-to-pos 5) + (in-base-region 6)) + ;; DECOMP BEGINS ;; Shared gameplay-camera tuning used for collision movement, input response, @@ -147,17 +165,15 @@ (advance-used-point! (_type_ tracking-spline-sampler) none) (prune-most-collinear! (_type_) none) (prune-shallow-points! (_type_ float) none) - (add-point! (_type_ vector float float symbol) int) + (add-point! (_type_ vector meters meters symbol) int) (accumulate-sample! (_type_ float vector tracking-spline-sampler) vector) (sample-point! (_type_ float vector tracking-spline-sampler) vector) (apply-trail-correction! (_type_ vector int) none) - (follow-update! (_type_ vector float float) vector) - (trim-to-length! (_type_ float) none) + (follow-update! (_type_ vector meters meters) vector) + (trim-to-length! (_type_ meters) none) (debug-draw (_type_) none))) -;; A scalar spring-like seeker. value accelerates toward target and its speed -;; is limited by both max-vel and max-partial times the remaining distance, so -;; it eases down automatically near the target. + (deftype cam-float-seeker (structure) ((target float) (value float) @@ -173,8 +189,8 @@ (jump-to-target! (_type_ float) float))) (defmethod init-cam-float-seeker ((this cam-float-seeker) (initial-value float) (accel float) (max-vel float) (max-partial float)) - "Initialize target and value to initial-value, clear velocity, and set the - acceleration and two speed limits." + "Initialize target and value to initial-value, clear + velocity, and set the acceleration and two speed limits." (set! (-> this target) initial-value) (set! (-> this value) initial-value) (set! (-> this vel) 0.0) @@ -196,24 +212,27 @@ (none)) (defmethod update! ((this cam-float-seeker) (offset float)) - "Advance one frame toward target plus offset. Acceleration and displacement - use the display time ratio, and velocity is capped by the smaller of max-vel - and max-partial times the remaining distance." + "Advance one frame toward target plus offset. Acceleration and + displacement use the display time ratio, and velocity is capped by the + smaller of max-vel and max-partial times the remaining distance." 0.0 0.0 (let* ((pos-error (- (+ (-> this target) offset) (-> this value))) (partial-velocity-limit (* (-> this max-partial) (fabs pos-error)))) - (let ((daccel (* pos-error (* (-> this accel) (-> *display* time-adjust-ratio))))) (+! (-> this vel) daccel)) + (let ((daccel (* pos-error (* (-> this accel) (-> *display* time-adjust-ratio))))) + (+! (-> this vel) daccel)) (let ((abs-vel (fabs (-> this vel))) (abs-vel-limit (fmin partial-velocity-limit (-> this max-vel)))) - (if (< abs-vel-limit abs-vel) (set! (-> this vel) (* (-> this vel) (/ abs-vel-limit abs-vel)))))) - (let ((dpos (* (-> this vel) (-> *display* time-adjust-ratio)))) (+! (-> this value) dpos)) + (if (< abs-vel-limit abs-vel) + (set! (-> this vel) (* (-> this vel) (/ abs-vel-limit abs-vel)))))) + (let ((dpos (* (-> this vel) (-> *display* time-adjust-ratio)))) + (+! (-> this value) dpos)) 0 (none)) (defmethod jump-to-target! ((this cam-float-seeker) (offset float)) - "Set value directly to target plus offset, clear velocity, and return the new - value." + "Set value directly to target plus offset, clear velocity, + and return the new value." (set! (-> this value) (+ (-> this target) offset)) (set! (-> this vel) 0.0)) @@ -231,11 +250,15 @@ (update! (_type_ vector) none))) (defmethod init! ((this cam-vector-seeker) (initial-value vector) (accel float) (max-vel float) (max-partial float)) - "Initialize target and value from initial-value, or zero when it is false; - clear velocity and set the acceleration and speed limits." + "Initialize target and value from initial-value, or zero when it is + false; clear velocity and set the acceleration and speed limits." (cond - (initial-value (vector-copy! (-> this target) initial-value) (vector-copy! (-> this value) initial-value)) - (else (vector-reset! (-> this target)) (vector-reset! (-> this value)))) + (initial-value + (vector-copy! (-> this target) initial-value) + (vector-copy! (-> this value) initial-value)) + (else + (vector-reset! (-> this target)) + (vector-reset! (-> this value)))) (vector-reset! (-> this vel)) (set! (-> this accel) accel) (set! (-> this max-vel) max-vel) @@ -244,19 +267,23 @@ (none)) (defmethod update! ((this cam-vector-seeker) (offset vector)) - "Advance one frame toward target plus optional offset, limiting velocity - magnitude by max-vel and the remaining-distance limit." + "Advance one frame toward target plus optional offset, limiting + velocity magnitude by max-vel and the remaining-distance limit." (let ((error (new 'stack-no-clear 'vector))) 0.0 (cond - (offset (vector+! error (-> this target) offset) (vector-! error error (-> this value))) - (else (vector-! error (-> this target) (-> this value)))) + (offset + (vector+! error (-> this target) offset) + (vector-! error error (-> this value))) + (else + (vector-! error (-> this target) (-> this value)))) (let ((partial-velocity-limit (* (-> this max-partial) (vector-length error)))) (vector-float*! error error (* (-> this accel) (-> *display* time-adjust-ratio))) (vector+! (-> this vel) (-> this vel) error) (let ((velocity (vector-length (-> this vel))) (velocity-limit (fmin partial-velocity-limit (-> this max-vel)))) - (if (< velocity-limit velocity) (vector-float*! (-> this vel) (-> this vel) (/ velocity-limit velocity))))) + (if (< velocity-limit velocity) + (vector-float*! (-> this vel) (-> this vel) (/ velocity-limit velocity))))) (vector-float*! error (-> this vel) (-> *display* time-adjust-ratio)) (vector+! (-> this value) (-> this value) error)) 0 @@ -286,8 +313,8 @@ (dist-from-dest float) (flip-control-axis vector :inline) (velocity vector :inline) - (tracking-status uint64) - (tracking-options int32) + (tracking-status cam-track-status) + (tracking-options cam-slave-options-i) (tracking cam-rotation-tracker :inline)) (:states cam-combiner-active)) @@ -296,9 +323,9 @@ ;; slave alive together while the combiner transitions between them. (deftype camera-slave (process) ((trans vector :inline) - (fov float) - (fov0 float) - (fov1 float) + (fov degrees) + (fov0 degrees) + (fov1 degrees) (fov-index cam-index :inline) (tracking cam-rotation-tracker :inline) (view-off-param float) @@ -314,8 +341,8 @@ (circular-follow vector :inline) (max-angle-offset float) (max-angle-curr float) - (options uint32) - (cam-entity entity) + (options cam-slave-options) + (cam-entity entity-camera) (velocity vector :inline) (desired-pos vector :inline) (time-dist-too-far uint32) @@ -338,8 +365,8 @@ (spline-follow-dist float) (change-event-from (pointer process-drawable)) (enter-has-run symbol) - (blend-from-type uint64) - (blend-to-type uint64) + (blend-from-type camera-blend-to-type) + (blend-to-type camera-blend-to-type) (have-phony-joystick basic) (phony-joystick-x float) (phony-joystick-y float) @@ -378,10 +405,10 @@ ;; active slaves, target transforms and tracking trail, and transition state; ;; the combiner produces the final rendered camera. (deftype camera-master (process) - ((master-options uint32) + ((master-options cam-master-options) (num-slaves int32) (slave (pointer camera-slave) 2) - (slave-options uint32) + (slave-options cam-slave-options) (view-off-param-save float) (changer uint32) (cam-entity entity) diff --git a/goal_src/jak1/engine/camera/camera.gc b/goal_src/jak1/engine/camera/camera.gc index d2796edf4d..28da007701 100644 --- a/goal_src/jak1/engine/camera/camera.gc +++ b/goal_src/jak1/engine/camera/camera.gc @@ -16,15 +16,18 @@ (define *cam-res-string* (new 'global 'string 64 (the-as string #f))) -(defun cam-slave-get-vector-with-offset ((source-actor entity-actor) (out vector) (prop-name symbol)) +(defun cam-slave-get-vector-with-offset ((source-actor entity-camera) (out vector) (prop-name symbol)) "Read property from actor, using its live translation or rotation for the matching property names, add an optional property-offset vector, and write out. Return true when a value was available." (local-vars (base-value structure)) (cond - ((= prop-name 'trans) (set! base-value (-> source-actor trans))) - ((= prop-name 'rot) (set! base-value (-> source-actor quat))) - (else (set! base-value (res-lump-struct source-actor prop-name structure)))) + ((= prop-name 'trans) + (set! base-value (-> source-actor trans))) + ((= prop-name 'rot) + (set! base-value (-> source-actor quat))) + (else + (set! base-value (res-lump-struct source-actor prop-name structure)))) (let ((struct-getter (method-of-type res-lump get-property-struct))) (format (clear *res-key-string*) "~S~S" prop-name '-offset) (let ((offset-value (struct-getter source-actor @@ -35,8 +38,12 @@ (the-as (pointer res-tag) #f) *res-static-buf*))) (cond - ((and base-value offset-value) (vector+! out (the-as vector base-value) (the-as vector offset-value)) #t) - ((the-as vector base-value) (vector-copy! out (the-as vector base-value)) #t) + ((and base-value offset-value) + (vector+! out (the-as vector base-value) (the-as vector offset-value)) + #t) + ((the-as vector base-value) + (set! (-> out quad) (-> (the-as vector base-value) quad)) + #t) (else #f))))) (defun cam-slave-get-flags ((source-entity entity) (prop-name symbol)) @@ -62,7 +69,7 @@ (the-as uint128 0) (the-as (pointer res-tag) #f) *res-static-buf*))) - (logclear (logior base-flags set-flags) clear-flags))))) + (the-as cam-slave-options (logclear (logior base-flags set-flags) clear-flags)))))) (defun cam-slave-get-float ((source-entity entity) (prop-name symbol) (default-value float)) "Read property from entity with default-value, add the @@ -92,7 +99,9 @@ 0.0 (the-as (pointer res-tag) #f) *res-static-buf*))) - (if (= base-fov 0.0) (+ 11650.845 fov-offset) (+ base-fov fov-offset))))) + (if (= base-fov 0.0) + (+ 11650.845 fov-offset) + (+ base-fov fov-offset))))) (defun cam-slave-get-intro-step ((source-entity entity)) "Read intro-time plus intro-time-offset and return the @@ -108,7 +117,9 @@ 0.0 (the-as (pointer res-tag) #f) *res-static-buf*)))) - (if (>= 0.0 duration) 0.004166667 (/ 0.016666668 duration))))) + (if (>= 0.0 duration) + 0.004166667 + (/ 0.016666668 duration))))) (defun cam-slave-get-interp-time ((source-entity entity)) "Read interpTime plus interpTime-offset from entity and @@ -124,12 +135,12 @@ 0.0 (the-as (pointer res-tag) #f) *res-static-buf*)))) - (if (>= 0.001 duration) (set! duration 0.0)) + (if (>= 0.001 duration) + (set! duration 0.0)) duration))) -(defun cam-slave-get-rot ((source-actor entity-actor) (out-matrix matrix)) - "Convert actor's rotation to out-matrix after composing an optional - rot-offset quaternion." +(defun cam-slave-get-rot ((source-actor entity-camera) (out-matrix matrix)) + "Get the rotation of the entity, including optional rotation offset." (let ((struct-getter (method-of-type res-lump get-property-struct)) (source-copy source-actor)) (format (clear *res-key-string*) "~S~S" 'rot '-offset) @@ -146,7 +157,8 @@ (quaternion*! combined-rotation (the-as quaternion rotation-offset) (-> source-actor quat)) (quaternion-normalize! combined-rotation) (quaternion->matrix out-matrix combined-rotation))) - (else (quaternion->matrix out-matrix (-> source-actor quat)))))) + (else + (quaternion->matrix out-matrix (-> source-actor quat)))))) out-matrix) (defun cam-state-from-entity ((source-entity entity)) @@ -156,12 +168,16 @@ (let ((camera-path (new 'stack 'curve))) (the-as state (cond - ((not source-entity) (the-as (state camera-slave) #f)) + ((not source-entity) + (the-as (state camera-slave) #f)) ((res-lump-struct source-entity 'pivot structure) cam-circular) - ((res-lump-struct source-entity 'align structure) cam-standoff-read-entity) + ((res-lump-struct source-entity 'align structure) + cam-standoff-read-entity) ((get-curve-data! source-entity camera-path 'campath 'campath-k -1000000000.0) cam-spline) - ((< 0.0 (cam-slave-get-float source-entity 'stringMaxLength 0.0)) *camera-base-mode*) - (else cam-fixed-read-entity))))) + ((< 0.0 (cam-slave-get-float source-entity 'stringMaxLength 0.0)) + *camera-base-mode*) + (else + cam-fixed-read-entity))))) (defun parameter-ease-none ((value object)) "Return value unchanged." @@ -181,8 +197,10 @@ ((>= t 1.0) 1.0) ((>= 0.0 t) 0.0) ((>= 0.25 t) (/ t 2)) - ((>= t 0.75) (- 1.0 (* 0.5 (- 1.0 t)))) - (else (+ 0.125 (* 1.5 (+ -0.25 t)))))) + ((>= t 0.75) + (- 1.0 (* 0.5 (- 1.0 t)))) + (else + (+ 0.125 (* 1.5 (+ -0.25 t)))))) (defun parameter-ease-sqrt-clamp ((t float)) "Clamp t to 0..1 and apply the symmetric square-root @@ -190,8 +208,10 @@ (cond ((>= t 1.0) 1.0) ((>= 0.0 t) 0.0) - ((>= 0.5 t) (* 0.5 (- 1.0 (sqrtf (- 1.0 (* 2.0 t)))))) - (else (* 0.5 (+ 1.0 (sqrtf (+ -1.0 (* 2.0 t)))))))) + ((>= 0.5 t) + (* 0.5 (- 1.0 (sqrtf (- 1.0 (* 2.0 t)))))) + (else + (* 0.5 (+ 1.0 (sqrtf (+ -1.0 (* 2.0 t)))))))) (defun fourth-power ((x float)) "Return x to the fourth power." @@ -207,8 +227,10 @@ (cond ((>= t 1.0) 1.0) ((>= 0.0 t) 0.0) - ((>= 0.5 t) (* 0.5 (square (* 2.0 t)))) - (else (- 1.0 (* 0.5 (square (* 2.0 (- 1.0 t)))))))) + ((>= 0.5 t) + (* 0.5 (square (* 2.0 t)))) + (else + (- 1.0 (* 0.5 (square (* 2.0 (- 1.0 t)))))))) (defun parameter-ease-sin-clamp ((t float)) "Clamp t to 0..1 and apply a half-cosine ease with zero @@ -216,7 +238,8 @@ (cond ((>= t 1.0) 1.0) ((>= 0.0 t) 0.0) - (else (+ 0.5 (* 0.5 (sin (* 182.04445 (+ -90.0 (* 180.0 t))))))))) + (else + (+ 0.5 (* 0.5 (sin (* 182.04445 (+ -90.0 (* 180.0 t))))))))) (defmethod setup-from-entity! ((this cam-index) (prop-name symbol) (source-entity entity) (cam-pos vector) (fallback-curve curve)) "Read the two endpoint vectors from entity data or @@ -314,7 +337,11 @@ (set! (-> this sample-len) 0.0) (set! (-> this used-count) 1) (vector-copy! (-> this old-position) start-pos) - (let ((i 1)) (while (!= i 31) (set! (-> this point i next) (+ i 1)) (+! i 1)) (set! (-> this point i next) -134250495)) + (let ((i 1)) + (while (!= i 31) + (set! (-> this point i next) (+ i 1)) + (+! i 1)) + (set! (-> this point i next) -134250495)) 0 (none)) @@ -350,7 +377,8 @@ (set! (-> this partial-point) (-> sampler partial-pt)) (when (= (-> this next-to-last-point) cur-pt) (set! (-> this summed-len) (-> this point cur-pt tp-length)) - (if (= (-> sampler cur-pt) (-> this end-point)) (set! (-> this partial-point) 0.99999))) + (if (= (-> sampler cur-pt) (-> this end-point)) + (set! (-> this partial-point) 0.99999))) (when (!= (-> sampler cur-pt) cur-pt) (while (and (!= (-> this point cur-pt next) (-> sampler cur-pt)) (!= (-> this point cur-pt next) (-> this next-to-last-point))) (set! (-> this summed-len) (- (-> this summed-len) (-> this point cur-pt tp-length))) @@ -364,7 +392,9 @@ (set! (-> this free-point) (-> this used-point)) (set! (-> this used-point) (-> sampler cur-pt)) (cond - ((= (-> sampler cur-pt) (-> this end-point)) (set! (-> this partial-point) 0.0) (set! (-> this summed-len) 0.0)) + ((= (-> sampler cur-pt) (-> this end-point)) + (set! (-> this partial-point) 0.0) + (set! (-> this summed-len) 0.0)) ((= (-> sampler cur-pt) (-> this next-to-last-point)) (set! (-> this summed-len) (-> this point (-> this next-to-last-point) tp-length)))))) 0 @@ -379,9 +409,9 @@ (set! (-> sampler partial-pt) (-> this partial-point)) (sample-point! this (-> this sample-len) (-> sample-pos position) sampler)) (if (or (= (-> sampler cur-pt) (-> this end-point)) - (= (-> sampler cur-pt) (-> this next-to-last-point)) - (= (-> this point (-> sampler cur-pt) next) (-> this next-to-last-point))) - (set! (-> sampler cur-pt) (-> this used-point))) + (= (-> sampler cur-pt) (-> this next-to-last-point)) + (= (-> this point (-> sampler cur-pt) next) (-> this next-to-last-point))) + (set! (-> sampler cur-pt) (-> this used-point))) (let ((cur-pt (-> this point (-> sampler cur-pt) next))) (when (!= cur-pt -134250495) (let ((next-pt (-> this point cur-pt next)) @@ -396,7 +426,8 @@ (set! best-pt cur-pt))) (set! cur-pt next-pt) (set! next-pt (-> this point cur-pt next))) - (if (< -2.0 best-dot) (delete-point! this best-pt)))))) + (if (< -2.0 best-dot) + (delete-point! this best-pt)))))) 0 (none)) @@ -419,17 +450,17 @@ (= (-> this point next-pt next) (-> this end-point)) (= (-> this point next-pt next) (-> this next-to-last-point)))) (if (< (* (-> this point cur-pt tp-length) - (+ 1.0 - (vector-dot (the-as vector (+ (the-as uint (-> this point 0 direction)) (* 48 cur-pt))) - (the-as vector (+ (the-as uint (the-as vector (-> this point 0 direction))) (* 48 next-pt)))))) - budget) - (delete-point! this cur-pt) - (set! cur-pt next-pt)) + (+ 1.0 + (vector-dot (the-as vector (+ (the-as uint (-> this point 0 direction)) (* 48 cur-pt))) + (the-as vector (+ (the-as uint (the-as vector (-> this point 0 direction))) (* 48 next-pt)))))) + budget) + (delete-point! this cur-pt) + (set! cur-pt next-pt)) (set! next-pt (-> this point cur-pt next))))))) 0 (none)) -(defmethod add-point! ((this tracking-spline) (new-pos vector) (min-dist float) (prune-budget float) (can-prune symbol)) +(defmethod add-point! ((this tracking-spline) (new-pos vector) (min-dist meters) (prune-budget meters) (can-prune symbol)) "Append new-pos when it is at least min-dist from the tail, optionally pruning the trail to obtain a free slot." (let ((free-pt (-> this free-point)) @@ -444,7 +475,8 @@ (prune-most-collinear! this) (set! free-pt (-> this free-point))) (cond - ((= free-pt -134250495) (format 0 "ERROR : pos spline overflow~%")) + ((= free-pt -134250495) + (format 0 "ERROR : pos spline overflow~%")) (else (+! (-> this summed-len) (-> this point tail-pt tp-length)) (set! (-> this free-point) (-> this point free-pt next)) @@ -454,7 +486,8 @@ (set! (-> this point free-pt next) -134250495) (vector-copy! (-> this point free-pt position) new-pos) (+! (-> this used-count) 1) - (if (< 0.0 prune-budget) (prune-shallow-points! this prune-budget))))) + (if (< 0.0 prune-budget) + (prune-shallow-points! this prune-budget))))) 0) (defmethod accumulate-sample! ((this tracking-spline) (arc-len float) (out-pos vector) (sampler tracking-spline-sampler)) @@ -496,9 +529,9 @@ out-pos) (defmethod apply-trail-correction! ((this tracking-spline) (move vector) (stop-pt int)) - "Bias move along the changes in trail direction before - stop-pt. The correction is strongest on short, curved trails and fades as the recorded path - becomes straighter." + "Bias move along the changes in trail direction + before stop-pt. The correction is strongest on short, curved trails and + fades as the recorded path becomes straighter." (let ((trail-dir (new 'stack-no-clear 'vector))) (vector-! trail-dir (-> this point (-> this used-point) position) (-> this point (-> this end-point) position)) (let* ((chord-len (vector-length trail-dir)) @@ -510,7 +543,9 @@ ((< (-> *CAMERA-bank* min-detectable-velocity) (-> this summed-len)) (vector-float*! trail-dir trail-dir (/ 1.0 chord-len)) (/ chord-len (-> this summed-len))) - (else (vector-reset! trail-dir) 0.0))) + (else + (vector-reset! trail-dir) + 0.0))) (straightness-bias (+ -0.2 chord-to-arc)) (straightness-scale (* 2.0 straightness-bias)) (alignment-weight (fmin 1.0 (fmax 0.05 straightness-scale))) @@ -527,16 +562,17 @@ (let ((forward-dot (vector-dot seg-dir trail-dir))) (cond ((>= 0.0 forward-dot)) - (else (set! correction (* correction (fmax 0.0 (- 0.75 (fabs (* alignment-weight forward-dot))))))))) + (else + (set! correction (* correction (fmax 0.0 (- 0.75 (fabs (* alignment-weight forward-dot))))))))) (cond ((< correction 0.0) (if (and *debug-segment* *display-camera-marks*) - (camera-line-rel-len (-> this point next-pt position) - seg-dir - (* -40.96 correction) - (-> (new 'static 'inline-array qword 1 (new 'static 'qword :data (new 'static 'array uint32 4 #xff #xff #x0 #x80))) - 0 - vector4w))) + (camera-line-rel-len (-> this point next-pt position) + seg-dir + (* -40.96 correction) + (-> (new 'static 'inline-array qword 1 (new 'static 'qword :data (new 'static 'array uint32 4 #xff #xff #x0 #x80))) + 0 + vector4w))) (vector--float*! move move seg-dir correction)) ((and *debug-segment* *display-camera-marks*) (camera-line-rel-len (-> this point next-pt position) @@ -549,10 +585,11 @@ 0 (none)) -(defmethod follow-update! ((this tracking-spline) (pos vector) (accel float) (max-speed float)) +(defmethod follow-update! ((this tracking-spline) (pos vector) (accel meters) (max-speed meters)) "Advance the trail follower toward pos using accel and - max-speed. Average 64 evenly spaced samples over the adaptive sample window, apply the - trail-direction correction, and return the smoothed position." + max-speed. Average 64 evenly spaced samples over the adaptive sample + window, apply the trail-direction correction, and return the smoothed + position." (let ((cur-pt (-> this used-point)) (partial (-> this partial-point))) (let ((trail-len (-> this summed-len))) @@ -587,7 +624,7 @@ (vector-copy! (-> this old-position) pos) pos) -(defmethod trim-to-length! ((this tracking-spline) (max-len float)) +(defmethod trim-to-length! ((this tracking-spline) (max-len meters)) "Drop the oldest trail segments until its live length is no greater than max-len." (when (< max-len (-> this summed-len)) @@ -611,7 +648,8 @@ (+! live-count 1) (set! cur-pt (-> this point cur-pt next))) (when (!= live-count (-> this used-count)) - (if *debug-segment* (format 0 "ERROR: tracking spline used count ~D actual ~D~%" (-> this used-count) live-count)) + (if *debug-segment* + (format 0 "ERROR: tracking spline used count ~D actual ~D~%" (-> this used-count) live-count)) (set! (-> this used-count) live-count)) (let ((free-pt (-> this free-point)) (free-count 0)) @@ -620,7 +658,7 @@ (set! free-pt (-> this point free-pt next))) (when (!= free-count (- 32 (-> this used-count))) (if *debug-segment* - (format 0 "ERROR: tracking spline free count ~D actual ~D~%" (- 32 (-> this used-count)) free-count)) + (format 0 "ERROR: tracking spline free count ~D actual ~D~%" (- 32 (-> this used-count)) free-count)) (set! (-> this free-point) -134250495) (dotimes (i 32) (when (not (logtest? live-mask 1)) @@ -639,14 +677,14 @@ (set! (-> self options) (-> *camera* slave-options)) (set! (-> self change-event-from) (the-as (pointer process-drawable) (-> *camera* changer)))) (else - (set! (-> self options) (the-as uint 0)) + (set! (-> self options) (cam-slave-options)) (set! (-> self change-event-from) (the-as (pointer process-drawable) #f)))) (cond (*camera-combiner* (vector-copy! (-> self trans) (-> *camera-combiner* trans)) (matrix-copy! (-> self tracking inv-mat) (-> *camera-combiner* inv-camera-rot)) - (when *camera-init-mat* - (matrix-copy! (-> self tracking inv-mat) *camera-init-mat*)) + (if *camera-init-mat* + (matrix-copy! (-> self tracking inv-mat) *camera-init-mat*)) (set! (-> self fov) (-> *camera-combiner* fov)) (vector-copy! (-> self velocity) (-> *camera-combiner* velocity))) (else @@ -676,7 +714,9 @@ "Reinitialize the camera slave and immediately enter next-state." (with-pp (cam-slave-init-vars) - (let ((enter-fn (the-as (function object) enter-state))) (set! (-> pp next-state) next-state) (enter-fn)) + (let ((enter-fn (the-as (function object) enter-state))) + (set! (-> pp next-state) next-state) + (enter-fn)) 0 (none))) @@ -686,13 +726,15 @@ initial-state current." (stack-size-set! (-> self main-thread) 512) (change-to-last-brother self) - (if (and (nonzero? camera-slave-debug) *debug-segment*) (add-connection *debug-engine* self camera-slave-debug self #f #f)) + (if (and (nonzero? camera-slave-debug) *debug-segment*) + (add-connection *debug-engine* self camera-slave-debug self #f #f)) (cam-slave-init-vars) (let ((voicebox-state 'cam-voicebox) (call-arg (the-as basic (-> initial-state name)))) (cond ((= (the-as symbol call-arg) voicebox-state)) - (camera-entity (set! (-> self cam-entity) camera-entity)) + (camera-entity + (set! (-> self cam-entity) (the-as entity-camera camera-entity))) (else (let ((activation-event (new 'stack-no-clear 'event-message-block))) (set! (-> activation-event from) self) @@ -703,7 +745,8 @@ (set! call-arg *camera*) (send-event-fn (the-as camera-master call-arg) activation-event))))) (let ((state-enter-fn (the-as (function object object) (-> initial-state enter)))) - (if state-enter-fn (state-enter-fn (the-as symbol call-arg)))) + (if state-enter-fn + (state-enter-fn (the-as symbol call-arg)))) (set! (-> self enter-has-run) #t) (set! (-> self event-hook) (-> initial-state event)) (let ((enter-state-fn (the-as (function object object) enter-state))) @@ -725,7 +768,8 @@ (let ((next-state (the-as object (-> message param 0)))) (cam-slave-init-vars) (let ((state-enter-fn (the-as (function object) (-> (the-as state next-state) enter)))) - (if state-enter-fn (state-enter-fn))) + (if state-enter-fn + (state-enter-fn))) (set! (-> self enter-has-run) #t) (set! (-> self event-hook) (-> (the-as state next-state) event)) (when (= event-type 'change-state) @@ -736,12 +780,14 @@ (cond ((-> message param 0) (set! (-> self tracking use-point-of-interest) #t) - (vector-copy! (-> self tracking point-of-interest) (the-as vector (-> message param 0))) + (set! (-> self tracking point-of-interest quad) (-> (the-as vector (-> message param 0)) quad)) (set! (-> self tracking point-of-interest-blend target) 1.0)) - (else (set! (-> self tracking use-point-of-interest) #f) (set! (-> self tracking point-of-interest-blend target) 0.0)))) + (else + (set! (-> self tracking use-point-of-interest) #f) + (set! (-> self tracking point-of-interest-blend target) 0.0)))) (('teleport) (cam-calc-follow! (-> self tracking) (-> self trans) #f) - (slave-set-rotation! (-> self tracking) (-> self trans) (the-as float (-> self options)) (-> self fov) #f)))) + (slave-set-rotation! (-> self tracking) (-> self trans) (-> self options) (-> self fov) #f)))) (defbehavior cam-curve-pos camera-slave ((pos vector) (tangent vector) (path curve) (use-follow-point? symbol)) "Add the active intro and camera-path offsets to pos. When tangent is @@ -750,10 +796,12 @@ (let ((curve-offset (new-stack-vector0))) 0.0 (let ((tangent-sample (new-stack-vector0))) - (if tangent (set! (-> tangent w) 0.0)) + (if tangent + (set! (-> tangent w) 0.0)) (when (< (-> self intro-t) 1.0) (+! (-> self intro-t) (* (-> self intro-t-step) (-> *display* time-adjust-ratio))) - (if (< 1.0 (-> self intro-t)) (set! (-> self intro-t) 1.0)) + (if (< 1.0 (-> self intro-t)) + (set! (-> self intro-t) 1.0)) (curve-get-pos! curve-offset (parameter-ease-sin-clamp (-> self intro-t)) (-> self intro-curve)) (vector+! curve-offset curve-offset (-> self intro-offset)) (vector+! pos pos curve-offset) @@ -773,8 +821,8 @@ ((not (-> self spline-exists))) ((= (-> self spline-follow-dist) 0.0) (let ((spline-t (if use-follow-point? - (point->parameter (-> self index) (-> self tracking follow-pt)) - (point->parameter (-> self index) (-> *camera* tpos-curr-adj))))) + (point->parameter (-> self index) (-> self tracking follow-pt)) + (point->parameter (-> self index) (-> *camera* tpos-curr-adj))))) (curve-get-pos! curve-offset spline-t (-> self spline-curve))) (vector+! curve-offset curve-offset (-> self spline-offset)) (vector+! pos pos curve-offset)) @@ -782,8 +830,8 @@ (let ((reference-pos (new 'stack-no-clear 'vector))) (curve-length (-> self spline-curve)) (if use-follow-point? - (vector-copy! reference-pos (-> self tracking follow-pt)) - (vector-copy! reference-pos (-> *camera* tpos-curr-adj))) + (vector-copy! reference-pos (-> self tracking follow-pt)) + (vector-copy! reference-pos (-> *camera* tpos-curr-adj))) (set! (-> self spline-tt) (curve-closest-point (-> self spline-curve) reference-pos (-> self spline-tt) 1024.0 10 (-> self spline-follow-dist)))) (curve-get-pos! curve-offset (-> self spline-tt) (-> self spline-curve)) @@ -806,9 +854,13 @@ (set! (-> self intro-t) 0.0) (set! (-> self intro-t-step) (cam-slave-get-intro-step (-> self cam-entity))) (set! (-> self outro-exit-value) (cam-slave-get-float (-> self cam-entity) 'intro-exitValue 0.0)) - (if (= (-> self outro-exit-value) 0.0) (set! (-> self outro-exit-value) 0.5))) - (else (set! (-> self intro-t) 1.0) (set! (-> self intro-t-step) 0.0))) - (if (nonzero? (-> *camera* no-intro)) (set! (-> self intro-t) 1.0)) + (if (= (-> self outro-exit-value) 0.0) + (set! (-> self outro-exit-value) 0.5))) + (else + (set! (-> self intro-t) 1.0) + (set! (-> self intro-t-step) 0.0))) + (if (nonzero? (-> *camera* no-intro)) + (set! (-> self intro-t) 1.0)) 0 (none)) @@ -851,10 +903,11 @@ (view-facing-angle (acos (vector-dot target-from-camera-flat target-facing-flat))) (clamped-angle (fmax 1820.4445 view-facing-angle))) (if (< clamped-angle 8192.0) - (vector-float*! desired-offset - desired-offset - (+ lead-scale - (* (/ (- 1.0 lead-scale) (- 1.0 (cos 32768.0))) (+ (- (cos 32768.0)) (cos (* 5.142857 (- 8192.0 clamped-angle))))))))) + (vector-float*! desired-offset + desired-offset + (+ lead-scale + (* (/ (- 1.0 lead-scale) (- 1.0 (cos (degrees 180)))) + (+ (- (cos (degrees 180))) (cos (* 5.142857 (- 8192.0 clamped-angle))))))))) (cond ((< (-> *camera* ease-t) 1.0)) ((< (-> tracker follow-blend) 1.0) @@ -863,7 +916,8 @@ (vector-float*! desired-offset desired-offset blend-factor)) (+! (-> tracker follow-blend) (/ (-> *display* time-adjust-ratio) 60)) (vector+! (-> tracker follow-off) (-> tracker follow-off) desired-offset)) - (else (vector-copy! (-> tracker follow-off) desired-offset)))) + (else + (vector-copy! (-> tracker follow-off) desired-offset)))) (vector+! (-> tracker follow-pt) (-> *camera* tpos-curr-adj) (-> tracker follow-off)) (vector--float*! (-> tracker follow-pt) (-> tracker follow-pt) @@ -874,7 +928,8 @@ (let ((normal-offset (new-stack-vector0))) (set! (-> tracker follow-blend) 0.0) (cond - ((-> tracker no-follow) (vector-reset! normal-offset)) + ((-> tracker no-follow) + (vector-reset! normal-offset)) (else (vector-! normal-offset (-> *camera* tpos-curr-adj) camera-pos) (vector-normalize! normal-offset 1.0) @@ -892,8 +947,8 @@ (distance-weight (fmax 0.0 distance-upper))) (vector-float*! normal-offset (-> *camera* tgt-rot-mat vector 2) (* (lerp 2048.0 8192.0 distance-weight) behind-weight)))))) (if smooth? - (vector-seek-3d-smooth! (-> tracker follow-off) normal-offset (* 20480.0 (seconds-per-frame)) 0.05) - (set! (-> tracker follow-off quad) (-> normal-offset quad)))) + (vector-seek-3d-smooth! (-> tracker follow-off) normal-offset (* 20480.0 (seconds-per-frame)) 0.05) + (vector-copy! (-> tracker follow-off) normal-offset))) (vector+! (-> tracker follow-pt) (-> *camera* tpos-curr-adj) (-> tracker follow-off)) (vector--float*! (-> tracker follow-pt) (-> tracker follow-pt) (-> *camera* local-down) (-> *camera* target-height)))) (-> tracker follow-pt)) @@ -912,7 +967,8 @@ (when (< up-dot 0.99999) (vector-cross! desired-up (-> camera-matrix vector 1) desired-up) (let ((signed-sine (vector-length desired-up))) - (if (< 0.0 (vector-dot desired-up (-> camera-matrix vector 2))) (set! signed-sine (- signed-sine))) + (if (< 0.0 (vector-dot desired-up (-> camera-matrix vector 2))) + (set! signed-sine (- signed-sine))) (matrix-axis-sin-cos! roll-correction (-> camera-matrix vector 2) signed-sine up-dot)) (matrix*! camera-matrix camera-matrix roll-correction))))) camera-matrix) @@ -927,33 +983,43 @@ adjusted quaternion step. The step grows with aim-vector distance; options-bits bit 2 selects full three-dimensional rather than local-down-flattened distance." (let ((distance-work (new-stack-vector0)) - (current-rotation (new-stack-quaternion0))) - (let ((target-rotation (new-stack-quaternion0)) - (delta-rotation (new-stack-quaternion0))) - 0.0 - (let* ((aim-distance (cond - ((logtest? (the-as int options-bits) 4) (vector-length aim-vector)) - (else (vector-flatten! distance-work aim-vector (-> *camera* local-down)) (vector-length distance-work)))) - (distance-weight (* 0.00048828125 (+ -1024.0 aim-distance)))) - (cond - ((< distance-weight 0.0) (set! distance-weight 0.0)) - ((< 1.0 distance-weight) (set! distance-weight 1.0))) - (let ((turn-step (* 364.0889 (-> *display* time-adjust-ratio) distance-weight))) - (matrix->quaternion current-rotation current-matrix) - (matrix->quaternion target-rotation target-matrix) - (quaternion-conjugate! delta-rotation current-rotation) - (quaternion*! delta-rotation delta-rotation target-rotation) - (quaternion-normalize! delta-rotation) - (if (< (-> delta-rotation w) 0.0) (quaternion-negate! delta-rotation delta-rotation)) - (let ((turn-angle (acos (-> delta-rotation w)))) - (if (< (* (/ (-> *display* time-adjust-ratio) 4) turn-angle) turn-step) - (set! turn-step (* (/ (-> *display* time-adjust-ratio) 4) turn-angle))) - (cond - ((< (-> delta-rotation w) 0.9999999) - (quaternion-float*! delta-rotation delta-rotation (/ (sin turn-step) (sin turn-angle))) - (set! (-> delta-rotation w) (cos turn-step))) - (else (quaternion-identity! delta-rotation)))))) - (quaternion*! current-rotation current-rotation delta-rotation)) + (current-rotation (new 'stack-no-clear 'quaternion))) + (vector-zero! (-> current-rotation vec)) + (let ((target-rotation (new 'stack-no-clear 'quaternion))) + (vector-zero! (-> target-rotation vec)) + (let ((delta-rotation (new 'stack-no-clear 'quaternion))) + (vector-zero! (-> delta-rotation vec)) + 0.0 + (let* ((aim-distance (cond + ((logtest? (the-as int options-bits) 4) + (vector-length aim-vector)) + (else + (vector-flatten! distance-work aim-vector (-> *camera* local-down)) + (vector-length distance-work)))) + (distance-weight (* 0.00048828125 (+ -1024.0 aim-distance)))) + (cond + ((< distance-weight 0.0) + (set! distance-weight 0.0)) + ((< 1.0 distance-weight) + (set! distance-weight 1.0))) + (let ((turn-step (* 364.0889 (-> *display* time-adjust-ratio) distance-weight))) + (matrix->quaternion current-rotation current-matrix) + (matrix->quaternion target-rotation target-matrix) + (quaternion-conjugate! delta-rotation current-rotation) + (quaternion*! delta-rotation delta-rotation target-rotation) + (quaternion-normalize! delta-rotation) + (if (< (-> delta-rotation w) 0.0) + (quaternion-negate! delta-rotation delta-rotation)) + (let ((turn-angle (acos (-> delta-rotation w)))) + (if (< (* (/ (-> *display* time-adjust-ratio) 4) turn-angle) turn-step) + (set! turn-step (* (/ (-> *display* time-adjust-ratio) 4) turn-angle))) + (cond + ((< (-> delta-rotation w) 0.9999999) + (quaternion-float*! delta-rotation delta-rotation (/ (sin turn-step) (sin turn-angle))) + (set! (-> delta-rotation w) (cos turn-step))) + (else + (quaternion-identity! delta-rotation)))))) + (quaternion*! current-rotation current-rotation delta-rotation))) (quaternion-normalize! current-rotation) (quaternion->matrix current-matrix current-rotation))) @@ -986,7 +1052,8 @@ (let ((right-axis-base (-> camera-matrix vector)) (horizontal-scale (* 0.8 (tan (/ fov 2))))) (.lvf vf1 (&-> right-axis-base 0 quad)) - (let ((horizontal-scale-bits horizontal-scale)) (.mov vf2 horizontal-scale-bits))) + (let ((horizontal-scale-bits horizontal-scale)) + (.mov vf2 horizontal-scale-bits))) (.add.x.vf.w vf1 vf0 vf0) (.mul.x.vf.xyz vf1 vf1 vf2) (.svf (&-> horizontal-edge quad) vf1)) @@ -995,7 +1062,7 @@ (let ((horizontal-edge-dot (vector-dot frustum-edge (-> camera-matrix vector 0)))) (when (< horizontal-edge-dot (fabs horizontal-target-dot)) (if (< horizontal-target-dot 0.0) - (vector--float*! frustum-edge frustum-edge (-> camera-matrix vector 0) (* 2.0 horizontal-edge-dot))) + (vector--float*! frustum-edge frustum-edge (-> camera-matrix vector 0) (* 2.0 horizontal-edge-dot))) (matrix-from-two-vectors! correction-matrix frustum-edge target-dir) (vector-matrix*! (-> camera-matrix vector 2) (-> camera-matrix vector 2) correction-matrix) (vector-cross! (-> camera-matrix vector 0) (-> camera-matrix vector 1) (-> camera-matrix vector 2))))) @@ -1009,7 +1076,8 @@ (let ((up-axis (-> camera-matrix vector 1)) (vertical-scale (* 0.525 (tan (/ fov 2))))) (.lvf vf1 (&-> up-axis quad)) - (let ((vertical-scale-bits vertical-scale)) (.mov vf2 vertical-scale-bits))) + (let ((vertical-scale-bits vertical-scale)) + (.mov vf2 vertical-scale-bits))) (.add.x.vf.w vf1 vf0 vf0) (.mul.x.vf.xyz vf1 vf1 vf2) (.svf (&-> vertical-edge quad) vf1)) @@ -1035,23 +1103,21 @@ (set! rotate-up? #f)) ((< vertical-dot-limit 0.0) (let ((opposite-head-dot (- (vector-dot frustum-edge target-dir)))) - (if (< opposite-head-dot vertical-dot-limit) (set! vertical-dot-limit opposite-head-dot))))))) + (if (< opposite-head-dot vertical-dot-limit) + (set! vertical-dot-limit opposite-head-dot))))))) (let ((correction-angle (if rotate-up? (- (acos vertical-dot-limit)) (acos vertical-dot-limit)))) (matrix-axis-angle! correction-matrix (-> camera-matrix vector 0) correction-angle)))) (vector-matrix*! (-> camera-matrix vector 2) (-> camera-matrix vector 2) correction-matrix)) (vector-cross! (-> camera-matrix vector 1) (-> camera-matrix vector 2) (-> camera-matrix vector 0)))) -(defun slave-set-rotation! ((tracker cam-rotation-tracker) (camera-pos vector) (options-bits float) (fov float) (smooth? symbol)) +;; ERROR: Unsupported inline assembly instruction kind - [mula.s f0, f3] +;; ERROR: Unsupported inline assembly instruction kind - [madda.s f1, f4] +;; ERROR: Unsupported inline assembly instruction kind - [madd.s f0, f2, f5] +(defun slave-set-rotation! ((tracker cam-rotation-tracker) (camera-pos vector) (options-bits cam-slave-options) (fov float) (smooth? symbol)) "Build tracker's inverse camera rotation from its follow point, optional point of interest and tilt; keep the target in frame, optionally blend toward the new - orientation, and remove roll. options-bits is a raw cam-slave-options word carried in a float." - ;; Start from the follow point and blend toward a point of interest without - ;; changing the aim-vector length. The tilt guard leaves 15 degrees of room - ;; before either vertical pole so the pitch adjustment cannot flip the view. - ;; Underwater framing narrows the effective field of view as far as one - ;; quarter, then the safe-frame correction, optional orientation blend, and - ;; final roll removal produce the inverse camera rotation. - (local-vars (forward-down-dot float) (tilt-matrix matrix)) + orientation, and remove roll." + (local-vars (output-matrix matrix) (forward-down-dot float)) (rlet ((vf0 :class vf) (vf4 :class vf) (vf5 :class vf) @@ -1069,46 +1135,52 @@ (vector-! point-of-interest-vector (-> tracker point-of-interest) camera-pos) (vector-normalize! point-of-interest-vector (* aim-distance (-> tracker point-of-interest-blend value))) (let ((blended-aim-out aim-vector)) - (let ((base-aim aim-vector)) (.mov.vf.w vf6 vf0) (.lvf vf4 (&-> base-aim quad))) + (let ((base-aim aim-vector)) + (.mov.vf.w vf6 vf0) + (.lvf vf4 (&-> base-aim quad))) (.lvf vf5 (&-> point-of-interest-vector quad)) (.add.vf.xyz vf6 vf4 vf5) (.svf (&-> blended-aim-out quad) vf6)) (vector-normalize! aim-vector aim-distance)))) - (else (vector-! aim-vector (-> tracker follow-pt) camera-pos))) + (else + (vector-! aim-vector (-> tracker follow-pt) camera-pos))) (forward-down->inv-matrix target-matrix aim-vector (-> *camera* local-down)) (when (!= tilt-angle 0.0) 0.0 0.0 - (set! tilt-matrix (new 'stack-no-clear 'matrix)) - (let ((aim-direction (new 'stack-no-clear 'vector))) - (vector-normalize-copy! aim-direction aim-vector 1.0) - (let* ((down-axis (-> *camera* local-down))) (set! forward-down-dot (vector-dot aim-direction down-axis)))) - (let* ((down-dot forward-down-dot) - (vertical-angle (acos (fabs down-dot)))) - (cond - ((< 0.0 tilt-angle) - (set! tilt-angle - (if (< 0.0 down-dot) - (fmin tilt-angle (fmax 0.0 (+ -2730.6667 vertical-angle))) - (fmin tilt-angle (fmax 0.0 (- 32768.0 (+ 2730.6667 vertical-angle))))))) - ((< tilt-angle 0.0) - (set! tilt-angle - (if (< 0.0 down-dot) - (fmax tilt-angle (- (fmax 0.0 (- 32768.0 (+ 2730.6667 vertical-angle))))) - (fmax tilt-angle (- (fmax 0.0 (+ -2730.6667 vertical-angle))))))))) - (matrix-rotate-x! tilt-matrix tilt-angle) - (matrix*! target-matrix tilt-matrix target-matrix))) + (let ((tilt-matrix (new 'stack-no-clear 'matrix))) + (let ((aim-direction (new 'stack-no-clear 'vector))) + (vector-normalize-copy! aim-direction aim-vector 1.0) + (let* ((down-axis (-> *camera* local-down))) + (set! forward-down-dot (vector-dot aim-direction down-axis)))) + (let* ((down-dot forward-down-dot) + (vertical-angle (acos (fabs down-dot)))) + (cond + ((< 0.0 tilt-angle) + (set! tilt-angle + (if (< 0.0 down-dot) + (fmin tilt-angle (fmax 0.0 (+ -2730.6667 vertical-angle))) + (fmin tilt-angle (fmax 0.0 (- 32768.0 (+ 2730.6667 vertical-angle))))))) + ((< tilt-angle 0.0) + (set! tilt-angle + (if (< 0.0 down-dot) + (fmax tilt-angle (- (fmax 0.0 (- 32768.0 (+ 2730.6667 vertical-angle))))) + (fmax tilt-angle (- (fmax 0.0 (+ -2730.6667 vertical-angle))))))))) + (matrix-rotate-x! tilt-matrix tilt-angle) + (matrix*! target-matrix tilt-matrix target-matrix)))) (if (and (= (-> *camera* under-water) 2) *target* (!= (-> *target* next-state name) 'target-swim-up)) - (set! (-> tracker underwater-blend target) 1.0) - (set! (-> tracker underwater-blend target) 0.0)) + (set! (-> tracker underwater-blend target) 1.0) + (set! (-> tracker underwater-blend target) 0.0)) (vector-into-frustum-nosmooth! target-matrix camera-pos (lerp-clamp fov (/ fov 4) (-> tracker underwater-blend value))) - (cond - (smooth? (slave-matrix-blend-2 (-> tracker inv-mat) options-bits aim-vector target-matrix)) - (else - (matrix-copy! (-> tracker inv-mat) target-matrix)))) + (set! output-matrix + (cond + (smooth? + (slave-matrix-blend-2 (-> tracker inv-mat) (the-as float options-bits) aim-vector target-matrix) + output-matrix) + (else + (matrix-copy! (-> tracker inv-mat) target-matrix))))) (mat-remove-z-rot (-> tracker inv-mat) (-> *camera* local-down)) - 0 - (none))) + 0)) (defun v-slrp2! ((out vector) (from-vector vector) (to-vector vector) (t float) (plane-normal vector) (max-angle float)) "Spherically interpolate from-vector toward to-vector by t while @@ -1119,56 +1191,51 @@ ;; angular arc without the length collapse of a linear vector blend. With a ;; plane normal, only the in-plane direction rotates; the component on the ;; normal is restored and interpolated independently. - (local-vars - (direction-dot float) - (to-length float) - (from-length float) - (angle-limit float) - (to-direction vector) - (rotation-matrix matrix)) - (set! angle-limit max-angle) - (let ((from-direction (new-stack-vector0))) - (set! to-direction (new 'stack-no-clear 'vector)) - (set! (-> to-direction quad) (the-as uint128 0)) + (local-vars (direction-dot float) (to-length float) (from-length float)) + (let ((angle-limit max-angle) + (from-direction (new-stack-vector0)) + (to-direction (new-stack-vector0))) 1.0 1.0 (let ((rotation-axis (new-stack-vector0))) 0.0 1.0 - (set! rotation-matrix (new 'stack-no-clear 'matrix)) - (set! (-> rotation-matrix vector 0 quad) (the-as uint128 0)) - (set! (-> rotation-matrix vector 1 quad) (the-as uint128 0)) - (set! (-> rotation-matrix vector 2 quad) (the-as uint128 0)) - (set! (-> rotation-matrix vector 3 quad) (the-as uint128 0)) - (cond - ((< 1.0 t) (set! t 1.0)) - ((< t 0.0) (set! t 0.0))) - (cond - (plane-normal - (vector-flatten! from-direction from-vector plane-normal) - (vector-flatten! to-direction to-vector plane-normal) - (set! from-length (vector-normalize-ret-len! from-direction 1.0)) - (set! to-length (vector-normalize-ret-len! to-direction 1.0)) - (vector-normalize! (vector-cross! rotation-axis to-direction from-direction) 1.0) - (let ((axis-side (vector-dot plane-normal rotation-axis))) - (vector-normalize-copy! rotation-axis plane-normal 1.0) - (if (< axis-side 0.0) (vector-negate! rotation-axis rotation-axis)))) - (else - (set! (-> from-direction quad) (-> from-vector quad)) - (vector-copy! to-direction to-vector) - (set! from-length (vector-normalize-ret-len! from-direction 1.0)) - (set! to-length (vector-normalize-ret-len! to-direction 1.0)) - (vector-normalize! (vector-cross! rotation-axis to-vector from-vector) 1.0))) - (let ((acos-fn acos)) - (let* ((from-direction-copy from-direction)) (set! direction-dot (vector-dot from-direction-copy to-direction))) - (let* ((angle (acos-fn direction-dot)) - (step-angle (* t angle))) - (when (< angle-limit step-angle) - (set! step-angle angle-limit) - (set! t (/ angle-limit angle))) - (let ((cos-angle (cos step-angle))) - (matrix-axis-sin-cos! rotation-matrix rotation-axis (sqrtf (- 1.0 (square cos-angle))) cos-angle)))) - (vector-matrix*! out from-direction rotation-matrix) + (let ((rotation-matrix (new 'stack-no-clear 'matrix))) + (set! (-> rotation-matrix vector 0 quad) (the-as uint128 0)) + (set! (-> rotation-matrix vector 1 quad) (the-as uint128 0)) + (set! (-> rotation-matrix vector 2 quad) (the-as uint128 0)) + (set! (-> rotation-matrix vector 3 quad) (the-as uint128 0)) + (cond + ((< 1.0 t) (set! t 1.0)) + ((< t 0.0) (set! t 0.0))) + (cond + (plane-normal + (vector-flatten! from-direction from-vector plane-normal) + (vector-flatten! to-direction to-vector plane-normal) + (set! from-length (vector-normalize-ret-len! from-direction 1.0)) + (set! to-length (vector-normalize-ret-len! to-direction 1.0)) + (vector-normalize! (vector-cross! rotation-axis to-direction from-direction) 1.0) + (let ((axis-side (vector-dot plane-normal rotation-axis))) + (vector-normalize-copy! rotation-axis plane-normal 1.0) + (if (< axis-side 0.0) + (vector-negate! rotation-axis rotation-axis)))) + (else + (vector-copy! from-direction from-vector) + (set! (-> to-direction quad) (-> to-vector quad)) + (set! from-length (vector-normalize-ret-len! from-direction 1.0)) + (set! to-length (vector-normalize-ret-len! to-direction 1.0)) + (vector-normalize! (vector-cross! rotation-axis to-vector from-vector) 1.0))) + (let ((acos-fn acos)) + (let* ((from-direction-copy from-direction)) + (set! direction-dot (vector-dot from-direction-copy to-direction))) + (let* ((angle (acos-fn direction-dot)) + (step-angle (* t angle))) + (when (< angle-limit step-angle) + (set! step-angle angle-limit) + (set! t (/ angle-limit angle))) + (let ((cos-angle (cos step-angle))) + (matrix-axis-sin-cos! rotation-matrix rotation-axis (sqrtf (- 1.0 (square cos-angle))) cos-angle)))) + (vector-matrix*! out from-direction rotation-matrix)) (vector-normalize! out (lerp from-length to-length t)) (when plane-normal (vector+float*! out out rotation-axis (vector-dot from-vector rotation-axis)) @@ -1182,11 +1249,10 @@ "Spherically interpolate from-vector toward to-vector by no more than max-angle, using the required angular fraction and interpolating length separately. An optional plane-normal constrains the rotation plane." - (local-vars (direction-dot float) (to-length float) (from-length float) (angle-limit float) (to-direction vector)) - (set! angle-limit max-angle) - (let ((from-direction (new-stack-vector0))) - (set! to-direction (new 'stack-no-clear 'vector)) - (set! (-> to-direction quad) (the-as uint128 0)) + (local-vars (direction-dot float) (to-length float) (from-length float)) + (let ((angle-limit max-angle) + (from-direction (new-stack-vector0)) + (to-direction (new-stack-vector0))) 0.0 0.0 (let ((rotation-axis (new-stack-vector0)) @@ -1202,15 +1268,17 @@ (vector-normalize! (vector-cross! rotation-axis to-direction from-direction) 1.0) (let ((axis-side (vector-dot plane-normal rotation-axis))) (vector-normalize-copy! rotation-axis plane-normal 1.0) - (if (< axis-side 0.0) (vector-negate! rotation-axis rotation-axis)))) + (if (< axis-side 0.0) + (vector-negate! rotation-axis rotation-axis)))) (else - (set! (-> from-direction quad) (-> from-vector quad)) - (vector-copy! to-direction to-vector) + (vector-copy! from-direction from-vector) + (set! (-> to-direction quad) (-> to-vector quad)) (set! from-length (vector-normalize-ret-len! from-direction 1.0)) (set! to-length (vector-normalize-ret-len! to-direction 1.0)) (vector-normalize! (vector-cross! rotation-axis to-vector from-vector) 1.0))) (let ((acos-fn acos)) - (let* ((from-direction-copy from-direction)) (set! direction-dot (vector-dot from-direction-copy to-direction))) + (let* ((from-direction-copy from-direction)) + (set! direction-dot (vector-dot from-direction-copy to-direction))) (let ((angle (acos-fn direction-dot))) (when (< angle-limit angle) (set! fraction (/ angle-limit angle))