;;-*-Lisp-*-
(in-package goal)

;; name: rigid-body-plat.gc
;; name in dgo: rigid-body-plat
;; dgos: GAME, COMMON

;; DECOMP BEGINS

(deftype rigid-body-platform-constants (rigid-body-object-constants)
  ((drag-factor            float)
   (buoyancy-factor        float)
   (max-buoyancy-depth     meters)
   (player-weight          meters)
   (player-bonk-factor     float)
   (player-dive-factor     float)
   (player-force-distance  meters)
   (player-force-clamp     meters)
   (player-force-timeout   uint64)
   (explosion-force        meters)
   (control-point-count    int32)
   (platform               symbol)
   (sound-name             string)
   )
  )


(deftype rigid-body-control-point (structure)
  ((local-pos  vector  :inline)
   (world-pos  vector  :inline)
   (velocity   vector  :inline)
   )
  )


(deftype rigid-body-control-point-inline-array (inline-array-class)
  ((data  rigid-body-control-point  :inline :dynamic)
   )
  )


(set! (-> rigid-body-control-point-inline-array heap-base) (the-as uint 48))

(deftype rigid-body-platform (rigid-body-object)
  ((info                  rigid-body-platform-constants :override)
   (control-point-array   rigid-body-control-point-inline-array)
   (player-velocity       vector                         :inline)
   (player-velocity-prev  vector                         :inline)
   (unknown-pad           uint32                         8)
   (float-height-offset   float)
   (player-bonk-timeout   uint64)
   (water-anim            water-anim)
   )
  (:methods
    (rigid-body-platform-method-53 (_type_ vector) float)
    (rigid-body-platform-method-54 (_type_ rigid-body-control-point) none)
    (rigid-body-platform-method-55 (_type_) none)
    (rigid-body-platform-method-56 (_type_ vector) none)
    )
  )


(defmethod relocate ((this rigid-body-platform) (new-addr int))
  (if (nonzero? (-> this control-point-array))
      (&+! (-> this control-point-array) new-addr)
      )
  (call-parent-method this new-addr)
  )

(defmethod rigid-body-platform-method-53 ((this rigid-body-platform) (arg0 vector))
  (local-vars (f0-1 object))
  (let ((v1-0 (-> this water-anim)))
    0.0
    (set! f0-1 (cond
                 (v1-0
                   (let ((a0-1 v1-0))
                     (if (if a0-1
                             (-> a0-1 child 3)
                             )
                         (set! f0-1 (-> v1-0 child 9))
                         (set! f0-1 (-> v1-0 child 9))
                         )
                     )
                   f0-1
                   )
                 (else
                   (get-height *ocean* arg0 #t)
                   )
                 )
          )
    )
  (the-as float f0-1)
  )

(defmethod rigid-body-platform-method-54 ((this rigid-body-platform) (ctrl-point rigid-body-control-point))
  (set! (-> ctrl-point world-pos w)
        (+ (rigid-body-platform-method-53 this (-> ctrl-point world-pos)) (-> this float-height-offset))
        )
  (let* ((s4-0 (new 'stack-no-clear 'vector))
         (f0-3 (- (-> ctrl-point world-pos w) (-> ctrl-point world-pos y)))
         (f30-0 (/ f0-3 (-> this info max-buoyancy-depth)))
         )
    (when (< 0.0 f0-3)
      (vector-float*!
        s4-0
        *y-vector*
        (* (-> this rbody state info mass)
           (fmin 1.0 f30-0)
           (/ (-> this info extra gravity) (the float (-> this info control-point-count)))
           (-> this info buoyancy-factor)
           )
        )
      (let ((v1-6 (-> this rbody))
            (a1-9 (-> ctrl-point world-pos))
            (a2-0 s4-0)
            )
        (rigid-body-method-18 (-> v1-6 state) a1-9 a2-0)
        )
      (vector-float*! s4-0 (-> ctrl-point velocity) (* -1.0 (-> this info drag-factor) (fmin 1.0 f30-0)))
      (let ((v1-11 (-> this rbody))
            (a1-13 (-> ctrl-point world-pos))
            )
        (rigid-body-method-18 (-> v1-11 state) a1-13 s4-0)
        )
      )
    )
  0
  0
  (none)
  )

(defmethod rigid-body-object-method-50 ((this rigid-body-platform) (arg0 float))
  (when (logtest? (-> this flags) (rigid-body-object-flag player-impulse-force player-contact-force))
    (if (logtest? (-> this flags) (rigid-body-object-flag player-impulse-force))
        (logclear! (-> this flags) (rigid-body-object-flag player-impulse-force))
        )
    (let ((rigid-body (-> this rbody))
          (force-pos (-> this player-force-position))
          (force (-> this player-force))
          (force-dist (-> this info player-force-distance))
          )
      (rigid-body-method-21 (-> rigid-body state) force-pos force force-dist)
      )
    )
  0
  (none)
  )

(defmethod rigid-body-platform-method-55 ((this rigid-body-platform))
  (let ((a1-0 (new 'stack-no-clear 'vector)))
    (vector-float*! a1-0 *y-vector* (* -1.0 (-> this info extra gravity) (-> this rbody state info mass)))
    (rigid-body-method-20 (-> this rbody state) a1-0)
    )
  0
  (none)
  )

(defmethod rigid-body-platform-method-56 ((this rigid-body-platform) (arg0 vector))
  (let ((v1-0 (new 'stack-no-clear 'vector)))
    (vector-! v1-0 arg0 (-> this rbody state position))
    (set! (-> v1-0 y) 0.0)
    (let* ((f0-1 (vector-length v1-0))
           (f1-1 (* 10.0 (fmax 0.0 (fmin 4096.0 (+ -4096.0 f0-1)))))
           )
      (when (< 0.0 f1-1)
        (vector-float*! v1-0 v1-0 (/ f1-1 f0-1))
        (rigid-body-method-20 (-> this rbody state) v1-0)
        )
      )
    )
  0
  (none)
  )

(defmethod rigid-body-object-method-29 ((this rigid-body-platform) (arg0 float))
  (let ((s4-0 (-> this rbody state matrix)))
    (dotimes (s3-0 (-> this info control-point-count))
      (let ((s2-0 (-> this control-point-array data s3-0)))
        (vector-matrix*! (-> s2-0 world-pos) (-> s2-0 local-pos) s4-0)
        (let ((v1-4 (-> this rbody))
              (a1-2 (-> s2-0 world-pos))
              (a2-1 (-> s2-0 velocity))
              )
          (rigid-body-method-22 (-> v1-4 state) a1-2 a2-1)
          )
        (rigid-body-platform-method-54 this s2-0)
        )
      )
    )
  (rigid-body-platform-method-55 this)
  (rigid-body-object-method-50 this arg0)
  0
  (none)
  )

(defmethod rigid-body-object-method-30 ((this rigid-body-platform))
  (if (-> this info platform)
      (detect-riders! (-> this root))
      )
  (set! (-> this player-velocity-prev quad) (-> this player-velocity quad))
  (if *target*
      (set! (-> this player-velocity quad) (-> *target* control transv quad))
      (set! (-> this player-velocity quad) (-> *null-vector* quad))
      )
  (let ((t9-1 (method-of-type rigid-body-object rigid-body-object-method-30)))
    (t9-1 this)
    )
  (logclear! (-> this flags) (rigid-body-object-flag player-contact-force))
  0
  (none)
  )

(defmethod rigid-body-object-method-47 ((this rigid-body-platform)
                                       (arg0 process-drawable)
                                       (arg1 attack-info)
                                       (arg2 touching-shapes-entry)
                                       (arg3 penetrate)
                                       )
  ((method-of-type rigid-body-object rigid-body-object-method-47) this arg0 arg1 arg2 arg3)
  #f
  )

(defmethod rigid-body-object-method-46 ((this rigid-body-platform) (arg0 process-drawable) (arg1 int) (arg2 symbol) (arg3 event-message-block))
  (case arg2
    (('edge-grabbed)
     (let ((v1-1 (the-as object (-> arg3 param 0))))
       (when (not (logtest? (-> this flags) (rigid-body-object-flag player-impulse-force)))
         (logior! (-> this flags) (rigid-body-object-flag player-contact-force))
         (set! (-> this player-force-position quad) (-> (the-as rigid-body-control-point v1-1) velocity quad))
         (vector-reset! (-> this player-force))
         (set! (-> this player-force y) (* -1.0 (-> this info player-weight)))
         )
       )
     )
    (('ridden)
     (let ((v1-7 (the-as object (-> arg3 param 0))))
       (when (the-as uint v1-7)
         (let* ((s5-1 (handle->process (-> (the-as collide-rider v1-7) rider-handle)))
                (v1-11 (if (type? s5-1 process-focusable)
                           (the-as process-focusable s5-1)
                           )
                       )
                )
           (when (and v1-11
                      (logtest? (-> v1-11 mask) (process-mask target))
                      (not (logtest? (-> v1-11 focus-status) (focus-status on-water under-water)))
                      )
             (when (not (logtest? (-> this flags) (rigid-body-object-flag player-impulse-force)))
               (logior! (-> this flags) (rigid-body-object-flag player-contact-force))
               (set! (-> this player-force-position quad) (-> v1-11 root trans quad))
               (vector-reset! (-> this player-force))
               (let* ((a1-5 (-> this player-force-position))
                      (f30-0 0.0)
                      (f28-0 1.0)
                      (f26-0 1.0)
                      (f0-4 (+ (- -4096.0 (-> a1-5 y)) (rigid-body-platform-method-53 this a1-5)))
                      (f1-2 12288.0)
                      (f0-8 (fmax f30-0 (fmin f28-0 (- f26-0 (* f0-4 (/ 1.0 f1-2))))))
                      )
                 (set! (-> this player-force y) (* -1.0 (-> this info player-weight) f0-8))
                 )
               )
             )
           )
         )
       )
     )
    (('bonk)
     (when (time-elapsed?
             (the-as int (-> this player-bonk-timeout))
             (the-as time-frame (-> this info player-force-timeout))
             )
       (set! (-> this player-bonk-timeout) (the-as uint (current-time)))
       (let* ((s4-0 arg0)
              (v1-31 (if (type? s4-0 process-drawable)
                         s4-0
                         )
                     )
              )
         (when v1-31
           (logior! (-> this flags) (rigid-body-object-flag player-impulse-force))
           (set! (-> this player-force-position quad) (-> v1-31 root trans quad))
           (let ((f0-14 (fmin
                          (* 0.00012207031
                             (the-as float (-> arg3 param 1))
                             (-> this info player-bonk-factor)
                             (-> this info player-weight)
                             )
                          (-> this info player-force-clamp)
                          )
                        )
                 )
             (vector-reset! (-> this player-force))
             (set! (-> this player-force y) (- f0-14))
             )
           )
         )
       )
     )
    (else
      ((method-of-type rigid-body-object rigid-body-object-method-46) this arg0 arg1 arg2 arg3)
      )
    )
  )

(defmethod rigid-body-object-method-37 ((this rigid-body-platform))
  (if (logtest? (-> this flags) (rigid-body-object-flag player-impulse-force))
      (sound-play-by-name
        (string->sound-name (-> this info sound-name))
        (new-sound-id)
        1024
        0
        0
        (sound-group sfx)
        #t
        )
      )
  (rigid-body-object-method-30 this)
  (quaternion-copy! (-> this root quat) (-> this rbody state rotation))
  (let ((v1-9 (-> this rbody))
        (a1-2 (-> this root trans))
        )
    (rigid-body-method-23 (-> v1-9 state) a1-2)
    )
  (rider-post)
  (none)
  )

(defmethod alloc-and-init-rigid-body-control ((this rigid-body-platform) (arg0 rigid-body-object-constants))
  (set! (-> this info) (the-as rigid-body-platform-constants arg0))
  (set! (-> this rbody) (new 'process 'rigid-body-control this))
  (set! (-> this control-point-array)
        (new 'process 'rigid-body-control-point-inline-array (-> this info control-point-count))
        )
  (update-transforms (-> this root))
  (let ((v1-5 (-> this rbody))
        (a1-3 (-> this info info))
        (a2-2 (-> this root trans))
        (a3-0 (-> this root quat))
        (t0-0 (method-of-object this rigid-body-object-method-29))
        )
    (rigid-body-method-25 (-> v1-5 state) a1-3 a2-2 a3-0 t0-0)
    )
  (set! (-> this player-bonk-timeout) (the-as uint (current-time)))
  (set! (-> this player-force quad) (-> *null-vector* quad))
  (set! (-> this player-velocity quad) (-> *null-vector* quad))
  (set! (-> this player-velocity-prev quad) (-> *null-vector* quad))
  (set! (-> this root max-iteration-count) (the-as uint 4))
  (set! (-> this max-time-step) (-> arg0 extra max-time-step))
  (set! (-> this water-anim) (the-as water-anim (entity-actor-lookup (-> this entity) 'water-actor 0)))
  0
  (none)
  )

(defmethod allocate-and-init-cshape ((this rigid-body-platform))
  (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) cshape-reaction-default)
    (set! (-> s5-0 no-reaction)
          (the-as (function collide-shape-moving collide-query vector vector object) nothing)
          )
    (let ((s4-0 (new 'process 'collide-shape-prim-mesh s5-0 (the-as uint 0) (the-as uint 0))))
      (set! (-> s4-0 prim-core collide-as) (collide-spec pusher))
      (set! (-> s4-0 prim-core collide-with) (collide-spec jak player-list))
      (set! (-> s4-0 prim-core action) (collide-action solid rideable))
      (set! (-> s4-0 transform-index) 0)
      (set-vector! (-> s4-0 local-sphere) 0.0 0.0 0.0 20480.0)
      (set! (-> s5-0 total-prims) (the-as uint 1))
      (set! (-> s5-0 root-prim) s4-0)
      )
    (pusher-init s5-0)
    (set! (-> s5-0 nav-radius) (* 0.75 (-> s5-0 root-prim local-sphere w)))
    (let ((v1-15 (-> s5-0 root-prim)))
      (set! (-> s5-0 backup-collide-as) (-> v1-15 prim-core collide-as))
      (set! (-> s5-0 backup-collide-with) (-> v1-15 prim-core collide-with))
      )
    (set! (-> this root) s5-0)
    )
  0
  (none)
  )

(define *rigid-body-platform-constants* (new 'static 'rigid-body-platform-constants
                                          :info (new 'static 'rigid-body-info
                                            :mass 2.0
                                            :inv-mass 0.5
                                            :linear-damping 1.0
                                            :angular-damping 1.0
                                            :bounce-factor 0.5
                                            :friction-factor 0.1
                                            :cm-offset-joint (new 'static 'vector :w 1.0)
                                            :inertial-tensor-box (new 'static 'array meters 3 (meters 4) (meters 4) (meters 4))
                                            )
                                          :extra (new 'static 'rigid-body-object-extra-info
                                            :max-time-step 0.033333335
                                            :gravity (meters 80)
                                            :idle-distance (meters 50)
                                            :attack-force-scale 1.0
                                            )
                                          :name '*rigid-body-platform-constants*
                                          :drag-factor 0.8
                                          :buoyancy-factor 1.5
                                          :max-buoyancy-depth (meters 1.5)
                                          :player-weight (meters 6.6)
                                          :player-bonk-factor 1.0
                                          :player-dive-factor 1.0
                                          :player-force-distance (meters 1000)
                                          :player-force-clamp (meters 1000000)
                                          :player-force-timeout #x1e
                                          :explosion-force (meters 1000)
                                          :control-point-count 1
                                          :platform #t
                                          :sound-name #f
                                          )
        )

(defmethod init-skel-and-rigid-body ((this rigid-body-platform))
  (set! (-> this float-height-offset) 0.0)
  (alloc-and-init-rigid-body-control this *rigid-body-platform-constants*)
  (let ((s5-0 (-> this info control-point-count)))
    (dotimes (s4-0 s5-0)
      (let ((s3-0 (-> this control-point-array data s4-0)))
        (let ((f30-0 (* 65536.0 (/ (the float s4-0) (the float s5-0)))))
          (set! (-> s3-0 local-pos x) (* 12288.0 (sin f30-0)))
          (set! (-> s3-0 local-pos y) -10240.0)
          (set! (-> s3-0 local-pos z) (* 12288.0 (cos f30-0)))
          )
        (set! (-> s3-0 local-pos w) 1.0)
        )
      )
    )
  0
  (none)
  )

(defmethod init-from-entity! ((this rigid-body-platform) (arg0 entity-actor))
  "Typically the method that does the initial setup on the process, potentially using the [[entity-actor]] provided as part of that.
This commonly includes things such as:
- stack size
- collision information
- loading the skeleton group / bones
- sounds"
  (logior! (-> this mask) (process-mask platform))
  (allocate-and-init-cshape this)
  (process-drawable-from-entity! this arg0)
  (init-skel-and-rigid-body this)
  (rigid-body-object-method-34 this)
  0
  (none)
  )
