;;-*-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)
   (basebutton-method-26 (_type_) none)
   (basebutton-method-27 (_type_) collide-shape-moving)
   (arm-trigger-event! (_type_) symbol)
   (basebutton-method-29 (_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) (arg0 vector) (arg1 quaternion))
  (set! (-> this move-to?) #t)
  (if arg0 (set! (-> this move-to-pos quad) (-> arg0 quad)) (set! (-> this move-to-pos quad) (-> this root trans quad)))
  (if arg1 (quaternion-copy! (-> this move-to-quat) arg1) (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)
            (basebutton-method-29 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)
        (set! (-> self root trans quad) (-> self move-to-pos quad))
        (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-no-eval :num! (seek! max (-> self anim-speed)))
      (until (ja-done? 0)
        (suspend)
        (ja :num! (seek! max (-> self anim-speed))))
      (basebutton-method-29 self (-> self event-down) (-> self notify-actor))
      (go-virtual basebutton-down-idle))
  :post
    (behavior ()
      (when (-> self move-to?)
        (set! (-> self move-to?) #f)
        (set! (-> self root trans quad) (-> self move-to-pos quad))
        (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))
         (basebutton-method-29 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)
        (set! (-> self root trans quad) (-> self move-to-pos quad))
        (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-no-eval :num! (seek! 0.0 (-> self anim-speed)))
      (until (ja-done? 0)
        (suspend)
        (ja :num! (seek! 0.0 (-> self anim-speed))))
      (basebutton-method-29 self (-> self event-up) (-> self notify-actor))
      (go-virtual basebutton-up-idle))
  :post
    (behavior ()
      (when (-> self move-to?)
        (set! (-> self move-to?) #f)
        (set! (-> self root trans quad) (-> self move-to-pos quad))
        (quaternion-copy! (-> self root quat) (-> self move-to-quat)))
      (rider-post)))

(defmethod press! ((this basebutton) (arg0 symbol))
  (set! (-> this down?) arg0)
  (cond
    (arg0 (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 basebutton-method-29 ((this basebutton) (arg0 symbol) (arg1 entity))
  (with-pp
    (when arg0
      (cond
        (arg1
         (let ((v1-0 (new 'stack-no-clear 'event-message-block)))
           (set! (-> v1-0 from) pp)
           (set! (-> v1-0 num-params) 0)
           (set! (-> v1-0 message) arg0)
           (let ((a1-1 arg1)) (send-event-function (if a1-1 (-> a1-1 extra process)) v1-0))))
        (else (if (nonzero? (-> this link)) (send-to-all (-> this link) arg0)))))
    (none)))

(defmethod reset! ((this basebutton))
  (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))
  (let ((v0-0 'trigger)) (set! (-> this event-going-down) v0-0) v0-0))

(defmethod basebutton-method-26 ((this basebutton))
  (initialize-skeleton this *generic-button-sg* '())
  (logior! (-> this skel status) (janim-status inited))
  (ja-channel-set! 1)
  (cond
    ((-> this down?)
     (let ((s5-0 (-> this skel root-channel 0)))
       (joint-control-channel-group-eval! s5-0 (the-as art-joint-anim (-> this draw art-group data 2)) num-func-identity)
       (set! (-> s5-0 frame-num) (the float (+ (-> (the-as art-joint-anim (-> this draw art-group data 2)) data 0 length) -1)))))
    (else
     (let ((s5-1 (-> this skel root-channel 0)))
       (joint-control-channel-group-eval! s5-1 (the-as art-joint-anim (-> this draw art-group data 2)) num-func-identity)
       (set! (-> s5-1 frame-num) 0.0))))
  (set! (-> this anim-speed) 2.0)
  (update-transforms! (-> this root))
  (ja-post)
  (none))

(defmethod basebutton-method-27 ((this basebutton))
  (let ((s5-0 (new 'process 'collide-shape-moving this (collide-list-enum hit-by-player))))
    (set! (-> s5-0 dynam) (copy *standard-dynamics* 'process))
    (set! (-> s5-0 reaction) default-collision-reaction)
    (set! (-> s5-0 no-reaction) (the-as (function collide-shape-moving collide-shape-intersect vector vector none) nothing))
    (alloc-riders s5-0 1)
    (let ((s4-0 (new 'process 'collide-shape-prim-group s5-0 (the-as uint 2) 0)))
      (set! (-> s4-0 prim-core collide-as) (collide-kind ground-object))
      (set! (-> s4-0 collide-with) (collide-kind target))
      (set! (-> s4-0 prim-core action) (collide-action solid rider-plat-sticky))
      (set-vector! (-> s4-0 local-sphere) 0.0 0.0 0.0 12288.0)
      (set-root-prim! s5-0 s4-0)
      (let ((s3-0 (new 'process 'collide-shape-prim-mesh s5-0 (the-as uint 0) (the-as uint 0))))
        (set! (-> s3-0 prim-core collide-as) (collide-kind ground-object))
        (set! (-> s3-0 collide-with) (collide-kind target))
        (set! (-> s3-0 prim-core action) (collide-action solid rider-plat-sticky))
        (set! (-> s3-0 prim-core offense) (collide-offense indestructible))
        (set! (-> s3-0 transform-index) 4)
        (set-vector! (-> s3-0 local-sphere) 0.0 0.0 0.0 12288.0)
        (append-prim s4-0 s3-0))
      (let ((s3-1 (new 'process 'collide-shape-prim-mesh s5-0 (the-as uint 1) (the-as uint 0))))
        (set! (-> s3-1 prim-core collide-as) (collide-kind ground-object))
        (set! (-> s3-1 collide-with) (collide-kind target))
        (set! (-> s3-1 prim-core action) (collide-action solid rider-plat-sticky))
        (set! (-> s3-1 prim-core offense) (collide-offense indestructible))
        (set! (-> s3-1 transform-index) 3)
        (set-vector! (-> s3-1 local-sphere) 0.0 0.0 0.0 12288.0)
        (append-prim s4-0 s3-1)))
    (set! (-> s5-0 nav-radius) (* 0.75 (-> s5-0 root-prim local-sphere w)))
    (backup-collide-with-as s5-0)
    (set! (-> this root) s5-0)
    s5-0))

(defmethod init-from-entity! ((this basebutton) (arg0 entity-actor))
  (reset! this)
  (set! (-> this spawned-by-other?) #f)
  (set! (-> this button-id) -1)
  (let ((v1-4 (res-lump-value (-> this entity) 'extra-id uint128 :default (the-as uint128 -1))))
    (if (>= (the-as int v1-4) 0) (set! (-> this button-id) (the-as int v1-4))))
  (when (or (res-lump-struct arg0 'next-actor structure) (res-lump-struct arg0 '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)))))
  (basebutton-method-27 this)
  (process-drawable-from-entity! this arg0)
  (let ((v1-16 #f))
    (if (and (-> this entity) (logtest? (-> this entity extra perm status) (entity-perm-status complete))) (set! v1-16 #t))
    (set! (-> this down?) v1-16))
  (set! (-> this notify-actor) (entity-actor-lookup arg0 'alt-actor 0))
  (set! (-> this timeout) (res-lump-float arg0 'timeout))
  (if (not (-> this spawned-by-other?)) (nav-mesh-connect this (-> this root) (the-as nav-control #f)))
  (arm-trigger-event! this)
  (basebutton-method-26 this)
  (go (method-of-object this basebutton-startup))
  (none))

(defbehavior basebutton-init-by-other basebutton ((arg0 entity-actor) (arg1 vector) (arg2 quaternion) (arg3 entity-actor) (arg4 symbol) (arg5 float))
  (reset! self)
  (set! (-> self spawned-by-other?) #t)
  (set! (-> self button-id) -1)
  (set! (-> self down?) arg4)
  (set! (-> self notify-actor) arg3)
  (set! (-> self timeout) arg5)
  (if arg0 (set! (-> self entity) arg0))
  (basebutton-method-27 self)
  (set! (-> self root trans quad) (-> arg1 quad))
  (quaternion-copy! (-> self root quat) arg2)
  (set-vector! (-> self root scale) 1.0 1.0 1.0 1.0)
  (arm-trigger-event! self)
  (basebutton-method-26 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))


(defstate use (warp-gate)
  :virtual #t
  :trans
    (behavior ()
      (send-event *camera* 'joystick 0.0 0.0))
  :code
    (behavior ((arg0 int) (arg1 level))
      (set-time! (-> self state-time))
      (when (not arg1)
        (process-release? *target*)
        (go-virtual idle))
      (let ((s4-0 (new 'stack-no-clear 'event-message-block)))
        (set! (-> s4-0 from) self)
        (set! (-> s4-0 num-params) 3)
        (set! (-> s4-0 message) 'change-state)
        (set! (-> s4-0 param 0) (the-as uint target-warp-out))
        (let ((v1-9 (new 'static 'vector)))
          (set! (-> v1-9 quad) (-> self root trans quad))
          (set! (-> s4-0 param 1) (the-as uint v1-9)))
        (set! (-> s4-0 param 2) (the-as uint (target-pos 0)))
        (send-event-function *target* s4-0))
      ;; 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) (-> arg1 load-name))
         (while (or (not (member (level-status *level* (-> arg1 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* arg0)))
      (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)))

(defstate target-warp-out (target)
  :event
    (behavior ((proc process) (argc int) (message symbol) (block event-message-block))
      (case message
        (('death-end)
         (let ((v0-0 (the-as object (logior (-> self draw status) (draw-status hidden)))))
           (set! (-> self draw status) (the-as draw-status v0-0))
           v0-0))
        (else (target-generic-event-handler proc argc message block))))
  :enter
    (behavior ((arg0 vector) (arg1 vector))
      (set-time! (-> self state-time))
      (logclear! (-> self control status) (cshape-moving-flags onsurf onground tsurf))
      (set! (-> self control mod-surface) *warp-jump-mods*)
      (set! (-> self control unknown-vector102 quad) (-> arg0 quad))
      (set! (-> self control unknown-vector103 quad) (-> arg1 quad))
      (+! (-> self control unknown-vector102 y) -4096.0)
      (set! (-> self control unknown-uint20) (the-as uint #f))
      (vector-reset! (-> self control transv))
      (logior! (-> self state-flags) (state-flags use-alt-cam-pos))
      (set! (-> self alt-cam-pos quad) (-> arg1 quad)))
  :exit
    (behavior ()
      (logclear! (-> self state-flags) (state-flags use-alt-cam-pos)))
  :code
    (behavior ((arg0 vector) (arg1 vector))
      (send-event *camera* 'change-state cam-fixed 0)
      (ja-channel-push! 1 (seconds 0.2))
      (ja-no-eval :group! eichar-duck-high-jump-ja :num! (seek! (ja-aframe 16.0 0)) :frame-num 0.0)
      (until (ja-done? 0)
        (suspend)
        (ja :num! (seek! (ja-aframe 16.0 0))))
      (vector-! (-> self control transv) (-> self control unknown-vector102) (-> self control trans))
      (vector-xz-normalize! (-> self control transv) 32768.0)
      (let ((gp-2 (new-stack-vector0)))
        (let ((f0-6 (vector-dot (-> self control dynam gravity-normal) (-> self control transv))))
          0.0
          (vector-! gp-2 (-> self control transv) (vector-float*! gp-2 (-> self control dynam gravity-normal) f0-6)))
        (let* ((f0-7 (vector-length gp-2))
               (f1-1 f0-7)
               (f2-4 (- (sqrtf (* 2.0
                                  (-> self control dynam gravity-length)
                                  (vector-dot (-> self control dynam gravity-normal)
                                              (vector-! (new 'stack-no-clear 'vector) (-> self control unknown-vector102) (-> self control trans)))))
                        (* 0.008333334 (- (-> self control dynam gravity-length))))))
          (vector+! (-> self control transv)
                    (vector-float*! (-> self control transv) (-> self control dynam gravity-normal) f2-4)
                    (vector-float*! gp-2 gp-2 (/ f0-7 f1-1)))))
      (clear-collide-with-as (-> self control))
      (set-time! (-> self state-time))
      (set! (-> self trans-hook)
            (lambda :behavior target ()
              (let ((gp-0 (new-stack-vector0))
                    (f30-0 (vector-dot (-> self control dynam gravity-normal) (-> self control transv))))
                0.0
                (vector-! gp-0 (-> self control transv) (vector-float*! gp-0 (-> self control dynam gravity-normal) f30-0))
                (let* ((f0-3 (vector-length gp-0))
                       (f1-0 f0-3))
                  (if (< f30-0 0.0) (set! f30-0 8192.0))
                  (vector+! (-> self control transv)
                            (vector-float*! (-> self control transv) (-> self control dynam gravity-normal) f30-0)
                            (vector-float*! gp-0 gp-0 (/ f0-3 f1-0)))))
              (let ((gp-2 (vector-! (new-stack-vector0) (-> self control unknown-vector102) (-> self control trans))))
                (set! (-> gp-2 y) 0.0)
                (send-event *target* 'sidekick #f)
                (when (and (or (< (vector-dot gp-2 (-> self control transv)) 0.0) (-> self control unknown-spoolanim00))
                           (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 unknown-spoolanim00))
                    (send-event self 'do-effect 'death-warp-out -1.0)
                    (let ((v0-2 #t)) (set! (-> self control unknown-uint20) (the-as uint v0-2)) v0-2))))))
      (ja-no-eval :group! eichar-duck-high-jump-ja :num! (seek! (ja-aframe 40.0 0)) :frame-num (ja-aframe 16.0 0))
      (until (ja-done? 0)
        (suspend)
        (ja :num! (seek! (ja-aframe 40.0 0))))
      (anim-loop))
  :post target-no-stick-post)