Files
jak-project/goal_src/jak1/engine/common-obs/basebutton.gc
T
2026-07-28 12:00:35 -07:00

497 lines
23 KiB
Common Lisp

;;-*-Lisp-*-
(in-package goal)
(bundles "GAME.CGO")
(require "engine/common-obs/generic-obs.gc")
(require "engine/target/logic-target.gc")
;; DECOMP BEGINS
(deftype basebutton (process-drawable)
((root collide-shape-moving :override)
(down? symbol)
(spawned-by-other? symbol)
(move-to? symbol)
(notify-actor entity-actor)
(timeout float)
(button-id int32)
(event-going-down symbol)
(event-down symbol)
(event-going-up symbol)
(event-up symbol)
(anim-speed float)
(move-to-pos vector :inline)
(move-to-quat quaternion :inline))
(:state-methods
basebutton-down-idle
basebutton-going-down
basebutton-going-up
basebutton-startup
basebutton-up-idle)
(:methods
(reset! (_type_) float)
(setup-skel-and-anim! (_type_) none)
(setup-collision! (_type_) collide-shape-moving)
(arm-trigger-event! (_type_) symbol)
(notify-event! (_type_ symbol entity) none)
(move-to-vec-or-quat! (_type_ vector quaternion) quaternion)
(press! (_type_ symbol) int)))
(defskelgroup *generic-button-sg*
generic-button
generic-button-lod0-jg
generic-button-idle-ja
((generic-button-lod0-mg (meters 999999)))
:bounds (static-spherem 0 0 0 3))
(defmethod move-to-vec-or-quat! ((this basebutton) (position vector) (rotation quaternion))
"Queue a new root transform for the next update. A false position or rotation retains that
component of the current root transform."
(set! (-> this move-to?) #t)
(if position
(vector-copy! (-> this move-to-pos) position)
(vector-copy! (-> this move-to-pos) (-> this root trans)))
(if rotation
(quaternion-copy! (-> this move-to-quat) rotation)
(quaternion-copy! (-> this move-to-quat) (-> this root quat))))
(defstate basebutton-startup (basebutton)
:virtual #t
:code
(behavior ()
(if (-> self down?) (go-virtual basebutton-down-idle) (go-virtual basebutton-up-idle))))
(defstate basebutton-up-idle (basebutton)
:virtual #t
:event
(behavior ((proc process) (argc int) (message symbol) (block event-message-block))
(case message
(('attack)
(case (-> block param 1)
(('flop)
(notify-event! self (-> self event-going-down) (-> self notify-actor))
(sound-play "silo-button")
(go-virtual basebutton-going-down))))
(('trigger) (sound-play "silo-button") (go-virtual basebutton-going-down))
(('move-to) (move-to-vec-or-quat! self (the-as vector (-> block param 0)) (the-as quaternion (-> block param 1))))))
:enter
(behavior ()
(press! self #f))
:trans
(behavior ()
(if (-> self move-to?) (rider-trans)))
:code anim-loop
:post
(behavior ()
(when (-> self move-to?)
(set! (-> self move-to?) #f)
(vector-copy! (-> self root trans) (-> self move-to-pos))
(quaternion-copy! (-> self root quat) (-> self move-to-quat))
(rider-post))))
(defstate basebutton-going-down (basebutton)
:virtual #t
:event
(behavior ((proc process) (argc int) (message symbol) (block event-message-block))
(case message
(('untrigger) (sound-play "silo-button") (go-virtual basebutton-going-up))
(('move-to) (move-to-vec-or-quat! self (the-as vector (-> block param 0)) (the-as quaternion (-> block param 1))))))
:enter
(behavior ()
(press! self #t))
:trans rider-trans
:code
(behavior ()
(ja-play :num! (seek! max (-> self anim-speed)))
(notify-event! self (-> self event-down) (-> self notify-actor))
(go-virtual basebutton-down-idle))
:post
(behavior ()
(when (-> self move-to?)
(set! (-> self move-to?) #f)
(vector-copy! (-> self root trans) (-> self move-to-pos))
(quaternion-copy! (-> self root quat) (-> self move-to-quat)))
(rider-post)))
(defstate basebutton-down-idle (basebutton)
:virtual #t
:event
(behavior ((proc process) (argc int) (message symbol) (block event-message-block))
(case message
(('untrigger) (sound-play "silo-button") (go-virtual basebutton-going-up))
(('move-to) (move-to-vec-or-quat! self (the-as vector (-> block param 0)) (the-as quaternion (-> block param 1))))))
:enter
(behavior ()
(press! self #t))
:trans
(behavior ()
(if (-> self move-to?) (rider-trans)))
:code
(behavior ()
(set-time! (-> self state-time))
(cond
((= (-> self timeout) 0.0) (anim-loop))
(else
(until (time-elapsed? (-> self state-time) (the int (* 300.0 (-> self timeout))))
(suspend))
(notify-event! self (-> self event-going-up) (-> self notify-actor))
(sound-play "silo-button")
(go-virtual basebutton-going-up))))
:post
(behavior ()
(when (-> self move-to?)
(set! (-> self move-to?) #f)
(vector-copy! (-> self root trans) (-> self move-to-pos))
(quaternion-copy! (-> self root quat) (-> self move-to-quat))
(rider-post))))
(defstate basebutton-going-up (basebutton)
:virtual #t
:event
(behavior ((proc process) (argc int) (message symbol) (block event-message-block))
(case message
(('move-to) (move-to-vec-or-quat! self (the-as vector (-> block param 0)) (the-as quaternion (-> block param 1))))
(('trigger) (sound-play "silo-button") (go-virtual basebutton-going-down))))
:enter
(behavior ()
(press! self #f))
:trans rider-trans
:code
(behavior ()
(ja-play :num! (seek! 0.0 (-> self anim-speed)))
(notify-event! self (-> self event-up) (-> self notify-actor))
(go-virtual basebutton-up-idle))
:post
(behavior ()
(when (-> self move-to?)
(set! (-> self move-to?) #f)
(vector-copy! (-> self root trans) (-> self move-to-pos))
(quaternion-copy! (-> self root quat) (-> self move-to-quat)))
(rider-post)))
(defmethod press! ((this basebutton) (down? symbol))
"Set the pressed state. Placed buttons also mirror it into persistent entity completion;
dynamically spawned buttons do not."
(set! (-> this down?) down?)
(cond
(down? (if (not (-> this spawned-by-other?)) (process-entity-status! this (entity-perm-status complete) #t)))
(else (if (not (-> this spawned-by-other?)) (process-entity-status! this (entity-perm-status complete) #f)))))
(defmethod notify-event! ((this basebutton) (event symbol) (actor entity))
"Send event directly to actor when supplied; otherwise broadcast it to the button's linked
actors. A false event is ignored."
(with-pp
(when event
(cond
(actor
(let ((event-block (new 'stack-no-clear 'event-message-block)))
(set! (-> event-block from) pp)
(set! (-> event-block num-params) 0)
(set! (-> event-block message) event)
(let ((recipient actor)) (send-event-function (if recipient (-> recipient extra process)) event-block))))
(else (if (nonzero? (-> this link)) (send-to-all (-> this link) event)))))
(none)))
(defmethod reset! ((this basebutton))
"Reset to an unpressed dynamic-button configuration with no notification target, timeout,
queued transform, or armed events. The animation speed is reset to 1."
(set! (-> this down?) #f)
(set! (-> this spawned-by-other?) #t)
(set! (-> this move-to?) #f)
(set! (-> this notify-actor) #f)
(set! (-> this timeout) 0.0)
(set! (-> this event-going-down) #f)
(set! (-> this event-down) #f)
(set! (-> this event-going-up) #f)
(set! (-> this event-up) #f)
(set! (-> this anim-speed) 1.0))
(defmethod arm-trigger-event! ((this basebutton))
"Arm trigger as the notification sent when the button begins moving down."
(let ((trigger-event 'trigger)) (set! (-> this event-going-down) trigger-event) trigger-event))
(defmethod setup-skel-and-anim! ((this basebutton))
"Create the generic button skeleton and animation channel. Pose the channel at the last frame
when the button is already down, otherwise at frame zero, set animation speed to 2, and
update the skeleton transforms."
(local-vars (anim-channel joint-control-channel))
(initialize-skeleton this *generic-button-sg* '())
(logior! (-> this skel status) (janim-status inited))
(ja-channel-set! 1)
(cond
((-> this down?)
(set! anim-channel (-> this skel root-channel 0))
(joint-control-channel-group-eval! anim-channel
(the-as art-joint-anim (-> this draw art-group data 2))
num-func-identity)
(set! (-> anim-channel frame-num)
(the float (+ (-> (the-as art-joint-anim (-> this draw art-group data 2)) data 0 length) -1))))
(else
(set! anim-channel (-> this skel root-channel 0))
(joint-control-channel-group-eval! anim-channel
(the-as art-joint-anim (-> this draw art-group data 2))
num-func-identity)
(set! (-> anim-channel frame-num) 0.0)))
(set! (-> this anim-speed) 2.0)
(update-transforms! (-> this root))
(ja-post)
(none))
(defmethod setup-collision! ((this basebutton))
"Create the moving collision shape with one rider, a three-metre primitive-group bound, and
two indestructible sticky mesh primitives attached to skeleton transforms 4 and 3."
(let ((collision (new 'process 'collide-shape-moving this (collide-list-enum hit-by-player))))
(set! (-> collision dynam) (copy *standard-dynamics* 'process))
(set! (-> collision reaction) default-collision-reaction)
(set! (-> collision no-reaction)
(the-as (function collide-shape-moving collide-shape-intersect vector vector none) nothing))
(alloc-riders collision 1)
(let ((primitive-group (new 'process 'collide-shape-prim-group collision (the-as uint 2) 0)))
(set! (-> primitive-group prim-core collide-as) (collide-kind ground-object))
(set! (-> primitive-group collide-with) (collide-kind target))
(set! (-> primitive-group prim-core action) (collide-action solid rider-plat-sticky))
(set-vector! (-> primitive-group local-sphere) 0.0 0.0 0.0 12288.0)
(set-root-prim! collision primitive-group)
(let ((mesh-primitive (new 'process 'collide-shape-prim-mesh collision (the-as uint 0) (the-as uint 0))))
(set! (-> mesh-primitive prim-core collide-as) (collide-kind ground-object))
(set! (-> mesh-primitive collide-with) (collide-kind target))
(set! (-> mesh-primitive prim-core action) (collide-action solid rider-plat-sticky))
(set! (-> mesh-primitive prim-core offense) (collide-offense indestructible))
(set! (-> mesh-primitive transform-index) 4)
(set-vector! (-> mesh-primitive local-sphere) 0.0 0.0 0.0 12288.0)
(append-prim primitive-group mesh-primitive))
(let ((second-mesh-primitive (new 'process 'collide-shape-prim-mesh collision (the-as uint 1) (the-as uint 0))))
(set! (-> second-mesh-primitive prim-core collide-as) (collide-kind ground-object))
(set! (-> second-mesh-primitive collide-with) (collide-kind target))
(set! (-> second-mesh-primitive prim-core action) (collide-action solid rider-plat-sticky))
(set! (-> second-mesh-primitive prim-core offense) (collide-offense indestructible))
(set! (-> second-mesh-primitive transform-index) 3)
(set-vector! (-> second-mesh-primitive local-sphere) 0.0 0.0 0.0 12288.0)
(append-prim primitive-group second-mesh-primitive)))
(set! (-> collision nav-radius) (* 0.75 (-> collision root-prim local-sphere w)))
(backup-collide-with-as collision)
(set! (-> this root) collision)
collision))
(defmethod init-from-entity! ((this basebutton) (source-entity entity-actor))
"Initialize a placed button from its entity. Resolve button-id from extra-id or actor-link
order, create its drawable and collision data, restore its saved pressed state, read the
optional notification actor and timeout, connect it to navigation, pose its skeleton, and
enter the startup state."
(reset! this)
(set! (-> this spawned-by-other?) #f)
(set! (-> this button-id) -1)
(let ((raw-button-id (res-lump-value (-> this entity) 'extra-id uint128 :default (the-as uint128 -1))))
(if (>= (the-as int raw-button-id) 0) (set! (-> this button-id) (the-as int raw-button-id))))
(when (or (res-lump-struct source-entity 'next-actor structure) (res-lump-struct source-entity 'prev-actor structure))
(set! (-> this link) (new 'process 'actor-link-info this))
(if (< (-> this button-id) 0) (set! (-> this button-id) (actor-count-before (-> this link)))))
(setup-collision! this)
(process-drawable-from-entity! this source-entity)
(let ((initially-down? #f))
(if (and (-> this entity) (logtest? (-> this entity extra perm status) (entity-perm-status complete)))
(set! initially-down? #t))
(set! (-> this down?) initially-down?))
(set! (-> this notify-actor) (entity-actor-lookup source-entity 'alt-actor 0))
(set! (-> this timeout) (res-lump-float source-entity 'timeout))
(if (not (-> this spawned-by-other?)) (nav-mesh-connect this (-> this root) (the-as nav-control #f)))
(arm-trigger-event! this)
(setup-skel-and-anim! this)
(go (method-of-object this basebutton-startup))
(none))
(defbehavior basebutton-init-by-other basebutton ((source-entity entity-actor)
(position vector)
(rotation quaternion)
(notify-actor entity-actor)
(down? symbol)
(timeout float))
"Initialize a dynamically spawned button from the supplied transform and notification actor.
Unlike a placed button it has no entity completion or navigation state. Set its initial pressed
state and timeout, create the common drawable, collision, and skeleton data, and enter startup."
(reset! self)
(set! (-> self spawned-by-other?) #t)
(set! (-> self button-id) -1)
(set! (-> self down?) down?)
(set! (-> self notify-actor) notify-actor)
(set! (-> self timeout) timeout)
(if source-entity (set! (-> self entity) source-entity))
(setup-collision! self)
(vector-copy! (-> self root trans) position)
(quaternion-copy! (-> self root quat) rotation)
(set-vector! (-> self root scale) 1.0 1.0 1.0 1.0)
(arm-trigger-event! self)
(setup-skel-and-anim! self)
(go-virtual basebutton-startup)
(none))
(define *warp-info*
(new 'static 'boxed-array :type string "training-warp" "village1-warp" "village2-warp" "village3-warp" "citadel-warp"))
(deftype warp-gate (process-drawable)
((level symbol)
(level-slot int32)
(min-slot int32)
(max-slot int32))
(:state-methods
idle
active
(use int level)
hidden))
;; Freeze player input, hand the target both ends of the camera transition, and keep the old level
;; resident until the target is hidden or the destination has finished loading.
(defstate use (warp-gate)
:virtual #t
:trans
(behavior ()
(send-event *camera* 'joystick 0.0 0.0))
:code
(behavior ((slot int) (destination-level level))
(set-time! (-> self state-time))
(when (not destination-level)
(process-release? *target*)
(go-virtual idle))
(let ((event-block (new 'stack-no-clear 'event-message-block)))
(set! (-> event-block from) self)
(set! (-> event-block num-params) 3)
(set! (-> event-block message) 'change-state)
(set! (-> event-block param 0) (the-as uint target-warp-out))
(let ((gate-position (new 'static 'vector)))
(vector-copy! gate-position (-> self root trans))
(set! (-> event-block param 1) (the-as uint gate-position)))
(set! (-> event-block param 2) (the-as uint (target-pos 0)))
(send-event-function *target* event-block))
;; og:preserve-this
;; NOTE : added case for "training" here. in the original game, the training level does NOT come
;; with its own code for warp gates and buttons, and uses the villagep-obs imported from village1
;; instead. opengoal loads files different enough that warp from training to anywhere except village1
;; crashes the game due to running unlinked code. the original game also crashes, but it is not consistent.
;; the citadel/lavatube case makes it so we wait until it's safe to unload both levels in the heaps,
;; since the citadel warp gate is located in both levels at once (visually lavatube, technically citadel)
;; we add "training" to the list here so that the training warp gate waits until it's safe to
;; dispose the old code from memory.
(case (-> self level)
(('citadel 'lavatube 'training)
(while (and *target* (not (logtest? (-> *target* draw status) (draw-status hidden))))
(suspend)))
(else
(load-state-want-levels (-> self level) (-> destination-level load-name))
(while (or (not (member (level-status *level* (-> destination-level load-name)) '(loaded active)))
(not (time-elapsed? (-> self state-time) (seconds 2))))
(suspend))))
(set-blackout-frames (seconds 0.05))
(start 'play (get-continue-by-name *game-info* (-> *warp-info* slot)))
(logior! (-> self mask) (process-mask sleep))
(suspend)
0))
(define *warp-jump-mods*
(new 'static
'surface
:name 'jump
:turnv 273066.66
:turnvv 1820444.5
:tiltv 32768.0
:tiltvv 131072.0
:transv-max 65536.0
:target-speed 65536.0
:slip-factor 1.0
:slide-factor 1.0
:slope-up-factor 1.0
:slope-down-factor 1.0
:slope-slip-angle 1.0
:impact-fric 1.0
:bend-factor 1.0
:bend-speed 1.0
:alignv 1.0
:slope-up-traction 1.0
:align-speed 1.0
:mode 'air
:flags (surface-flags always-rotate-toward-transv)))
;; Launch Jak through the gate while a fixed camera watches, then hand control to the warp effect.
(defstate target-warp-out (target)
:event
(behavior ((sender process) (argc int) (message symbol) (block event-message-block))
(case message
(('death-end)
(let ((new-draw-status (the-as object (logior (-> self draw status) (draw-status hidden)))))
(set! (-> self draw status) (the-as draw-status new-draw-status))
new-draw-status))
(else (target-generic-event-handler sender argc message block))))
:enter
(behavior ((gate-position vector) (camera-position vector))
;; Save both ends of the camera transition. The gate target is lowered one metre so the
;; ballistic launch converges below its visible centre.
(set-time! (-> self state-time))
(logclear! (-> self control status) (collide-status on-surface on-ground touch-surface))
(set! (-> self control mod-surface) *warp-jump-mods*)
(vector-copy! (-> self control state-vector0) gate-position)
(vector-copy! (-> self control state-vector1) camera-position)
(+! (-> self control state-vector0 y) -4096.0)
(set! (-> self control state-var0) (the-as uint #f))
(vector-reset! (-> self control transv))
(logior! (-> self state-flags) (state-flags use-alt-cam-pos))
(vector-copy! (-> self alt-cam-pos) camera-position))
:exit
(behavior ()
(logclear! (-> self state-flags) (state-flags use-alt-cam-pos)))
:code
(behavior ((gate-position vector) (camera-position vector))
;; Launch toward the gate with a vertical speed chosen from the height difference and gravity.
;; Once Jak passes the gate (or spool animation begins), fade him out, damp horizontal speed,
;; start the warp death effect once, and leave the animation looping until the transition ends.
(send-event *camera* 'change-state cam-fixed 0)
(ja-channel-push! 1 (seconds 0.2))
(ja-play :group! eichar-duck-high-jump-ja :num! (seek! (ja-aframe 16.0 0)) :frame-num 0.0)
(vector-! (-> self control transv) (-> self control state-vector0) (-> self control trans))
(vector-xz-normalize! (-> self control transv) 32768.0)
(let ((planar-velocity (new-stack-vector0)))
(let ((gravity-axis-speed (vector-dot (-> self control dynam gravity-normal) (-> self control transv))))
0.0
(vector-! planar-velocity
(-> self control transv)
(vector-float*! planar-velocity (-> self control dynam gravity-normal) gravity-axis-speed)))
(let* ((planar-speed (vector-length planar-velocity))
(normalization-speed planar-speed)
(launch-speed (- (sqrtf (* 2.0
(-> self control dynam gravity-length)
(vector-dot (-> self control dynam gravity-normal)
(vector-! (new 'stack-no-clear 'vector) (-> self control state-vector0) (-> self control trans)))))
(* 0.008333334 (- (-> self control dynam gravity-length))))))
(vector+! (-> self control transv)
(vector-float*! (-> self control transv) (-> self control dynam gravity-normal) launch-speed)
(vector-float*! planar-velocity planar-velocity (/ planar-speed normalization-speed)))))
(clear-collide-with-as (-> self control))
(set-time! (-> self state-time))
(set! (-> self trans-hook)
(lambda :behavior target ()
;; Keep vertical speed from turning downward before the portal effect takes over,
;; while retaining the current planar direction and magnitude.
(let ((planar-velocity (new-stack-vector0))
(gravity-axis-speed (vector-dot (-> self control dynam gravity-normal) (-> self control transv))))
0.0
(vector-! planar-velocity
(-> self control transv)
(vector-float*! planar-velocity (-> self control dynam gravity-normal) gravity-axis-speed))
(let* ((planar-speed (vector-length planar-velocity))
(normalization-speed planar-speed))
(if (< gravity-axis-speed 0.0) (set! gravity-axis-speed 8192.0))
(vector+! (-> self control transv)
(vector-float*! (-> self control transv) (-> self control dynam gravity-normal) gravity-axis-speed)
(vector-float*! planar-velocity planar-velocity (/ planar-speed normalization-speed)))))
(let ((to-gate (vector-! (new-stack-vector0) (-> self control state-vector0) (-> self control trans))))
(set! (-> to-gate y) 0.0)
(send-event *target* 'sidekick #f)
(when (and (or (< (vector-dot to-gate (-> self control transv)) 0.0) (-> self control state-spool-anim))
(time-elapsed? (-> self state-time) (seconds 0.05)))
(vector-seek! (-> self draw color-mult) (new 'static 'vector) (* 2.0 (seconds-per-frame)))
(set! (-> self control transv x) (* 0.95 (-> self control transv x)))
(set! (-> self control transv z) (* 0.95 (-> self control transv z)))
(when (not (-> self control state-spool-anim))
(send-event self 'do-effect 'death-warp-out -1.0)
(let ((warp-started? #t)) (set! (-> self control state-var0) (the-as uint warp-started?)) warp-started?))))))
(ja-play :group! eichar-duck-high-jump-ja :num! (seek! (ja-aframe 40.0 0)) :frame-num (ja-aframe 16.0 0))
(anim-loop))
:post target-no-stick-post)