Archive/jak-project
1
0
Fork 0
mirror of https://github.com/open-goal/jak-project.git synced 2024-10-20 21:27:52 -04:00
Code Issues Actions 3 Packages Projects Releases Wiki Activity
jak-project/goal_src/jak2/engine/common_objs/elevator.gc
water111 029983270e
[decomp] target cleanup (#2021) 
everything up to collide-reaction-target (which is mostly done, but
could use a few more names)

Fixes issues with gun-part and target-part
2022-11-13 19:09:34 -05:00

869 lines
32 KiB
Common Lisp
Raw Blame History

;;-*-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
;; +++elevator-status
(defenum elevator-status
:type uint64
:bitfield #t
(elevator-status-0)
(elevator-status-1)
(moving)
)
;; ---elevator-status
;; DECOMP BEGINS
(deftype elevator-params (structure)
((xz-threshold float :offset-assert 0)
(y-threshold float :offset-assert 4)
(start-pos float :offset-assert 8)
(move-rate float :offset-assert 12)
(flags elevator-flags :offset-assert 16)
)
:method-count-assert 9
:size-assert #x18
:flag-assert #x900000018
)
(deftype path-step (structure)
((next-pos float :offset-assert 0)
(dist float :offset-assert 4)
)
:method-count-assert 9
:size-assert #x8
:flag-assert #x900000008
)
(deftype path-step-inline-array (inline-array-class)
((data path-step :inline :dynamic :offset-assert 16)
)
:method-count-assert 9
:size-assert #x10
:flag-assert #x900000010
)
(set! (-> path-step-inline-array heap-base) (the-as uint 16))
(deftype elevator (base-plat)
((params elevator-params :inline :offset-assert 272)
(path-seq path-step-inline-array :offset-assert 296)
(path-dest float :offset-assert 300)
(bottom-top float 2 :offset-assert 304)
(move-pos float 2 :offset-assert 312)
(move-dist float :offset-assert 320)
(path-pos float :offset-assert 324)
(path-eased-pos float :offset-assert 328)
(ride-timer uint64 :offset-assert 336)
(sticky-player-last-ride-time time-frame :offset-assert 344)
(elevator-status elevator-status :offset-assert 352)
(on-activate basic :offset-assert 360)
(on-deactivate basic :offset-assert 364)
)
:heap-base #xf0
:method-count-assert 49
:size-assert #x170
:flag-assert #x3100f00170
(:methods
(dormant () _type_ :state 34)
(waiting () _type_ :state 35)
(running () _type_ :state 36)
(arrived () _type_ :state 37)
(elevator-method-38 (_type_) none 38)
(calc-dist-between-points! (_type_ int int) none 39)
(elevator-method-40 (_type_) object 40)
(init-defaults! (_type_) none 41)
(clear-ambient-sound! (_type_) none 42)
(elevator-method-43 (_type_ vector float float) symbol 43)
(elevator-method-44 (_type_) symbol 44)
(elevator-method-45 (_type_) symbol 45)
(move-to-next-point! (_type_) none 46)
(find-closest-point-in-path! (_type_ vector path-step symbol symbol) symbol 47)
(elevator-method-48 (_type_) none 48)
)
)
(defmethod elevator-method-43 elevator ((obj elevator) (arg0 vector) (arg1 float) (arg2 float))
#f
)
(defmethod elevator-method-48 elevator ((obj 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))
(set! (-> s5-0 start-pos y) (+ 8192.0 (-> s5-0 start-pos y)))
(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! elevator ((obj elevator))
"Initializes default settings related to the [[elevator]]:
- `elevator-xz-threshold`
- `elevator-y-threshold`
- `elevator-start-pos`
- `elevator-move-rate`
- `elevator-flags`"
(let ((entity (-> obj entity)))
(set! (-> obj 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 (-> obj entity))
(set! (-> obj 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 (-> obj entity))
(set! (-> obj 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 (-> obj entity))
(set! (-> obj 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 (-> obj entity))
(set! (-> obj 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: Return type mismatch none vs object.
;; WARN: rewrite_to_get_var got a none typed variable. Is there unreachable code? [OP: 18]
;; WARN: rewrite_to_get_var got a none typed variable. Is there unreachable code? [OP: 119]
;; WARN: rewrite_to_get_var got a none typed variable. Is there unreachable code? [OP: 209]
;; WARN: rewrite_to_get_var got a none typed variable. Is there unreachable code? [OP: 222]
;; WARN: rewrite_to_get_var got a none typed variable. Is there unreachable code? [OP: 236]
;; WARN: rewrite_to_get_var got a none typed variable. Is there unreachable code? [OP: 246]
;; WARN: rewrite_to_get_var got a none typed variable. Is there unreachable code? [OP: 257]
;; WARN: rewrite_to_get_var got a none typed variable. Is there unreachable code? [OP: 264]
;; WARN: rewrite_to_get_var got a none typed variable. Is there unreachable code? [OP: 276]
;; WARN: rewrite_to_get_var got a none typed variable. Is there unreachable code? [OP: 301]
;; WARN: rewrite_to_get_var got a none typed variable. Is there unreachable code? [OP: 326]
;; WARN: rewrite_to_get_var got a none typed variable. Is there unreachable code? [OP: 334]
;; WARN: rewrite_to_get_var got a none typed variable. Is there unreachable code? [OP: 337]
;; WARN: rewrite_to_get_var got a none typed variable. Is there unreachable code? [OP: 174]
;; WARN: rewrite_to_get_var got a none typed variable. Is there unreachable code? [OP: 40]
;; 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))
(let ((evt-type event-type))
(the-as
object
(cond
((= evt-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))
)
)
((= evt-type 'ridden)
(let ((proc-focus (handle->process (-> (the-as focus (-> event param 0)) handle))))
(if (= (-> proc-focus type) target)
(set! (-> self sticky-player-last-ride-time) (-> self clock frame-counter))
)
)
#t
)
((= evt-type 'use-camera)
(if (-> event param 0)
(set-setting! 'entity-name (-> event param 0) 0 0)
(remove-setting! 'entity-name)
)
)
((= evt-type '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)
)
)
((= evt-type '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)
)
((= evt-type '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)
)
)
((= evt-type '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) (-> self clock frame-counter))
)
(('point-inside-shaft?)
(elevator-method-43 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)
)
)
)
)
((= evt-type 'go-dormant)
(go-virtual dormant)
)
(else
(plat-event proc arg1 event-type event)
)
)
)
)
)
(defmethod find-closest-point-in-path! elevator ((obj elevator) (arg0 vector) (arg1 path-step) (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 (-> obj params))
(smallest-dist 0.0)
(point-idx-tracker -1.0)
)
(dotimes (path-vertex-idx (-> obj path curve num-cverts))
(set! path-point
(get-point-in-path! (-> obj 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 (-> obj bottom-top 0))) (< (-> arg0 y) (-> path-point y)))
(and (= path-vertex-idx (the int (-> obj 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 next-pos) point-idx-tracker)
#t
)
)
)
;; WARN: Return type mismatch object vs symbol.
(defmethod elevator-method-44 elevator ((obj elevator))
(let* ((target-temp *target*)
(target (if (type? target-temp process-focusable)
target-temp
)
)
)
(the-as
symbol
(and target (elevator-method-43 obj (get-trans target 0) (-> obj move-pos 0) (-> obj move-pos 1)))
)
)
)
(defmethod elevator-method-45 elevator ((obj elevator))
"@returns Stub, or always returns [[#t]]"
#t
)
(defmethod move-to-next-point! elevator ((obj 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
(zero? (logand (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! obj (get-trans target 0) (new 'stack-no-clear 'path-step) #t #t)
(!= (-> obj move-pos 1) zero)
)
(set! (-> obj move-pos 0) (-> obj move-pos 1))
(set! (-> obj move-pos 1) zero)
(logior! (-> obj elevator-status) (elevator-status moving))
(go (method-of-object obj 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-override trans))
(update! (-> self sound))
)
(plat-post)
(none)
)
(defstate dormant (elevator)
:virtual #t
:event (behavior ((proc process) (arg1 int) (event-type symbol) (event event-message-block))
(case event-type
(('trigger)
(go-virtual waiting)
)
(('bonk)
#f
)
(else
(plat-event proc arg1 event-type event)
)
)
)
:trans (the-as (function none :behavior elevator) plat-trans)
:code (the-as (function none :behavior elevator) sleep-code)
:post (the-as (function none :behavior elevator) plat-post)
)
(defstate waiting (elevator)
:virtual #t
:event (behavior ((proc process) (arg1 int) (event-type symbol) (event event-message-block))
(case event-type
(('ridden)
(if (elevator-method-45 self)
(logior! (-> self elevator-status) (elevator-status elevator-status-0))
)
(elevator-event proc arg1 event-type event)
)
(else
(elevator-event proc arg1 event-type event)
)
)
)
:enter (behavior ()
(set! (-> self ride-timer) (the-as uint (-> self clock frame-counter)))
(logclear! (-> self elevator-status) (elevator-status elevator-status-0 moving))
(logior! (-> self mask) (process-mask actor-pause))
(if (nonzero? (-> self sound))
(update-vol! (-> self sound) 0.0)
)
(none)
)
:trans (behavior ()
(plat-trans)
(when (not (logtest? (-> self elevator-status) (elevator-status elevator-status-0)))
(set! (-> self ride-timer) (the-as uint (-> self clock frame-counter)))
(-> self params)
(if (and (logtest? (-> self params flags) (elevator-flags elevator-flags-0))
(zero? (logand (-> 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)))
(>= (- (-> self clock frame-counter) (the-as int (-> 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)
)
(none)
)
:code (the-as (function none :behavior elevator) sleep-code)
:post (behavior ()
(logclear! (-> self elevator-status) (elevator-status elevator-status-0))
(debug-draw (-> self path))
(plat-post)
(none)
)
)
(defstate running (elevator)
:virtual #t
:event (behavior ((proc process) (arg1 int) (event-type symbol) (event event-message-block))
(case event-type
(('running?)
#t
)
(('player-ridden?)
(logtest? (-> self elevator-status) (elevator-status elevator-status-0))
)
(else
(elevator-event proc arg1 event-type event)
)
)
)
: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 elevator-status-1))
(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)
(let ((gp-0 (-> self on-activate)))
(if gp-0
(eval!
(new
'stack
'script-context
(the-as basic (* (the int (-> self move-pos 0)) 8))
self
(-> self root-override trans)
)
(the-as pair gp-0)
)
)
)
(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)
(apply-settings *setting-control*)
)
(none)
)
: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)
)
(none)
)
:trans (behavior ()
(if (and (not (logtest? (-> self elevator-status) (elevator-status elevator-status-1)))
(= (-> 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)
(none)
)
:code (behavior ()
(logior! (-> self elevator-status) (elevator-status elevator-status-1))
(until #f
(suspend)
(if (= (-> self path-pos) 1.0)
(logclear! (-> self elevator-status) (elevator-status elevator-status-1))
)
)
#f
(none)
)
:post (behavior ()
(when (logtest? (-> self elevator-status) (elevator-status elevator-status-1))
(seek!
(-> self path-pos)
(-> self path-dest)
(* (/ (-> self params move-rate) (-> self move-dist)) (-> self clock 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)
(none)
)
)
(defstate arrived (elevator)
:virtual #t
:event (behavior ((proc process) (arg1 int) (event-type symbol) (event event-message-block))
(case event-type
(('ridden)
(set! (-> self ride-timer) (the-as uint (-> self clock frame-counter)))
(elevator-event proc arg1 event-type event)
)
(else
(elevator-event proc arg1 event-type event)
)
)
)
:enter (behavior ()
(set! (-> self ride-timer) (the-as uint (-> self clock frame-counter)))
(if (not (-> *setting-control* user-current jump))
(remove-setting! 'jump)
)
(let ((gp-0 (-> self on-deactivate)))
(if gp-0
(eval!
(new
'stack
'script-context
(the-as basic (* (the int (-> self move-pos 1)) 8))
self
(-> self root-override trans)
)
(the-as pair gp-0)
)
)
)
(none)
)
:trans (behavior ()
(if (and (< (the-as int (- (-> self ride-timer) (the-as uint (-> self sticky-player-last-ride-time)))) 600)
(begin *target* *target*)
(logtest? (-> *target* focus-status) (focus-status in-air))
)
(set! (-> self ride-timer) (the-as uint (-> self clock frame-counter)))
)
(when (or (logtest? (-> self elevator-status) (elevator-status moving))
(>= (- (-> self clock frame-counter) (the-as int (-> 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)
(none)
)
:code (the-as (function none :behavior elevator) sleep-code)
:post (the-as (function none :behavior elevator) plat-post)
)
(defmethod calc-dist-between-points! elevator ((obj 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! (-> obj path-seq data path-point-x next-pos) (the float path-point-y))
(let ((point-x (get-point-in-path! (-> obj path) (new 'stack-no-clear 'vector) (the float path-point-x) 'interp))
(point-y (get-point-in-path! (-> obj path) (new 'stack-no-clear 'vector) (the float path-point-y) 'interp))
)
(set! (-> obj path-seq data path-point-x dist) (vector-vector-distance point-x point-y))
)
0
(none)
)
(defmethod clear-ambient-sound! elevator ((obj elevator))
"Might be a virtual function, but clears the object's [[ambient-sound]]"
(set! (-> obj sound) (the-as ambient-sound 0))
0
(none)
)
(defmethod base-plat-method-33 elevator ((obj elevator))
0
(none)
)
;; WARN: Return type mismatch base-plat vs elevator.
(defmethod relocate elevator ((obj elevator) (arg0 int))
(if (nonzero? (-> obj path-seq))
(&+! (-> obj path-seq) arg0)
)
(the-as elevator ((the-as (function base-plat int base-plat) (find-parent-method elevator 7)) obj arg0))
)
(defmethod elevator-method-40 elevator ((obj elevator))
"TODO - need to figure out some flags to be confident about this"
(if (logtest? (-> obj params flags) (elevator-flags elevator-flags-6))
(go (method-of-object obj arrived))
(go (method-of-object obj waiting))
)
)
;; WARN: Return type mismatch object vs none.
(defmethod init-from-entity! elevator ((obj elevator) (entity entity-actor))
(local-vars (sv-32 float) (sv-36 path-control) (sv-40 target))
(base-plat-method-31 obj)
(process-drawable-from-entity! obj entity)
(initialize-skeleton obj (the-as skeleton-group (get-art-group obj)) (the-as pair 0))
(stop-bouncing! obj)
(set! (-> obj elevator-status) (elevator-status))
(update-transforms (-> obj root-override))
(base-plat-method-32 obj)
(init-defaults! obj)
(set! (-> obj on-activate) (res-lump-struct (-> obj entity) 'on-activate basic))
(set! (-> obj on-deactivate) (res-lump-struct (-> obj entity) 'on-deactivate basic))
(set! (-> obj path) (new 'process 'path-control obj 'path 0.0 entity #f))
(if (logtest? (-> obj path flags) (path-control-flag not-found))
(go process-drawable-art-error "error in path")
)
(logior! (-> obj path flags) (path-control-flag display draw-line draw-point draw-text))
(let ((num-path-points (-> obj path curve num-cverts))
(s4-1 0)
(f30-0 0.0)
(f28-0 0.0)
)
(set! (-> obj path-seq) (new 'process 'path-step-inline-array num-path-points))
(dotimes (path-point-idx num-path-points)
(calc-dist-between-points! obj path-point-idx (mod (+ path-point-idx 1) num-path-points))
(let ((v1-31 (get-point-in-path! (-> obj 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! (-> obj 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! (-> obj 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 (-> obj path))
(let ((s5-2 *target*))
(set! sv-40 (if (type? s5-2 process-focusable)
s5-2
)
)
)
(if (not (and sv-40
(logtest? (-> obj params flags) (elevator-flags elevator-flags-4))
(find-closest-point-in-path! obj (get-trans sv-40 0) (the-as path-step (& sv-32)) #f #t)
)
)
(set! sv-32 (-> obj params start-pos))
)
(set! (-> obj move-pos 0) sv-32)
(set! (-> obj move-pos 1) sv-32)
(get-point-in-path! sv-36 (-> obj basetrans) sv-32 'interp)
(set! (-> obj root-override pause-adjust-distance)
(+ 122880.0 (-> obj params xz-threshold) (total-distance (-> obj path)))
)
(clear-ambient-sound! obj)
(base-plat-method-33 obj)
(elevator-method-40 obj)
(none)
)
Reference in a new issue View git blame Copy permalink