mirror of
https://github.com/open-goal/jak-project.git
synced 2024-10-20 21:27:52 -04:00
cd68cb671e
Major change to how `deftype` shows up in our code: - the decompiler will no longer emit the `offset-assert`, `method-count-assert`, `size-assert` and `flag-assert` parameters. There are extremely few cases where having this in the decompiled code is helpful, as the types there come from `all-types` which already has those parameters. This also doesn't break type consistency because: - the asserts aren't compared. - the first step of the test uses `all-types`, which has the asserts, which will throw an error if they're bad. - the decompiler won't emit the `heap-base` parameter unless necessary now. - the decompiler will try its hardest to turn a fixed-offset field into an `overlay-at` field. It falls back to the old offset if all else fails. - `overlay-at` now supports field "dereferencing" to specify the offset that's within a field that's a structure, e.g.: ```lisp (deftype foobar (structure) ((vec vector :inline) (flags int32 :overlay-at (-> vec w)) ) ) ``` in this structure, the offset of `flags` will be 12 because that is the final offset of `vec`'s `w` field within this structure. - **removed ID from all method declarations.** IDs are only ever automatically assigned now. Fixes #3068. - added an `:overlay` parameter to method declarations, in order to declare a new method that goes on top of a previously-defined method. Syntax is `:overlay <method-name>`. Please do not ever use this. - added `state-methods` list parameter. This lets you quickly specify a list of states to be put in the method table. Same syntax as the `states` list parameter. The decompiler will try to put as many states in this as it can without messing with the method ID order. Also changes `defmethod` to make the first type definition (before the arguments) optional. The type can now be inferred from the first argument. Fixes #3093. --------- Co-authored-by: Hat Kid <6624576+Hat-Kid@users.noreply.github.com>
839 lines
28 KiB
Common Lisp
839 lines
28 KiB
Common Lisp
;;-*-Lisp-*-
|
|
(in-package goal)
|
|
|
|
;; name: elevator.gc
|
|
;; name in dgo: elevator
|
|
;; dgos: GAME, COMMON
|
|
|
|
;; +++elevator-flags
|
|
(defenum elevator-flags
|
|
:type uint64
|
|
:bitfield #t
|
|
(elevator-flags-0)
|
|
(elevator-flags-1)
|
|
(elevator-flags-2)
|
|
(elevator-flags-3)
|
|
(elevator-flags-4)
|
|
(prevent-jump)
|
|
(elevator-flags-6)
|
|
(elevator-flags-7)
|
|
(elevator-flags-8)
|
|
(elevator-flags-9)
|
|
(elevator-flags-10)
|
|
(elevator-flags-11)
|
|
(elevator-flags-12)
|
|
(elevator-flags-13)
|
|
(elevator-flags-14)
|
|
(elevator-flags-15)
|
|
(airlock-opened)
|
|
(elevator-flags-17)
|
|
)
|
|
;; ---elevator-flags
|
|
|
|
|
|
;; +++elevator-status
|
|
(defenum elevator-status
|
|
:type uint64
|
|
:bitfield #t
|
|
(waiting-to-descend)
|
|
(waiting-to-ascend)
|
|
(moving)
|
|
(elevator-status-3)
|
|
(elevator-status-4)
|
|
(elevator-status-5)
|
|
(elevator-status-6)
|
|
(elevator-status-7)
|
|
(elevator-status-8)
|
|
(elevator-status-9)
|
|
)
|
|
;; ---elevator-status
|
|
|
|
|
|
;; DECOMP BEGINS
|
|
|
|
(deftype elevator-params (structure)
|
|
((xz-threshold float)
|
|
(y-threshold float)
|
|
(start-pos float)
|
|
(move-rate float)
|
|
(flags elevator-flags)
|
|
)
|
|
)
|
|
|
|
|
|
(deftype path-step (structure)
|
|
((next-pos float)
|
|
(dist float)
|
|
)
|
|
)
|
|
|
|
|
|
(deftype path-step-inline-array (inline-array-class)
|
|
((data path-step :inline :dynamic)
|
|
)
|
|
)
|
|
|
|
|
|
(set! (-> path-step-inline-array heap-base) (the-as uint 16))
|
|
|
|
(deftype elevator (base-plat)
|
|
((params elevator-params :inline)
|
|
(path-seq path-step-inline-array)
|
|
(path-dest float)
|
|
(bottom-top float 2)
|
|
(move-pos float 2)
|
|
(move-dist float)
|
|
(path-pos float)
|
|
(path-eased-pos float)
|
|
(ride-timer time-frame)
|
|
(sticky-player-last-ride-time time-frame)
|
|
(elevator-status elevator-status)
|
|
(on-activate pair)
|
|
(on-deactivate pair)
|
|
)
|
|
(:state-methods
|
|
dormant
|
|
waiting
|
|
running
|
|
arrived
|
|
)
|
|
(:methods
|
|
(elevator-method-38 (_type_) none)
|
|
(calc-dist-between-points! (_type_ int int) none)
|
|
(activate-elevator (_type_) object)
|
|
(init-defaults! (_type_) none)
|
|
(set-ambient-sound! (_type_) none)
|
|
(move-between-points (_type_ vector float float) symbol)
|
|
(elevator-method-44 (_type_) symbol)
|
|
(commited-to-ride? (_type_) symbol)
|
|
(move-to-next-point! (_type_) none)
|
|
(find-closest-point-in-path! (_type_ vector (pointer float) symbol symbol) symbol)
|
|
(elevator-method-48 (_type_) none)
|
|
)
|
|
)
|
|
|
|
|
|
(defmethod move-between-points ((this elevator) (arg0 vector) (arg1 float) (arg2 float))
|
|
"Move between two points on the elevator's path
|
|
@param vec TODO not sure
|
|
@param point-a The first point fetched from the elevator's path
|
|
@param point-b The second point fetched from the path
|
|
@see [[path-control]] and [[elevator]]"
|
|
#f
|
|
)
|
|
|
|
(defmethod elevator-method-48 ((this elevator))
|
|
"TODO - collision related"
|
|
(let ((target *target*))
|
|
(when target
|
|
(let ((s4-0 (-> target control collision-spheres 0))
|
|
(s5-0 (new 'stack-no-clear 'collide-query))
|
|
)
|
|
(set! (-> s5-0 start-pos quad) (-> s4-0 prim-core world-sphere quad))
|
|
(+! (-> s5-0 start-pos y) 8192.0)
|
|
(set! (-> s5-0 start-pos w) 1.0)
|
|
(vector-reset! (-> s5-0 move-dist))
|
|
(set! (-> s5-0 move-dist y) -90112.0)
|
|
(let ((collide-query s5-0))
|
|
(set! (-> collide-query radius) (-> s4-0 local-sphere w))
|
|
(set! (-> collide-query collide-with) (collide-spec hit-by-others-list pusher))
|
|
(set! (-> collide-query ignore-process0) target)
|
|
(set! (-> collide-query ignore-process1) #f)
|
|
(set! (-> collide-query ignore-pat) (-> target control pat-ignore-mask))
|
|
(set! (-> collide-query action-mask) (collide-action solid))
|
|
)
|
|
(let ((f0-5 (fill-and-probe-using-line-sphere *collide-cache* s5-0)))
|
|
(when (< 0.0 f0-5)
|
|
(vector-float*! (-> s5-0 move-dist) (-> s5-0 move-dist) f0-5)
|
|
(vector+! (-> s5-0 move-dist) (-> s5-0 move-dist) (-> s5-0 start-pos))
|
|
(vector-! (-> s5-0 move-dist) (-> s5-0 move-dist) (the-as vector (-> s4-0 prim-core)))
|
|
(move-by-vector! (-> target control) (-> s5-0 move-dist))
|
|
)
|
|
)
|
|
)
|
|
)
|
|
)
|
|
(none)
|
|
)
|
|
|
|
(defmethod init-defaults! ((this elevator))
|
|
"Initializes default settings related to the [[elevator]]:
|
|
- `elevator-xz-threshold`
|
|
- `elevator-y-threshold`
|
|
- `elevator-start-pos`
|
|
- `elevator-move-rate`
|
|
- `elevator-flags`"
|
|
(let ((entity (-> this entity)))
|
|
(set! (-> this params xz-threshold) ((method-of-object entity get-property-value-float)
|
|
entity
|
|
'elevator-xz-threshold
|
|
'interp
|
|
-1000000000.0
|
|
81920.0
|
|
(the-as (pointer res-tag) #f)
|
|
*res-static-buf*
|
|
)
|
|
)
|
|
(set! entity (-> this entity))
|
|
(set! (-> this params y-threshold) ((method-of-object entity get-property-value-float)
|
|
entity
|
|
'elevator-y-threshold
|
|
'interp
|
|
-1000000000.0
|
|
20480.0
|
|
(the-as (pointer res-tag) #f)
|
|
*res-static-buf*
|
|
)
|
|
)
|
|
(set! entity (-> this entity))
|
|
(set! (-> this params start-pos) ((method-of-object entity get-property-value-float)
|
|
entity
|
|
'elevator-start-pos
|
|
'interp
|
|
-1000000000.0
|
|
0.0
|
|
(the-as (pointer res-tag) #f)
|
|
*res-static-buf*
|
|
)
|
|
)
|
|
(set! entity (-> this entity))
|
|
(set! (-> this params move-rate) ((method-of-object entity get-property-value-float)
|
|
entity
|
|
'elevator-move-rate
|
|
'interp
|
|
-1000000000.0
|
|
25600.0
|
|
(the-as (pointer res-tag) #f)
|
|
*res-static-buf*
|
|
)
|
|
)
|
|
(set! entity (-> this entity))
|
|
(set! (-> this params flags) (the-as elevator-flags ((method-of-object entity get-property-value)
|
|
entity
|
|
'elevator-flags
|
|
'interp
|
|
-1000000000.0
|
|
(the-as uint128 1)
|
|
(the-as (pointer res-tag) #f)
|
|
*res-static-buf*
|
|
)
|
|
)
|
|
)
|
|
)
|
|
0
|
|
(none)
|
|
)
|
|
|
|
(defun ease-value-in-out ((value float) (step-amount float))
|
|
"TODO - the math in this function is full of duplication and isn't totally clear
|
|
but if the name is to be believed, it's to slow a values grow at the beginning and end of it's range
|
|
which is obviously useful for an elevator."
|
|
(let* ((step step-amount)
|
|
(f4-0 (- 1.0 step-amount))
|
|
(f3-0 (/ step (- 1.0 f4-0)))
|
|
(f2-1 (* step step))
|
|
(f1-6 (+ (* 2.0 step (- f4-0 step)) f2-1))
|
|
(f1-7 (+ (* (- 1.0 f4-0) (- 1.0 f4-0) f3-0) f1-6))
|
|
)
|
|
(/ (cond
|
|
((< value step)
|
|
(* value value)
|
|
)
|
|
((< value f4-0)
|
|
(+ (* 2.0 step (- value step)) f2-1)
|
|
)
|
|
(else
|
|
(let ((f0-7 (- 1.0 value)))
|
|
(- f1-7 (* f0-7 f0-7 f3-0))
|
|
)
|
|
)
|
|
)
|
|
f1-7
|
|
)
|
|
)
|
|
)
|
|
|
|
;; WARN: disable def twice: 11. This may happen when a cond (no else) is nested inside of another conditional, but it should be rare.
|
|
(defbehavior elevator-event elevator ((proc process) (arg1 int) (event-type symbol) (event event-message-block))
|
|
(case event-type
|
|
(('status?)
|
|
(and (= (the float (/ (the-as int (-> event param 0)) 8)) (-> self move-pos 0))
|
|
(= (the float (/ (the-as int (-> event param 1)) 8)) (-> self move-pos 1))
|
|
)
|
|
)
|
|
(('ridden)
|
|
(let ((proc-focus (handle->process (-> (the-as focus (-> event param 0)) handle))))
|
|
(if (= (-> proc-focus type) target)
|
|
(set-time! (-> self sticky-player-last-ride-time))
|
|
)
|
|
)
|
|
#t
|
|
)
|
|
(('use-camera)
|
|
(if (-> event param 0)
|
|
(set-setting! 'entity-name (-> event param 0) 0.0 0)
|
|
(remove-setting! 'entity-name)
|
|
)
|
|
)
|
|
(('move-to)
|
|
(when (and (-> self next-state) (let ((next-state-0 (-> self next-state name)))
|
|
(or (= next-state-0 'waiting) (= next-state-0 'arrived))
|
|
)
|
|
)
|
|
(set! (-> self move-pos 0) (-> self move-pos 1))
|
|
(cond
|
|
((not (logtest? (-> event param 0) 7))
|
|
(let ((gp-0 (the-as number (-> event param 0))))
|
|
(set! (-> self move-pos 1) (if (type? (the-as uint gp-0) float)
|
|
(the-as float gp-0)
|
|
)
|
|
)
|
|
)
|
|
)
|
|
(else
|
|
(case (-> event param 0)
|
|
(('quote 'bottom)
|
|
(set! (-> self move-pos 1) (-> self bottom-top 0))
|
|
)
|
|
(('quote 'top)
|
|
(set! (-> self move-pos 1) (-> self bottom-top 1))
|
|
)
|
|
)
|
|
)
|
|
)
|
|
(go-virtual running)
|
|
)
|
|
)
|
|
(('jump-to)
|
|
(cond
|
|
((not (logtest? (-> event param 0) 7))
|
|
(let ((gp-1 (the-as number (-> event param 0))))
|
|
(set! (-> self move-pos 1) (if (type? (the-as uint gp-1) float)
|
|
(the-as float gp-1)
|
|
)
|
|
)
|
|
)
|
|
)
|
|
(else
|
|
(case (-> event param 0)
|
|
(('quote 'bottom)
|
|
(set! (-> self move-pos 1) (-> self bottom-top 0))
|
|
)
|
|
(('quote 'top)
|
|
(set! (-> self move-pos 1) (-> self bottom-top 1))
|
|
)
|
|
)
|
|
)
|
|
)
|
|
(set! (-> self move-pos 0) (-> self move-pos 1))
|
|
(get-point-in-path! (-> self path) (-> self basetrans) (-> self move-pos 0) 'interp)
|
|
(go-virtual waiting)
|
|
)
|
|
(('trigger)
|
|
(when (and (-> self next-state) (let ((next-state-1 (-> self next-state name)))
|
|
(or (= next-state-1 'waiting) (= next-state-1 'arrived))
|
|
)
|
|
)
|
|
(set! (-> self move-pos 0) (-> self move-pos 1))
|
|
(cond
|
|
((= (-> self move-pos 0) (-> self bottom-top 0))
|
|
(set! (-> self move-pos 1) (-> self bottom-top 1))
|
|
)
|
|
((= (-> self move-pos 0) (-> self bottom-top 1))
|
|
(set! (-> self move-pos 1) (-> self bottom-top 0))
|
|
)
|
|
)
|
|
(go-virtual running)
|
|
)
|
|
)
|
|
(('query)
|
|
(case (-> event param 0)
|
|
(('waiting?)
|
|
(and (-> self next-state) (= (-> self next-state name) 'waiting))
|
|
)
|
|
(('arrived?)
|
|
(and (-> self next-state) (let ((v1-61 (-> self next-state name)))
|
|
(or (= v1-61 'arrived) (= v1-61 'waiting))
|
|
)
|
|
)
|
|
)
|
|
(('running?)
|
|
(and (-> self next-state) (= (-> self next-state name) 'running))
|
|
)
|
|
(('path-pos?)
|
|
(+ (-> self move-pos 0) (* (-> self path-pos) (- (-> self move-pos 1) (-> self move-pos 0))))
|
|
)
|
|
(('player-standing-on?)
|
|
(= (-> self sticky-player-last-ride-time) (current-time))
|
|
)
|
|
(('point-inside-shaft?)
|
|
(move-between-points self (the-as vector (-> event param 1)) (-> self bottom-top 1) (-> self bottom-top 0))
|
|
)
|
|
(('going-down?)
|
|
(< (-> (get-point-in-path! (-> self path) (new 'stack-no-clear 'vector) (-> self move-pos 1) 'interp) y)
|
|
(-> (get-point-in-path! (-> self path) (new 'stack-no-clear 'vector) (-> self move-pos 0) 'interp) y)
|
|
)
|
|
)
|
|
(('going-up?)
|
|
(< (-> (get-point-in-path! (-> self path) (new 'stack-no-clear 'vector) (-> self move-pos 0) 'interp) y)
|
|
(-> (get-point-in-path! (-> self path) (new 'stack-no-clear 'vector) (-> self move-pos 1) 'interp) y)
|
|
)
|
|
)
|
|
)
|
|
)
|
|
(('go-dormant)
|
|
(go-virtual dormant)
|
|
)
|
|
(else
|
|
(plat-event proc arg1 event-type event)
|
|
)
|
|
)
|
|
)
|
|
|
|
(defmethod find-closest-point-in-path! ((this elevator) (arg0 vector) (arg1 (pointer float)) (arg2 symbol) (arg3 symbol))
|
|
"Finds and sets the provided [[path-step]]'s `next-pos` field to the vertex index in the path which is closest to
|
|
the provided [[vector]]
|
|
|
|
@param vec The point at which distance calculations are based off
|
|
@param! next-step If a point is found, `next-pos` will be set to the correct point
|
|
@param arg2 TODO
|
|
@param arg3 TODO
|
|
@returns [[#t]] if a point in the path was found"
|
|
(local-vars (path-point vector))
|
|
(let ((elev-params (-> this params))
|
|
(smallest-dist 0.0)
|
|
(point-idx-tracker -1.0)
|
|
)
|
|
(dotimes (path-vertex-idx (-> this path curve num-cverts))
|
|
(set! path-point
|
|
(get-point-in-path! (-> this path) (new 'stack-no-clear 'vector) (the float path-vertex-idx) 'interp)
|
|
)
|
|
(when (and (or (not arg2) (< (vector-vector-xz-distance path-point arg0) (-> elev-params xz-threshold)))
|
|
(or (not arg3)
|
|
(< (fabs (- (-> path-point y) (-> arg0 y))) (-> elev-params y-threshold))
|
|
(and (= path-vertex-idx (the int (-> this bottom-top 0))) (< (-> arg0 y) (-> path-point y)))
|
|
(and (= path-vertex-idx (the int (-> this bottom-top 1))) (< (-> path-point y) (-> arg0 y)))
|
|
)
|
|
)
|
|
(let* ((t9-2 vector-vector-distance)
|
|
(a1-3 arg0)
|
|
(dist (t9-2 path-point a1-3))
|
|
)
|
|
(when (or (= point-idx-tracker -1.0) (< dist smallest-dist))
|
|
(set! smallest-dist dist)
|
|
(set! point-idx-tracker (the float path-vertex-idx))
|
|
)
|
|
)
|
|
)
|
|
)
|
|
(when (!= point-idx-tracker -1.0)
|
|
(set! (-> arg1 0) point-idx-tracker)
|
|
#t
|
|
)
|
|
)
|
|
)
|
|
|
|
;; WARN: Return type mismatch object vs symbol.
|
|
(defmethod elevator-method-44 ((this elevator))
|
|
(let* ((target-temp *target*)
|
|
(target (if (type? target-temp process-focusable)
|
|
target-temp
|
|
)
|
|
)
|
|
)
|
|
(the-as
|
|
symbol
|
|
(and target (move-between-points this (get-trans target 0) (-> this move-pos 0) (-> this move-pos 1)))
|
|
)
|
|
)
|
|
)
|
|
|
|
(defmethod commited-to-ride? ((this elevator))
|
|
"@returns if the target is considered within the elevator area enough to begin descending/ascending"
|
|
#t
|
|
)
|
|
|
|
(defmethod move-to-next-point! ((this elevator))
|
|
"If the [[*target*]] is in a valid state and there is a point to transition to in the elevator's path
|
|
do so.
|
|
@see [[elevator::47]]"
|
|
(local-vars (zero float))
|
|
(let ((target *target*))
|
|
(when (and target
|
|
(not (logtest? (focus-status dead inactive in-air grabbed edge-grab pole pilot-riding pilot teleporting)
|
|
(-> target focus-status)
|
|
)
|
|
)
|
|
)
|
|
(set! zero (the-as float 0.0))
|
|
(when (and (find-closest-point-in-path! this (get-trans target 0) (& zero) #t #t) (!= (-> this move-pos 1) zero))
|
|
(set! (-> this move-pos 0) (-> this move-pos 1))
|
|
(set! (-> this move-pos 1) zero)
|
|
(logior! (-> this elevator-status) (elevator-status moving))
|
|
(go (method-of-object this running))
|
|
)
|
|
)
|
|
)
|
|
0
|
|
(none)
|
|
)
|
|
|
|
(defbehavior move-post elevator ()
|
|
(when (nonzero? (-> self sound))
|
|
(let ((f0-3 (sqrtf (sin-rad (* 3.1415925 (-> self path-pos))))))
|
|
(update-vol! (-> self sound) f0-3)
|
|
)
|
|
(update-trans! (-> self sound) (-> self root trans))
|
|
(update! (-> self sound))
|
|
)
|
|
(plat-post)
|
|
(none)
|
|
)
|
|
|
|
(defstate dormant (elevator)
|
|
:virtual #t
|
|
:event (behavior ((proc process) (argc int) (message symbol) (block event-message-block))
|
|
(case message
|
|
(('trigger)
|
|
(go-virtual waiting)
|
|
)
|
|
(('bonk)
|
|
#f
|
|
)
|
|
(else
|
|
(plat-event proc argc message block)
|
|
)
|
|
)
|
|
)
|
|
:trans plat-trans
|
|
:code sleep-code
|
|
:post plat-post
|
|
)
|
|
|
|
(defstate waiting (elevator)
|
|
:virtual #t
|
|
:event (behavior ((proc process) (argc int) (message symbol) (block event-message-block))
|
|
(case message
|
|
(('ridden)
|
|
(if (commited-to-ride? self)
|
|
(logior! (-> self elevator-status) (elevator-status waiting-to-descend))
|
|
)
|
|
(elevator-event proc argc message block)
|
|
)
|
|
(else
|
|
(elevator-event proc argc message block)
|
|
)
|
|
)
|
|
)
|
|
:enter (behavior ()
|
|
(set-time! (-> self ride-timer))
|
|
(logclear! (-> self elevator-status) (elevator-status waiting-to-descend moving))
|
|
(logior! (-> self mask) (process-mask actor-pause))
|
|
(if (nonzero? (-> self sound))
|
|
(update-vol! (-> self sound) 0.0)
|
|
)
|
|
)
|
|
:trans (behavior ()
|
|
(plat-trans)
|
|
(when (not (logtest? (-> self elevator-status) (elevator-status waiting-to-descend)))
|
|
(set-time! (-> self ride-timer))
|
|
(-> self params)
|
|
(if (and (logtest? (-> self params flags) (elevator-flags elevator-flags-0))
|
|
(not (logtest? (-> self params flags) (elevator-flags elevator-flags-3)))
|
|
)
|
|
(move-to-next-point! self)
|
|
)
|
|
)
|
|
(when (and (not (logtest? (-> self params flags) (elevator-flags elevator-flags-3)))
|
|
(time-elapsed? (-> self ride-timer) (seconds 1))
|
|
)
|
|
(set! (-> self move-pos 0) (-> self move-pos 1))
|
|
(set! (-> self move-pos 1) (-> self path-seq data (the int (-> self move-pos 1)) next-pos))
|
|
(go-virtual running)
|
|
)
|
|
)
|
|
:code sleep-code
|
|
:post (behavior ()
|
|
(logclear! (-> self elevator-status) (elevator-status waiting-to-descend))
|
|
(debug-draw (-> self path))
|
|
(plat-post)
|
|
)
|
|
)
|
|
|
|
(defstate running (elevator)
|
|
:virtual #t
|
|
:event (behavior ((proc process) (argc int) (message symbol) (block event-message-block))
|
|
(case message
|
|
(('running?)
|
|
#t
|
|
)
|
|
(('player-ridden?)
|
|
(logtest? (-> self elevator-status) (elevator-status waiting-to-descend))
|
|
)
|
|
(else
|
|
(elevator-event proc argc message block)
|
|
)
|
|
)
|
|
)
|
|
:enter (behavior ()
|
|
(if (not (logtest? (-> self params flags) (elevator-flags elevator-flags-7)))
|
|
(process-entity-status! self (entity-perm-status no-kill) #t)
|
|
)
|
|
(logclear! (-> self elevator-status) (elevator-status waiting-to-ascend))
|
|
(when (logtest? (-> self params flags) (elevator-flags elevator-flags-2))
|
|
(logclear! (-> self params flags) (elevator-flags elevator-flags-2))
|
|
(logior! (-> self params flags) (elevator-flags elevator-flags-0))
|
|
)
|
|
(set! (-> self move-dist) 0.0)
|
|
(let ((v1-13 (the int (-> self move-pos 0)))
|
|
(a0-3 (the int (-> self move-pos 1)))
|
|
(a1-1 0)
|
|
)
|
|
(while (let ((a2-3 (abs (- a0-3 v1-13))))
|
|
(< a1-1 a2-3)
|
|
)
|
|
(+! (-> self move-dist) (-> self path-seq data (+ (min v1-13 a0-3) a1-1) dist))
|
|
(+! a1-1 1)
|
|
)
|
|
)
|
|
(logclear! (-> self mask) (process-mask actor-pause))
|
|
(set-setting! 'board #f 0.0 0)
|
|
(let ((gp-0 (-> self on-activate)))
|
|
(if gp-0
|
|
(script-eval gp-0 :key (* (the int (-> self move-pos 0)) 8) :vector (-> self root trans))
|
|
)
|
|
)
|
|
(set! (-> self path-pos) 0.0)
|
|
(if (nonzero? (-> self sound))
|
|
(update-vol! (-> self sound) 0.0)
|
|
)
|
|
(when (logtest? (-> self params flags) (elevator-flags prevent-jump))
|
|
(set-setting! 'jump #f 0.0 0)
|
|
(apply-settings *setting-control*)
|
|
)
|
|
)
|
|
:exit (behavior ()
|
|
(if (not (logtest? (-> self params flags) (elevator-flags elevator-flags-7)))
|
|
(process-entity-status! self (entity-perm-status no-kill) #f)
|
|
)
|
|
(remove-setting! 'board)
|
|
(if (logtest? (-> self params flags) (elevator-flags prevent-jump))
|
|
(remove-setting! 'jump)
|
|
)
|
|
)
|
|
:trans (behavior ()
|
|
(if (and (not (logtest? (-> self elevator-status) (elevator-status waiting-to-ascend)))
|
|
(= (-> self path-pos) 1.0)
|
|
)
|
|
(go-virtual arrived)
|
|
)
|
|
(if (elevator-method-44 self)
|
|
(set! (-> self path-dest) 0.0)
|
|
(set! (-> self path-dest) 1.0)
|
|
)
|
|
(if (logtest? (-> self params flags) (elevator-flags prevent-jump))
|
|
(elevator-method-48 self)
|
|
)
|
|
(plat-trans)
|
|
)
|
|
:code (behavior ()
|
|
(logior! (-> self elevator-status) (elevator-status waiting-to-ascend))
|
|
(until #f
|
|
(suspend)
|
|
(if (= (-> self path-pos) 1.0)
|
|
(logclear! (-> self elevator-status) (elevator-status waiting-to-ascend))
|
|
)
|
|
)
|
|
#f
|
|
)
|
|
:post (behavior ()
|
|
(when (logtest? (-> self elevator-status) (elevator-status waiting-to-ascend))
|
|
(seek!
|
|
(-> self path-pos)
|
|
(-> self path-dest)
|
|
;; og:preserve-this pc port fast elevator option
|
|
(* (/ (* (#if PC_PORT (if (eligible-for-fast-elevator? *pc-settings* self) 1.5 1.0)
|
|
1.0)
|
|
(-> self params move-rate)) (-> self move-dist)) (seconds-per-frame))
|
|
)
|
|
(let* ((f30-0 (-> self move-pos 0))
|
|
(f28-0 (-> self move-pos 1))
|
|
(f0-9 (+ f30-0 (* (ease-value-in-out (-> self path-pos) 0.08) (- f28-0 f30-0))))
|
|
)
|
|
(get-point-in-path! (-> self path) (-> self basetrans) f0-9 'interp)
|
|
)
|
|
)
|
|
(move-post)
|
|
)
|
|
)
|
|
|
|
(defstate arrived (elevator)
|
|
:virtual #t
|
|
:event (behavior ((proc process) (argc int) (message symbol) (block event-message-block))
|
|
(case message
|
|
(('ridden)
|
|
(set-time! (-> self ride-timer))
|
|
(elevator-event proc argc message block)
|
|
)
|
|
(else
|
|
(elevator-event proc argc message block)
|
|
)
|
|
)
|
|
)
|
|
:enter (behavior ()
|
|
(set-time! (-> self ride-timer))
|
|
(if (not (-> *setting-control* user-current jump))
|
|
(remove-setting! 'jump)
|
|
)
|
|
(let ((gp-0 (-> self on-deactivate)))
|
|
(if gp-0
|
|
(script-eval gp-0 :key (* (the int (-> self move-pos 1)) 8) :vector (-> self root trans))
|
|
)
|
|
)
|
|
)
|
|
:trans (behavior ()
|
|
(if (and (< (- (-> self ride-timer) (-> self sticky-player-last-ride-time)) (seconds 2))
|
|
(begin *target* *target*)
|
|
(focus-test? *target* in-air)
|
|
)
|
|
(set-time! (-> self ride-timer))
|
|
)
|
|
(when (or (logtest? (-> self elevator-status) (elevator-status moving))
|
|
(time-elapsed? (-> self ride-timer) (seconds 0.5))
|
|
)
|
|
(cond
|
|
((and (logtest? (-> self params flags) (elevator-flags elevator-flags-1))
|
|
(!= (-> self move-pos 1) (-> self params start-pos))
|
|
)
|
|
(set! (-> self move-pos 0) (-> self move-pos 1))
|
|
(set! (-> self move-pos 1) (-> self params start-pos))
|
|
(go-virtual running)
|
|
)
|
|
(else
|
|
(go-virtual waiting)
|
|
)
|
|
)
|
|
)
|
|
(plat-trans)
|
|
)
|
|
:code sleep-code
|
|
:post plat-post
|
|
)
|
|
|
|
(defmethod calc-dist-between-points! ((this elevator) (path-point-x int) (path-point-y int))
|
|
"Calculates the distance between two points in the elevator's path.
|
|
|
|
@param path-point-x The index of the first point in the distance calculation, and where `next-pos` and `dist` are stored in the `path-seq` array
|
|
@param path-point-y The second point in the distance calculation"
|
|
(set! (-> this path-seq data path-point-x next-pos) (the float path-point-y))
|
|
(let ((point-x (get-point-in-path! (-> this path) (new 'stack-no-clear 'vector) (the float path-point-x) 'interp))
|
|
(point-y (get-point-in-path! (-> this path) (new 'stack-no-clear 'vector) (the float path-point-y) 'interp))
|
|
)
|
|
(set! (-> this path-seq data path-point-x dist) (vector-vector-distance point-x point-y))
|
|
)
|
|
0
|
|
(none)
|
|
)
|
|
|
|
(defmethod set-ambient-sound! ((this elevator))
|
|
"Sets the elevator's [[ambient-sound]] up"
|
|
(set! (-> this sound) (the-as ambient-sound 0))
|
|
0
|
|
(none)
|
|
)
|
|
|
|
(defmethod init-plat! ((this elevator))
|
|
"Does any necessary initial platform setup.
|
|
For example for an elevator pre-compute the distance between the first and last points (both ways) and clear the sound."
|
|
0
|
|
(none)
|
|
)
|
|
|
|
(defmethod relocate ((this elevator) (arg0 int))
|
|
(if (nonzero? (-> this path-seq))
|
|
(&+! (-> this path-seq) arg0)
|
|
)
|
|
(call-parent-method this arg0)
|
|
)
|
|
|
|
(defmethod activate-elevator ((this elevator))
|
|
"Puts the elevator initially into the correct state. This is typically based upon game completion"
|
|
(if (logtest? (-> this params flags) (elevator-flags elevator-flags-6))
|
|
(go (method-of-object this arrived))
|
|
(go (method-of-object this waiting))
|
|
)
|
|
)
|
|
|
|
;; WARN: Return type mismatch object vs none.
|
|
(defmethod init-from-entity! ((this elevator) (entity entity-actor))
|
|
"Typically the method that does the initial setup on the process, potentially using the [[entity-actor]] provided as part of that.
|
|
This commonly includes things such as:
|
|
- stack size
|
|
- collision information
|
|
- loading the skeleton group / bones
|
|
- sounds"
|
|
(local-vars (sv-32 float) (sv-36 path-control) (sv-40 target))
|
|
(init-plat-collision! this)
|
|
(process-drawable-from-entity! this entity)
|
|
(initialize-skeleton this (the-as skeleton-group (get-art-group this)) (the-as pair 0))
|
|
(stop-bouncing! this)
|
|
(set! (-> this elevator-status) (elevator-status))
|
|
(update-transforms (-> this root))
|
|
(base-plat-method-32 this)
|
|
(init-defaults! this)
|
|
(set! (-> this on-activate) (res-lump-struct (-> this entity) 'on-activate pair))
|
|
(set! (-> this on-deactivate) (res-lump-struct (-> this entity) 'on-deactivate pair))
|
|
(set! (-> this path) (new 'process 'path-control this 'path 0.0 entity #f))
|
|
(if (logtest? (-> this path flags) (path-control-flag not-found))
|
|
(go process-drawable-art-error "error in path")
|
|
)
|
|
(logior! (-> this path flags) (path-control-flag display draw-line draw-point draw-text))
|
|
(let ((num-path-points (-> this path curve num-cverts))
|
|
(s4-1 0)
|
|
(f30-0 0.0)
|
|
(f28-0 0.0)
|
|
)
|
|
(set! (-> this path-seq) (new 'process 'path-step-inline-array num-path-points))
|
|
(dotimes (path-point-idx num-path-points)
|
|
(calc-dist-between-points! this path-point-idx (mod (+ path-point-idx 1) num-path-points))
|
|
(let ((v1-31 (get-point-in-path! (-> this path) (new 'stack-no-clear 'vector) (the float path-point-idx) 'interp)))
|
|
(when (or (not (logtest? s4-1 1)) (< (-> v1-31 y) f28-0))
|
|
(set! (-> this bottom-top 0) (the float path-point-idx))
|
|
(set! f28-0 (-> v1-31 y))
|
|
(set! s4-1 (logior s4-1 1))
|
|
)
|
|
(when (or (not (logtest? s4-1 2)) (< f30-0 (-> v1-31 y)))
|
|
(set! (-> this bottom-top 1) (the float path-point-idx))
|
|
(set! f30-0 (-> v1-31 y))
|
|
(set! s4-1 (logior s4-1 2))
|
|
)
|
|
)
|
|
)
|
|
)
|
|
(set! sv-32 (the-as float 0.0))
|
|
(set! sv-36 (-> this path))
|
|
(let ((s5-2 *target*))
|
|
(set! sv-40 (if (type? s5-2 process-focusable)
|
|
s5-2
|
|
)
|
|
)
|
|
)
|
|
(if (not (and sv-40
|
|
(logtest? (-> this params flags) (elevator-flags elevator-flags-4))
|
|
(find-closest-point-in-path! this (get-trans sv-40 0) (& sv-32) #f #t)
|
|
)
|
|
)
|
|
(set! sv-32 (-> this params start-pos))
|
|
)
|
|
(set! (-> this move-pos 0) sv-32)
|
|
(set! (-> this move-pos 1) sv-32)
|
|
(get-point-in-path! sv-36 (-> this basetrans) sv-32 'interp)
|
|
(set! (-> this root pause-adjust-distance)
|
|
(+ 122880.0 (-> this params xz-threshold) (total-distance (-> this path)))
|
|
)
|
|
(set-ambient-sound! this)
|
|
(init-plat! this)
|
|
(activate-elevator this)
|
|
(none)
|
|
)
|