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

;; name: carry-h.gc
;; name in dgo: carry-h
;; dgos: ENGINE, GAME

;; +++carry-mode
(defenum carry-mode
  :type uint8
  :bitfield #t
  (carry 0)
  (mech-carry 1)
  (mech-drag 2)
  (cm3)
  (cm4)
  (cm5)
  (cm6)
  (cm7)
  )
;; ---carry-mode

;; DECOMP BEGINS

(deftype carry-info (basic)
  ((process           (pointer target))
   (pickup-time       time-frame)
   (other-value       float)
   (other             handle)
   (point             vector      :inline)
   (normal            vector      :inline)
   (max-angle         degrees)
   (max-distance      meters)
   (max-pull          meters)
   (min-pull          meters)
   (grab-trans-blend  float)
   (carry-radius      meters)
   (backup-radius     meters)
   (joint             int8)
   (mode              carry-mode)
   (face-dir          int8)
   (local-point       vector      :inline)
   (local-normal      vector      :inline)
   (grab-quat         quaternion  :inline)
   (grab-trans        vector      :inline)
   (hold-trans        vector      :inline)
   )
  (:methods
    (new (symbol type process-drawable int vector vector float) _type_)
    (carry-info-method-9 (_type_) none)
    (distance-from-destination (_type_ carry-info) float)
    (drag! (_type_ carry-info) none)
    (drop-impl! (_type_ carry-info) none)
    (carry-info-method-13 (_type_) symbol :behavior process-drawable)
    (carry! (_type_ carry-info vector vector) none)
    (drop! (_type_ carry-info) none)
    (translate! (_type_) symbol :behavior process-drawable)
    )
  )


(defmethod new carry-info ((allocation symbol)
                         (type-to-make type)
                         (arg0 process-drawable)
                         (arg1 int)
                         (arg2 vector)
                         (arg3 vector)
                         (arg4 float)
                         )
  (let ((gp-0 (object-new allocation type-to-make (the-as int (-> type-to-make size)))))
    (set! (-> gp-0 mode) (carry-mode carry))
    (set! (-> gp-0 process) (the-as (pointer target) (process->ppointer arg0)))
    (set! (-> gp-0 other) (the-as handle #f))
    (set! (-> gp-0 joint) arg1)
    (set! arg4 (cond
                 ((= arg4 0.0)
                  131072.0
                  )
                 (else
                   (empty)
                   arg4
                   )
                 )
          )
    (set! (-> gp-0 max-angle) arg4)
    (set! (-> gp-0 max-distance) 8192.0)
    (set! (-> gp-0 local-point quad) (-> arg2 quad))
    (set! (-> gp-0 local-normal quad) (-> arg3 quad))
    (let* ((s5-1 (-> arg0 root))
           (v1-7 (if (type? s5-1 collide-shape)
                     (the-as collide-shape s5-1)
                     )
                 )
           )
      (when v1-7
        (set! (-> gp-0 backup-radius) (-> v1-7 root-prim local-sphere w))
        (set! (-> gp-0 carry-radius) (-> v1-7 root-prim local-sphere w))
        )
      )
    gp-0
    )
  )

(defmethod carry-info-method-9 ((this carry-info))
  (let ((s5-0 (-> this process 0 node-list data (-> this joint) bone transform)))
    (vector-rotate*! (-> this normal) (-> this local-normal) s5-0)
    (vector-matrix*! (-> this point) (-> this local-point) s5-0)
    )
  0
  (none)
  )

(defmethod distance-from-destination ((this carry-info) (arg0 carry-info))
  "Returns the distance from the current `point` and the provided [[carry-info]]'s `point`.
Returns `-1.0` if it exceeds the maximum allowed"
  (let* ((f28-0 (vector-y-angle (vector-! (new 'stack-no-clear 'vector) (-> arg0 point) (-> this point))))
         (f30-0 (fabs (deg-diff f28-0 (vector-y-angle (-> this normal)))))
         (f28-1 (fabs (deg-diff (+ 32768.0 f28-0) (vector-y-angle (-> arg0 normal)))))
         (f26-0 (vector-vector-distance (-> this point) (-> arg0 point)))
         )
    (cond
      ((or (< (-> this max-distance) f26-0)
           (< (-> arg0 max-distance) f26-0)
           (< (-> this max-angle) f30-0)
           (or (< (-> arg0 max-angle) f28-1) (not (logtest? (-> this mode) (-> arg0 mode))))
           )
       (if (< (-> this max-distance) f26-0)
           (format
             #t
             "  ~A ~A failed for this distance ~M ~M~%"
             (-> this process 0 name)
             (-> arg0 process 0 name)
             f26-0
             (-> this max-distance)
             )
           )
       (if (< (-> arg0 max-distance) f26-0)
           (format
             #t
             "  ~A ~A failed for other distance ~M ~M~%"
             (-> this process 0 name)
             (-> arg0 process 0 name)
             f26-0
             (-> arg0 max-distance)
             )
           )
       (if (< (-> this max-angle) f30-0)
           (format
             #t
             "  ~A ~A failed for this angle ~R ~R~%"
             (-> this process 0 name)
             (-> arg0 process 0 name)
             f30-0
             (-> this max-angle)
             )
           )
       (if (< (-> arg0 max-angle) f28-1)
           (format
             #t
             "  ~A ~A failed for other angle ~R ~R~%"
             (-> this process 0 name)
             (-> arg0 process 0 name)
             f28-1
             (-> arg0 max-angle)
             )
           )
       (if (not (logtest? (-> this mode) (-> arg0 mode)))
           (format
             #t
             "  ~A ~A failed for mode ~X ~X~%"
             (-> this process 0 name)
             (-> arg0 process 0 name)
             (-> this mode)
             (-> arg0 mode)
             )
           )
       -1.0
       )
      (else
        (+ f26-0 (* 409.6 (- 32768.0 f30-0)))
        )
      )
    )
  )

(defmethod drag! ((this carry-info) (arg0 carry-info))
  (let ((v1-0 (-> arg0 process)))
    (set! (-> this other) (the-as handle (logior (if v1-0
                                                     (new 'static 'handle :pid (-> v1-0 0 pid))
                                                     (new 'static 'handle)
                                                     )
                                                 (new 'static 'handle :process v1-0)
                                                 )
                                  )
          )
    )
  (let ((v1-3 (-> this process)))
    (set! (-> arg0 other) (the-as handle (logior (if v1-3
                                                     (new 'static 'handle :pid (-> v1-3 0 pid))
                                                     (new 'static 'handle)
                                                     )
                                                 (new 'static 'handle :process v1-3)
                                                 )
                                  )
          )
    )
  (set! (-> this pickup-time) (-> this process 0 clock frame-counter))
  (set! (-> arg0 pickup-time) (-> arg0 process 0 clock frame-counter))
  (set! (-> arg0 grab-trans-blend) 1.0)
  (let* ((s4-0 (the-as collide-shape (-> arg0 process 0 control)))
         (v1-17 (if (type? (the-as control-info s4-0) collide-shape)
                    s4-0
                    )
                )
         )
    (if v1-17
        (set! (-> v1-17 root-prim local-sphere w) (-> arg0 carry-radius))
        )
    )
  (quaternion-copy! (-> arg0 grab-quat) (-> arg0 process 0 control quat))
  (quaternion-rotate-y! (-> arg0 grab-quat) (-> arg0 grab-quat) (- (vector-y-angle (-> this normal))))
  (let* ((f30-0 (quaternion-y-angle (-> arg0 grab-quat)))
         (f0-8 (the float (the int (* 0.000061035156 (+ 73728.0 (the float (sar (shl (the int f30-0) 48) 48)))))))
         (f28-0 (the float (sar (shl (the int (* 16384.0 f0-8)) 48) 48)))
         )
    (quaternion-rotate-y! (-> arg0 grab-quat) (-> arg0 grab-quat) (deg-diff f30-0 f28-0))
    (let ((s3-2
            (matrix-4x4-inverse!
              (new 'stack-no-clear 'matrix)
              (-> arg0 process 0 node-list data (-> arg0 joint) bone transform)
              )
            )
          (s4-3 (vector-negate! (new 'stack-no-clear 'vector) (-> this normal)))
          )
      (set! (-> s4-3 y) 0.0)
      (vector-xz-normalize! s4-3 (-> arg0 max-pull))
      (vector+! s4-3 s4-3 (-> arg0 point))
      (vector-! s4-3 s4-3 (-> arg0 process 0 control trans))
      (vector-rotate-y! s4-3 s4-3 (- (deg-diff f30-0 f28-0)))
      (vector+! s4-3 s4-3 (-> arg0 process 0 control trans))
      (vector-matrix*! s4-3 s4-3 s3-2)
      (set! (-> arg0 grab-trans quad) (-> s4-3 quad))
      )
    )
  (set! (-> arg0 hold-trans x)
        (+ (fmax (fmin (- (-> arg0 grab-trans x) (-> arg0 local-point x)) (-> arg0 min-pull)) (- (-> arg0 min-pull)))
           (-> arg0 local-point x)
           )
        )
  (set! (-> arg0 hold-trans z)
        (+ (fmax (fmin (- (-> arg0 grab-trans z) (-> arg0 local-point z)) (-> arg0 min-pull)) (- (-> arg0 min-pull)))
           (-> arg0 local-point z)
           )
        )
  (change-parent (ppointer->process (-> arg0 process)) (ppointer->process (-> this process)))
  (let ((v1-49 (-> (the-as collide-shape (-> (the-as process-drawable (ppointer->process (-> arg0 process))) root))
                   root-prim
                   )
               )
        )
    (set! (-> (the-as collide-shape (-> (the-as process-drawable (ppointer->process (-> arg0 process))) root))
              backup-collide-as
              )
          (-> v1-49 prim-core collide-as)
          )
    (set! (-> (the-as collide-shape (-> (the-as process-drawable (ppointer->process (-> arg0 process))) root))
              backup-collide-with
              )
          (-> v1-49 prim-core collide-with)
          )
    )
  (let ((v1-54 (-> (the-as collide-shape (-> (the-as process-drawable (ppointer->process (-> arg0 process))) root))
                   root-prim
                   )
               )
        )
    (set! (-> v1-54 prim-core collide-as) (collide-spec))
    (set! (-> v1-54 prim-core collide-with) (collide-spec))
    )
  0
  0
  (none)
  )

(defmethod drop-impl! ((this carry-info) (arg0 carry-info))
  (let ((a1-2 (vector-z-quaternion! (new 'stack-no-clear 'vector) (-> arg0 process 0 control quat))))
    (set! (-> a1-2 y) 0.0)
    (set-heading-vec-clear-roll-pitch! (-> arg0 process 0 control) a1-2)
    )
  (let* ((s4-0 (the-as collide-shape (-> arg0 process 0 control)))
         (v1-9 (if (type? (the-as control-info s4-0) collide-shape)
                   s4-0
                   )
               )
         )
    (if v1-9
        (set! (-> v1-9 root-prim local-sphere w) (-> arg0 backup-radius))
        )
    )
  (set! (-> this other) (the-as handle #f))
  (set! (-> arg0 other) (the-as handle #f))
  (change-parent (ppointer->process (-> arg0 process)) *entity-pool*)
  (let ((v1-16
          (-> (the-as collide-shape (-> (the-as process-drawable (ppointer->process (-> arg0 process))) root))
              root-prim
              )
          )
        )
    (set! (-> v1-16 prim-core collide-as)
          (-> (the-as collide-shape (-> (the-as process-drawable (ppointer->process (-> arg0 process))) root))
              backup-collide-as
              )
          )
    (set! (-> v1-16 prim-core collide-with)
          (-> (the-as collide-shape (-> (the-as process-drawable (ppointer->process (-> arg0 process))) root))
              backup-collide-with
              )
          )
    )
  0
  (none)
  )

(defmethod carry-info-method-13 ((this carry-info))
  (let ((a1-0 (new 'stack-no-clear 'event-message-block)))
    (set! (-> a1-0 from) (process->ppointer self))
    (set! (-> a1-0 num-params) 0)
    (set! (-> a1-0 message) 'carry-info)
    (let* ((s4-0 (the-as carry-info (send-event-function (handle->process (-> this other)) a1-0)))
           (s2-0 (-> this process 0 node-list data (-> this joint) bone transform))
           (v1-10 (vector-matrix*!
                    (new 'stack-no-clear 'vector)
                    (vector-lerp!
                      (new 'stack-no-clear 'vector)
                      (-> this hold-trans)
                      (-> this grab-trans)
                      (-> this grab-trans-blend)
                      )
                    s2-0
                    )
                  )
           (s3-2 (vector-! (new 'stack-no-clear 'vector) v1-10 (-> this process 0 control trans)))
           )
      (when s4-0
        (let ((s5-1 (new 'stack-no-clear 'matrix)))
          (let* ((a2-3 (-> s4-0 process 0 node-list data (-> s4-0 joint) bone transform))
                 (v1-16 (-> a2-3 quad 0))
                 (a0-16 (-> a2-3 quad 1))
                 (a1-3 (-> a2-3 quad 2))
                 (a2-4 (-> a2-3 trans quad))
                 )
            (set! (-> s5-1 quad 0) v1-16)
            (set! (-> s5-1 quad 1) a0-16)
            (set! (-> s5-1 quad 2) a1-3)
            (set! (-> s5-1 trans quad) a2-4)
            )
          (vector-normalize! (the-as vector (-> s5-1 vector)) 1.0)
          (vector-normalize! (-> s5-1 vector 1) 1.0)
          (vector-normalize! (-> s5-1 vector 2) 1.0)
          (vector-reset! (-> s5-1 trans))
          (let* ((a1-8 (quaternion-normalize! (matrix->quaternion (new 'stack-no-clear 'quaternion) s5-1)))
                 (s5-3 (quaternion-normalize! (quaternion*! a1-8 a1-8 (-> this grab-quat))))
                 (v1-19 (vector-! (new 'stack-no-clear 'vector) (-> s4-0 point) s3-2))
                 (f30-0 (* 0.033333335 (the float (- (current-time) (-> this pickup-time)))))
                 )
            (cond
              ((time-elapsed? (-> this pickup-time) (seconds 1))
               (set! (-> this process 0 control trans quad) (-> v1-19 quad))
               (quaternion-copy! (-> this process 0 control quat) s5-3)
               )
              (else
                (vector-lerp!
                  (-> this process 0 control trans)
                  (-> this process 0 control trans)
                  v1-19
                  (fmin 1.0 (* f30-0 (-> self clock time-adjust-ratio)))
                  )
                (quaternion-slerp!
                  (-> this process 0 control quat)
                  (-> this process 0 control quat)
                  s5-3
                  (fmin 1.0 (* f30-0 (-> self clock time-adjust-ratio)))
                  )
                )
              )
            )
          )
        #t
        )
      )
    )
  )

;; WARN: Return type mismatch vector vs none.
(defmethod carry! ((this carry-info) (arg0 carry-info) (arg1 vector) (arg2 vector))
  (let ((v1-0 (-> arg0 process)))
    (set! (-> this other) (the-as handle (logior (if v1-0
                                                     (new 'static 'handle :pid (-> v1-0 0 pid))
                                                     (new 'static 'handle)
                                                     )
                                                 (new 'static 'handle :process v1-0)
                                                 )
                                  )
          )
    )
  (let ((v1-3 (-> this process)))
    (set! (-> arg0 other) (the-as handle (logior (if v1-3
                                                     (new 'static 'handle :pid (-> v1-3 0 pid))
                                                     (new 'static 'handle)
                                                     )
                                                 (new 'static 'handle :process v1-3)
                                                 )
                                  )
          )
    )
  (set! (-> this pickup-time) (-> this process 0 clock frame-counter))
  (set! (-> arg0 pickup-time) (-> arg0 process 0 clock frame-counter))
  (set! (-> arg0 grab-trans-blend) 1.0)
  (let* ((s2-0 (the-as collide-shape (-> arg0 process 0 control)))
         (v1-17 (if (type? (the-as control-info s2-0) collide-shape)
                    s2-0
                    )
                )
         )
    (if v1-17
        (set! (-> v1-17 root-prim local-sphere w) (-> arg0 carry-radius))
        )
    )
  (quaternion-copy! (-> arg0 grab-quat) (-> arg0 process 0 control quat))
  (set! (-> arg0 grab-trans quad) (-> arg0 process 0 control trans quad))
  (set! (-> arg0 hold-trans quad) (-> this process 0 control trans quad))
  (let ((s2-2 (vector-! (new 'stack-no-clear 'vector) (-> this point) (-> arg0 point))))
    (vector-xz-normalize! s2-2 (-> arg0 max-pull))
    (vector+! s2-2 s2-2 (-> arg0 point))
    (let ((f30-0 (y-angle (-> arg0 process 0 control))))
      (vector-y-angle (vector-! (new 'stack-no-clear 'vector) s2-2 (-> this process 0 control trans)))
      (let* ((f0-5 (the float (-> this face-dir)))
             (f28-0 (the float (sar (shl (the int (* 16384.0 f0-5)) 48) 48)))
             )
        (set-vector! arg2 (sin (+ f30-0 f28-0)) 0.0 (cos (+ f30-0 f28-0)) 1.0)
        )
      )
    )
  (vector+float*! arg1 (-> arg0 point) arg2 (- (-> arg0 carry-radius)))
  (change-parent (ppointer->process (-> arg0 process)) (ppointer->process (-> this process)))
  (let ((v1-49 (-> (the-as collide-shape (-> (the-as process-drawable (ppointer->process (-> arg0 process))) root))
                   root-prim
                   )
               )
        )
    (set! (-> (the-as collide-shape (-> (the-as process-drawable (ppointer->process (-> arg0 process))) root))
              backup-collide-as
              )
          (-> v1-49 prim-core collide-as)
          )
    (set! (-> (the-as collide-shape (-> (the-as process-drawable (ppointer->process (-> arg0 process))) root))
              backup-collide-with
              )
          (-> v1-49 prim-core collide-with)
          )
    )
  (let ((v1-54 (-> (the-as collide-shape (-> (the-as process-drawable (ppointer->process (-> arg0 process))) root))
                   root-prim
                   )
               )
        )
    (set! (-> v1-54 prim-core collide-as) (collide-spec))
    (set! (-> v1-54 prim-core collide-with) (collide-spec))
    )
  0
  (none)
  )

(defmethod translate! ((this carry-info))
  (let ((a1-0 (new 'stack-no-clear 'event-message-block)))
    (set! (-> a1-0 from) (process->ppointer self))
    (set! (-> a1-0 num-params) 0)
    (set! (-> a1-0 message) 'carry-info)
    (let ((a0-6 (the-as carry-info (send-event-function (handle->process (-> this other)) a1-0))))
      (when a0-6
        (let ((v1-6 (vector-! (new 'stack-no-clear 'vector) (-> this grab-trans) (-> this hold-trans))))
          (vector+! (-> this process 0 control trans) (-> a0-6 process 0 control trans) v1-6)
          )
        #t
        )
      )
    )
  )

(defmethod drop! ((this carry-info) (arg0 carry-info))
  (drop-impl! this arg0)
  (none)
  )
