jak-project/goal_src/jak2/engine/common_objs/conveyor.gc

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

;; name: conveyor.gc
;; name in dgo: conveyor
;; dgos: GAME, COMMON

;; DECOMP BEGINS

(deftype conveyor-section (structure)
  ((start       vector  :inline)
   (trailing    plane   :inline)
   (pull-dir    vector  :inline)
   (radial-dir  vector  :inline)
   )
  )


(deftype conveyor-section-array (inline-array-class)
  ((data  conveyor-section  :inline :dynamic)
   )
  )


(set! (-> conveyor-section-array heap-base) (the-as uint 64))

(deftype conveyor (process-drawable)
  ((speed                 float)
   (belt-radius           float)
   (pull-y-threshold      float)
   (speed-mult-array      (array float))
   (speed-mult-array-len  int8)
   (sections              conveyor-section-array)
   (leading               plane   :inline)
   (collide-bounds        sphere  :inline)
   )
  (:state-methods
    idle
    )
  (:methods
    (conveyor-method-21 (_type_) float)
    (get-art-group (_type_) art-group)
    (reset-root! (_type_) none)
    (init! (_type_) none)
    (set-and-get-ambient-sound! (_type_) ambient-sound)
    (conveyor-method-26 (_type_ process-focusable) symbol :behavior conveyor)
    (conveyor-method-27 (_type_) symbol)
    )
  )


(defmethod relocate ((this conveyor) (new-addr int))
  (&+! (-> this sections) new-addr)
  (call-parent-method this new-addr)
  )

;; WARN: Return type mismatch symbol vs art-group.
(defmethod get-art-group ((this conveyor))
  "@returns The respective [[art-group]] for the [[conveyor]]"
  (go process-drawable-art-error "invalid type")
  (the-as art-group #f)
  )

(defmethod reset-root! ((this conveyor))
  "Re-initializes the `root` [[trsqv]]"
  (set! (-> this root) (new 'process 'trsqv))
  0
  (none)
  )

(defmethod init! ((this conveyor))
  "Initializes defaults for things like the `speed` and `belt-radius`"
  (local-vars (tag res-tag))
  (set! (-> this speed) 24576.0)
  (set! (-> this belt-radius) 11878.4)
  (set! (-> this pull-y-threshold) 10240.0)
  (set! (-> this speed-mult-array) #f)
  (set! (-> this speed-mult-array-len) 0)
  (let ((entity (-> this entity)))
    (set! tag (new 'static 'res-tag))
    (let ((scale-factor (res-lump-data entity 'scale-factor pointer :tag-ptr (& tag))))
      (when scale-factor
        (set! (-> this speed-mult-array) (the-as (array float) scale-factor))
        (set! (-> this speed-mult-array-len) (the-as int (-> tag elt-count)))
        )
      )
    )
  0
  (none)
  )

;; WARN: Return type mismatch object vs ambient-sound.
(defmethod set-and-get-ambient-sound! ((this conveyor))
  "So long as [[actor-option::16]] is not set, fetch the [[ambient-sound]] for the [[conveyor]]
and return it as well.  Otherwise, set it to `0`"
  (let ((actor-options (res-lump-value (-> this entity) 'options actor-option :time -1000000000.0)))
    (the-as
      ambient-sound
      (cond
        ((not (logtest? (actor-option no-amb-sound) actor-options))
         (let ((sound
                 (the-as object (new 'process 'ambient-sound (static-sound-spec "conveyor" :fo-max 80) (-> this root trans)))
                 )
               )
           (set! (-> this sound) (the-as ambient-sound sound))
           sound
           )
         )
        (else
          (set! (-> this sound) (the-as ambient-sound 0))
          0
          )
        )
      )
    )
  )

(defmethod conveyor-method-26 ((this conveyor) (proc-focus process-focusable))
  "TODO - conveyor section related, perhaps related to moving the process along the belt?"
  (let ((vec (new 'stack-no-clear 'vector)))
    (set! (-> vec quad) (-> (get-trans proc-focus 0) quad))
    (set! (-> vec w) 1.0)
    (when (>= (vector4-dot vec (the-as vector (-> this leading))) 0.0)
      (let* ((sections (-> this sections))
             (section-count (-> sections length))
             )
        (dotimes (section-idx section-count)
          (let ((section (-> sections data section-idx)))
            (when (< (vector4-dot vec (the-as vector (-> section trailing))) 0.0)
              (let ((vec-temp (new 'stack-no-clear 'vector)))
                (vector-! vec-temp vec (-> section start))
                (when (>= (-> this belt-radius) (fabs (vector-dot vec-temp (-> section radial-dir))))
                  (let* ((f0-7 (vector-dot vec-temp (-> section pull-dir)))
                         (f1-6 (- (-> vec-temp y) (* (-> section pull-dir y) f0-7)))
                         )
                    (when (>= (-> this pull-y-threshold) (fabs f1-6))
                      (let ((a2-8 (new 'stack-no-clear 'vector)))
                        (let ((f0-10 (-> this speed)))
                          (if (< section-idx (-> this speed-mult-array-len))
                              (set! f0-10
                                    (* f0-10 (-> (the-as (pointer float) (+ (the-as uint (-> this speed-mult-array)) (* section-idx 4)))))
                                    )
                              )
                          (vector-float*! a2-8 (-> section pull-dir) (* f0-10 (seconds-per-frame)))
                          )
                        (send-event proc-focus 'push-trans a2-8 (seconds 10))
                        )
                      )
                    )
                  )
                )
              (return #f)
              )
            )
          )
        )
      #f
      )
    )
  )

(defmethod conveyor-method-27 ((this conveyor))
  "TODO - collision related, has some dead code as well (previous iteration?)"
  (local-vars (a0-10 float) (a2-5 float) (a2-12 float))
  (rlet ((acc :class vf)
         (vf0 :class vf)
         (vf1 :class vf)
         (vf2 :class vf)
         (vf3 :class vf)
         (vf4 :class vf)
         )
    (init-vf0-vector)
    (set! *actor-list-length* 0)
    (if #t
        (set! *actor-list-length* (fill-actor-list-for-sphere *actor-hash* (-> this collide-bounds) *actor-list* 256))
        )
    (when #t
      (let ((a0-2 (-> *collide-player-list* alive-list next0)))
        *collide-player-list*
        (let ((v1-11 (-> a0-2 next0)))
          (while (!= a0-2 (-> *collide-player-list* alive-list-end))
            (let* ((a0-3 (-> (the-as connection a0-2) param1))
                   (a1-1 (-> (the-as collide-shape a0-3) root-prim))
                   )
              (when (logtest? (-> a1-1 prim-core collide-as) (collide-spec jak bot enemy hit-by-others-list player-list))
                (let ((a1-2 (-> a1-1 prim-core)))
                  (let ((a2-4 a1-2)
                        (a3-1 (-> this collide-bounds))
                        )
                    (.lvf vf2 (&-> a2-4 world-sphere quad))
                    (.lvf vf3 (&-> a3-1 quad))
                    )
                  (.sub.vf vf1 vf3 vf2)
                  (.mul.vf vf1 vf1 vf1)
                  (.add.y.vf.x vf1 vf1 vf1)
                  (.add.z.vf.x vf1 vf1 vf1)
                  (.mov a2-5 vf1)
                  (let ((f0-0 a2-5)
                        (f1-1 (+ (-> a1-2 world-sphere w) (-> this collide-bounds r)))
                        )
                    (b! (>= f0-0 (* f1-1 f1-1)) cfg-8 :delay #f)
                    )
                  )
                (when (< *actor-list-length* 256)
                  (set! (-> *actor-list* *actor-list-length*) (the-as collide-shape a0-3))
                  (set! *actor-list-length* (+ *actor-list-length* 1))
                  )
                )
              )
            (label cfg-8)
            (set! a0-2 v1-11)
            *collide-player-list*
            (set! v1-11 (-> v1-11 next0))
            )
          )
        )
      )
    (when #f
      (let ((a0-5 (-> *collide-hit-by-player-list* alive-list next0)))
        *collide-hit-by-player-list*
        (let ((v1-18 (-> a0-5 next0)))
          (while (!= a0-5 (-> *collide-hit-by-player-list* alive-list-end))
            (let* ((a0-6 (-> (the-as connection a0-5) param1))
                   (a1-13 (-> (the-as collide-shape a0-6) root-prim))
                   )
              (when (logtest? (-> a1-13 prim-core collide-as) (collide-spec jak bot enemy hit-by-others-list player-list))
                (let ((a1-14 (-> a1-13 prim-core)))
                  (let ((a2-11 a1-14)
                        (a3-2 (-> this collide-bounds))
                        )
                    (.lvf vf2 (&-> a2-11 world-sphere quad))
                    (.lvf vf3 (&-> a3-2 quad))
                    )
                  (.sub.vf vf1 vf3 vf2)
                  (.mul.vf vf1 vf1 vf1)
                  (.add.y.vf.x vf1 vf1 vf1)
                  (.add.z.vf.x vf1 vf1 vf1)
                  (.mov a2-12 vf1)
                  (let ((f0-1 a2-12)
                        (f1-5 (+ (-> a1-14 world-sphere w) (-> this collide-bounds r)))
                        )
                    (b! (>= f0-1 (* f1-5 f1-5)) cfg-17 :delay #f)
                    )
                  )
                (when (< *actor-list-length* 256)
                  (set! (-> *actor-list* *actor-list-length*) (the-as collide-shape a0-6))
                  (set! *actor-list-length* (+ *actor-list-length* 1))
                  )
                )
              )
            (label cfg-17)
            (set! a0-5 v1-18)
            *collide-hit-by-player-list*
            (set! v1-18 (-> v1-18 next0))
            )
          )
        )
      )
    (dotimes (s5-0 *actor-list-length*)
      (let* ((v1-23 (-> *actor-list* s5-0))
             (a0-9 (-> v1-23 root-prim))
             )
        (when (logtest? (-> a0-9 prim-core collide-as) (collide-spec jak bot enemy hit-by-others-list player-list))
          (.lvf vf1 (&-> this collide-bounds quad))
          (.lvf vf2 (&-> a0-9 prim-core world-sphere quad))
          (.sub.vf vf3 vf1 vf2)
          (.add.w.vf.w vf4 vf1 vf2)
          (.mul.vf.xyz vf3 vf3 vf3)
          (.mul.w.vf.w vf4 vf4 vf4)
          (.mul.x.vf.w acc vf0 vf3)
          (.add.mul.y.vf.w acc vf0 vf3 acc)
          (.add.mul.z.vf.w vf3 vf0 vf3 acc)
          (.sub.w.vf.w vf3 vf3 vf4)
          (let ((f0-2 0.0))
            (.add.w.vf.x vf3 vf0 vf3)
            (.mov a0-10 vf3)
            (let ((s4-0 (-> v1-23 process)))
              (b! (< f0-2 a0-10) cfg-27)
              (let ((a1-29 (if (type? s4-0 process-focusable)
                               (the-as process-focusable s4-0)
                               )
                           )
                    )
                (if a1-29
                    (conveyor-method-26 this a1-29)
                    )
                )
              )
            )
          (label cfg-27)
          0
          )
        )
      )
    #f
    )
  )

(defmethod conveyor-method-21 ((this conveyor))
  "TODO - quite dense, has to do with the conveyor sections and the path they are associated with"
  (local-vars (sv-32 conveyor-section) (sv-48 conveyor-section))
  (let* ((s5-0 (-> this path))
         (s4-0 (-> s5-0 curve num-cverts))
         (s3-0 (new 'stack-no-clear 'vector))
         )
    (let ((s2-0 (new 'process 'conveyor-section-array (+ s4-0 -1))))
      (set! (-> this sections) s2-0)
      (set! (-> this collide-bounds quad) (the-as uint128 0))
      (get-point-in-path! s5-0 s3-0 0.0 'exact)
      (vector+! (the-as vector (-> this collide-bounds)) (the-as vector (-> this collide-bounds)) s3-0)
      (let ((s1-0 (+ s4-0 -1)))
        (set! sv-32 (the-as conveyor-section #f))
        (dotimes (s0-0 s1-0)
          (set! sv-48 (-> s2-0 data s0-0))
          (set! (-> sv-48 start quad) (-> s3-0 quad))
          (get-point-in-path! s5-0 s3-0 (the float (+ s0-0 1)) 'exact)
          (vector+! (the-as vector (-> this collide-bounds)) (the-as vector (-> this collide-bounds)) s3-0)
          (vector-! (-> sv-48 pull-dir) s3-0 (-> sv-48 start))
          (vector-normalize! (-> sv-48 pull-dir) 1.0)
          (set! (-> sv-48 trailing quad) (-> sv-48 pull-dir quad))
          (set! (-> sv-48 trailing y) 0.0)
          (vector-normalize! (-> sv-48 trailing) 1.0)
          (set-vector! (-> sv-48 radial-dir) (- (-> sv-48 trailing z)) 0.0 (-> sv-48 trailing x) 1.0)
          (set! (-> sv-48 trailing w) (- (vector-dot s3-0 (the-as vector (-> sv-48 trailing)))))
          (when (the-as vector sv-32)
            (vector+! (&+ (the-as vector sv-32) 16) (&+ (the-as vector sv-32) 16) (the-as vector (-> sv-48 trailing)))
            (vector-normalize! (&+ (the-as vector sv-32) 16) 1.0)
            (set! (-> sv-32 trailing w) (- (vector-dot (-> sv-48 start) (&+ (the-as vector sv-32) 16))))
            )
          (set! sv-32 sv-48)
          sv-32
          )
        )
      )
    (let ((s2-1 (-> this sections data)))
      (set! (-> this leading quad) (-> s2-1 0 pull-dir quad))
      (set! (-> this leading y) 0.0)
      (vector-normalize! (-> this leading) 1.0)
      (set! (-> this leading w) (- (vector-dot (the-as vector (-> s2-1 0)) (the-as vector (-> this leading)))))
      )
    (let ((f0-19 (/ 1.0 (the float s4-0)))
          (f30-0 0.0)
          )
      (vector-float*! (the-as vector (-> this collide-bounds)) (the-as vector (-> this collide-bounds)) f0-19)
      (dotimes (s2-2 s4-0)
        (get-point-in-path! s5-0 s3-0 (the float s2-2) 'exact)
        (let ((f0-22 (vector-vector-distance-squared s3-0 (-> this collide-bounds))))
          (if (< f30-0 f0-22)
              (set! f30-0 f0-22)
              )
          )
        )
      (set! (-> this collide-bounds r) (+ (sqrtf f30-0) (-> this belt-radius)))
      )
    )
  )

(defstate idle (conveyor)
  :virtual #t
  :code sleep-code
  :post (behavior ()
    (conveyor-method-27 self)
    (if (nonzero? (-> self sound))
        (update! (-> self sound))
        )
    )
  )

;; WARN: Return type mismatch object vs none.
(defmethod init-from-entity! ((this conveyor) (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"
  (reset-root! this)
  (process-drawable-from-entity! this arg0)
  (initialize-skeleton this (the-as skeleton-group (get-art-group this)) (the-as pair 0))
  (set! (-> this path) (new 'process 'path-control this 'path 0.0 (the-as entity #f) #f))
  (logior! (-> this path flags) (path-control-flag display draw-line draw-point draw-text))
  (if (< (-> this path curve num-cverts) 2)
      (go process-drawable-art-error "bad path")
      )
  (init! this)
  (set-and-get-ambient-sound! this)
  (conveyor-method-21 this)
  (ja-post)
  (go (method-of-object this idle))
  (none)
  )

(deftype strip-conveyor (conveyor)
  ()
  )


(defskelgroup skel-strip-conveyor strip-conveyor strip-conveyor-lod0-jg strip-conveyor-idle-ja
              ((strip-conveyor-lod0-mg (meters 999999)))
              :bounds (static-spherem 0 0 0 36)
              )

(defmethod get-art-group ((this strip-conveyor))
  "@returns The respective [[art-group]] for the [[conveyor]]"
  (art-group-get-by-name *level* "skel-strip-conveyor" (the-as (pointer uint32) #f))
  )

(deftype lgconveyor (conveyor)
  ()
  )


(defskelgroup skel-lgconveyor lgconveyor lgconveyor-lod0-jg lgconveyor-idle-ja
              ((lgconveyor-lod0-mg (meters 999999)))
              :bounds (static-spherem 0 3 0 15)
              :longest-edge (meters 24.7389)
              :origin-joint-index 3
              )

(defmethod get-art-group ((this lgconveyor))
  "@returns The respective [[art-group]] for the [[conveyor]]"
  (art-group-get-by-name *level* "skel-lgconveyor" (the-as (pointer uint32) #f))
  )

;; WARN: Return type mismatch float vs none.
(defmethod init! ((this lgconveyor))
  "Initializes defaults for things like the `speed` and `belt-radius`"
  (set! (-> this speed) 30720.0)
  (set! (-> this belt-radius) 11878.4)
  (set! (-> this pull-y-threshold) 10240.0)
  (none)
  )

(defstate idle (lgconveyor)
  :virtual #t
  :code (behavior ()
    (until #f
      (ja-no-eval :group! lgconveyor-idle-ja :num! (seek!) :frame-num 0.0)
      (until (ja-done? 0)
        (suspend)
        (ja :num! (seek!))
        )
      )
    #f
    )
  :post (behavior ()
    (let ((t9-0 (-> (method-of-type conveyor idle) post)))
      (if t9-0
          ((the-as (function none) t9-0))
          )
      )
    (ja-post)
    )
  )