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

;; name: collide-shape-h.gc
;; name in dgo: collide-shape-h
;; dgos: GAME

;; +++collide-action
(defenum collide-action
  :bitfield #t
  :type uint32
  (solid                  0) ;; 1
  (semi-solid             1) ;; 2
  (rideable               2) ;; 4
  (can-ride               3) ;; 8
  (dont-push-away         4) ;; 16
  (pull-rider-can-collide 5) ;; 32
  (deadly                 6) ;; 64
  (persistent-attack      7) ;; 128
  (no-smack               8) ;; 256
  (no-standon             9) ;; 512
  (block-turn-around     10) ;; 1024
  (check-edge            11) ;; 2048
  (check-stuck           12) ;; 4096
  (stuck-wall-escape     13) ;; 8192
  (no-normal-reset       14) ;; 163884
  (edge-grabbed          15) ;; 32768
  (nav-sphere            16) ;; hi 1
  )
;; ---collide-action


;; +++overlaps-others-options
(defenum overlaps-others-options
  :type uint32
  :bitfield #t
  (oo0)
  (oo1)
  (oo2)
  (oo3)
  (oo4)
  )
;; ---overlaps-others-options


;; +++collide-list-enum
(defenum collide-list-enum
  (hit-by-player)
  (usually-hit-by-player)
  (hit-by-others)
  (player)
  )
;; ---collide-list-enum


;; +++collide-status
(defenum collide-status
  :bitfield #t
  :type uint64
  (on-surface 0)
  (on-ground 1)
  (touch-surface 2)
  (touch-wall 3)
  (touch-ceiling 4)
  (touch-actor 5)
  (on-special-surface 6)
  (touch-edge 7)
  (no-touch 8)
  (blocked 9)
  (on-water 10)
  (impact-surface 11)
  (touch-background 12)
  (stuck 13)
  (touch-ceiling-sticky 14)
  (glance 15)
  (probe-hit 16)
  )
;; ---collide-status


(defmacro normalized-heading-to-quaternion! (quat heading)
  "Modified for PC. This does a clever trick, but it doesn't work if the heading is exactly
   [0, 0, -1] because this tries to normalize a quaternion that's all 0's.
   I think that, on PS2, something prevents the heading from being exactly 0, 0, -1,
   but this doesn't happen on PC. A similar thing happened with Jak 1's punch glitch,
   where some trig functions were slightly off from returning exactly 0.0 and 1.0 on PS2
   rounding only."
  `(begin
     (if (and (= (-> ,heading x) 0.0)
              (= (+ 1.0 (-> ,heading z)) 0.0)
              )
         (quaternion-set! ,quat 0.0 1.0 0.0 0.0)
         (quaternion-set! ,quat 0.0 (-> ,heading x) 0.0 (+ 1.0 (-> ,heading z)))
         )
     (quaternion-normalize! ,quat)
     )
  )

(declare-type collide-shape trsqv)
(declare-type collide-shape-moving collide-shape)
(declare-type control-info collide-shape-moving)
(declare-type touching-list structure)
(declare-type collide-query structure)
(declare-type water-info structure)
(declare-type collide-shape-prim-group basic)
(declare-type collide-cache-prim structure)
(declare-type collide-shape-prim basic)
(declare-type collide-cache basic)
(declare-type rigid-body structure)

(define-extern cshape-reaction-update-state (function control-info collide-query vector none))
(define-extern cshape-reaction-just-move (function control-info collide-query vector collide-status))
(define-extern collide-shape-draw-debug-marks (function none))

;; +++cshape-reaction-flags
(defenum cshape-reaction-flags
  :bitfield #t
  :type uint32
  (csrf00)
  (csrf01)
  (csrf02)
  (csrf03)
  (csrf04)
  (csrf05)
  (csrf06)
  (csrf07)
  (csrf08)
  (csrf09)
  (csrf10)
  (csrf11)
  (csrf12)
  (csrf13)
  (csrf14)
  (csrf15)
  (csrf16)
  (csrf17)
  (csrf18)
  (csrf19)
  (csrf20)
  (csrf21)
  (csrf22)
  (csrf23)
  (csrf24)
  (csrf25)
  (csrf26)
  (csrf27)
  (csrf28)
  (csrf29)
  (csrf30)
  (csrf31)
  )
;; ---cshape-reaction-flags


;; +++nav-flags
(defenum nav-flags
  :type uint8
  :bitfield #t
  (has-root-sphere 0)
  (has-extra-sphere 1)
  (has-child-spheres 2)
  )
;; ---nav-flags


;; DECOMP BEGINS

(deftype collide-rider (structure)
  "Something that rides a moving object."
  ((rider-handle     handle)
   (sticky-prim      collide-shape-prim)
   (prim-ry          float)
   (rider-local-pos  vector  :inline)
   )
  )


(deftype collide-rider-pool (basic)
  "A pool containing all the riders of an object."
  ((alloc-count  int32)
   (riders       collide-rider  20 :inline)
   )
  (:methods
    (add-rider (_type_ handle) collide-rider)
    (prepare (_type_) none)
    )
  )


(defmethod prepare ((this collide-rider-pool))
  "Gets this pool ready to be used to allow allocations.  This should be called once at the start of every frame."
  (set! (-> this alloc-count) 0)
  0
  (none)
  )

(deftype pull-rider-info (structure)
  ((rider           collide-rider)
   (rider-cshape    collide-shape-moving)
   (rider-delta-ry  float)
   (rider-dest      vector  :inline)
   )
  )


(kmemopen global "collide-lists")

(define *collide-hit-by-player-list* (new 'global 'engine 'collide-hit-by-player-list 640 connection))

(define *collide-hit-by-others-list* (new 'global 'engine 'collide-hit-by-others-list 768 connection))

(define *collide-player-list* (new 'global 'engine 'collide-player-list 32 connection))

(kmemclose)

(deftype overlaps-others-params (structure)
  ((options                      overlaps-others-options)
   (collide-with-filter          collide-spec)
   (tlist                        touching-list)
   (filtered-root-collide-with   collide-spec)
   (filtered-child-collide-with  collide-spec)
   (filtered-other-collide-as    collide-spec)
   )
  )


(deftype move-above-ground-params (structure)
  ((gnd-collide-with        collide-spec)
   (popup                   float)
   (dont-move-if-overlaps?  symbol)
   (hover-if-no-ground?     symbol)
   (overlaps-params         overlaps-others-params  :inline)
   (new-pos                 vector                  :inline)
   (old-gspot-pos           vector                  :inline)
   (old-gspot-normal        vector                  :inline)
   (pat                     pat-surface)
   (on-ground?              symbol)
   (do-move?                symbol)
   )
  )


(deftype collide-prim-core (structure)
  "Collide primitives use this to store their world sphere and their collision flags."
  ((world-sphere  vector   :inline)
   (collide-as    collide-spec)
   (collide-with  collide-spec)
   (action        collide-action)
   (prim-type     int8)
   (unused1       uint8    3)
   (quad          uint128  2 :overlay-at (-> world-sphere data 0))
   )
  )


(deftype collide-shape-prim (basic)
  "Base class for collide primitives."
  ((cshape           collide-shape)
   (prim-id          uint32)
   (transform-index  int8)
   (unused2          int8               3)
   (prim-core        collide-prim-core  :inline :offset  16)
   (local-sphere     vector             :inline :offset  48)
   (specific         uint8              16      :offset  64)
   (world-sphere     vector             :inline :overlay-at (-> prim-core quad 0))
   (collide-as       collide-spec               :overlay-at (-> prim-core quad 1))
   (collide-with     collide-spec               :offset  36)
   (action           collide-action             :offset  40)
   (prim-type        int8                       :offset  44)
   (radius           meters                     :overlay-at (-> local-sphere w))
   )
  (:methods
    (new (symbol type collide-shape uint int) _type_)
    (debug-draw (_type_) none)
    (add-fg-prim-using-box (_type_ collide-cache) none)
    (add-fg-prim-using-line-sphere (_type_ collide-cache object) none)
    (overlaps-others-test (_type_ overlaps-others-params collide-shape-prim) symbol)
    (overlaps-others-group (_type_ overlaps-others-params collide-shape-prim-group) symbol)
    (collide-shape-prim-method-14 () none)
    (collide-with-collide-cache-prim-mesh (_type_ collide-query collide-cache-prim) none)
    (collide-with-collide-cache-prim-sphere (_type_ collide-query collide-cache-prim) none)
    (on-platform-test (_type_ collide-shape-prim collide-query float) none)
    (should-push-away-test (_type_ collide-shape-prim collide-query) none)
    (should-push-away-a-group-test (_type_ collide-shape-prim-group collide-query) none)
    )
  )


(deftype collide-shape-prim-sphere (collide-shape-prim)
  "A sphere primitive for collide shapes."
  ((pat         pat-surface  :overlay-at (-> specific 0))
   (nav-radius  float        :overlay-at (-> specific 4))
   )
  (:methods
    (new (symbol type collide-shape uint) _type_)
    )
  )


(deftype collide-shape-prim-mesh (collide-shape-prim)
  "A mesh primitive for collide shapes."
  ((mesh              collide-mesh              :overlay-at (-> specific 0))
   (mesh-id           int32                     :overlay-at (-> specific 4))
   (mesh-cache-id     uint32                    :overlay-at (-> specific 8))
   (mesh-cache-entry  collide-mesh-cache-entry  :overlay-at (-> specific 12))
   )
  (:methods
    (new (symbol type collide-shape uint uint) _type_)
    )
  )


(deftype collide-shape-prim-group (collide-shape-prim)
  "A group of collide primitives."
  ((num-children        uint8                              :overlay-at (-> specific 0))
   (num-alloc-children  uint8                              :overlay-at (-> specific 1))
   (child               (inline-array collide-shape-prim)  :overlay-at (-> specific 4))
   )
  (:methods
    (new (symbol type collide-shape uint int) _type_)
    )
  )


(deftype collide-shape (trsqv)
  "The parent of all of an object's collide primitives.
Most [[process-drawable]]s have a [[collide-shape]] that represents their root transform."
  ((actor-hash-index     int16   :offset  12)
   (process              process-drawable)
   (max-iteration-count  uint8)
   (nav-flags            nav-flags)
   (total-prims          uint8)
   (num-riders           uint8)
   (pat-ignore-mask      pat-surface)
   (event-self           symbol  :offset 152)
   (event-other          symbol)
   (root-prim            collide-shape-prim)
   (riders               (inline-array collide-rider))
   (penetrate-using      penetrate)
   (penetrated-by        penetrate)
   (backup-collide-as    collide-spec)
   (backup-collide-with  collide-spec)
   (event-priority       uint8   :offset 192)
   (rider-max-momentum   float)
   )
  (:methods
    (new (symbol type process-drawable collide-list-enum) _type_)
    (move-by-vector! (_type_ vector) none)
    (move-to-point! (_type_ vector) none)
    (debug-draw (_type_) none)
    (fill-cache-for-shape (_type_ float collide-query) none)
    (fill-cache-integrate-and-collide (_type_ vector collide-query meters) none)
    (find-prim-by-id (_type_ uint) collide-shape-prim)
    (find-prim-by-id-logtest (_type_ uint) collide-shape-prim)
    (detect-riders! (_type_) symbol)
    (build-bounding-box-for-shape (_type_ bounding-box float collide-spec) symbol)
    (integrate-and-collide! (_type_ vector) none)
    (find-collision-meshes (_type_) none)
    (on-platform (_type_ collide-shape collide-query) symbol)
    (find-overlapping-shapes (_type_ overlaps-others-params) symbol)
    (shove-to-closest-point-on-path (_type_ attack-info float) vector)
    (should-push-away (_type_ collide-shape collide-query) symbol)
    (pull-rider! (_type_ pull-rider-info) none)
    (pull-riders! (_type_) symbol)
    (do-push-aways (_type_) collide-spec)
    (update-transforms (_type_) none)
    (set-collide-with! (_type_ collide-spec) none)
    (set-collide-as! (_type_ collide-spec) none)
    (modify-collide-as! (_type_ int collide-spec collide-spec) none)
    (send-shoves (_type_ process touching-shapes-entry float float float) symbol)
    (above-ground? (_type_ collide-query vector collide-spec float float float) symbol)
    (water-info-init! (_type_ water-info collide-action) water-info)
    (iterate-prims (_type_ (function collide-shape-prim none)) none)
    (pusher-init (_type_) none)
    )
  )


(deftype collide-shape-moving (collide-shape)
  "A [[collide-shape]] for moving objects."
  ((rider-time          time-frame)
   (rider-last-move     vector                                                              :inline)
   (trans-old           vector                                                              :inline)
   (trans-old-old       vector                                                              :inline :offset 240)
   (trans-old-old-old   vector                                                              :inline :offset 256)
   (poly-pat            pat-surface                                                                 :offset 272)
   (cur-pat             pat-surface)
   (ground-pat          pat-surface)
   (status              collide-status)
   (old-status          collide-status)
   (prev-status         collide-status)
   (reaction-flag       cshape-reaction-flags)
   (reaction            (function control-info collide-query vector vector collide-status)          :offset 316)
   (no-reaction         (function collide-shape-moving collide-query vector vector object))
   (local-normal        vector                                                              :inline)
   (surface-normal      vector                                                              :inline)
   (poly-normal         vector                                                              :inline)
   (ground-poly-normal  vector                                                              :inline)
   (gspot-pos           vector                                                              :inline)
   (gspot-normal        vector                                                              :inline)
   (ground-touch-point  vector                                                              :inline)
   (ground-impact-vel   meters)
   (surface-angle       float)
   (poly-angle          float)
   (touch-angle         float)
   (coverage            float)
   (dynam               dynamics)
   (surf                surface)
   )
  (:methods
    (new (symbol type process-drawable collide-list-enum) _type_)
    (find-ground (_type_ collide-query collide-spec float float float process) symbol)
    (react-to-pat! (_type_ pat-surface) cshape-reaction-flags)
    (integrate-no-collide! (_type_ vector) none)
    (integrate-for-enemy-no-mtg (_type_ vector overlaps-others-params) symbol)
    (move-above-ground (_type_ vector move-above-ground-params) none)
    (move-to-ground (_type_ float float symbol collide-spec) none)
    (move-to-ground-point (_type_ vector vector vector) none)
    (compute-acc-due-to-gravity (_type_ vector float) vector)
    (rbody-collision (_type_ rigid-body-control float) none)
    (try-snap-to-surface (_type_ vector float float float) symbol)
    (fill-and-try-snap-to-surface (_type_ vector float float float collide-query) symbol)
    (step-collision! (_type_ vector vector float int) float)
    (collide-with-all-collide-cache-prims (_type_ matrix collide-query) none)
    )
  )


(defmethod new collide-shape-prim ((allocation symbol) (type-to-make type) (arg0 collide-shape) (arg1 uint) (arg2 int))
  (let ((v0-0 (object-new allocation type-to-make arg2)))
    (set! (-> v0-0 cshape) arg0)
    (set! (-> v0-0 prim-id) arg1)
    (set! (-> v0-0 prim-core action) (collide-action))
    (set! (-> v0-0 prim-core collide-as) (collide-spec))
    (set! (-> v0-0 prim-core collide-with) (collide-spec))
    (set! (-> v0-0 transform-index) -2)
    (set! (-> v0-0 prim-core prim-type) -2)
    v0-0
    )
  )

;; WARN: Return type mismatch collide-shape-prim vs collide-shape-prim-sphere.
(defmethod new collide-shape-prim-sphere ((allocation symbol) (type-to-make type) (arg0 collide-shape) (arg1 uint))
  (let ((v0-0 ((method-of-type collide-shape-prim new) allocation type-to-make arg0 arg1 80)))
    (set! (-> (the-as collide-shape-prim-sphere v0-0) pat)
          (new 'static 'pat-surface :mode (pat-mode obstacle) :material (pat-material stone))
          )
    (set! (-> (the-as collide-shape-prim-sphere v0-0) prim-core prim-type) -1)
    (the-as collide-shape-prim-sphere v0-0)
    )
  )

;; WARN: Return type mismatch collide-shape-prim vs collide-shape-prim-mesh.
(defmethod new collide-shape-prim-mesh ((allocation symbol) (type-to-make type) (arg0 collide-shape) (arg1 uint) (arg2 uint))
  (let ((v0-0 ((method-of-type collide-shape-prim new) allocation type-to-make arg0 arg2 80)))
    (set! (-> (the-as collide-shape-prim-mesh v0-0) mesh) #f)
    (set! (-> (the-as collide-shape-prim-mesh v0-0) mesh-id) (the-as int arg1))
    (set! (-> (the-as collide-shape-prim-mesh v0-0) mesh-cache-id) (the-as uint 0))
    (set! (-> (the-as collide-shape-prim-mesh v0-0) prim-core prim-type) 1)
    (the-as collide-shape-prim-mesh v0-0)
    )
  )

;; WARN: Return type mismatch collide-shape-prim vs collide-shape-prim-group.
(defmethod new collide-shape-prim-group ((allocation symbol) (type-to-make type) (arg0 collide-shape) (arg1 uint) (arg2 int))
  (let ((v0-0 ((method-of-type collide-shape-prim new) allocation type-to-make arg0 (the-as uint arg2) 80)))
    (set! (-> (the-as collide-shape-prim-group v0-0) num-children) arg1)
    (set! (-> (the-as collide-shape-prim-group v0-0) num-alloc-children) arg1)
    (set! (-> (the-as collide-shape-prim-group v0-0) prim-core prim-type) 0)
    (set! (-> (the-as collide-shape-prim-group v0-0) child)
          (the-as (inline-array collide-shape-prim) (&+ (the-as collide-shape-prim-group v0-0) 80))
          )
    (the-as collide-shape-prim-group v0-0)
    )
  )

;; WARN: Return type mismatch uint vs int.
(defmethod length ((this collide-shape-prim-group))
  (the-as int (-> this num-children))
  )

(defmethod new collide-shape ((allocation symbol) (type-to-make type) (arg0 process-drawable) (arg1 collide-list-enum))
  (let ((s5-0 (object-new allocation type-to-make (the-as int (-> type-to-make size)))))
    (set! (-> s5-0 actor-hash-index) -1)
    (set! (-> s5-0 process) arg0)
    (set! (-> s5-0 max-iteration-count) (the-as uint 1))
    (set! (-> s5-0 nav-flags) (nav-flags has-root-sphere))
    (set! (-> s5-0 event-self) #f)
    (set! (-> s5-0 event-other) #f)
    (set! (-> s5-0 riders) (the-as (inline-array collide-rider) #f))
    (set! (-> s5-0 root-prim) #f)
    (set! (-> s5-0 penetrate-using) (penetrate))
    (set! (-> s5-0 penetrated-by) (penetrate))
    (set! (-> s5-0 event-priority) (the-as uint 0))
    (set! (-> s5-0 rider-max-momentum) 409600.0)
    (case (-> arg0 type symbol)
      (('camera)
       (set! (-> s5-0 pat-ignore-mask) (new 'static 'pat-surface :nocamera #x1 :probe #x1 :noendlessfall #x1))
       )
      (('target)
       (set! (-> s5-0 pat-ignore-mask) (new 'static 'pat-surface :noentity #x1 :nojak #x1 :probe #x1 :board #x1))
       )
      (else
        (set! (-> s5-0 pat-ignore-mask)
              (new 'static 'pat-surface :noentity #x1 :nojak #x1 :probe #x1 :noendlessfall #x1 :board #x1)
              )
        )
      )
    (set! (-> s5-0 trans w) 1.0)
    (quaternion-identity! (-> s5-0 quat))
    (vector-identity! (-> s5-0 scale))
    (cond
      ((= arg1 (collide-list-enum hit-by-player))
       (add-connection *collide-hit-by-player-list* arg0 #f s5-0 #f #f)
       )
      ((= arg1 (collide-list-enum usually-hit-by-player))
       (add-connection *collide-hit-by-others-list* arg0 #f s5-0 #f #f)
       )
      ((= arg1 (collide-list-enum hit-by-others))
       (add-connection *collide-player-list* arg0 #f s5-0 #f #f)
       )
      (else
        (format 0 "Unsupported collide-list-enum in collide-shape constructor!~%")
        )
      )
    s5-0
    )
  )

;; WARN: Return type mismatch collide-shape vs collide-shape-moving.
(defmethod new collide-shape-moving ((allocation symbol) (type-to-make type) (arg0 process-drawable) (arg1 collide-list-enum))
  (let ((v0-0 ((method-of-type collide-shape new) allocation type-to-make arg0 arg1)))
    (set! (-> (the-as collide-shape-moving v0-0) gspot-pos y) -40959590.0)
    (vector-copy! (-> (the-as collide-shape-moving v0-0) gspot-normal) *y-vector*)
    (set! (-> (the-as collide-shape-moving v0-0) surf) *standard-ground-surface*)
    (the-as collide-shape-moving v0-0)
    )
  )

(define *collide-shape-prim-backgnd* (new 'static 'collide-shape-prim-mesh
                                       :cshape #f
                                       :prim-core (new 'static 'collide-prim-core
                                         :world-sphere (new 'static 'vector :w 204800000.0)
                                         :collide-as (collide-spec backgnd)
                                         :action (collide-action solid)
                                         :prim-type 2
                                         )
                                       :local-sphere (new 'static 'vector :w 204800000.0)
                                       :mesh #f
                                       )
        )

(define *collide-shape-prim-water* (new 'static 'collide-shape-prim-mesh
                                     :cshape #f
                                     :prim-core (new 'static 'collide-prim-core
                                       :world-sphere (new 'static 'vector :w 204800000.0)
                                       :collide-as (collide-spec water)
                                       :action (collide-action solid)
                                       :prim-type 2
                                       )
                                     :local-sphere (new 'static 'vector :w 204800000.0)
                                     :mesh #f
                                     )
        )

(define-perm *collide-rider-pool* collide-rider-pool (new 'global 'collide-rider-pool))
