d/jak2: fix elevator issues and cleanup script-context new method (#2304)

This fixes the issue where elevators leave you behind (stack structure
related)

At the same time I cleaned up some things I found along the way, most
notably changing `script-context`'s `basic` field to `object` as
non-basics use this method as well.

Fixes #2305
This commit is contained in:
Tyler Wilding
2023-03-09 20:03:43 -05:00
committed by GitHub
parent 2f6bfd2e64
commit 021bae08ec
95 changed files with 493 additions and 566 deletions
+5 -5
View File
@@ -1968,7 +1968,7 @@ This commonly includes things such as:
(let ((s5-1 (-> obj on-death)))
(if s5-1
(eval!
(new 'stack 'script-context (the-as basic (process->ppointer pp)) pp (-> obj root-override2 trans))
(new 'stack 'script-context (process->ppointer pp) pp (-> obj root-override2 trans))
(the-as pair s5-1)
)
)
@@ -2013,7 +2013,7 @@ This commonly includes things such as:
(let ((s5-3 (-> obj on-death)))
(if s5-3
(eval!
(new 'stack 'script-context (the-as basic (process->ppointer pp)) pp (-> obj root-override2 trans))
(new 'stack 'script-context (process->ppointer pp) pp (-> obj root-override2 trans))
(the-as pair s5-3)
)
)
@@ -2457,7 +2457,7 @@ This commonly includes things such as:
(let ((gp-0 (-> self on-active)))
(if gp-0
(eval!
(new 'stack 'script-context (the-as basic (process->ppointer self)) self (-> self root-override2 trans))
(new 'stack 'script-context (process->ppointer self) self (-> self root-override2 trans))
(the-as pair gp-0)
)
)
@@ -2514,7 +2514,7 @@ This commonly includes things such as:
(let ((gp-0 (-> self on-notice)))
(if gp-0
(eval!
(new 'stack 'script-context (the-as basic (process->ppointer self)) self (-> self root-override2 trans))
(new 'stack 'script-context (process->ppointer self) self (-> self root-override2 trans))
(the-as pair gp-0)
)
)
@@ -2582,7 +2582,7 @@ This commonly includes things such as:
(let ((gp-0 (-> self on-hostile)))
(if gp-0
(eval!
(new 'stack 'script-context (the-as basic (process->ppointer self)) self (-> self root-override2 trans))
(new 'stack 'script-context (process->ppointer self) self (-> self root-override2 trans))
(the-as pair gp-0)
)
)
+3 -3
View File
@@ -427,9 +427,9 @@
)
)
(eval!
(new 'stack 'script-context (the-as basic (process->ppointer self)) self (if v1-5
(-> v1-5 root trans)
)
(new 'stack 'script-context (process->ppointer self) self (if v1-5
(-> v1-5 root trans)
)
)
gp-0
)
+1 -1
View File
@@ -188,7 +188,7 @@
(let ((activation-script (res-lump-struct (-> self entity) 'on-activate structure)))
(if activation-script
(eval!
(new 'stack 'script-context (the-as basic (process->ppointer self)) self (the-as vector #f))
(new 'stack 'script-context (process->ppointer self) self (the-as vector #f))
(the-as pair activation-script)
)
)
+15 -30
View File
@@ -92,8 +92,8 @@
(ride-timer time-frame :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)
(on-activate pair :offset-assert 360)
(on-deactivate pair :offset-assert 364)
)
:heap-base #xf0
:method-count-assert 49
@@ -106,14 +106,14 @@
(arrived () _type_ :state 37)
(elevator-method-38 (_type_) none 38)
(calc-dist-between-points! (_type_ int int) none 39)
(activate-elevator (_type_) none 40)
(activate-elevator (_type_) object 40)
(init-defaults! (_type_) none 41)
(set-ambient-sound! (_type_) none 42)
(move-between-points (_type_ vector float float) symbol 43)
(elevator-method-44 (_type_) symbol 44)
(commited-to-ride? (_type_) symbol 45)
(move-to-next-point! (_type_) none 46)
(find-closest-point-in-path! (_type_ vector path-step symbol symbol) symbol 47)
(find-closest-point-in-path! (_type_ vector (pointer float) symbol symbol) symbol 47)
(elevator-method-48 (_type_) none 48)
)
)
@@ -451,7 +451,7 @@ which is obviously useful for an elevator."
;; definition for method 47 of type elevator
;; INFO: Used lq/sq
(defmethod find-closest-point-in-path! elevator ((obj elevator) (arg0 vector) (arg1 path-step) (arg2 symbol) (arg3 symbol))
(defmethod find-closest-point-in-path! elevator ((obj 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]]
@@ -488,7 +488,7 @@ the provided [[vector]]
)
)
(when (!= point-idx-tracker -1.0)
(set! (-> arg1 next-pos) point-idx-tracker)
(set! (-> arg1 0) point-idx-tracker)
#t
)
)
@@ -537,9 +537,7 @@ do so.
)
)
(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)
)
(when (and (find-closest-point-in-path! obj (get-trans target 0) (& zero) #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))
@@ -681,14 +679,8 @@ do so.
(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)
(new 'stack 'script-context (* (the int (-> self move-pos 0)) 8) self (-> self root-override trans))
gp-0
)
)
)
@@ -780,14 +772,8 @@ do so.
(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)
(new 'stack 'script-context (* (the int (-> self move-pos 1)) 8) self (-> self root-override trans))
gp-0
)
)
)
@@ -868,14 +854,12 @@ For example for an elevator pre-compute the distance between the first and last
)
;; definition for method 40 of type elevator
;; WARN: Return type mismatch object vs none.
(defmethod activate-elevator elevator ((obj elevator))
"Puts the elevator initially into the correct state. This is typically based upon game completion"
(if (logtest? (-> obj params flags) (elevator-flags elevator-flags-6))
(go (method-of-object obj arrived))
(go (method-of-object obj waiting))
)
(none)
)
;; definition for method 11 of type elevator
@@ -894,6 +878,7 @@ For example for an elevator pre-compute the distance between the first and last
;; WARN: Stack slot offset 32 signed mismatch
;; WARN: Stack slot offset 32 signed mismatch
;; WARN: Stack slot offset 32 signed mismatch
;; WARN: Return type mismatch object vs none.
(defmethod init-from-entity! elevator ((obj 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:
@@ -910,8 +895,8 @@ This commonly includes things such as:
(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 on-activate) (res-lump-struct (-> obj entity) 'on-activate pair))
(set! (-> obj on-deactivate) (res-lump-struct (-> obj entity) 'on-deactivate pair))
(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")
@@ -949,7 +934,7 @@ This commonly includes things such as:
)
(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)
(find-closest-point-in-path! obj (get-trans sv-40 0) (& sv-32) #f #t)
)
)
(set! sv-32 (-> obj params start-pos))
+10 -12
View File
@@ -1544,18 +1544,16 @@
(set! (-> arg0 handle) (the-as handle #f))
(set! (-> arg0 depth) 0.0)
(let ((s2-0 (the-as object (-> arg1 region on-inside))))
(set! s2-0 (cond
((= (the-as symbol (-> (the-as pair s2-0) car)) 'water)
(empty)
s2-0
)
(else
(eval!
(new 'stack 'script-context (the-as basic (process->ppointer pp)) pp (the-as vector #f))
(the-as pair s2-0)
)
)
)
(set! s2-0
(cond
((= (the-as symbol (-> (the-as pair s2-0) car)) 'water)
(empty)
s2-0
)
(else
(eval! (new 'stack 'script-context (process->ppointer pp) pp (the-as vector #f)) (the-as pair s2-0))
)
)
)
(let ((a0-4 (-> arg2 root-prim)))
(when s2-0
+11 -15
View File
@@ -313,22 +313,18 @@
(return #f)
)
((= arg0 'script)
(let ((gp-1
(get-property-struct
(-> obj res)
'effect-script
'exact
arg1
(the-as structure #f)
(the-as (pointer res-tag) #f)
*res-static-buf*
)
)
(let ((gp-1 (get-property-struct
(-> obj res)
'effect-script
'exact
arg1
(the-as structure #f)
(the-as (pointer res-tag) #f)
*res-static-buf*
)
)
)
(eval!
(new 'stack 'script-context (the-as basic (process->ppointer pp)) pp (the-as vector #f))
(the-as pair gp-1)
)
(eval! (new 'stack 'script-context (process->ppointer pp) pp (the-as vector #f)) (the-as pair gp-1))
)
(return #f)
)
+2 -2
View File
@@ -2243,7 +2243,7 @@
)
(let ((gp-3 (-> self info on-complete)))
(if gp-3
(eval! (new 'stack 'script-context (the-as basic (process->ppointer self)) self (the-as vector #f)) gp-3)
(eval! (new 'stack 'script-context (process->ppointer self) self (the-as vector #f)) gp-3)
)
)
(task-node-close! (-> self info final-node))
@@ -2277,7 +2277,7 @@
)
(let ((gp-1 (-> self info on-fail)))
(if gp-1
(eval! (new 'stack 'script-context (the-as basic (process->ppointer self)) self (the-as vector #f)) gp-1)
(eval! (new 'stack 'script-context (process->ppointer self) self (the-as vector #f)) gp-1)
)
)
(let ((a0-10 (-> self info retry-continue))
+3 -3
View File
@@ -609,7 +609,7 @@ otherwise, add the [[drawable-region-sphere]] to `region-start-prim-list` and in
(new
'stack
'script-context
(the-as basic a2-5)
a2-5
pp
(-> (the-as region-prim-area (+ (* gp-2 4) #x70000000)) region-enter-prim-list 0 bsphere)
)
@@ -635,7 +635,7 @@ otherwise, add the [[drawable-region-sphere]] to `region-start-prim-list` and in
(new
'stack
'script-context
(the-as basic a2-6)
a2-6
pp
(-> (the-as region-prim-area (+ (* gp-3 4) #x70000000)) region-exit-prim-list 0 bsphere)
)
@@ -654,7 +654,7 @@ otherwise, add the [[drawable-region-sphere]] to `region-start-prim-list` and in
(new
'stack
'script-context
(the-as basic a2-7)
a2-7
pp
(-> (the-as region-prim-area (+ (* gp-4 4) #x70000000)) region-inside-prim-list 0 bsphere)
)
+2 -13
View File
@@ -149,18 +149,7 @@
;; definition for method 21 of type load-state
;; WARN: Return type mismatch int vs none.
;; WARN: Failed store: (s.w! (+ v1-22 12) a0-5) at op 48
;; WARN: Failed store: (s.w! (+ a1-4 12) v1-25) at op 56
;; WARN: Failed store: (s.w! (+ a1-8 12) v1-28) at op 64
;; WARN: Failed store: (s.w! (+ a1-12 12) v1-31) at op 72
;; WARN: Failed store: (s.w! (+ a2-4 12) a1-21) at op 97
;; WARN: Failed store: (s.w! (+ a2-8 12) a1-25) at op 109
;; WARN: Failed store: (s.w! (+ a1-31 12) #f) at op 114
;; WARN: Failed store: (s.w! (+ a1-35 12) #f) at op 119
;; WARN: Failed load: (set! a0-11 (l.wu (+ a0-10 12))) at op 138
;; WARN: Failed load: (set! a0-16 (l.wu (+ a0-15 12))) at op 146
;; WARN: Failed load: (set! a0-21 (l.wu (+ a0-20 12))) at op 154
;; WARN: Failed load: (set! a0-26 (l.wu (+ a0-25 12))) at op 162
;; ERROR: Failed store: (s.w! (+ v1-22 12) a0-5) at op 48
(defmethod add-borrow-levels load-state ((obj load-state))
(dotimes (s5-0 6)
(let ((a0-1 (-> obj want s5-0 name)))
@@ -319,7 +308,7 @@
;; WARN: Function (method 17 load-state) has a return type of none, but the expression builder found a return statement.
(defmethod execute-commands-up-to load-state ((obj load-state) (arg0 float))
(with-pp
(let ((s4-0 (new 'stack 'script-context (the-as basic (process->ppointer pp)) pp (the-as vector #f))))
(let ((s4-0 (new 'stack 'script-context (process->ppointer pp) pp (the-as vector #f))))
(set! (-> s4-0 load-state) obj)
(while (not (null? (-> obj command-list)))
(let ((f0-0 (command-get-float (car (car (-> obj command-list))) 0.0))
+2 -8
View File
@@ -214,14 +214,8 @@
(set-setting! 'allow-continue #t 0 0)
(set-setting! 'border-mode #t 0 0)
(apply-settings *setting-control*)
(eval!
(new 'stack 'script-context (the-as basic (process->ppointer self)) self (the-as vector #f))
'(teleport)
)
(eval!
(new 'stack 'script-context (the-as basic (process->ppointer self)) self (the-as vector #f))
(-> arg0 on-goto)
)
(eval! (new 'stack 'script-context (process->ppointer self) self (the-as vector #f)) '(teleport))
(eval! (new 'stack 'script-context (process->ppointer self) self (the-as vector #f)) (-> arg0 on-goto))
(set-setting! 'allow-continue #f 0 0)
(set-setting! 'border-mode #f 0 0)
(apply-settings *setting-control*)
+2 -5
View File
@@ -1185,10 +1185,7 @@
(set! (-> self rider) (process->handle *target*))
(let ((gp-2 (res-lump-struct (-> self entity) 'on-exit structure)))
(if (and gp-2 (not *scene-player*))
(eval!
(new 'stack 'script-context (the-as basic (process->ppointer self)) self (the-as vector #f))
(the-as pair gp-2)
)
(eval! (new 'stack 'script-context (process->ppointer self) self (the-as vector #f)) (the-as pair gp-2))
)
)
(go-virtual setup)
@@ -2275,7 +2272,7 @@
(case (-> arg0 event-type)
(('script)
(eval!
(new 'stack 'script-context (the-as basic (process->ppointer pp)) pp (the-as vector #f))
(new 'stack 'script-context (process->ppointer pp) pp (the-as vector #f))
(the-as pair (-> arg0 param))
)
)
+3 -3
View File
@@ -33,7 +33,7 @@
;; definition of type script-context
(deftype script-context (structure)
((load-state load-state :offset-assert 0)
(key basic :offset-assert 4)
(key object :offset-assert 4)
(process process :offset-assert 8)
(trans vector :offset-assert 12)
(side-effect? symbol :offset-assert 16)
@@ -47,7 +47,7 @@
:size-assert #xa0
:flag-assert #xc000000a0
(:methods
(new (symbol type basic process vector) _type_ 0)
(new (symbol type object process vector) _type_ 0)
(eval! (_type_ pair) object 9)
(script-context-method-10 (_type_ object pair) object 10)
(script-context-method-11 (_type_ pair pair symbol) symbol 11)
@@ -83,7 +83,7 @@
;; definition for method 0 of type script-context
;; WARN: Return type mismatch structure vs script-context.
(defmethod new script-context ((allocation symbol) (type-to-make type) (arg0 basic) (arg1 process) (arg2 vector))
(defmethod new script-context ((allocation symbol) (type-to-make type) (arg0 object) (arg1 process) (arg2 vector))
(let ((t9-0 (method-of-type structure new))
(v1-1 type-to-make)
)
+1 -1
View File
@@ -351,7 +351,7 @@
(with-pp
(cond
((eval!
(new 'stack 'script-context (the-as basic (process->ppointer pp)) pp (the-as vector #f))
(new 'stack 'script-context (process->ppointer pp) pp (the-as vector #f))
(res-lump-struct (-> obj entity) 'on-activate pair)
)
(cleanup-for-death obj)
-2
View File
@@ -163,14 +163,12 @@
)
;; definition for method 40 of type cpad-elevator
;; WARN: Return type mismatch object vs none.
(defmethod activate-elevator cpad-elevator ((obj cpad-elevator))
"Puts the elevator initially into the correct state. This is typically based upon game completion"
(if (task-node-closed? (game-task-node dig-knock-down-introduction))
(go (method-of-object obj arrived))
(go (method-of-object obj dormant))
)
(none)
)
;; definition for method 10 of type cpad-elevator
+17 -19
View File
@@ -519,25 +519,23 @@
*game-info*
61
4
(the-as
(function object)
(lambda :behavior task-manager
()
(send-event *traffic-manager* 'decrease-alert-level 0)
(send-event *traffic-manager* 'set-alert-duration 9000)
(send-event *target* 'end-mode)
(set-setting! 'pilot #f 0 0)
(set! (-> self state-time) (-> self clock frame-counter))
(while (< (- (-> self clock frame-counter) (-> self state-time)) (seconds 2))
(suspend)
)
(eval!
(new 'stack 'script-context (the-as basic (process->ppointer self)) self (the-as vector #f))
'(send-event "keira-npc-1" 'say)
)
(none)
)
)
(the-as (function object) (lambda :behavior task-manager
()
(send-event *traffic-manager* 'decrease-alert-level 0)
(send-event *traffic-manager* 'set-alert-duration 9000)
(send-event *target* 'end-mode)
(set-setting! 'pilot #f 0 0)
(set! (-> self state-time) (-> self clock frame-counter))
(while (< (- (-> self clock frame-counter) (-> self state-time)) (seconds 2))
(suspend)
)
(eval!
(new 'stack 'script-context (process->ppointer self) self (the-as vector #f))
'(send-event "keira-npc-1" 'say)
)
(none)
)
)
)
;; failed to figure out what this is:
@@ -308,7 +308,7 @@
(let ((gp-0 (-> self on-notice)))
(if gp-0
(eval!
(new 'stack 'script-context (the-as basic (process->ppointer self)) self (-> self root-override2 trans))
(new 'stack 'script-context (process->ppointer self) self (-> self root-override2 trans))
(the-as pair gp-0)
)
)
+1 -1
View File
@@ -369,7 +369,7 @@
(let ((gp-0 (-> self on-notice)))
(if gp-0
(eval!
(new 'stack 'script-context (the-as basic (process->ppointer self)) self (-> self root-override2 trans))
(new 'stack 'script-context (process->ppointer self) self (-> self root-override2 trans))
(the-as pair gp-0)
)
)
+1 -1
View File
@@ -2869,7 +2869,7 @@
)
)
(eval!
(new 'stack 'script-context (the-as basic (process->ppointer self)) self (the-as vector #f))
(new 'stack 'script-context (process->ppointer self) self (the-as vector #f))
'(birth-pickup ("pecker-npc-1" "head") skill FACT_SUPER_SKILL_INC flags (suck-in))
)
(task-node-close! (game-task-node city-play-onin-game-skill))
+1 -1
View File
@@ -1978,7 +1978,7 @@
(when (or (not v1-130) (!= (-> v1-130 display?) 'display))
(backup-load-state-and-set-cmds *load-state* '())
(eval!
(new 'stack 'script-context (the-as basic (process->ppointer self)) self (the-as vector #f))
(new 'stack 'script-context (process->ppointer self) self (the-as vector #f))
'(want-display 'ctyport 'display)
)
(restore-load-state-and-cleanup *load-state*)
+8 -26
View File
@@ -197,10 +197,7 @@
(when (and (< f30-0 0.0) (< 0.0 (-> obj last-distance)))
(let ((s5-1 (res-lump-struct (-> obj entity) 'on-cross structure)))
(if s5-1
(eval!
(new 'stack 'script-context (the-as basic (process->ppointer self)) self (the-as vector #f))
(the-as pair s5-1)
)
(eval! (new 'stack 'script-context (process->ppointer self) self (the-as vector #f)) (the-as pair s5-1))
)
)
)
@@ -253,7 +250,7 @@
(logtest? (-> a0-12 extra perm status) (entity-perm-status subtask-complete))
)
(and (eval!
(new 'stack 'script-context (the-as basic (process->ppointer self)) self (the-as vector #f))
(new 'stack 'script-context (process->ppointer self) self (the-as vector #f))
(the-as pair (-> obj open-test))
)
(-> *setting-control* user-current airlock)
@@ -282,7 +279,7 @@
(defmethod destination-loaded? com-airlock ((obj com-airlock) (arg0 symbol))
(with-pp
(let ((gp-1 (eval!
(new 'stack 'script-context (the-as basic (process->ppointer pp)) pp (the-as vector #f))
(new 'stack 'script-context (process->ppointer pp) pp (the-as vector #f))
(the-as pair (-> obj level-name))
)
)
@@ -522,10 +519,7 @@
(begin
(let ((gp-0 (res-lump-struct (-> self entity) 'on-activate structure)))
(if gp-0
(eval!
(new 'stack 'script-context (the-as basic (process->ppointer self)) self (the-as vector #f))
(the-as pair gp-0)
)
(eval! (new 'stack 'script-context (process->ppointer self) self (the-as vector #f)) (the-as pair gp-0))
)
)
(destination-loaded? self #f)
@@ -590,10 +584,7 @@
()
(let ((gp-0 (res-lump-struct (-> self entity) 'on-exit structure)))
(if (and gp-0 (not *scene-player*))
(eval!
(new 'stack 'script-context (the-as basic (process->ppointer self)) self (the-as vector #f))
(the-as pair gp-0)
)
(eval! (new 'stack 'script-context (process->ppointer self) self (the-as vector #f)) (the-as pair gp-0))
)
)
(the-as
@@ -602,10 +593,7 @@
(let ((gp-1 (res-lump-struct (-> self entity) 'on-inside structure)))
(set! (-> self were-behind?) #f)
(if (and gp-1 (not *scene-player*))
(eval!
(new 'stack 'script-context (the-as basic (process->ppointer self)) self (the-as vector #f))
(the-as pair gp-1)
)
(eval! (new 'stack 'script-context (process->ppointer self) self (the-as vector #f)) (the-as pair gp-1))
)
)
)
@@ -662,10 +650,7 @@
(when (< 0.0 (check-crossing-distance self (target-pos 0) #f))
(let ((gp-3 (res-lump-struct (-> self entity) 'on-deactivate structure)))
(if (and gp-3 (not *scene-player*))
(eval!
(new 'stack 'script-context (the-as basic (process->ppointer self)) self (the-as vector #f))
(the-as pair gp-3)
)
(eval! (new 'stack 'script-context (process->ppointer self) self (the-as vector #f)) (the-as pair gp-3))
)
)
)
@@ -800,10 +785,7 @@
(process-entity-status! self (entity-perm-status subtask-complete) #t)
(let ((s5-10 (res-lump-struct (-> self entity) 'on-enter structure)))
(if s5-10
(eval!
(new 'stack 'script-context (the-as basic (process->ppointer self)) self (the-as vector #f))
(the-as pair s5-10)
)
(eval! (new 'stack 'script-context (process->ppointer self) self (the-as vector #f)) (the-as pair s5-10))
)
)
(if (and (-> self sound-open)
+3 -12
View File
@@ -1564,10 +1564,7 @@
(set! (-> self state-time) (-> self clock frame-counter))
(let ((gp-0 (-> self on-notice)))
(if gp-0
(eval!
(new 'stack 'script-context (the-as basic (process->ppointer self)) self (-> self root trans))
(the-as pair gp-0)
)
(eval! (new 'stack 'script-context (process->ppointer self) self (-> self root trans)) (the-as pair gp-0))
)
)
(battle-method-47 self)
@@ -1704,10 +1701,7 @@
(battle-method-47 self)
(let ((gp-0 (-> self on-hostile)))
(if gp-0
(eval!
(new 'stack 'script-context (the-as basic (process->ppointer self)) self (-> self root trans))
(the-as pair gp-0)
)
(eval! (new 'stack 'script-context (process->ppointer self) self (-> self root trans)) (the-as pair gp-0))
)
)
(none)
@@ -1732,10 +1726,7 @@
(process-entity-status! self (entity-perm-status subtask-complete) #t)
(let ((gp-0 (-> self on-beaten)))
(if gp-0
(eval!
(new 'stack 'script-context (the-as basic (process->ppointer self)) self (-> self root trans))
(the-as pair gp-0)
)
(eval! (new 'stack 'script-context (process->ppointer self) self (-> self root trans)) (the-as pair gp-0))
)
)
(battle-method-48 self)
+2 -2
View File
@@ -329,7 +329,7 @@
(process-entity-status! self (entity-perm-status subtask-complete) #f)
(if (-> self on-start)
(eval!
(new 'stack 'script-context (the-as basic (process->ppointer self)) self (-> self root trans))
(new 'stack 'script-context (process->ppointer self) self (-> self root trans))
(the-as pair (-> self on-start))
)
)
@@ -712,7 +712,7 @@
(blocking-plane-destroy)
(if (-> self on-stop)
(eval!
(new 'stack 'script-context (the-as basic (process->ppointer self)) self (-> self root trans))
(new 'stack 'script-context (process->ppointer self) self (-> self root trans))
(the-as pair (-> self on-stop))
)
)
@@ -1708,7 +1708,7 @@
(let ((gp-1 (-> self on-notice)))
(if gp-1
(eval!
(new 'stack 'script-context (the-as basic (process->ppointer self)) self (-> self root-override2 trans))
(new 'stack 'script-context (process->ppointer self) self (-> self root-override2 trans))
(the-as pair gp-1)
)
)
+1 -1
View File
@@ -813,7 +813,7 @@
(let ((gp-0 (-> self on-notice)))
(if gp-0
(eval!
(new 'stack 'script-context (the-as basic (process->ppointer self)) self (-> self root-override2 trans))
(new 'stack 'script-context (process->ppointer self) self (-> self root-override2 trans))
(the-as pair gp-0)
)
)
+1 -10
View File
@@ -84,10 +84,7 @@
)
(let ((gp-1 (res-lump-struct (-> obj entity) 'on-notice structure)))
(not (if gp-1
(eval!
(new 'stack 'script-context (the-as basic (process->ppointer pp)) pp (the-as vector #f))
(the-as pair gp-1)
)
(eval! (new 'stack 'script-context (process->ppointer pp) pp (the-as vector #f)) (the-as pair gp-1))
)
)
)
@@ -190,7 +187,6 @@
)
;; definition for method 40 of type com-elevator
;; WARN: Return type mismatch object vs none.
(defmethod activate-elevator com-elevator ((obj com-elevator))
"Puts the elevator initially into the correct state. This is typically based upon game completion"
(cond
@@ -204,7 +200,6 @@
(go (method-of-object obj waiting))
)
)
(none)
)
;; definition for method 10 of type com-elevator
@@ -377,7 +372,3 @@ For example for an elevator pre-compute the distance between the first and last
(set! (-> obj sound-id) (new-sound-id))
(none)
)
+1 -1
View File
@@ -698,7 +698,7 @@
(let ((gp-0 (-> self on-notice)))
(if gp-0
(eval!
(new 'stack 'script-context (the-as basic (process->ppointer self)) self (-> self root-override2 trans))
(new 'stack 'script-context (process->ppointer self) self (-> self root-override2 trans))
(the-as pair gp-0)
)
)
+1 -1
View File
@@ -486,7 +486,7 @@
(let ((gp-0 (-> self on-notice)))
(if gp-0
(eval!
(new 'stack 'script-context (the-as basic (process->ppointer self)) self (-> self root-override2 trans))
(new 'stack 'script-context (process->ppointer self) self (-> self root-override2 trans))
(the-as pair gp-0)
)
)
+4 -18
View File
@@ -524,12 +524,7 @@
;; definition for method 25 of type warp-gate
(defmethod handle-notice warp-gate ((obj warp-gate))
(with-pp
(let ((s5-0 (eval!
(new 'stack 'script-context (the-as basic (process->ppointer pp)) pp (the-as vector #f))
(-> obj on-notice)
)
)
)
(let ((s5-0 (eval! (new 'stack 'script-context (process->ppointer pp) pp (the-as vector #f)) (-> obj on-notice))))
(cond
((= s5-0 'hide)
(logior! (-> obj draw status) (draw-control-status no-draw))
@@ -617,10 +612,7 @@
(if (and (cpad-pressed? 0 triangle) (process-grab? *target* #f))
(go-virtual use (-> self continue))
)
(eval!
(new 'stack 'script-context (the-as basic (process->ppointer self)) self (the-as vector #f))
(-> self on-close)
)
(eval! (new 'stack 'script-context (process->ppointer self) self (the-as vector #f)) (-> self on-close))
(let ((gp-0
(new 'stack 'font-context *font-default-matrix* 32 320 0.0 (font-color default) (font-flags shadow kerning))
)
@@ -717,10 +709,7 @@
(set! (-> s5-0 param 3) (the-as uint (process->handle self)))
(send-event-function *target* s5-0)
)
(eval!
(new 'stack 'script-context (the-as basic (process->ppointer self)) self (the-as vector #f))
(-> self on-activate)
)
(eval! (new 'stack 'script-context (process->ppointer self) self (the-as vector #f)) (-> self on-activate))
(while (begin
(set! v1-38 (when (-> self wait-for)
(let* ((s5-1 (-> self wait-for))
@@ -1355,10 +1344,7 @@ This commonly includes things such as:
(apply-settings *setting-control*)
(sound-stop (-> self hover-sound))
(set! (-> self hover-sound) (new 'static 'sound-id))
(eval!
(new 'stack 'script-context (the-as basic (process->ppointer self)) self (the-as vector #f))
(-> self on-activate)
)
(eval! (new 'stack 'script-context (process->ppointer self) self (the-as vector #f)) (-> self on-activate))
(sleep-code)
(none)
)
+1 -1
View File
@@ -824,7 +824,7 @@
(set! (-> *setting-control* user-default allow-timeout) #t)
(let ((gp-24 (demo-menu)))
(eval!
(new 'stack 'script-context (the-as basic (process->ppointer self)) self (the-as vector #f))
(new 'stack 'script-context (process->ppointer self) self (the-as vector #f))
'(fadeout (seconds (new 'static 'bfloat :data 0.3)))
)
(let ((s5-8 (-> self clock frame-counter)))
+1 -1
View File
@@ -1446,7 +1446,7 @@ This commonly includes things such as:
)
((>= 4 s5-0)
(eval!
(new 'stack 'script-context (the-as basic (process->ppointer pp)) pp (the-as vector #f))
(new 'stack 'script-context (process->ppointer pp) pp (the-as vector #f))
'(want-anim "dig-digger-explode")
)
)
+1 -4
View File
@@ -883,10 +883,7 @@ This commonly includes things such as:
(process-entity-status! self (entity-perm-status subtask-complete) #t)
(let ((gp-1 (res-lump-struct (-> self entity) 'on-activate structure)))
(if gp-1
(eval!
(new 'stack 'script-context (the-as basic (process->ppointer self)) self (the-as vector #f))
(the-as pair gp-1)
)
(eval! (new 'stack 'script-context (process->ppointer self) self (the-as vector #f)) (the-as pair gp-1))
)
)
(go-virtual idle-down)
+2 -8
View File
@@ -576,7 +576,6 @@ This commonly includes things such as:
((method-of-type elevator activate-elevator) obj)
(go (method-of-object obj dormant))
)
(none)
)
;; definition for method 33 of type drill-elevator
@@ -717,7 +716,7 @@ do so.
)
)
(set! sv-16 (the-as float 0.0))
(when (and (find-closest-point-in-path! obj (get-trans a0-1 0) (the-as path-step (& sv-16)) #t #t)
(when (and (find-closest-point-in-path! obj (get-trans a0-1 0) (& sv-16) #t #t)
(!= (-> obj move-pos 1) sv-16)
(= sv-16 (-> obj bottom-top 0))
)
@@ -751,11 +750,9 @@ For example for an elevator pre-compute the distance between the first and last
)
;; definition for method 40 of type drill-mech-elevator
;; WARN: Return type mismatch object vs none.
(defmethod activate-elevator drill-mech-elevator ((obj drill-mech-elevator))
"Puts the elevator initially into the correct state. This is typically based upon game completion"
(go (method-of-object obj waiting))
(none)
)
;; definition of type fire-floor
@@ -1392,10 +1389,7 @@ This commonly includes things such as:
(send-event! self (-> self event-down))
(let ((gp-0 (res-lump-struct (-> self entity) 'on-activate structure)))
(if gp-0
(eval!
(new 'stack 'script-context (the-as basic (process->ppointer self)) self (the-as vector #f))
(the-as pair gp-0)
)
(eval! (new 'stack 'script-context (process->ppointer self) self (the-as vector #f)) (the-as pair gp-0))
)
)
(go-virtual down-idle)
+1 -5
View File
@@ -658,7 +658,7 @@ This commonly includes things such as:
)
((< f0-0 163840.0)
(eval!
(new 'stack 'script-context (the-as basic (process->ppointer self)) self (the-as vector #f))
(new 'stack 'script-context (process->ppointer self) self (the-as vector #f))
'(want-anim "city-protect-slums-intro")
)
)
@@ -669,7 +669,3 @@ This commonly includes things such as:
)
)
)
+1 -1
View File
@@ -602,7 +602,7 @@
(let ((gp-0 (-> self on-hostile)))
(if gp-0
(eval!
(new 'stack 'script-context (the-as basic (process->ppointer self)) self (-> self root-override2 trans))
(new 'stack 'script-context (process->ppointer self) self (-> self root-override2 trans))
(the-as pair gp-0)
)
)
+1 -1
View File
@@ -303,7 +303,7 @@
(let ((gp-0 (-> self on-notice)))
(if gp-0
(eval!
(new 'stack 'script-context (the-as basic (process->ppointer self)) self (-> self root-override2 trans))
(new 'stack 'script-context (process->ppointer self) self (-> self root-override2 trans))
(the-as pair gp-0)
)
)
+1 -1
View File
@@ -32,7 +32,7 @@
()
(if (-> self aborted?)
(eval!
(new 'stack 'script-context (the-as basic (process->ppointer self)) self (the-as vector #f))
(new 'stack 'script-context (process->ppointer self) self (the-as vector #f))
'(cond
((task-closed? "tomb-water-resolution")
(send-event "tomb-sphinx-2" 'trigger)
+3 -12
View File
@@ -1746,10 +1746,7 @@ This commonly includes things such as:
:trans (behavior ()
(let ((gp-0 (-> self on-notice)))
(when gp-0
(if (eval!
(new 'stack 'script-context (the-as basic (process->ppointer self)) self (the-as vector #f))
(the-as pair gp-0)
)
(if (eval! (new 'stack 'script-context (process->ppointer self) self (the-as vector #f)) (the-as pair gp-0))
(go-virtual open #f)
)
)
@@ -1868,10 +1865,7 @@ This commonly includes things such as:
)
(let ((gp-2 (-> self on-activate)))
(if gp-2
(eval!
(new 'stack 'script-context (the-as basic (process->ppointer self)) self (the-as vector #f))
(the-as pair gp-2)
)
(eval! (new 'stack 'script-context (process->ppointer self) self (the-as vector #f)) (the-as pair gp-2))
)
)
)
@@ -1982,10 +1976,7 @@ This commonly includes things such as:
(transform-post)
(let ((s5-1 (-> obj on-notice)))
(when s5-1
(if (eval!
(new 'stack 'script-context (the-as basic (process->ppointer pp)) pp (the-as vector #f))
(the-as pair s5-1)
)
(if (eval! (new 'stack 'script-context (process->ppointer pp) pp (the-as vector #f)) (the-as pair s5-1))
(go (method-of-object obj open) #t)
)
)
+2 -6
View File
@@ -263,13 +263,13 @@
(case (-> self stage)
((2)
(eval!
(new 'stack 'script-context (the-as basic (process->ppointer self)) self (the-as vector #f))
(new 'stack 'script-context (process->ppointer self) self (the-as vector #f))
'(want-anim "nest-kor-boss-fight-mid")
)
)
((3)
(eval!
(new 'stack 'script-context (the-as basic (process->ppointer self)) self (the-as vector #f))
(new 'stack 'script-context (process->ppointer self) self (the-as vector #f))
'(want-anim "outro-nest")
)
)
@@ -2978,7 +2978,3 @@
(none)
)
)
+1 -1
View File
@@ -224,7 +224,7 @@
(let ((gp-0 (-> self on-notice)))
(if gp-0
(eval!
(new 'stack 'script-context (the-as basic (process->ppointer self)) self (-> self root-override2 trans))
(new 'stack 'script-context (process->ppointer self) self (-> self root-override2 trans))
(the-as pair gp-0)
)
)
+1 -1
View File
@@ -519,7 +519,7 @@
(let ((gp-0 (-> self on-notice)))
(if gp-0
(eval!
(new 'stack 'script-context (the-as basic (process->ppointer self)) self (-> self root-override2 trans))
(new 'stack 'script-context (process->ppointer self) self (-> self root-override2 trans))
(the-as pair gp-0)
)
)
+1 -1
View File
@@ -2658,7 +2658,7 @@ This commonly includes things such as:
(with-pp
(if (= (-> obj stage) 2)
(eval!
(new 'stack 'script-context (the-as basic (process->ppointer pp)) pp (the-as vector #f))
(new 'stack 'script-context (process->ppointer pp) pp (the-as vector #f))
'(want-anim "palace-boss-res")
)
)
+1 -1
View File
@@ -656,7 +656,7 @@
(let ((gp-0 (-> self on-notice)))
(if gp-0
(eval!
(new 'stack 'script-context (the-as basic (process->ppointer self)) self (-> self root-override2 trans))
(new 'stack 'script-context (process->ppointer self) self (-> self root-override2 trans))
(the-as pair gp-0)
)
)
+3 -8
View File
@@ -436,7 +436,6 @@
)
;; definition for method 3 of type ik-setup
;; INFO: this function exists in multiple non-identical object files
(defmethod inspect ik-setup ((obj ik-setup))
(when (not obj)
(set! obj obj)
@@ -1099,7 +1098,7 @@
(let ((gp-1 (-> self on-stop-sentry)))
(if gp-1
(eval!
(new 'stack 'script-context (the-as basic (process->ppointer self)) self (-> self root-override2 trans))
(new 'stack 'script-context (process->ppointer self) self (-> self root-override2 trans))
(the-as pair gp-1)
)
)
@@ -1195,7 +1194,7 @@
(let ((gp-2 (-> self on-stop-sentry)))
(if gp-2
(eval!
(new 'stack 'script-context (the-as basic (process->ppointer self)) self (-> self root-override2 trans))
(new 'stack 'script-context (process->ppointer self) self (-> self root-override2 trans))
(the-as pair gp-2)
)
)
@@ -1448,7 +1447,7 @@
(let ((gp-0 (-> self on-notice)))
(if gp-0
(eval!
(new 'stack 'script-context (the-as basic (process->ppointer self)) self (-> self root-override2 trans))
(new 'stack 'script-context (process->ppointer self) self (-> self root-override2 trans))
(the-as pair gp-0)
)
)
@@ -2628,7 +2627,3 @@
)
(none)
)
+2 -5
View File
@@ -325,10 +325,7 @@ For example for an elevator pre-compute the distance between the first and last
)
(let ((data (res-lump-struct (-> self entity) 'on-activate structure)))
(if data
(eval!
(new 'stack 'script-context (the-as basic (process->ppointer self)) self (the-as vector #f))
(the-as pair data)
)
(eval! (new 'stack 'script-context (process->ppointer self) self (the-as vector #f)) (the-as pair data))
)
)
(none)
@@ -1576,7 +1573,7 @@ This commonly includes things such as:
(set! (-> obj attack-id) id)
)
(if (eval!
(new 'stack 'script-context (the-as basic (process->ppointer pp)) pp (the-as vector #f))
(new 'stack 'script-context (process->ppointer pp) pp (the-as vector #f))
(res-lump-struct (-> obj entity) 'on-activate pair)
)
(go (method-of-object obj hit) #t)
+1 -4
View File
@@ -3185,10 +3185,7 @@ This commonly includes things such as:
(when (not arg0)
(let ((gp-0 (-> self on-activate)))
(if gp-0
(eval!
(new 'stack 'script-context (the-as basic (process->ppointer self)) self (-> self root trans))
(the-as pair gp-0)
)
(eval! (new 'stack 'script-context (process->ppointer self) self (-> self root trans)) (the-as pair gp-0))
)
)
(ja-no-eval :group! (-> self draw art-group data 3)
+2 -6
View File
@@ -384,7 +384,7 @@
)
:trans (behavior ()
(if (not (eval!
(new 'stack 'script-context (the-as basic (process->ppointer self)) self (the-as vector #f))
(new 'stack 'script-context (process->ppointer self) self (the-as vector #f))
(the-as pair (-> self draw-test-script))
)
)
@@ -594,7 +594,7 @@ This commonly includes things such as:
(set! (-> obj draw-test-script) (res-lump-struct (-> obj entity) 'on-activate script-context))
(cond
((and (eval!
(new 'stack 'script-context (the-as basic (process->ppointer pp)) pp (the-as vector #f))
(new 'stack 'script-context (process->ppointer pp) pp (the-as vector #f))
(the-as pair (-> obj draw-test-script))
)
(= *bot-record-path* -1)
@@ -609,7 +609,3 @@ This commonly includes things such as:
(none)
)
)
+5 -9
View File
@@ -181,7 +181,7 @@ For example for an elevator pre-compute the distance between the first and last
)
:trans (behavior ()
(when (not (eval!
(new 'stack 'script-context (the-as basic (process->ppointer self)) self (the-as vector #f))
(new 'stack 'script-context (process->ppointer self) self (the-as vector #f))
(the-as pair (-> self draw-test-script))
)
)
@@ -474,7 +474,7 @@ otherwise, [[plat::34]]
(with-pp
(cond
((and (eval!
(new 'stack 'script-context (the-as basic (process->ppointer pp)) pp (the-as vector #f))
(new 'stack 'script-context (process->ppointer pp) pp (the-as vector #f))
(the-as pair (-> obj draw-test-script))
)
(= *bot-record-path* -1)
@@ -799,7 +799,7 @@ This commonly includes things such as:
)
(transform-post)
(if (eval!
(new 'stack 'script-context (the-as basic (process->ppointer pp)) pp (the-as vector #f))
(new 'stack 'script-context (process->ppointer pp) pp (the-as vector #f))
(res-lump-struct (-> obj entity) 'on-activate pair)
)
(go (method-of-object obj die))
@@ -962,7 +962,7 @@ This commonly includes things such as:
(transform-post)
(cond
((eval!
(new 'stack 'script-context (the-as basic (process->ppointer pp)) pp (the-as vector #f))
(new 'stack 'script-context (process->ppointer pp) pp (the-as vector #f))
(res-lump-struct (-> obj entity) 'on-activate pair)
)
(if (= (-> obj bridge-id) 1)
@@ -1113,7 +1113,7 @@ This commonly includes things such as:
(let ((s5-2 #t))
(cond
((eval!
(new 'stack 'script-context (the-as basic (process->ppointer pp)) pp (the-as vector #f))
(new 'stack 'script-context (process->ppointer pp) pp (the-as vector #f))
(res-lump-struct (-> obj entity) 'on-activate pair)
)
(set! s5-2 #f)
@@ -1703,7 +1703,3 @@ This commonly includes things such as:
)
(none)
)