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

;; name: rigid-body-plat.gc
;; name in dgo: rigid-body-plat
;; dgos: VOCA

;; 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   time-frame)
   (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)
   (float-height-offset  float)
   (player-bonk-timeout  time-frame)
   (water-anim           entity-actor)
   )
  (:methods
    (get-lava-height (_type_ vector) float)
    (rigid-body-platform-method-57 (_type_ (inline-array vector)) none)
    (rigid-body-platform-method-58 (_type_) none)
    (rigid-body-platform-method-59 (_type_ vector) none)
    )
  )


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

(defmethod get-lava-height ((this rigid-body-platform) (arg0 vector))
  (let ((v1-0 (-> this water-anim)))
    0.0
    (cond
      (v1-0
        (let ((a0-1 v1-0))
          (if (if a0-1
                  (-> a0-1 extra process)
                  )
              (-> v1-0 extra trans y)
              (-> v1-0 extra trans y)
              )
          )
        )
      (else
        (get-height *ocean* arg0 #t)
        )
      )
    )
  )

(defmethod rigid-body-platform-method-57 ((this rigid-body-platform) (arg0 (inline-array vector)))
  (set! (-> arg0 1 w) (+ (get-lava-height this (-> arg0 1)) (-> this float-height-offset)))
  (let* ((s4-0 (new 'stack-no-clear 'vector))
         (f0-3 (- (-> arg0 1 w) (-> arg0 1 y)))
         (f30-0 (/ f0-3 (-> this info max-buoyancy-depth)))
         )
    (when (< 0.0 f0-3)
      (vector-float*!
        s4-0
        *y-vector*
        (* (-> this rbody info mass)
           (fmin 1.0 f30-0)
           (/ (-> this info extra gravity) (the float (-> this info control-point-count)))
           (-> this info buoyancy-factor)
           )
        )
      (apply-impact! (-> this rbody) (-> arg0 1) s4-0)
      (vector-float*! s4-0 (-> arg0 2) (* -1.0 (-> this info drag-factor) (fmin 1.0 f30-0)))
      (apply-impact! (-> this rbody) (-> arg0 1) s4-0)
      )
    )
  0
  0
  (none)
  )

(defmethod rigid-body-object-method-53 ((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))
        )
    (rigid-body-control-method-21
      (-> this rbody)
      (-> this player-force-position)
      (-> this player-force)
      (-> this info player-force-distance)
      )
    )
  0
  (none)
  )

(defmethod rigid-body-platform-method-58 ((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 info mass)))
    (add-force! (-> this rbody) a1-0)
    )
  0
  (none)
  )

(defmethod rigid-body-platform-method-59 ((this rigid-body-platform) (arg0 vector))
  (let ((v1-0 (new 'stack-no-clear 'vector)))
    (vector-! v1-0 arg0 (-> this rbody 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))
        (add-force! (-> this rbody) v1-0)
        )
      )
    )
  0
  (none)
  )

(defmethod apply-gravity! ((this rigid-body-platform) (arg0 float))
  (let ((s4-0 (-> this rbody 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)
        (rigid-body-control-method-23 (-> this rbody) (-> s2-0 world-pos) (-> s2-0 velocity))
        (rigid-body-platform-method-57 this (the-as (inline-array vector) s2-0))
        )
      )
    )
  (rigid-body-platform-method-58 this)
  (rigid-body-object-method-53 this arg0)
  0
  (none)
  )

(defmethod rigid-body-object-method-32 ((this rigid-body-platform))
  (if (-> this info platform)
      (detect-riders! (-> this root))
      )
  (let ((t9-1 (method-of-type rigid-body-object rigid-body-object-method-32)))
    (t9-1 this)
    )
  (logclear! (-> this flags) (rigid-body-object-flag player-contact-force))
  0
  (none)
  )

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

(defmethod rbody-event-handler ((this rigid-body-platform) (arg0 process) (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))
         (vector-copy! (-> this player-force-position) (-> (the-as rigid-body-control-point v1-1) velocity))
         (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 ((v1-11 (as-type (handle->process (-> (the-as collide-rider v1-7) rider-handle)) process-focusable)))
           (when (and v1-11
                      (logtest? (-> v1-11 mask) (process-mask target))
                      (not (logtest? (-> (the-as process-focusable 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))
               (vector-copy! (-> this player-force-position) (-> (the-as process-focusable v1-11) root trans))
               (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)) (get-lava-height 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? (-> this player-bonk-timeout) (-> this info player-force-timeout))
       (set-time! (-> this player-bonk-timeout))
       (let ((v1-31 (as-type arg0 process-drawable)))
         (when v1-31
           (logior! (-> this flags) (rigid-body-object-flag player-impulse-force))
           (vector-copy! (-> this player-force-position) (-> (the-as process-focusable v1-31) root trans))
           (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 rbody-event-handler) this arg0 arg1 arg2 arg3)
      )
    )
  )

(defmethod rbody-post ((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) #t)
      )
  (rigid-body-object-method-32 this)
  (quaternion-copy! (-> this root quat) (the-as quaternion (-> this rbody rot)))
  (rigid-body-control-method-25 (-> this rbody) (-> this root trans))
  (rider-post)
  (none)
  )

(defmethod alloc-rbody-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))
  (init!
    (-> this rbody)
    (-> this info info)
    (-> this root trans)
    (-> this root quat)
    (the-as (function rigid-body-object float) (method-of-object this apply-gravity!))
    )
  (set-time! (-> this player-bonk-timeout))
  (vector-copy! (-> this player-force) *null-vector*)
  (set! (-> this root max-iteration-count) (the-as uint 4))
  (set! (-> this max-time-step) (-> arg0 extra max-time-step))
  (set! (-> this water-anim) (entity-actor-lookup (-> this entity) 'water-actor 0))
  0
  (none)
  )

(defmethod init-collision! ((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 (seconds 0.1)
                                          :explosion-force (meters 1000)
                                          :control-point-count 1
                                          :platform #t
                                          :sound-name #f
                                          )
        )

(defmethod init-rbody-control! ((this rigid-body-platform))
  (set! (-> this float-height-offset) 0.0)
  (alloc-rbody-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)
  )

;; WARN: Return type mismatch int vs object.
(defmethod init-from-entity! ((this rigid-body-platform) (arg0 entity-actor))
  "Set up a newly created process from the entity that created it."
  (logior! (-> this mask) (process-mask platform))
  (init-collision! this)
  (process-drawable-from-entity! this arg0)
  (init-rbody-control! this)
  (go-idle this)
  0
  )
