diff --git a/goal_src/jak1/engine/anim/aligner-h.gc b/goal_src/jak1/engine/anim/aligner-h.gc index 130adb067d..c485ab188d 100644 --- a/goal_src/jak1/engine/anim/aligner-h.gc +++ b/goal_src/jak1/engine/anim/aligner-h.gc @@ -43,15 +43,16 @@ (new (symbol type process-drawable) _type_) (compute-alignment! (_type_) transformq) (align! (_type_ align-opts float float float) trsqv) - (align-vel-and-quat-only! (_type_ align-opts vector int float float) trsqv) - (first-transform (_type_) transform) - (snd-transform (_type_) transform))) + (align-with-external-travel! (_type_ align-opts vector int float float) trsqv) + (current-transform (_type_) transform) + (prev-transform (_type_) transform))) + (defmethod new align-control ((allocation symbol) (type-to-make type) (proc process-drawable)) - "Create a new align-control." + "Construct a new `align-control` for the given process." (let ((this (object-new allocation type-to-make (the-as int (-> type-to-make size))))) (when (zero? this) (go process-drawable-art-error "memory") - (return (the align-control 0))) + (return (the-as align-control 0))) (set! (-> this process) proc) this)) diff --git a/goal_src/jak1/engine/anim/aligner.gc b/goal_src/jak1/engine/anim/aligner.gc index 1935efdb89..f8af038e67 100644 --- a/goal_src/jak1/engine/anim/aligner.gc +++ b/goal_src/jak1/engine/anim/aligner.gc @@ -9,34 +9,40 @@ ;; ERROR: Unsupported inline assembly instruction kind - [lw ra, return-from-thread(s7)] ;; ERROR: Unsupported inline assembly instruction kind - [jr ra] (defmethod compute-alignment! ((this align-control)) - (local-vars (a0-9 symbol) (s7-0 none) (ra-0 int)) + "Compare the previous and current animation data to compute the change in the animated `align` matrix. + This change in the `align` matrix corresponds to a shift that should be applied to a `process-drawable`'s + `root` transform - animating the `align` matrix allows artists to move the actual process in the world. + This function only computes and stores the `delta` and deals with edge cases when switching animations, + it does not modify the `process-drawable`'s position." + (local-vars (frame-grp art-joint-anim) (frame-grp art-joint-anim) (disable? symbol) (s7-0 none) (ra-0 int)) (with-pp - (let ((s5-0 (-> this process skel active-channels))) - (dotimes (s4-0 s5-0) - (let* ((a0-3 (-> this process skel channel s4-0)) - (v1-5 (-> a0-3 frame-group)) - (a0-4 (-> a0-3 command)) - (a1-0 'stack) - (a2-0 (= a0-4 a1-0))) - (cond - ((or a2-0 (begin (set! a1-0 'stack1) (= a0-4 a1-0)))) - (else - (when (!= (-> v1-5 type) art-joint-anim) - ;; og:preserve-this - (go process-drawable-art-error "align joint-anim") - (abandon-thread) - 0)))))) - (let* ((a0-8 (-> this process skel root-channel 0)) - (v1-16 (-> a0-8 frame-group)) - (f0-0 (-> a0-8 frame-num))) - (= (-> a0-8 num-func) num-func-loop!) - (cond - ((or (not v1-16) (!= (-> this frame-group) v1-16)) (set! a0-9 #t)) - ((= (-> a0-8 num-func) num-func-loop!) (set! a0-9 (< (* (-> a0-8 param 0) (- f0-0 (-> this frame-num))) 0.0))) - (else (set! a0-9 (= f0-0 0.0)))) - (if a0-9 (logior! (-> this flags) (align-flags disabled)) (logclear! (-> this flags) (align-flags disabled))) - (set! (-> this frame-group) v1-16) - (set! (-> this frame-num) f0-0)) + (let ((chan-count (-> this process skel active-channels))) + (dotimes (chan-idx chan-count) + (let ((chan (-> this process skel channel chan-idx))) + (set! frame-grp (-> chan frame-group)) + (let* ((cmd (-> chan command)) + (stack-cmd 'stack) + (is-stack? (= cmd stack-cmd))) + (cond + ((or is-stack? (begin (set! stack-cmd 'stack1) (= cmd stack-cmd)))) + (else + (when (!= (-> frame-grp type) art-joint-anim) + ;; og:preserve-this + (go process-drawable-art-error "align joint-anim") + (abandon-thread) + 0))))))) + (let ((root-chan (-> this process skel root-channel 0))) + (set! frame-grp (-> root-chan frame-group)) + (let ((frame-num (-> root-chan frame-num))) + (= (-> root-chan num-func) num-func-loop!) + (cond + ((or (not frame-grp) (!= (-> this frame-group) frame-grp)) (set! disable? #t)) + ((= (-> root-chan num-func) num-func-loop!) + (set! disable? (< (* (-> root-chan param 0) (- frame-num (-> this frame-num))) 0.0))) + (else (set! disable? (= frame-num 0.0)))) + (if disable? (logior! (-> this flags) (align-flags disabled)) (logclear! (-> this flags) (align-flags disabled))) + (set! (-> this frame-group) frame-grp) + (set! (-> this frame-num) frame-num))) (mem-copy! (the-as pointer (-> this transform 1)) (the-as pointer (-> this transform)) 48) (quaternion-copy! (the-as quaternion (-> this transform 1 rot)) (-> this align quat)) (set! (-> this transform 1 scale quad) (-> this align scale quad)) @@ -62,60 +68,72 @@ (set! (-> v1-23 0 vector 1 quad) a1-14) (set! (-> v1-23 0 vector 2 quad) a2-6) (set! (-> v1-23 0 vector 3 quad) a3-3)) - (vector*! (the-as vector (-> this transform)) (-> s5-1 bone transform vector 3) (-> this process root scale))) - (vector-! (the-as vector (-> this delta)) (the-as vector (-> this transform)) (the-as vector (-> this transform 1))) + (vector*! (-> this transform 0 trans) (-> s5-1 bone transform vector 3) (-> this process root scale))) + (vector-! (-> this delta trans) (-> this transform 0 trans) (-> this transform 1 trans)) (set-vector! (-> this align scale) (vector-length (the-as vector (-> this matrix))) (vector-length (-> this matrix 0 vector 1)) (vector-length (-> this matrix 0 vector 2)) 1.0) (vector-! (-> this delta scale) (-> this align scale) (-> this transform 1 scale)) - (let ((a2-8 (matrix-inv-scale! (new 'stack-no-clear 'matrix) (-> this align scale)))) - (quaternion-normalize! (matrix->quaternion (-> this align quat) (matrix*! a2-8 (the-as matrix (-> this matrix)) a2-8)))) - (let ((a1-24 (quaternion-inverse! (new 'stack-no-clear 'quaternion) (the-as quaternion (-> this transform 1 rot))))) - (quaternion-normalize! (quaternion*! (-> this delta quat) a1-24 (-> this align quat)))) + (let ((scale-mat (matrix-inv-scale! (new 'stack-no-clear 'matrix) (-> this align scale)))) + (quaternion-normalize! (matrix->quaternion (-> this align quat) (matrix*! scale-mat (-> this matrix 0) scale-mat)))) + (let ((inv-t1-rot (quaternion-inverse! (new 'stack-no-clear 'quaternion) (the-as quaternion (-> this transform 1 rot))))) + (quaternion-normalize! (quaternion*! (-> this delta quat) inv-t1-rot (-> this align quat)))) (-> this delta))) -(defmethod first-transform ((this align-control)) +(defmethod current-transform ((this align-control)) + "Get the most recent `align` matrix as a transform." (the-as transform (-> this transform))) -(defmethod snd-transform ((this align-control)) +(defmethod prev-transform ((this align-control)) + "Get the previous `align` matrix as a transform." (-> this transform 1)) -(defmethod align! ((this align-control) (arg0 align-opts) (arg1 float) (arg2 float) (arg3 float)) +(defmethod align! ((this align-control) (opts align-opts) (x-vel-scale float) (y-vel-scale float) (z-vel-scale float)) + "Adjust the `root` of the given `proces-drawable` based on the animation of the `align` matrix. + The scale factors are multipliers for velocity and typically `1`." (when (not (logtest? (-> this flags) (align-flags disabled))) - (let* ((a0-1 (-> this process)) - (t9-0 (method-of-object a0-1 apply-alignment)) - (v1-4 (-> this delta)) - (t1-0 (new 'stack-no-clear 'vector))) - (set! (-> t1-0 x) arg1) - (set! (-> t1-0 y) arg2) - (set! (-> t1-0 z) arg3) - (set! (-> t1-0 w) 1.0) - (t9-0 a0-1 arg0 v1-4 t1-0))) + (let* ((proc (-> this process)) + (t9-0 (method-of-object proc apply-alignment)) + (delta (-> this delta)) + (offset (new 'stack-no-clear 'vector))) + (set! (-> offset x) x-vel-scale) + (set! (-> offset y) y-vel-scale) + (set! (-> offset z) z-vel-scale) + (set! (-> offset w) 1.0) + (t9-0 proc opts delta offset))) (-> this process root)) -(defmethod set-and-limit-velocity ((this trsqv) (arg0 int) (arg1 vector) (arg2 float)) - (let ((gp-0 (-> this transv))) - (when (logtest? arg0 4) - (set! (-> gp-0 x) (-> arg1 x)) - (set! (-> gp-0 z) (-> arg1 z)) - (let ((f0-4 (fmin (* (vector-xz-length arg1) (-> *display* frames-per-second)) arg2))) (vector-xz-normalize! gp-0 f0-4)))) +(defmethod set-and-limit-velocity ((this trsqv) (opts int) (vel vector) (limit float)) + "Set the `transv` to the given velocity, limited to a magnitude of `limit`." + (let ((transv (-> this transv))) + (when (logtest? opts 4) + (set! (-> transv x) (-> vel x)) + (set! (-> transv z) (-> vel z)) + (let ((new-vel (fmin (* (vector-xz-length vel) (-> *display* frames-per-second)) limit))) + (vector-xz-normalize! transv new-vel)))) this) -(defmethod align-vel-and-quat-only! ((this align-control) (arg0 align-opts) (arg1 vector) (arg2 int) (arg3 float) (arg4 float)) +(defmethod align-with-external-travel! ((this align-control) (opts align-opts) (xz-travel vector) (arg2 int) (y-vel-scale float) (xz-vel-scale float)) + "This method is intended to take an animation of walking or travel and re-align it to point in a different + direction, for example, to steer a creature along a path. The vertical movement is taken directly from + the animation's `align` matrix, but the horizontal xz movement is set from the `xz-travel` vector, a per- + frame position increment. The speed is limited to the speed of the original animation. The velocity scale + factors apply to the original animation (either y velocity, or the xz limit derived from the animation)" (when (not (logtest? (-> this flags) (align-flags disabled))) - (let ((s5-0 (-> this delta))) - (let ((s3-0 (-> this process root transv))) - (if (logtest? arg0 (align-opts adjust-y-vel)) - (set! (-> s3-0 y) (* (-> s5-0 trans y) arg3 (-> *display* frames-per-second)))) - (when (logtest? arg0 (align-opts adjust-xz-vel)) - (set! (-> s3-0 x) (-> arg1 x)) - (set! (-> s3-0 z) (-> arg1 z)) - (let ((f0-8 (* (fmin (vector-xz-length arg1) (* (vector-xz-length (-> s5-0 trans)) arg4)) (-> *display* frames-per-second))) + (let ((delta (-> this delta))) + (let ((transv (-> this process root transv))) + (if (logtest? opts (align-opts adjust-y-vel)) + (set! (-> transv y) (* (-> delta trans y) y-vel-scale (-> *display* frames-per-second)))) + (when (logtest? opts (align-opts adjust-xz-vel)) + (set! (-> transv x) (-> xz-travel x)) + (set! (-> transv z) (-> xz-travel z)) + (let ((limited-speed (* (fmin (vector-xz-length xz-travel) (* (vector-xz-length (-> delta trans)) xz-vel-scale)) + (-> *display* frames-per-second))) (t9-2 vector-xz-normalize!)) - (set! (-> this last-speed) f0-8) - (t9-2 s3-0 f0-8)))) - (if (logtest? arg0 (align-opts adjust-quat)) - (quaternion-normalize! (quaternion*! (-> this process root quat) (-> this process root quat) (-> s5-0 quat)))))) + (set! (-> this last-speed) limited-speed) + (t9-2 transv limited-speed)))) + (if (logtest? opts (align-opts adjust-quat)) + (quaternion-normalize! (quaternion*! (-> this process root quat) (-> this process root quat) (-> delta quat)))))) (-> this process root)) diff --git a/goal_src/jak1/engine/entity/actor-link-h.gc b/goal_src/jak1/engine/entity/actor-link-h.gc index 8ea79ffc3a..da7d9a3920 100644 --- a/goal_src/jak1/engine/entity/actor-link-h.gc +++ b/goal_src/jak1/engine/entity/actor-link-h.gc @@ -6,49 +6,31 @@ (require "engine/entity/entity-h.gc") (require "engine/game/game-h.gc") -;; The exact details of actor-link-h are not yet understood, but this system caches lookups for entities/process. -;; Some entities may reference other entities. This is done with an element in a res-lump/entity that contains -;; named lists (possibly of size 1) of other entities. These lists may store entities by a name, or by an -;; actor id (AID). - -;; This process is slow: it involves going from a process, to its entity, to doing a lookup, deciding if you have an AID/string, -;; then looking up the other actor by name, or AID. Lookup by name is extremely slow, as it involves checking each actor's name -;; per every actor in every level. Lookup by aid isn't bad, but is still a binary search through all actors. - -;; The next-actor and prev-actor res build a linked list of actors. +;; Actors can participate in a linked list of actors. +;; Each actor stores the `next-actor` and `prev-actor` as either AID or string name in their lump. +;; Once an actor is spawned, it can create an actor-link-info on its process heap +;; to cache the lookup of its next and previous actors. The reason for this cache +;; is somewhat mysterious, it seems like the lookup should be fast enough. ;; DECOMP BEGINS -;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; Initial Lookup Functions -;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; these functions find actors before we've built the links. - (defun entity-actor-lookup ((lump res-lump) (name symbol) (idx int)) - "Given an entity (the res-lump), look up a reference to another entity and return that entity." - (let* ((sv-16 (new 'static 'res-tag)) - (v1-1 (res-lump-data lump name (pointer uint32) :tag-ptr (& sv-16)))) + "Get an `entity-actor` from a lump by name and index, return #f if invalid. + The lump can contain either an actor name or aid." + (let* ((tag (new 'static 'res-tag)) + (data (res-lump-data lump name (pointer uint32) :tag-ptr (& tag)))) (the-as entity-actor - ;; check in range, and lookup succesful - (when (and v1-1 (< idx (the-as int (-> sv-16 elt-count)))) - ;; pick between string and aid lookup. - (if (= (-> sv-16 elt-type) string) - (entity-by-name (-> (the-as (pointer string) v1-1) idx)) - (entity-by-aid (-> (the-as (pointer uint32) v1-1) idx))))))) + (when (and data (< idx (the-as int (-> tag elt-count)))) + (if (= (-> tag elt-type) string) + (entity-by-name (the-as string (-> (the-as (pointer uint32) (&+ data (* idx 4))) 0))) + (entity-by-aid (-> (the-as (pointer uint32) (&+ data (* idx 4))) 0))))))) +;; WARN: Check prologue - tricky store of r0 (defun entity-actor-count ((res res-lump) (name symbol)) - "Get the number of entities that this res references under the name. - This works on more than just next/prev." + "Get the number of actors stored in `lump[name]`" (let ((tag (new 'static 'res-tag))) (if (res-lump-data res name pointer :tag-ptr (& tag)) (the-as int (-> tag elt-count)) 0))) -;; entity-actors are part of a linked list of entities. -;; these prevent you from looking up next-actor, prev-actor again and again to iterate. -;; The actor-link-info for an entity is stored in that res-lump's "extra" -;; of course, this only works for cases where each entity has at most 1 process. - -;; These are allocated on the process heap of the entity's process. - (deftype actor-link-info (basic) ((process process) (next entity-actor) @@ -56,7 +38,7 @@ (:methods (new (symbol type process) _type_) (get-matching-actor-type-mask (_type_ type) int) - (actor-count-before (_type_) int) + (actor-index (_type_) int) (link-to-next-and-prev-actor (_type_) entity-actor) (get-next (_type_) entity-actor) (get-prev (_type_) entity-actor) @@ -73,198 +55,205 @@ (send-to-prev (_type_ symbol) none) (actor-count (_type_) int))) -;;;;;;;;;;;;;;;; -;; Link Setup -;;;;;;;;;;;;;;;; (defmethod next-actor ((this entity-actor)) - "Utility function to look up the next actor in the list, assuming we don't have actor-link-info yet." - (declare (inline)) - ;; look up reference to next-actor - this is slow. + "Get the next actor from an entity-actor that is in a linked list of actors." (entity-actor-lookup this 'next-actor 0)) (defmethod prev-actor ((this entity-actor)) - "Look up previous actor in the list" - (declare (inline)) + "Get the previous actor from an entity-actor that is in a linked list" (entity-actor-lookup this 'prev-actor 0)) (defmethod new actor-link-info ((allocation symbol) (type-to-make type) (proc process)) - "Set up an actor-link-info for the given process. The entity of this process should be the entity-actor - that will get this actor-link-info" + "Create an `actor-link-info` which caches the `next` and `prev` lookups, + allowing fast iteration through an actor list." (let ((this (object-new allocation type-to-make (the-as int (-> type-to-make size))))) (set! (-> this process) proc) - ;; set next and prev - (set! (-> this next) (next-actor (-> proc entity))) - (set! (-> this prev) (prev-actor (-> proc entity))) + (let ((ent (-> proc entity))) + (set! (-> this next) (entity-actor-lookup ent 'next-actor 0)) + (set! ent (-> proc entity)) + (set! (-> this prev) (entity-actor-lookup ent 'prev-actor 0))) this)) -;;;;;;;;;;;;;;;;;;;; -;; Access -;;;;;;;;;;;;;;;;;;;; - -;; These methods can now be used to get next/prev more efficiently, without having to do a res lookup. (defmethod get-next ((this actor-link-info)) + "Return the next actor in the list, or #f." (-> this next)) (defmethod get-prev ((this actor-link-info)) + "Return the previous actor in the list, or #f" (-> this prev)) (defmethod get-next-process ((this actor-link-info)) - "Get the process for the next, if it exists." - ;; we can't easily get to the actor-link-info of the next, so we have to grab it from entity-links. - (the-as process (and (-> this next) (-> this next extra process)))) + "Get the process of the next entity. If there is no next entity, or that entity is not spawned, return #f." + (the-as process (and (-> this next) (-> (the-as entity-links (-> this next extra)) process)))) (defmethod get-prev-process ((this actor-link-info)) - "Get the process for the prev, if it exists" - (the-as process (and (-> this prev) (-> this prev extra process)))) + "Get the process of the previous entity. If there is no previous entity, or that entity is not spawned, return #f." + (the-as process (and (-> this prev) (-> (the-as entity-links (-> this prev extra)) process)))) (defmethod link-to-next-and-prev-actor ((this actor-link-info)) - "Redo the linking in the constructor by looking up the next/prev actor." - (set! (-> this next) (next-actor (-> this process entity))) - (set! (-> this prev) (prev-actor (-> this process entity))) + "Look up the previous and next actors in the list and cache them in this `actor-link-info`." + (let ((a0-1 (-> this process entity))) (set! (-> this next) (entity-actor-lookup a0-1 'next-actor 0))) + (let ((a0-2 (-> this process entity))) (set! (-> this prev) (entity-actor-lookup a0-2 'prev-actor 0))) (-> this next)) -(defmethod apply-function-forward ((this actor-link-info) (arg0 (function entity-actor object object)) (arg1 object)) - "Iterate forward through actors, and apply this function. Starts at (-> this next) - If the function returns truthy, stop iterating." - (let ((s3-0 (-> this next))) (while s3-0 (if (arg0 s3-0 arg1) (return (the-as int #f))) (set! s3-0 (next-actor s3-0)))) +(defmethod apply-function-forward ((this actor-link-info) (func (function entity-actor object object)) (param1 object)) + "Apply `func` to each actor in the list after this one, stopping when the function returns a truthy value." + (let ((ent (-> this next))) + (while ent + (if (func ent param1) (return (the-as int #f))) + (set! ent (entity-actor-lookup ent 'next-actor 0)))) 0) -(defmethod apply-function-reverse ((this actor-link-info) (arg0 (function entity-actor object object)) (arg1 object)) - "Iterate backward through actors and apply function. - If the function returns truth, stop iterating." - (let ((s3-0 (-> this prev))) (while s3-0 (if (arg0 s3-0 arg1) (return (the-as int #f))) (set! s3-0 (prev-actor s3-0)))) +(defmethod apply-function-reverse ((this actor-link-info) (func (function entity-actor object object)) (param1 object)) + "Apply `func` to each entity-actor in the list before this one, stopping when the function returns a truthy value." + (let ((ent (-> this prev))) + (while ent + (if (func ent param1) (return (the-as int #f))) + (set! ent (entity-actor-lookup ent 'prev-actor 0)))) 0) -(defmethod apply-all ((this actor-link-info) (arg0 (function entity-actor object object)) (arg1 object)) - "Apply to all entities. Starts at the back and hits everyone, including this object." - ;; start at us (next may give us #f here, so can't do that.) - (let ((s4-0 (-> this process entity))) - ;; while there is a prev... - (while (prev-actor s4-0) - ;; set prev (this is stupid, they do the slow lookup twice!) - (set! s4-0 (prev-actor s4-0))) - ;; now iterate forward. - (while s4-0 - (if (arg0 s4-0 arg1) (return (the-as int #f))) - (set! s4-0 (next-actor s4-0)))) +(defmethod apply-all ((this actor-link-info) (func (function entity-actor object object)) (param1 object)) + "Apply `func` to all actors in the list, starting at the beginning of the list. + `this` doesn't have to be the first actor in the list. Stops when `func` returns a non-truthy value." + (local-vars (ent entity-actor) (ent entity-actor)) + (let ((it (-> this process entity))) + (while (begin + (set! ent it) + (entity-actor-lookup ent 'prev-actor 0)) + (set! it (entity-actor-lookup it 'prev-actor 0))) + (while it + (if (func it param1) (return (the-as int #f))) + (set! ent it) + (set! it (entity-actor-lookup ent 'next-actor 0)))) 0) (defmethod send-to-all-after ((this actor-link-info) (message symbol)) - "Send an event to all processes after this link with no parameters." - (let ((iter (-> this next)) - (result (the object #f))) - (while iter - (let ((proc (-> iter extra process))) - (when proc - (set! result (or (send-event proc message) result))) - (set! iter (next-actor iter)))) - result)) + "`send-event!` with a 0 parameter message to all actors after the given actor." + (with-pp + (let ((iter (-> this next)) + (result (the-as object #f))) + (while iter + (let ((proc (-> iter extra process))) + (when proc + (let ((msg-block (new 'stack-no-clear 'event-message-block))) + (set! (-> msg-block from) pp) + (set! (-> msg-block num-params) 0) + (set! (-> msg-block message) message) + (set! result (or (send-event-function proc msg-block) result))))) + (set! iter (entity-actor-lookup iter 'next-actor 0))) + result))) (defmethod send-to-all-before ((this actor-link-info) (message symbol)) - "Send an event to all processes before this link with no parameters." - (let ((iter (-> this prev)) - (result (the object #f))) - (while iter - (let ((proc (-> iter extra process))) - (when proc - (set! result (or (send-event proc message) result))) - (set! iter (prev-actor iter)))) - result)) + "`send-event!` with a 0 parameter message to all actors before the given actor." + (with-pp + (let ((it (-> this prev)) + (result (the-as object #f))) + (while it + (let ((proc (-> it extra process))) + (when proc + (let ((msg-block (new 'stack-no-clear 'event-message-block))) + (set! (-> msg-block from) pp) + (set! (-> msg-block num-params) 0) + (set! (-> msg-block message) message) + (set! result (or (send-event-function proc msg-block) result))))) + (set! it (entity-actor-lookup it 'prev-actor 0))) + result))) -(defmethod send-to-next ((this actor-link-info) (message symbol)) - "Send event arg0 to the next actor's process" - (let ((a0-1 (-> this next))) - ;; do we have a next? - (when a0-1 - ;; get the actual process - (let ((a0-2 (-> a0-1 extra process))) - ;; do we have a process? - (when a0-2 - (send-event a0-2 message))))) +(defmethod send-to-next ((this actor-link-info) (msg symbol)) + "Send a 0-parameter message to the next actor if it is alive." + (let ((next (-> this next))) + (when next + (let ((proc (-> (the-as entity-links (-> next extra)) process))) (if proc (send-event proc msg))))) + 0 (none)) (defmethod send-to-prev ((this actor-link-info) (message symbol)) - "Send event arg1 to the next actor's process." - (let ((a0-1 (-> this prev))) (when a0-1 (let ((a0-2 (-> a0-1 extra process))) (when a0-2 (send-event a0-2 message))))) + "Send a 0-parameter message to the actor before this actor." + (let ((act (-> this prev))) + (when act + (let ((proc (-> (the-as entity-links (-> act extra)) process))) (if proc (send-event proc message))))) + 0 (none)) (defmethod send-to-next-and-prev ((this actor-link-info) (msg symbol)) - "Send an event to both next and prev with no params." + "Send a 0-parameter message to the next and previous actor." (send-to-next this msg) (send-to-prev this msg) (none)) (defmethod send-to-all ((this actor-link-info) (msg symbol)) + "Send a 0-parameter message to all actors in the list, + even if the provided actor-link-info isn't from the first actor" (send-to-all-after this msg) (send-to-all-before this msg) (none)) (defmethod actor-count ((this actor-link-info)) - "Count the number of actors in the entire list" + "Count the total number of actors in an actor list given any actor in the list." + (local-vars (act entity-actor) (act entity-actor)) (let ((actor (-> this process entity)) (count 0)) - ;; get back to the beginning. - (while (prev-actor actor) - (set! actor (prev-actor actor))) - ;; iterate and set the count + (while (begin + (set! act actor) + (entity-actor-lookup act 'prev-actor 0)) + (set! actor (entity-actor-lookup actor 'prev-actor 0))) (while actor (+! count 1) - (set! actor (next-actor actor))) + (set! act actor) + (set! actor (entity-actor-lookup act 'next-actor 0))) count)) (defmethod get-matching-actor-type-mask ((this actor-link-info) (matching-type type)) - "Iterate through _all_ actors that are part of this actor list. - If the nth actor is type matching-type, then set the nth bit of the result." - (let ((actor (the-as entity-actor (-> this process entity))) + "Given any actor in a list of actors, return a bitmask of all actors in the list where bit-i is set to 1 if + entity-actor i is exactly type `matching-type`. In other words, test bit `i` of the mask to see if actor + `i` is of the given type." + (let ((actor (-> this process entity)) (mask 0)) (let ((current-bit 1)) - ;; seek to beginning - (while (prev-actor actor) - (set! actor (prev-actor actor))) - ;; loop over actors + (while (let ((a0-2 actor)) (entity-actor-lookup a0-2 'prev-actor 0)) + (set! actor (entity-actor-lookup actor 'prev-actor 0))) (while actor - ;; if we match, set the bit (if (= (-> actor etype) matching-type) (set! mask (logior mask current-bit))) - ;; next - (set! actor (next-actor actor)) - ;; next bit - (set! current-bit (ash current-bit 1)))) + (let ((a0-3 actor)) (set! actor (entity-actor-lookup a0-3 'next-actor 0))) + (set! current-bit (* current-bit 2)))) mask)) -(defmethod actor-count-before ((this actor-link-info)) - "Get the number of actors _before_ this actor in the list." +(defmethod actor-index ((this actor-link-info)) + "Return the index of this actor" (let* ((this-actor (-> this process entity)) (actor this-actor) (count 0)) - ;; go to beginning (why not count here???) - (while (prev-actor actor) - (set! actor (prev-actor actor))) - ;; go forward, until we hit this actor + (while (let ((a0-2 actor)) (entity-actor-lookup a0-2 'prev-actor 0)) + (set! actor (entity-actor-lookup actor 'prev-actor 0))) (while (!= actor this-actor) (+! count 1) - (set! actor (next-actor actor))) + (let ((a0-3 actor)) (set! actor (entity-actor-lookup a0-3 'next-actor 0)))) count)) -(defun actor-link-subtask-complete-hook ((arg0 entity-actor) (arg1 (pointer symbol))) - "Sets arg1 if the thing is complete. Does not continue the apply if the complete perm is set." +(defun actor-link-subtask-complete-hook ((act entity-actor) (ret (pointer symbol))) + "Callback for checking to see if all actors in an actor list are complete. + This can be used as a callback for `apply-all` or similar. + It sets `ret` to `#t` if all actors are complete, otherwise it sets `ret` to `#f` and short circuits." (cond - ((logtest? (-> arg0 extra perm status) (entity-perm-status complete)) (set! (-> arg1 0) #t) #f) - (else (set! (-> arg1 0) #f) #t))) + ((logtest? (-> (the-as entity-links (-> act extra)) perm status) (entity-perm-status complete)) (set! (-> ret 0) #t) #f) + (else (set! (-> ret 0) #f) #t))) -(defun actor-link-dead-hook ((arg0 entity-actor) (arg1 (pointer symbol))) - "Sets arg1 is the thing is dead. Does not continue the apply if the dead perm is set." +(defun actor-link-dead-hook ((act entity-actor) (ret (pointer symbol))) + "Callback for checking to see if all actors in an actor list are dead. + This can be used as a callback for `apply-all` or similar. + It sets `ret` to `#t` if all actors are dead, otherwise it sets `ret` to `#f` and short circuits." (cond - ((logtest? (-> arg0 extra perm status) (entity-perm-status dead)) (set! (-> arg1 0) #t) #f) - (else (set! (-> arg1 0) #f) #t))) + ((logtest? (-> (the-as entity-links (-> act extra)) perm status) (entity-perm-status dead)) (set! (-> ret 0) #t) #f) + (else (set! (-> ret 0) #f) #t))) -(defun alt-actor-list-subtask-incomplete-count ((arg0 process-drawable)) - "Get the number of alt-actors which do not have the complete bit set in their perm." - (let ((alt-actor-count (entity-actor-count (the-as res-lump (-> arg0 entity)) 'alt-actor)) +(defun alt-actor-list-subtask-incomplete-count ((proc process-drawable)) + "Get the number of actors in this `alt-actor` list on this process which do not have the `complete` bit set + in their permanent status." + (let ((alt-actor-count (entity-actor-count (-> proc entity) 'alt-actor)) (incomplete-count 0)) - ;; iterate over all alt actors (dotimes (alt-actor-idx alt-actor-count) - ;; look up the alt actor - (let ((a0-3 (entity-actor-lookup (the-as res-lump (-> arg0 entity)) 'alt-actor alt-actor-idx))) - (if (or (not a0-3) (zero? (logand (-> a0-3 extra perm status) (entity-perm-status complete)))) (+! incomplete-count 1)))) + (let ((ent (entity-actor-lookup (-> proc entity) 'alt-actor alt-actor-idx))) + (if (or (not ent) (not (logtest? (-> (the-as entity-links (-> ent extra)) perm status) (entity-perm-status complete)))) + (+! incomplete-count 1)))) incomplete-count)) diff --git a/goal_src/jak1/engine/entity/ambient.gc b/goal_src/jak1/engine/entity/ambient.gc index 717fadd939..8a87c517bd 100644 --- a/goal_src/jak1/engine/entity/ambient.gc +++ b/goal_src/jak1/engine/entity/ambient.gc @@ -15,7 +15,7 @@ (set! (-> usage length) (max 50 (-> usage length))) (set! (-> usage data 49 name) "ambient") (+! (-> usage data 49 count) 1) - (let ((v1-6 (asize-of this))) (+! (-> usage data 49 used) v1-6) (+! (-> usage data 49 total) (logand -16 (+ v1-6 15)))) + (let ((size (asize-of this))) (+! (-> usage data 49 used) size) (+! (-> usage data 49 total) (logand -16 (+ size 15)))) (mem-usage (-> this ambient) usage (logior flags 128)) (the-as drawable-ambient 0)) @@ -23,174 +23,182 @@ (set! (-> usage length) (max 1 (-> usage length))) (set! (-> usage data 0 name) (symbol->string 'drawable-group)) (+! (-> usage data 0 count) 1) - (let ((v1-7 32)) (+! (-> usage data 0 used) v1-7) (+! (-> usage data 0 total) (logand -16 (+ v1-7 15)))) - (dotimes (s3-0 (-> this length)) - (mem-usage (-> this data s3-0) usage flags)) + (let ((size 32)) (+! (-> usage data 0 used) size) (+! (-> usage data 0 total) (logand -16 (+ size 15)))) + (dotimes (i (-> this length)) + (mem-usage (-> this data i) usage flags)) (the-as drawable-inline-array-ambient 0)) (define *hint-semaphore* (the-as (pointer level-hint) #f)) -(defun level-hint-process-cmd ((arg0 (pointer int32)) (arg1 int) (arg2 int)) - (let ((v1-2 (-> arg0 arg1)) - (gp-0 (+ arg1 1))) +(defun level-hint-process-cmd ((cmd-array (pointer int32)) (cmd-pos int) (array-len int)) + "Iterate through the `cmd-array`, executing commands and return the position of the next command to run, + or `-1` if the command is a condition that is not met." + (let ((cmd-id (-> cmd-array cmd-pos)) + (task-pos (+ cmd-pos 1))) (cond - ((< gp-0 arg2) - (let ((a0-2 (-> arg0 gp-0)) - (a1-2 v1-2)) + ((< task-pos array-len) + (let ((task (-> cmd-array task-pos)) + (cid cmd-id)) (cond - ((zero? a1-2) (if (task-known? (the-as game-task a0-2)) (set! gp-0 -1))) - ((= a1-2 1) (if (not (task-known? (the-as game-task a0-2))) (set! gp-0 -1))) - ((= a1-2 2) (if (nonzero? (get-task-status (the-as game-task a0-2))) (set! gp-0 -1))) - ((= a1-2 3) (if (!= (get-task-status (the-as game-task a0-2)) (task-status need-introduction)) (set! gp-0 -1))) - ((= a1-2 4) (if (!= (get-task-status (the-as game-task a0-2)) (task-status need-reminder)) (set! gp-0 -1))) - ((= a1-2 5) (if (!= (get-task-status (the-as game-task a0-2)) (task-status need-reminder-a)) (set! gp-0 -1))) - ((= a1-2 13) - (let ((v1-15 (get-task-status (the-as game-task a0-2)))) - (if (or (< (the-as int v1-15) 2) (< 4 (the-as int v1-15))) (set! gp-0 -1)))) - ((= a1-2 6) (if (!= (get-task-status (the-as game-task a0-2)) (task-status need-reward-speech)) (set! gp-0 -1))) - ((= a1-2 7) (close-specific-task! (the-as game-task a0-2) (task-status need-hint))) - ((= a1-2 8) (close-specific-task! (the-as game-task a0-2) (task-status need-introduction))) - ((= a1-2 9) (close-specific-task! (the-as game-task a0-2) (task-status need-reminder))) - ((= a1-2 10) (close-specific-task! (the-as game-task a0-2) (task-status need-reminder-a))) - ((= a1-2 11) (close-specific-task! (the-as game-task a0-2) (task-status need-reward-speech))) - ((= a1-2 12) (close-specific-task! (the-as game-task a0-2) (task-status need-resolution))) - (else (format #t "Unknown hint command ~D~%" v1-2))))) + ((zero? cid) (if (task-known? (the-as game-task task)) (set! task-pos -1))) + ((= cid 1) (if (not (task-known? (the-as game-task task))) (set! task-pos -1))) + ((= cid 2) (if (nonzero? (get-task-status (the-as game-task task))) (set! task-pos -1))) + ((= cid 3) (if (!= (get-task-status (the-as game-task task)) (task-status need-introduction)) (set! task-pos -1))) + ((= cid 4) (if (!= (get-task-status (the-as game-task task)) (task-status need-reminder)) (set! task-pos -1))) + ((= cid 5) (if (!= (get-task-status (the-as game-task task)) (task-status need-reminder-a)) (set! task-pos -1))) + ((= cid 13) + (let ((status (get-task-status (the-as game-task task)))) + (if (or (< (the-as int status) 2) (< 4 (the-as int status))) (set! task-pos -1)))) + ((= cid 6) (if (!= (get-task-status (the-as game-task task)) (task-status need-reward-speech)) (set! task-pos -1))) + ((= cid 7) (close-specific-task! (the-as game-task task) (task-status need-hint))) + ((= cid 8) (close-specific-task! (the-as game-task task) (task-status need-introduction))) + ((= cid 9) (close-specific-task! (the-as game-task task) (task-status need-reminder))) + ((= cid 10) (close-specific-task! (the-as game-task task) (task-status need-reminder-a))) + ((= cid 11) (close-specific-task! (the-as game-task task) (task-status need-reward-speech))) + ((= cid 12) (close-specific-task! (the-as game-task task) (task-status need-resolution))) + (else (format #t "Unknown hint command ~D~%" cmd-id))))) (else (format #t "Missing task ID for hint command ~S~%" (cond - ((= v1-2 13) "if-at-most-need-reminder-a") - ((= v1-2 12) "close-need-resolution") - ((= v1-2 11) "close-need-reward-speech") - ((= v1-2 10) "close-need-reminder-a") - ((= v1-2 9) "close-need-reminder") - ((= v1-2 8) "close-need-introduction") - ((= v1-2 7) "close-need-hint") - ((= v1-2 6) "if-need-reward-speech") - ((= v1-2 5) "if-need-reminder-a") - ((= v1-2 4) "if-need-reminder") - ((= v1-2 3) "if-need-introduction") - ((= v1-2 2) "if-resolved") - ((= v1-2 1) "if-known") - ((zero? v1-2) "if-unknown") + ((= cmd-id 13) "if-at-most-need-reminder-a") + ((= cmd-id 12) "close-need-resolution") + ((= cmd-id 11) "close-need-reward-speech") + ((= cmd-id 10) "close-need-reminder-a") + ((= cmd-id 9) "close-need-reminder") + ((= cmd-id 8) "close-need-introduction") + ((= cmd-id 7) "close-need-hint") + ((= cmd-id 6) "if-need-reward-speech") + ((= cmd-id 5) "if-need-reminder-a") + ((= cmd-id 4) "if-need-reminder") + ((= cmd-id 3) "if-need-introduction") + ((= cmd-id 2) "if-resolved") + ((= cmd-id 1) "if-known") + ((zero? cmd-id) "if-unknown") (else "*unknown*"))))) - gp-0)) + task-pos)) -(defun level-hint-task-process ((arg0 entity) (arg1 uint128) (arg2 string)) - (let ((gp-0 (res-lump-value arg0 'text-id int :default arg1)) - (s5-0 0)) +(defun level-hint-task-process ((ent entity) (default-text-id uint128) (unused-str string)) + "If this entity's hint can be played, run its command array. This can mutate game state and check conditions. + If all conditions pass, return the text-id. Otherwise, return -1." + (let ((id (res-lump-value ent 'text-id int :default default-text-id)) + (cmd-pos 0)) (cond - ((can-hint-be-played? (the-as text-id gp-0) arg0 arg2) - (let* ((sv-16 (new 'static 'res-tag)) - (s4-1 ((method-of-type res-lump get-property-data) - arg0 - 'cmds - 'exact - -1000000000.0 - (the-as pointer #f) - (& sv-16) - *res-static-buf*))) - (when s4-1 - (while (and (>= s5-0 0) (< s5-0 (the-as int (-> sv-16 elt-count)))) - (set! s5-0 (level-hint-process-cmd (the-as (pointer int32) s4-1) s5-0 (the-as int (-> sv-16 elt-count)))) - (if (>= s5-0 0) (set! s5-0 (+ s5-0 1)))))) + ((can-hint-be-played? (the-as text-id id) ent unused-str) + (let* ((tag (new 'static 'res-tag)) + (cmd-array ((method-of-type res-lump get-property-data) ent 'cmds 'exact -1000000000.0 (the-as pointer #f) (& tag) *res-static-buf*))) + (when cmd-array + (while (and (>= cmd-pos 0) (< cmd-pos (the-as int (-> tag elt-count)))) + (set! cmd-pos (level-hint-process-cmd (the-as (pointer int32) cmd-array) cmd-pos (the-as int (-> tag elt-count)))) + (if (>= cmd-pos 0) (set! cmd-pos (+ cmd-pos 1)))))) 0) - (else (set! s5-0 -1))) + (else (set! cmd-pos -1))) (cond - ((>= s5-0 0) (empty) gp-0) + ((>= cmd-pos 0) (empty) id) (else -1)))) (defun level-hint-surpress! () + "Suppress hints from playing by setting the last play time to now." (set-time! (-> *game-info* hint-play-time)) 0 (none)) -(defun can-grab-display? ((arg0 process)) - (let ((v1-2 (handle->process (-> *game-info* display-text-handle)))) - (when (and (or (not v1-2) (= v1-2 arg0) (time-elapsed? (-> *game-info* display-text-time) (seconds 0.1))) +(defun can-grab-display? ((proc process)) + "Can this process draw its hint text or similar to the screen? + Once it returns #t, it will become the exclusive process to draw to the screen for 0.1 seconds." + (let ((current-grabbed-proc (handle->process (-> *game-info* display-text-handle)))) + (when (and (or (not current-grabbed-proc) + (= current-grabbed-proc proc) + (time-elapsed? (-> *game-info* display-text-time) (seconds 0.1))) (and *target* (!= (-> *target* next-state name) 'target-look-around) (not (logtest? (-> *target* state-flags) (state-flags being-attacked dying))) (= *master-mode* 'game))) - (set! (-> *game-info* display-text-handle) (process->handle arg0)) + (set! (-> *game-info* display-text-handle) (process->handle proc)) (set-time! (-> *game-info* display-text-time)) #t))) (defun level-hint-displayed? () - (let ((a0-0 (ppointer->process *hint-semaphore*))) + "Is there a currently displayed level hint that shouldn't be interrupted?" + (let ((hint-proc (ppointer->process *hint-semaphore*))) (the-as symbol - (and (the-as level-hint a0-0) - (and (= (-> (the-as level-hint a0-0) next-state name) 'level-hint-normal) - (not (appeared-for-long-enough? (the-as level-hint a0-0)))))))) + (and (the-as level-hint hint-proc) + (and (= (-> (the-as level-hint hint-proc) next-state name) 'level-hint-normal) + (not (appeared-for-long-enough? (the-as level-hint hint-proc)))))))) -(defun level-hint-spawn ((arg0 text-id) (arg1 string) (arg2 entity) (arg3 process-tree) (arg4 game-task)) - (if (< (the-as uint 1) (the-as uint arg4)) (close-specific-task! arg4 (task-status need-hint))) - (let ((s3-1 (level-hint-task-process arg2 (the-as uint128 arg0) arg1))) - (when (!= s3-1 -1) +(defun level-hint-spawn ((default-id text-id) (sound string) (ent entity) (parent process-tree) (task game-task)) + "Try to spawn a level hint if it is appropriate to do so." + (if (< (the-as uint 1) (the-as uint task)) (close-specific-task! task (task-status need-hint))) + (let ((id (level-hint-task-process ent (the-as uint128 default-id) sound))) + (when (!= id -1) (kill-current-level-hint '() '() 'exit) - (process-spawn level-hint s3-1 arg1 arg2 :to arg3))) + (process-spawn level-hint id sound ent :to parent))) 0 (none)) -(defun ambient-hint-spawn ((arg0 string) (arg1 vector) (arg2 process-tree) (arg3 symbol)) - (case arg3 +(defun ambient-hint-spawn ((sound string) (pos vector) (parent process-tree) (mode symbol)) + "Spawn an ambient hint if it is appropriate to do so." + (case mode (('camera) (kill-current-level-hint '() '() 'exit))) - (and (not *hint-semaphore*) (process-spawn level-hint :init ambient-hint-init-by-other arg0 arg1 arg3 :to arg2))) + (and (not *hint-semaphore*) (process-spawn level-hint :init ambient-hint-init-by-other sound pos mode :to parent))) -(defun kill-current-level-hint ((arg0 pair) (arg1 pair) (arg2 symbol)) +(defun kill-current-level-hint ((allowed-modes pair) (forbidden-modes pair) (kill-event symbol)) + "Send `kill-event` to the current hint if it is one of the `allowed-modes` and not one of the `forbidden-modes`. + Putting `'()` for mode will disable that filter." (when *hint-semaphore* - (let ((s4-0 (ppointer->process *hint-semaphore*))) - (if (and (or (null? arg0) (member (-> (the-as level-hint s4-0) mode) arg0)) - (not (member (-> (the-as level-hint s4-0) mode) arg1))) - (send-event (the-as level-hint s4-0) arg2)))) + (let ((proc (ppointer->process *hint-semaphore*))) + (if (and (or (null? allowed-modes) (member (-> (the-as level-hint proc) mode) allowed-modes)) + (not (member (-> (the-as level-hint proc) mode) forbidden-modes))) + (send-event (the-as level-hint proc) kill-event)))) 0 (none)) ;; og:preserve-this (#when PC_PORT (define *level-hint-spool-name* (the string #f))) - -(defbehavior level-hint-init-by-other level-hint ((arg0 text-id) (arg1 string) (arg2 entity)) - (mark-text-as-seen *game-info* arg0) - (set! (-> self text-id-to-display) arg0) - (set! (-> self sound-to-play) arg1) +(defbehavior level-hint-init-by-other level-hint ((text text-id) (default-sound string) (ent entity)) + "Initialize a level hint, looking up the sound and mode." + (mark-text-as-seen *game-info* text) + (set! (-> self text-id-to-display) text) + (set! (-> self sound-to-play) default-sound) (set! (-> self total-time) 0) (set! (-> self total-off-time) 0) (set-time! (-> self last-time)) (set! *hint-semaphore* (the-as (pointer level-hint) (process->ppointer self))) (add-setting! 'hint (process->ppointer self) 0.0 0) (set! (-> self voicebox) (the-as handle #f)) - (let ((s5-1 (res-lump-struct arg2 'play-mode structure)) - (a0-6 (the-as string - ((method-of-type res-lump get-property-struct) - arg2 - 'sound-name - 'interp - -1000000000.0 - (-> self sound-to-play) - (the-as (pointer res-tag) #f) - *res-static-buf*)))) - (if (and (not s5-1) a0-6) - (set! s5-1 - (if (or (and (= (-> a0-6 data 0) 115) (= (-> a0-6 data 1) 97)) (and (= (-> a0-6 data 0) 97) (= (-> a0-6 data 1) 115))) + (let ((play-mode (res-lump-struct ent 'play-mode structure)) + (sound (the-as string + ((method-of-type res-lump get-property-struct) + ent + 'sound-name + 'interp + -1000000000.0 + (-> self sound-to-play) + (the-as (pointer res-tag) #f) + *res-static-buf*)))) + (if (and (not play-mode) sound) + (set! play-mode + (if (or (and (= (-> sound data 0) 115) (= (-> sound data 1) 97)) (and (= (-> sound data 0) 97) (= (-> sound data 1) 115))) 'voicebox 'sidekick))) - (set! (-> self mode) (the-as symbol s5-1)) - (if (or (= s5-1 'sidekick) (= s5-1 'voicebox)) (go level-hint-sidekick a0-6))) + (set! (-> self mode) (the-as symbol play-mode)) + (if (or (= play-mode 'sidekick) (= play-mode 'voicebox)) (go level-hint-sidekick sound))) (go level-hint-normal) 0 (none)) -(defbehavior ambient-hint-init-by-other level-hint ((arg0 string) (arg1 vector) (arg2 symbol)) - (set! (-> self sound-to-play) arg0) +(defbehavior ambient-hint-init-by-other level-hint ((sound string) (pos vector) (mode symbol)) + "Initialize a `level-hint` to play a hint from an ambient." + (set! (-> self sound-to-play) sound) (set! (-> self total-time) 0) (set! (-> self total-off-time) 0) (set-time! (-> self last-time)) - (set! (-> self trans) arg1) + (set! (-> self trans) pos) (set! *hint-semaphore* (the-as (pointer level-hint) (process->ppointer self))) (add-setting! 'hint (process->ppointer self) 0.0 0) - (set! (-> self mode) arg2) - (if (or (= arg2 'camera) (= arg2 'ambient) (= arg2 'stinger)) (add-setting! 'ambient (process->ppointer self) 0.0 0)) + (set! (-> self mode) mode) + (if (or (= mode 'camera) (= mode 'ambient) (= mode 'stinger)) (add-setting! 'ambient (process->ppointer self) 0.0 0)) (apply-settings *setting-control*) (set! (-> self event-hook) (lambda :behavior level-hint ((arg0 process) (arg1 int) (arg2 symbol) (arg3 event-message-block)) @@ -198,17 +206,18 @@ (('die 'exit) (if (= (ppointer->process *hint-semaphore*) self) (set! *hint-semaphore* (the-as (pointer level-hint) #f))) (deactivate self))))) - (go level-hint-ambient-sound arg0) + (go level-hint-ambient-sound sound) 0 (none)) (defmethod print-text ((this level-hint)) + "Display hint text on screen." (when (!= *common-text* #f) - (let ((s5-0 (new 'stack 'font-context *font-default-matrix* 56 160 0.0 (font-color default) (font-flags shadow kerning)))) - (set-width! s5-0 400) - (set-height! s5-0 96) - (set! (-> s5-0 flags) (font-flags shadow kerning middle large)) - (print-game-text (lookup-text! *common-text* (-> this text-id-to-display) #f) s5-0 #f 128 22))) + (let ((fc (new 'stack 'font-context *font-default-matrix* 56 160 0.0 (font-color default) (font-flags shadow kerning)))) + (set-width! fc 400) + (set-height! fc 96) + (set! (-> fc flags) (font-flags shadow kerning middle large)) + (print-game-text (lookup-text! *common-text* (-> this text-id-to-display) #f) fc #f 128 22))) 0 (none)) @@ -305,6 +314,8 @@ (when (not (and (or (< v1-36 0) (time-elapsed? s3-1 (seconds 3)) (time-elapsed? s4-4 (seconds 60))) *sound-player-enable*)) (suspend) (goto cfg-27))))) + ;;(while (= (current-str-id) s5-2) + ;; (suspend))) (else (go level-hint-error "NO SOUND " arg0)))))) (go level-hint-exit))) @@ -357,6 +368,8 @@ *sound-player-enable*)) (suspend) (goto cfg-19))))) + ;;(while (= (current-str-id) (-> self sound-id)) + ;; (suspend))) (else (go level-hint-error "NO SOUND " arg0))) (go level-hint-exit))) @@ -381,245 +394,263 @@ (behavior () (if (= (ppointer->process *hint-semaphore*) self) (set! *hint-semaphore* (the-as (pointer level-hint) #f))))) -(defun ambient-type-error ((arg0 drawable-ambient) (arg1 vector)) +(defun ambient-type-error ((proc drawable-ambient) (unused-pos vector)) + "Draw 3D debug text for a broken ambient." (when *display-entity-errors* - (let ((s2-0 (-> arg0 ambient))) + (let ((amb (-> proc ambient))) (format (clear *temp-string*) "~2j~s art error for ~s ~s" - (res-lump-struct s2-0 'effect-name structure :time 0.0) - (res-lump-struct s2-0 'type structure) - (res-lump-struct s2-0 'name structure))) + (res-lump-struct amb 'effect-name structure :time 0.0) + (res-lump-struct amb 'type structure) + (res-lump-struct amb 'name structure))) *temp-string* - (add-debug-text-3d #t (bucket-id debug-no-zbuf) *temp-string* (-> arg0 bsphere) (font-color red) (the-as vector2h #f))) + (add-debug-text-3d #t (bucket-id debug-no-zbuf) *temp-string* (-> proc bsphere) (font-color red) (the-as vector2h #f))) 0 (none)) -(defun ambient-type-poi ((arg0 drawable-ambient) (arg1 vector)) +(defun ambient-type-poi ((proc drawable-ambient) (pos vector)) + "Unused \"point of interest\" ambient, which at some point would display text when approaching named location." 0 (none)) -(defun ambient-type-hint ((arg0 drawable-ambient) (arg1 vector)) +(defun ambient-type-hint ((proc drawable-ambient) (unused-pos vector)) + "Spawn an ambient hint." (with-pp - (let ((s5-0 (level-hint-task-process (-> arg0 ambient) (the-as uint128 0) (the-as string #f)))) + (let ((text (level-hint-task-process (-> proc ambient) (the-as uint128 0) (the-as string #f)))) (cond - ((zero? s5-0) + ((zero? text) (when (and *debug-segment* (not (paused?)) (not (str-is-playing?)) (bottom-hud-hidden?)) - (let ((a1-3 (new 'stack 'font-context *font-default-matrix* 56 160 0.0 (font-color default) (font-flags shadow kerning)))) - (set-width! a1-3 400) - (set-height! a1-3 96) - (set! (-> a1-3 flags) (font-flags shadow kerning middle large)) - (print-game-text "AS: UNKNOWN ID" a1-3 #f 128 22)))) - ((!= s5-0 -1) (kill-current-level-hint '() '() 'exit) (process-spawn level-hint s5-0 #f (-> arg0 ambient) :to pp)))) + (let ((fc (new 'stack 'font-context *font-default-matrix* 56 160 0.0 (font-color default) (font-flags shadow kerning)))) + (set-width! fc 400) + (set-height! fc 96) + (set! (-> fc flags) (font-flags shadow kerning middle large)) + (print-game-text "AS: UNKNOWN ID" fc #f 128 22)))) + ((!= text -1) (kill-current-level-hint '() '() 'exit) (process-spawn level-hint text #f (-> proc ambient) :to pp)))) 0 (none))) -(defun ambient-type-sound ((arg0 drawable-ambient) (arg1 vector)) - (let* ((s5-0 (-> arg0 ambient)) - (s4-0 (-> s5-0 ambient-data user-uint64 0))) - (when (>= (current-time) (the-as time-frame s4-0)) - (let ((v1-5 (res-lump-data s5-0 'cycle-speed pointer))) - (set! (-> s5-0 ambient-data user-uint64 0) +(defun ambient-type-sound ((proc drawable-ambient) (unused-pos vector)) + "Start an ambient sound if it is appropriate to do so." + (let* ((amb (-> proc ambient)) + (start-time (-> amb ambient-data user-uint64 0))) + (when (>= (current-time) (the-as time-frame start-time)) + (let ((cycle-speed-array (res-lump-data amb 'cycle-speed pointer))) + (set! (-> amb ambient-data user-uint64 0) (the-as uint (+ (current-time) - (the int (* 300.0 (-> (the-as (pointer float) v1-5) 0))) - (rand-vu-int-count (the int (* 300.0 (-> (the-as (pointer float) v1-5) 1)))))))) - (when (< (the-as uint (- (current-time) (the-as int s4-0))) (the-as uint 300)) - (let* ((f30-0 (the float (rand-vu-int-count (the-as int (-> s5-0 ambient-data user-float 2))))) - (sv-16 (symbol->string (res-lump-struct s5-0 'effect-name symbol :time f30-0))) - (s4-2 (new 'stack 'sound-spec))) - (set! (-> s4-2 sound-name) (string->sound-name sv-16)) - (logior! (-> s4-2 mask) (sound-mask volume)) - (set! (-> s4-2 volume) 1024) - (logior! (-> s4-2 mask) (sound-mask bend)) - (set! (-> s4-2 bend) (the int (* 327.66998 (rand-vu-float-range -100.0 100.0)))) - (let* ((sv-112 (new 'static 'res-tag)) - (a1-7 ((method-of-type res-lump get-property-data) - s5-0 - 'effect-param - 'exact - f30-0 - (the-as pointer #f) - (& sv-112) - *res-static-buf*))) - (if a1-7 (effect-param->sound-spec s4-2 (the-as (pointer float) a1-7) (the-as int (-> sv-112 elt-count))))) + (the int (* 300.0 (-> (the-as (pointer float) cycle-speed-array) 0))) + (rand-vu-int-count (the int (* 300.0 (-> (the-as (pointer float) cycle-speed-array) 1)))))))) + (when (< (the-as uint (- (current-time) (the-as int start-time))) (the-as uint 300)) + (let* ((interp-time (the float (rand-vu-int-count (the-as int (-> amb ambient-data user-float 2))))) + (name (symbol->string (res-lump-struct amb 'effect-name symbol :time interp-time))) + (ss (new 'stack 'sound-spec))) + (set! (-> ss sound-name) (string->sound-name name)) + (logior! (-> ss mask) (sound-mask volume)) + (set! (-> ss volume) 1024) + (logior! (-> ss mask) (sound-mask bend)) + (set! (-> ss bend) (the int (* 327.66998 (rand-vu-float-range -100.0 100.0)))) + (let* ((tag (new 'static 'res-tag)) + (eparam-data ((method-of-type res-lump get-property-data) + amb + 'effect-param + 'exact + interp-time + (the-as pointer #f) + (& tag) + *res-static-buf*))) + (if eparam-data (effect-param->sound-spec ss (the-as (pointer float) eparam-data) (the-as int (-> tag elt-count))))) (when *debug-effect-control* - (format #t "(~5D) effect sound ~A ~S " (current-time) (res-lump-struct s5-0 'name structure) sv-16) + (format #t "(~5D) effect sound ~A ~S " (current-time) (res-lump-struct amb 'name structure) name) (format #t "volume: ~f pitch-mod: ~f~%" - (* 0.09765625 (the float (-> s4-2 volume))) - (* 0.000656168 (the float (-> s4-2 pitch-mod))))) - (sound-play-by-spec s4-2 (new-sound-id) (-> arg0 bsphere)))))) + (* 0.09765625 (the float (-> ss volume))) + (* 0.000656168 (the float (-> ss pitch-mod))))) + (sound-play-by-spec ss (new-sound-id) (-> proc bsphere)))))) 0 (none)) -(defun ambient-type-sound-loop ((arg0 drawable-ambient) (arg1 vector)) - (let* ((s5-0 (-> arg0 ambient)) - (s2-0 (symbol->string (the-as symbol (-> s5-0 ambient-data user-float 2)))) - (s3-0 (the-as object (-> s5-0 ambient-data user-float 1))) - (s4-0 (new 'stack 'sound-spec))) - (set! (-> s4-0 sound-name) (string->sound-name s2-0)) - (logior! (-> s4-0 mask) (sound-mask volume)) - (set! (-> s4-0 volume) 1024) +(defun ambient-type-sound-loop ((proc drawable-ambient) (unused-pos vector)) + "Play an ambient looping sound." + (let* ((amb (-> proc ambient)) + (name (symbol->string (the-as symbol (-> amb ambient-data user-float 2)))) + (s3-0 (the-as object (-> amb ambient-data user-float 1))) + (ss (new 'stack 'sound-spec))) + (set! (-> ss sound-name) (string->sound-name name)) + (logior! (-> ss mask) (sound-mask volume)) + (set! (-> ss volume) 1024) (when (the-as (pointer res-tag) s3-0) (let ((t9-2 effect-param->sound-spec) - (a0-5 s4-0) - (v1-8 (-> arg0 ambient)) + (a0-5 ss) + (v1-8 (-> proc ambient)) (a1-2 (-> (the-as (pointer res-tag) s3-0) 0))) (t9-2 a0-5 (the-as (pointer float) (&+ (-> v1-8 data-base) (-> a1-2 data-offset))) (the-as int (-> (the-as (pointer res-tag) s3-0) 0 elt-count))))) - (sound-play-by-spec s4-0 (the-as sound-id (-> s5-0 ambient-data user-float 0)) (-> arg0 bsphere))) + (sound-play-by-spec ss (the-as sound-id (-> amb ambient-data user-float 0)) (-> proc bsphere))) 0 (none)) -(defun ambient-type-light ((arg0 drawable-ambient) (arg1 vector)) +(defun ambient-type-light ((proc drawable-ambient) (pos vector)) + "useless \"light\" ambient. Checks if `pos` is within the volume, but has no effect." (when *target* - (let ((s4-0 (-> arg0 ambient)) - (s5-0 #t)) - (let ((s3-0 (-> ((method-of-type res-lump lookup-tag-idx) s4-0 'vol 'exact 0.0) lo))) - (when (>= (the-as int s3-0) 0) - (let ((s2-0 (the-as int s3-0)) - (s1-0 (-> s4-0 tag s3-0))) + (let ((amb (-> proc ambient)) + (in-vol? #t)) + (let ((first-vol-idx (-> ((method-of-type res-lump lookup-tag-idx) amb 'vol 'exact 0.0) lo))) + (when (>= (the-as int first-vol-idx) 0) + (let ((vol-idx (the-as int first-vol-idx)) + (vol (-> amb tag first-vol-idx))) 0 - (while (= (-> s1-0 name) (-> s4-0 tag s3-0 name)) - (let ((v1-8 (the-as object (make-property-data s4-0 0.0 (the-as res-tag-pair s2-0) (the-as pointer #f))))) - (set! s5-0 #t) - (countdown (a0-6 (-> s1-0 elt-count)) - (when (< (-> arg1 w) - (- (vector-dot arg1 (-> (the-as (inline-array vector) v1-8) a0-6)) (-> (the-as (inline-array vector) v1-8) a0-6 w))) - (set! s5-0 #f) + (while (= (-> vol name) (-> amb tag first-vol-idx name)) + (let ((elts (the-as object (make-property-data amb 0.0 (the-as res-tag-pair vol-idx) (the-as pointer #f))))) + (set! in-vol? #t) + (countdown (a0-6 (-> vol elt-count)) + (when (< (-> pos w) + (- (vector-dot pos (-> (the-as (inline-array vector) elts) a0-6)) (-> (the-as (inline-array vector) elts) a0-6 w))) + (set! in-vol? #f) (goto cfg-9)))) (label cfg-9) - (if s5-0 (goto cfg-15)) - (+! s2-0 1) - (set! s1-0 (-> s4-0 tag s2-0)))))) + (if in-vol? (goto cfg-15)) + (+! vol-idx 1) + (set! vol (-> amb tag vol-idx)))))) (label cfg-15) - (when s5-0))) + (when in-vol?))) 0 (none)) -(defun ambient-type-dark ((arg0 drawable-ambient) (arg1 vector)) +(defun ambient-type-dark ((proc drawable-ambient) (pos vector)) + "Run a \"dark\" ambient, which sets `*target*`'s `secondary-interp` to 1.0 when inside a volume." (when *target* - (let ((s4-0 (-> arg0 ambient)) - (s5-0 #t)) - (let ((s3-0 (-> ((method-of-type res-lump lookup-tag-idx) s4-0 'vol 'exact 0.0) lo))) - (when (>= (the-as int s3-0) 0) - (let ((s2-0 (the-as int s3-0)) - (s1-0 (-> s4-0 tag s3-0))) + (let ((amb (-> proc ambient)) + (in-vol? #t)) + (let ((first-vol-idx (-> ((method-of-type res-lump lookup-tag-idx) amb 'vol 'exact 0.0) lo))) + (when (>= (the-as int first-vol-idx) 0) + (let ((vol-idx (the-as int first-vol-idx)) + (vol (-> amb tag first-vol-idx))) 0 - (while (= (-> s1-0 name) (-> s4-0 tag s3-0 name)) - (let ((v1-8 (the-as object (make-property-data s4-0 0.0 (the-as res-tag-pair s2-0) (the-as pointer #f))))) - (set! s5-0 #t) - (countdown (a0-6 (-> s1-0 elt-count)) - (when (< (-> arg1 w) - (- (vector-dot arg1 (-> (the-as (inline-array vector) v1-8) a0-6)) (-> (the-as (inline-array vector) v1-8) a0-6 w))) - (set! s5-0 #f) + (while (= (-> vol name) (-> amb tag first-vol-idx name)) + (let ((planes (the-as object (make-property-data amb 0.0 (the-as res-tag-pair vol-idx) (the-as pointer #f))))) + (set! in-vol? #t) + (countdown (i (-> vol elt-count)) + (when (< (-> pos w) + (- (vector-dot pos (-> (the-as (inline-array vector) planes) i)) (-> (the-as (inline-array vector) planes) i w))) + (set! in-vol? #f) (goto cfg-9)))) (label cfg-9) - (if s5-0 (goto cfg-15)) - (+! s2-0 1) - (set! s1-0 (-> s4-0 tag s2-0)))))) + (if in-vol? (goto cfg-15)) + (+! vol-idx 1) + (set! vol (-> amb tag vol-idx)))))) (label cfg-15) - (if s5-0 (set! (-> *target* draw secondary-interp) 1.0)))) + (if in-vol? (set! (-> *target* draw secondary-interp) 1.0)))) 0 (none)) -(defun ambient-type-weather-off ((arg0 drawable-ambient) (arg1 vector)) +(defun ambient-type-weather-off ((proc drawable-ambient) (pos vector)) + "Check if `pos` is in a volume, if so set `*weather-off*` to `#t`." (when *target* - (let ((s4-0 (-> arg0 ambient)) - (s5-0 #t)) - (let ((s3-0 (-> ((method-of-type res-lump lookup-tag-idx) s4-0 'vol 'exact 0.0) lo))) - (when (>= (the-as int s3-0) 0) - (let ((s2-0 (the-as int s3-0)) - (s1-0 (-> s4-0 tag s3-0))) + (let ((amb (-> proc ambient)) + (in-vol? #t)) + (let ((first-vol-idx (-> ((method-of-type res-lump lookup-tag-idx) amb 'vol 'exact 0.0) lo))) + (when (>= (the-as int first-vol-idx) 0) + (let ((vol-idx (the-as int first-vol-idx)) + (vol (-> amb tag first-vol-idx))) 0 - (while (= (-> s1-0 name) (-> s4-0 tag s3-0 name)) - (let ((v1-8 (the-as object (make-property-data s4-0 0.0 (the-as res-tag-pair s2-0) (the-as pointer #f))))) - (set! s5-0 #t) - (countdown (a0-6 (-> s1-0 elt-count)) - (when (< (-> arg1 w) - (- (vector-dot arg1 (-> (the-as (inline-array vector) v1-8) a0-6)) (-> (the-as (inline-array vector) v1-8) a0-6 w))) - (set! s5-0 #f) + (while (= (-> vol name) (-> amb tag first-vol-idx name)) + (let ((planes (the-as object (make-property-data amb 0.0 (the-as res-tag-pair vol-idx) (the-as pointer #f))))) + (set! in-vol? #t) + (countdown (i (-> vol elt-count)) + (when (< (-> pos w) + (- (vector-dot pos (-> (the-as (inline-array vector) planes) i)) (-> (the-as (inline-array vector) planes) i w))) + (set! in-vol? #f) (goto cfg-9)))) (label cfg-9) - (if s5-0 (goto cfg-15)) - (+! s2-0 1) - (set! s1-0 (-> s4-0 tag s2-0)))))) + (if in-vol? (goto cfg-15)) + (+! vol-idx 1) + (set! vol (-> amb tag vol-idx)))))) (label cfg-15) - (if s5-0 (set! *weather-off* #t)))) + (if in-vol? (set! *weather-off* #t)))) 0 (none)) -(defun ambient-type-ocean-off ((arg0 drawable-ambient) (arg1 vector)) +(defun ambient-type-ocean-off ((proc drawable-ambient) (pos vector)) + "Set `*ocean-off*` to `#t` when this ambient runs, no volume check." (set! *ocean-off* #t) 0 (none)) -(defun ambient-type-ocean-near-off ((arg0 drawable-ambient) (arg1 vector)) +(defun ambient-type-ocean-near-off ((proc drawable-ambient) (pos vector)) + "Set `*ocean-near-off*`." (set! *ocean-near-off* #t) 0 (none)) -(defun ambient-type-music ((arg0 drawable-ambient) (arg1 vector)) - (let ((gp-0 (-> arg0 ambient))) - (if (-> gp-0 ambient-data user-float 0) - (set! (-> *setting-control* default music) (the-as symbol (-> gp-0 ambient-data user-float 0)))) - (when (nonzero? (-> gp-0 ambient-data user-float 1)) - (let ((f0-0 (res-lump-float gp-0 'priority :default 10.0))) - (when (>= f0-0 (-> *setting-control* default sound-flava-priority)) +(defun ambient-type-music ((proc drawable-ambient) (pos vector)) + "Ambient to set music or flava." + (let ((amb (-> proc ambient))) + (if (-> amb ambient-data user-float 0) + (set! (-> *setting-control* default music) (the-as symbol (-> amb ambient-data user-float 0)))) + (when (nonzero? (-> amb ambient-data user-float 1)) + (let ((pri (res-lump-float amb 'priority :default 10.0))) + (when (>= pri (-> *setting-control* default sound-flava-priority)) ;; og:preserve-this TODO this following form has been manually modified to work - (set! (-> *setting-control* default sound-flava) (the-as uint (-> gp-0 ambient-data user-int32 1))) - (set! (-> *setting-control* default sound-flava-priority) f0-0))))) + (set! (-> *setting-control* default sound-flava) (the-as uint (-> amb ambient-data user-int32 1))) + (set! (-> *setting-control* default sound-flava-priority) pri))))) 0 (none)) -(defmethod collect-ambients ((this drawable-ambient) (arg0 sphere) (arg1 int) (arg2 ambient-list)) - (dotimes (s2-0 arg1) - (when (spheres-overlap? arg0 (the-as sphere (-> this bsphere))) - (set! (-> arg2 items (-> arg2 num-items)) this) - (+! (-> arg2 num-items) 1)) +(defmethod collect-ambients ((this drawable-ambient) (collection-range sphere) (inline-len int) (list ambient-list)) + "Call this function on the first `drawable-ambient` in an `(inline-array drawable-ambient)` to collect + a list of all ambients that overlap the `collection-range` sphere. + This is a clever trick to avoid virtual dispatch per-element." + (dotimes (i inline-len) + (when (spheres-overlap? collection-range (the-as sphere (-> this bsphere))) + (set! (-> list items (-> list num-items)) this) + (+! (-> list num-items) 1)) (&+! this 32)) 0 (none)) -(defmethod collect-ambients ((this drawable-inline-array-ambient) (arg0 sphere) (arg1 int) (arg2 ambient-list)) - (collect-ambients (the-as drawable-ambient (-> this data)) arg0 (-> this length) arg2) +(defmethod collect-ambients ((this drawable-inline-array-ambient) (collection-range sphere) (unused-len int) (list ambient-list)) + "Collect all ambients intersecting the given sphere into the list." + (collect-ambients (the-as drawable-ambient (-> this data)) collection-range (-> this length) list) 0 (none)) -(defmethod collect-ambients ((this drawable-tree-ambient) (arg0 sphere) (arg1 int) (arg2 ambient-list)) - (collect-ambients (-> this data 0) arg0 (-> this length) arg2) +(defmethod collect-ambients ((this drawable-tree-ambient) (collection-range sphere) (unused-len int) (list ambient-list)) + "Collect all ambients overlapping the given sphere in this tree into the given list." + (collect-ambients (-> this data 0) collection-range (-> this length) list) 0 (none)) (defmethod birth-ambient! ((this entity-ambient)) + "\"Birth\" the ambient. This simply resolves data from res-lumps into the runtime formats, looking up names, + setting up callback functions, etc." (set! (-> this ambient-data quad) (the-as uint128 0)) (set! (-> this ambient-data function) ambient-type-error) (case (res-lump-struct this 'type structure) (('sound) - (let ((s5-0 (res-lump-struct this 'effect-name structure :time 0.0)) - (a0-7 (res-lump-data this 'cycle-speed pointer))) - (when (and s5-0 a0-7) + (let ((effect-name (res-lump-struct this 'effect-name structure :time 0.0)) + (cycle-speed-data (res-lump-data this 'cycle-speed pointer))) + (when (and effect-name cycle-speed-data) (cond - ((>= (-> (the-as (pointer float) a0-7)) 0.0) + ((>= (-> (the-as (pointer float) cycle-speed-data)) 0.0) (set! (-> this ambient-data function) ambient-type-sound) (set! (-> this ambient-data user-float 2) (the-as float 0)) - (let ((s5-1 (-> ((method-of-type res-lump lookup-tag-idx) this 'effect-name 'exact 0.0) lo))) - (when (>= (the-as int s5-1) 0) - (let ((s4-0 (the-as int s5-1)) - (v1-14 (-> this tag s5-1))) + (let ((first-name-tag-idx (-> ((method-of-type res-lump lookup-tag-idx) this 'effect-name 'exact 0.0) lo))) + (when (>= (the-as int first-name-tag-idx) 0) + (let ((name-tag-idx (the-as int first-name-tag-idx)) + (name (-> this tag first-name-tag-idx))) 0 - (while (= (-> v1-14 name) (-> this tag s5-1 name)) - (make-property-data this 0.0 (the-as res-tag-pair s4-0) (the-as pointer #f)) + (while (= (-> name name) (-> this tag first-name-tag-idx name)) + (make-property-data this 0.0 (the-as res-tag-pair name-tag-idx) (the-as pointer #f)) (set! (-> this ambient-data user-float 2) (the-as float (+ (the-as int (-> this ambient-data user-float 2)) 1))) - (+! s4-0 1) - (set! v1-14 (-> this tag s4-0))))))) + (+! name-tag-idx 1) + (set! name (-> this tag name-tag-idx))))))) (else (set! (-> this ambient-data user-float 0) (the-as float (new-sound-id))) (let ((v1-28 ((method-of-type res-lump lookup-tag-idx) this 'effect-param 'exact 0.0))) (set! (-> this ambient-data user-float 1) (the-as float (if (< (the-as int v1-28) 0) (the-as (pointer res-tag) #f) (&-> this tag (-> v1-28 lo)))))) - (set! (-> this ambient-data user-float 2) (the-as float s5-0)) + (set! (-> this ambient-data user-float 2) (the-as float effect-name)) (set! (-> this ambient-data function) ambient-type-sound-loop)))))) (('poi) (let ((s5-2 (res-lump-struct this 'effect-name structure :time 0.0))) @@ -655,60 +686,61 @@ (define *execute-ambients* #t) -(defmethod execute-ambient ((this drawable-ambient) (arg0 vector)) - ((-> this ambient ambient-data function) this arg0) +(defmethod execute-ambient ((this drawable-ambient) (pos vector)) + "Run the logic for this ambient." + ((-> this ambient ambient-data function) this pos) 0 (none)) ;; ERROR: function was not converted to expressions. Cannot decompile. (defmethod draw-debug ((this entity-ambient)) - (let ((gp-0 (-> this trans)) - (s5-0 (res-lump-struct this 'type symbol)) - (s3-0 #f)) + (let ((trans (-> this trans)) + (ambient-type (res-lump-struct this 'type symbol)) + (draw-sphere? #f)) (cond - ((= s5-0 'sound) + ((= ambient-type 'sound) (when *display-ambient-sound-marks* (add-debug-text-3d #t (bucket-id debug-no-zbuf) (symbol->string (res-lump-struct this 'effect-name symbol :time 0.0)) - gp-0 + trans (font-color white) (new 'static 'vector2h :y 24)) - (set! s3-0 #t))) - ((= s5-0 'hint) + (set! draw-sphere? #t))) + ((= ambient-type 'hint) (when *display-ambient-hint-marks* (let ((sv-16 (res-lump-value this 'text-id uint128)) (s3-2 add-debug-text-3d) (s2-1 #t) (s1-1 68)) (format (clear *temp-string*) "TEXT ID #x~X" sv-16) - (s3-2 s2-1 (the-as bucket-id s1-1) *temp-string* gp-0 (font-color white) (new 'static 'vector2h :y 24))) - (set! s3-0 #t))) - ((= s5-0 'poi) + (s3-2 s2-1 (the-as bucket-id s1-1) *temp-string* trans (font-color white) (new 'static 'vector2h :y 24))) + (set! draw-sphere? #t))) + ((= ambient-type 'poi) (when *display-ambient-poi-marks* (let ((a1-7 (res-lump-value this 'loc-name-id uint128))) (when (and (nonzero? a1-7) *common-text*) (add-debug-text-3d #t (bucket-id debug-no-zbuf) (lookup-text! *common-text* (the-as text-id a1-7) #f) - gp-0 + trans (font-color white) (new 'static 'vector2h :y 24)) - (set! s3-0 #t))))) - ((= s5-0 'light) (if *display-ambient-light-marks* (set! s3-0 #t))) - ((= s5-0 'dark) (if *display-ambient-dark-marks* (set! s3-0 #t))) - ((= s5-0 'weather-off) (if *display-ambient-weather-off-marks* (set! s3-0 #t))) - ((= s5-0 'ocean-off) (if *display-ambient-ocean-off-marks* (set! s3-0 #t))) - ((= s5-0 'ocean-near-off) (if *display-ambient-ocean-near-off-marks* (set! s3-0 #t))) - ((= s5-0 'music) (if *display-ambient-music-marks* (set! s3-0 #t)))) - (when s3-0 + (set! draw-sphere? #t))))) + ((= ambient-type 'light) (if *display-ambient-light-marks* (set! draw-sphere? #t))) + ((= ambient-type 'dark) (if *display-ambient-dark-marks* (set! draw-sphere? #t))) + ((= ambient-type 'weather-off) (if *display-ambient-weather-off-marks* (set! draw-sphere? #t))) + ((= ambient-type 'ocean-off) (if *display-ambient-ocean-off-marks* (set! draw-sphere? #t))) + ((= ambient-type 'ocean-near-off) (if *display-ambient-ocean-near-off-marks* (set! draw-sphere? #t))) + ((= ambient-type 'music) (if *display-ambient-music-marks* (set! draw-sphere? #t)))) + (when draw-sphere? (let ((t9-10 add-debug-sphere) (a0-11 #t) (a1-9 67) - (a2-9 gp-0) - (a3-7 (-> gp-0 w)) - (v1-53 s5-0)) + (a2-9 trans) + (a3-7 (-> trans w)) + (v1-53 ambient-type)) (t9-10 a0-11 (the-as bucket-id a1-9) a2-9 @@ -720,13 +752,13 @@ (add-debug-text-3d #t (bucket-id debug-no-zbuf) (res-lump-struct this 'name string) - gp-0 + trans (font-color white) (new 'static 'vector2h :y 8)) (add-debug-text-3d #t (bucket-id debug-no-zbuf) - (symbol->string s5-0) - gp-0 + (symbol->string ambient-type) + trans (font-color white) (new 'static 'vector2h :y 16)))) 0 diff --git a/goal_src/jak1/levels/beach/air-h.gc b/goal_src/jak1/levels/beach/air-h.gc index 2425f095bd..3e9e181429 100644 --- a/goal_src/jak1/levels/beach/air-h.gc +++ b/goal_src/jak1/levels/beach/air-h.gc @@ -3,7 +3,9 @@ (bundles "BEA.DGO") (require "engine/math/vector-h.gc") -;; DECOMP BEGINS +;; an air-box is a box that is axis-aligned only on the y axis +;; and supports fast querying for "point in box?" by storing +;; its origin, sin/cos of yaw, and lengths. (deftype air-box (structure) ((vecs vector 2 :inline) @@ -15,20 +17,24 @@ (z-length float :offset 24) (sin-angle float :offset 28))) -(defun point-in-air-box-area? ((arg0 float) (arg1 float) (arg2 air-box)) - (let ((v0-0 #f)) - (let ((f0-2 (+ (* arg0 (-> arg2 cos-angle)) (* arg1 (-> arg2 sin-angle)))) - (f1-5 (- (* arg1 (-> arg2 cos-angle)) (* arg0 (-> arg2 sin-angle))))) - (if (and (>= f0-2 0.0) (>= f1-5 0.0) (< f0-2 (-> arg2 x-length)) (< f1-5 (-> arg2 z-length))) (set! v0-0 #t))) - v0-0)) +;; DECOMP BEGINS -(defun point-in-air-box? ((arg0 vector) (arg1 air-box)) - (when (< (-> arg1 height-level) (-> arg0 y)) - (let ((f1-2 (- (-> arg0 x) (the-as float (-> arg1 x-pos)))) - (f2-1 (- (-> arg0 z) (-> arg1 z-pos))) - (v1-0 arg1) - (v0-0 #f)) - (let ((f0-5 (+ (* f1-2 (-> v1-0 cos-angle)) (* f2-1 (-> v1-0 sin-angle)))) - (f1-4 (- (* f2-1 (-> v1-0 cos-angle)) (* f1-2 (-> v1-0 sin-angle))))) - (if (and (>= f0-5 0.0) (>= f1-4 0.0) (< f0-5 (-> v1-0 x-length)) (< f1-4 (-> v1-0 z-length))) (set! v0-0 #t))) - v0-0))) +(defun point-in-air-box-area? ((x float) (z float) (box air-box)) + "Check if point `x, z` (relative to air-box origin) is within the projected area of the air-box. Effectively doesn't check height." + (let ((ret #f)) + (let ((rot-x (+ (* x (-> box cos-angle)) (* z (-> box sin-angle)))) + (rot-z (- (* z (-> box cos-angle)) (* x (-> box sin-angle))))) + (if (and (>= rot-x 0.0) (>= rot-z 0.0) (< rot-x (-> box x-length)) (< rot-z (-> box z-length))) (set! ret #t))) + ret)) + +(defun point-in-air-box? ((pt vector) (box air-box)) + "Is `pt` inside the `air-box`? The `air-box` is a box that is axis-aligned on the y (vertical) axis." + (when (< (-> box height-level) (-> pt y)) + (let ((x-local (- (-> pt x) (the-as float (-> box x-pos)))) + (z-local (- (-> pt z) (-> box z-pos))) + (b box) + (ret #f)) + (let ((x-rot (+ (* x-local (-> b cos-angle)) (* z-local (-> b sin-angle)))) + (z-rot (- (* z-local (-> b cos-angle)) (* x-local (-> b sin-angle))))) + (if (and (>= x-rot 0.0) (>= z-rot 0.0) (< x-rot (-> b x-length)) (< z-rot (-> b z-length))) (set! ret #t))) + ret))) diff --git a/goal_src/jak1/levels/beach/air.gc b/goal_src/jak1/levels/beach/air.gc index 1c542cd449..b56523d1a5 100644 --- a/goal_src/jak1/levels/beach/air.gc +++ b/goal_src/jak1/levels/beach/air.gc @@ -7,84 +7,88 @@ ;; DECOMP BEGINS -(defun point-in-air? ((arg0 vector) (arg1 (inline-array air-box)) (arg2 int)) - (local-vars (t0-0 symbol)) - (dotimes (v1-0 arg2) - (let ((t1-0 arg0) - (a3-1 (-> arg1 v1-0))) - (set! t0-0 - (when (< (-> a3-1 height-level) (-> t1-0 y)) - (let ((f0-2 (- (-> t1-0 x) (-> a3-1 x-pos))) - (f2-1 (- (-> t1-0 z) (-> a3-1 z-pos)))) - (set! t0-0 #f) - (let ((f1-5 (+ (* f0-2 (-> a3-1 cos-angle)) (* f2-1 (-> a3-1 sin-angle)))) - (f0-4 (- (* f2-1 (-> a3-1 cos-angle)) (* f0-2 (-> a3-1 sin-angle))))) - (if (and (>= f1-5 0.0) (>= f0-4 0.0) (< f1-5 (-> a3-1 x-length)) (< f0-4 (-> a3-1 z-length))) (set! t0-0 #t)))) - t0-0))) - (if t0-0 (return #t))) +(defun point-in-air? ((pt vector) (boxes (inline-array air-box)) (box-count int)) + "Check if `pt` is in any of the boxes." + (local-vars (ret symbol)) + (dotimes (i box-count) + (let ((p pt) + (box (-> boxes i))) + (set! ret + (when (< (-> box height-level) (-> p y)) + (let ((x-local (- (-> p x) (-> box x-pos))) + (z-local (- (-> p z) (-> box z-pos)))) + (set! ret #f) + (let ((x-rot (+ (* x-local (-> box cos-angle)) (* z-local (-> box sin-angle)))) + (z-rot (- (* z-local (-> box cos-angle)) (* x-local (-> box sin-angle))))) + (if (and (>= x-rot 0.0) (>= z-rot 0.0) (< x-rot (-> box x-length)) (< z-rot (-> box z-length))) (set! ret #t)))) + ret))) + (if ret (return #t))) #f) -(defun points-in-air? ((arg0 vector) (arg1 vector) (arg2 (inline-array air-box)) (arg3 int)) - (local-vars (t1-4 symbol)) - (dotimes (v1-0 arg3) - (let* ((t0-1 (-> arg2 v1-0)) - (f0-0 (-> t0-1 height-level))) - (when (and (< f0-0 (-> arg0 y)) (< f0-0 (-> arg1 y))) - (let ((f2-0 (- (-> arg0 x) (-> t0-1 x-pos))) - (f4-0 (- (-> arg0 z) (-> t0-1 z-pos))) - (f0-4 (- (-> arg1 x) (-> t0-1 x-pos))) - (f1-6 (- (-> arg1 z) (-> t0-1 z-pos))) - (t2-0 t0-1) - (t1-3 #f)) - (let ((f3-3 (+ (* f2-0 (-> t2-0 cos-angle)) (* f4-0 (-> t2-0 sin-angle)))) - (f2-2 (- (* f4-0 (-> t2-0 cos-angle)) (* f2-0 (-> t2-0 sin-angle))))) - (if (and (>= f3-3 0.0) (>= f2-2 0.0) (< f3-3 (-> t2-0 x-length)) (< f2-2 (-> t2-0 z-length))) (set! t1-3 #t))) - (set! t1-4 - (and t1-3 +(defun points-in-air? ((p1 vector) (p2 vector) (boxes (inline-array air-box)) (box-count int)) + "Are both `p1` and `p2` inside any of the boxes?" + (local-vars (ret symbol)) + (dotimes (i box-count) + (let* ((box (-> boxes i)) + (height (-> box height-level))) + (when (and (< height (-> p1 y)) (< height (-> p2 y))) + (let ((p1-x-local (- (-> p1 x) (-> box x-pos))) + (p1-z-local (- (-> p1 z) (-> box z-pos))) + (p2-x-local (- (-> p2 x) (-> box x-pos))) + (p2-z-local (- (-> p2 z) (-> box z-pos))) + (b box) + (p1-in-box? #f)) + (let ((p1-x-rot (+ (* p1-x-local (-> b cos-angle)) (* p1-z-local (-> b sin-angle)))) + (p1-z-rot (- (* p1-z-local (-> b cos-angle)) (* p1-x-local (-> b sin-angle))))) + (if (and (>= p1-x-rot 0.0) (>= p1-z-rot 0.0) (< p1-x-rot (-> b x-length)) (< p1-z-rot (-> b z-length))) + (set! p1-in-box? #t))) + (set! ret + (and p1-in-box? (begin - (set! t1-4 #f) - (let ((f2-5 (+ (* f0-4 (-> t0-1 cos-angle)) (* f1-6 (-> t0-1 sin-angle)))) - (f0-6 (- (* f1-6 (-> t0-1 cos-angle)) (* f0-4 (-> t0-1 sin-angle))))) - (if (and (>= f2-5 0.0) (>= f0-6 0.0) (< f2-5 (-> t0-1 x-length)) (< f0-6 (-> t0-1 z-length))) (set! t1-4 #t))) - t1-4)))) - (if t1-4 (return #t))))) + (set! ret #f) + (let ((p2-x-rot (+ (* p2-x-local (-> box cos-angle)) (* p2-z-local (-> box sin-angle)))) + (p2-z-rot (- (* p2-z-local (-> box cos-angle)) (* p2-x-local (-> box sin-angle))))) + (if (and (>= p2-x-rot 0.0) (>= p2-z-rot 0.0) (< p2-x-rot (-> box x-length)) (< p2-z-rot (-> box z-length))) (set! ret #t))) + ret)))) + (if ret (return #t))))) #f) -(defun-debug add-debug-air-box ((arg0 bucket-id) (arg1 air-box)) - (local-vars (a0-1 symbol)) - (let ((a1-1 (camera-pos)) - (s5-0 (new 'stack-no-clear 'vector)) - (s4-0 (new 'stack-no-clear 'vector))) - (-> arg1 cos-angle) - (-> arg1 sin-angle) - (let ((s2-0 (the-as uint #x800000ff))) - (let ((v1-0 arg1)) - (set! a0-1 - (when (< (-> v1-0 height-level) (-> a1-1 y)) - (let ((f0-4 (- (-> a1-1 x) (-> v1-0 x-pos))) - (f2-1 (- (-> a1-1 z) (-> v1-0 z-pos)))) - (set! a0-1 #f) - (let ((f1-5 (+ (* f0-4 (-> v1-0 cos-angle)) (* f2-1 (-> v1-0 sin-angle)))) - (f0-6 (- (* f2-1 (-> v1-0 cos-angle)) (* f0-4 (-> v1-0 sin-angle))))) - (if (and (>= f1-5 0.0) (>= f0-6 0.0) (< f1-5 (-> v1-0 x-length)) (< f0-6 (-> v1-0 z-length))) (set! a0-1 #t)))) - a0-1))) - (if a0-1 (set! s2-0 (the-as uint #x8000ff00))) - (set! (-> s5-0 y) (-> arg1 height-level)) - (set! (-> s4-0 y) (-> arg1 height-level)) - (set! (-> s5-0 w) 1.0) - (set! (-> s4-0 w) 1.0) - (set! (-> s5-0 x) (-> arg1 x-pos)) - (set! (-> s5-0 z) (-> arg1 z-pos)) - (set! (-> s4-0 x) (+ (-> arg1 x-pos) (* (-> arg1 cos-angle) (-> arg1 x-length)))) - (set! (-> s4-0 z) (+ (-> arg1 z-pos) (* (-> arg1 sin-angle) (-> arg1 x-length)))) - (add-debug-line #t arg0 s5-0 s4-0 (the-as rgba s2-0) #f (the-as rgba -1)) - (set! (-> s5-0 quad) (-> s4-0 quad)) - (set! (-> s4-0 x) (+ (-> s5-0 x) (* (- (-> arg1 sin-angle)) (-> arg1 z-length)))) - (set! (-> s4-0 z) (+ (-> s5-0 z) (* (-> arg1 cos-angle) (-> arg1 z-length)))) - (add-debug-line #t arg0 s5-0 s4-0 (the-as rgba s2-0) #f (the-as rgba -1)) - (set! (-> s5-0 x) (+ (-> arg1 x-pos) (* (- (-> arg1 sin-angle)) (-> arg1 z-length)))) - (set! (-> s5-0 z) (+ (-> arg1 z-pos) (* (-> arg1 cos-angle) (-> arg1 z-length)))) - (add-debug-line #t arg0 s5-0 s4-0 (the-as rgba s2-0) #f (the-as rgba -1)) - (set! (-> s4-0 x) (-> arg1 x-pos)) - (set! (-> s4-0 z) (-> arg1 z-pos)) - (add-debug-line #t arg0 s5-0 s4-0 (the-as rgba s2-0) #f (the-as rgba -1))))) +(defun-debug add-debug-air-box ((bucket bucket-id) (box air-box)) + (local-vars (cam-in-box? symbol)) + (let ((cam-pos (camera-pos)) + (p0 (new 'stack-no-clear 'vector)) + (p1 (new 'stack-no-clear 'vector))) + (-> box cos-angle) + (-> box sin-angle) + (let ((color (new 'static 'rgba :r #xff :a #x80))) + (let ((b box)) + (set! cam-in-box? + (when (< (-> b height-level) (-> cam-pos y)) + (let ((cam-x-local (- (-> cam-pos x) (-> b x-pos))) + (cam-z-local (- (-> cam-pos z) (-> b z-pos)))) + (set! cam-in-box? #f) + (let ((cam-x-rot (+ (* cam-x-local (-> b cos-angle)) (* cam-z-local (-> b sin-angle)))) + (cam-z-rot (- (* cam-z-local (-> b cos-angle)) (* cam-x-local (-> b sin-angle))))) + (if (and (>= cam-x-rot 0.0) (>= cam-z-rot 0.0) (< cam-x-rot (-> b x-length)) (< cam-z-rot (-> b z-length))) + (set! cam-in-box? #t)))) + cam-in-box?))) + (if cam-in-box? (set! color (new 'static 'rgba :g #xff :a #x80))) + (set! (-> p0 y) (-> box height-level)) + (set! (-> p1 y) (-> box height-level)) + (set! (-> p0 w) 1.0) + (set! (-> p1 w) 1.0) + (set! (-> p0 x) (-> box x-pos)) + (set! (-> p0 z) (-> box z-pos)) + (set! (-> p1 x) (+ (-> box x-pos) (* (-> box cos-angle) (-> box x-length)))) + (set! (-> p1 z) (+ (-> box z-pos) (* (-> box sin-angle) (-> box x-length)))) + (add-debug-line #t bucket p0 p1 (the-as rgba color) #f (the-as rgba -1)) + (set! (-> p0 quad) (-> p1 quad)) + (set! (-> p1 x) (+ (-> p0 x) (* (- (-> box sin-angle)) (-> box z-length)))) + (set! (-> p1 z) (+ (-> p0 z) (* (-> box cos-angle) (-> box z-length)))) + (add-debug-line #t bucket p0 p1 (the-as rgba color) #f (the-as rgba -1)) + (set! (-> p0 x) (+ (-> box x-pos) (* (- (-> box sin-angle)) (-> box z-length)))) + (set! (-> p0 z) (+ (-> box z-pos) (* (-> box cos-angle) (-> box z-length)))) + (add-debug-line #t bucket p0 p1 (the-as rgba color) #f (the-as rgba -1)) + (set! (-> p1 x) (-> box x-pos)) + (set! (-> p1 z) (-> box z-pos)) + (add-debug-line #t bucket p0 p1 (the-as rgba color) #f (the-as rgba -1)))))