jak-project/goal_src/jak3/levels/desert/wvehicle/was-squad-control.gc

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

;; name: was-squad-control.gc
;; name in dgo: was-squad-control
;; dgos: LPATK, LFACCAR, WASALL

(deftype mystery-traffic-object-spawn-params0 (structure)
  "was-squad-control::spawn-unit"
  ((params traffic-object-spawn-params :inline)
   (vec vector :inline)
   (quat quaternion :inline)
   )
  )

(define-extern wvehicle type)

;; DECOMP BEGINS

(deftype was-squad-control (squad-control)
  ((manager              handle)
   (target-count         int8)
   (process-count        int8)
   (active-count         int8)
   (reserve-count        int16)
   (spawnable-time       uint32)
   (spawn-time           uint32)
   (spawn-delay          uint32)
   (min-spawn-delay      uint32)
   (max-spawn-delay      uint32)
   (inaccuracy-factor    float)
   (attack-delay-factor  float)
   (target-speed         float)
   (nav-mesh             nav-mesh)
   (units                handle  10)
   )
  (:methods
    (spawn-unit (_type_ vector quaternion) none)
    (spawn-unit-offscreen (_type_) none)
    (add-unit (_type_ process-focusable) none)
    )
  )


(defmethod initialize ((this was-squad-control) (arg0 process))
  (format #t "was-squad-control::initialize~%")
  (let ((t9-1 (method-of-type squad-control initialize)))
    (t9-1 this arg0)
    )
  (set! (-> this manager) (process->handle arg0))
  (set! (-> this min-spawn-delay) (the-as uint 0))
  (set! (-> this max-spawn-delay) (the-as uint 300))
  (set! (-> this nav-mesh) (get-nav-mesh (the-as actor-id #xa7d6)))
  (dotimes (v1-5 10)
    (if (zero? (-> this units v1-5))
        (set! (-> this units v1-5) (the-as handle #f))
        )
    )
  (set! (-> this active-count) 0)
  0
  (none)
  )

(defmethod init-alert ((this was-squad-control))
  (format #t "was-squad-control::restore-defaults~%")
  (set! (-> this target-count) 0)
  (set! (-> this reserve-count) 0)
  (set! (-> this inaccuracy-factor) 1.0)
  (set! (-> this attack-delay-factor) 1.0)
  (set! (-> this target-speed) (cond
                                 ((task-node-closed? (game-task-node factory-boss-resolution))
                                  204800.0
                                  )
                                 ((task-node-closed? (game-task-node mine-boss-resolution))
                                  163840.0
                                  )
                                 (else
                                   143360.0
                                   )
                                 )
        )
  ((method-of-type squad-control init-alert) this)
  (none)
  )

(defmethod add-unit ((this was-squad-control) (arg0 process-focusable))
  (let ((s5-0 0))
    (b! #t cfg-16 :delay (nop!))
    (label cfg-1)
    (let ((s3-0 (handle->process (-> this units s5-0))))
      (b!
        (if (type? s3-0 process-focusable)
            s3-0
            )
        cfg-15
        :delay (empty-form)
        )
      )
    (format #t "was-squad-control::add-unit succeded~%")
    (set! (-> this units s5-0) (process->handle arg0))
    (b! #t cfg-18 :delay (nop!))
    (label cfg-15)
    (+! s5-0 1)
    (label cfg-16)
    (b! (< s5-0 10) cfg-1)
    )
  (format #t "was-squad-control::add-unit failed~%")
  (label cfg-18)
  0
  (none)
  )

(defmethod spawn-unit ((this was-squad-control) (arg0 vector) (arg1 quaternion))
  (format #t "was-squad-control::spawn-unit~%")
  (let* ((a0-2 (new 'stack-no-clear 'cquery-with-vec))
         (v1-0 (new 'stack-no-clear 'inline-array 'vector 2))
         (a1-2 (the-as uint #xa01013fd))
         (a1-3 (logand -2 a1-2))
         )
    (set! (-> a0-2 vec0 quad) (-> arg0 quad))
    (set! (-> a0-2 vec0 w) 20480.0)
    (set! (-> v1-0 0 quad) (-> a0-2 vec0 quad))
    (let ((a0-3 (-> a0-2 cquery)))
      (set! (-> a0-3 best-dist) (the-as float v1-0))
      (set! (-> a0-3 best-other-prim) (the-as collide-shape-prim 1))
      (set! (-> a0-3 collide-with) (the-as collide-spec a1-3))
      (set! (-> a0-3 ignore-process0) #f)
      (set! (-> a0-3 ignore-process1) #f)
      (set! (-> a0-3 ignore-pat)
            (new 'static 'pat-surface :noentity #x1 :nojak #x1 :probe #x1 :noendlessfall #x1 :board #x1)
            )
      (set! (-> a0-3 best-my-prim) (the-as collide-shape-prim #t))
      (set! (-> a0-3 action-mask) (collide-action solid))
      )
    )
  0
  (when (not #f)
    (let ((s3-0 (new 'stack-no-clear 'mystery-traffic-object-spawn-params0)))
      (vector-z-quaternion! (-> s3-0 vec) arg1)
      (vector-float*! (-> s3-0 vec) (-> s3-0 vec) (-> this target-speed))
      (set! (-> s3-0 params object-type) (the-as uint 6))
      (set! (-> s3-0 params behavior) (the-as uint 3))
      (set! (-> s3-0 params id) (the-as uint 0))
      (set! (-> s3-0 params nav-mesh) (-> this nav-mesh))
      (set! (-> s3-0 params nav-branch) #f)
      (set! (-> s3-0 params proc) #f)
      (set! (-> s3-0 params handle) (-> this alert-state target-status handle))
      (set! (-> s3-0 params user-data) (the-as uint 0))
      (set! (-> s3-0 params flags) (traffic-spawn-flags))
      (set! (-> s3-0 params guard-type) (the-as uint 11))
      (set! (-> s3-0 params entity) #f)
      (set! (-> s3-0 params velocity quad) (-> s3-0 vec quad))
      (set! (-> s3-0 params position quad) (-> arg0 quad))
      (quaternion-copy! (-> s3-0 params rotation) arg1)
      (let ((s5-1 (vehicle-spawn (vehicle-type v-marauder) (-> s3-0 params))))
        (when s5-1
          (send-event s5-1 'ai-set-inaccuracy-factor (-> this inaccuracy-factor))
          (send-event s5-1 'ai-set-attack-delay-factor (-> this attack-delay-factor))
          (send-event s5-1 'ai-set-target-speed (-> this target-speed))
          (set! (-> this spawn-time) (the-as uint (current-time)))
          (set! (-> this spawn-delay)
                (the-as
                  uint
                  (rand-vu-int-range (the-as int (-> this min-spawn-delay)) (the-as int (-> this max-spawn-delay)))
                  )
                )
          (add-unit this (the-as process-focusable s5-1))
          (+! (-> this reserve-count) -1)
          (+! (-> this active-count) 1)
          )
        )
      )
    )
  0
  (none)
  )

(defmethod spawn-unit-offscreen ((this was-squad-control))
  (let* ((s5-0 (handle->process (-> this alert-state target-status handle)))
         (s4-0 (if (type? s5-0 process-focusable)
                   s5-0
                   )
               )
         )
    (when s4-0
      (let ((s5-1 (new 'stack-no-clear 'inline-array 'matrix 2)))
        (let* ((s3-0 (-> s5-1 0))
               (a2-0 (camera-matrix))
               (v1-4 (-> a2-0 rvec quad))
               (a0-5 (-> a2-0 uvec quad))
               (a1-2 (-> a2-0 fvec quad))
               (a2-1 (-> a2-0 trans quad))
               )
          (set! (-> s3-0 rvec quad) v1-4)
          (set! (-> s3-0 uvec quad) a0-5)
          (set! (-> s3-0 fvec quad) a1-2)
          (set! (-> s3-0 trans quad) a2-1)
          )
        (set! (-> s5-1 1 fvec quad) (-> s5-1 0 trans quad))
        (set! (-> s5-1 1 trans quad) (-> (the-as process-focusable s4-0) root transv quad))
        (set! (-> s5-1 2 uvec quad) (-> s5-1 1 trans quad))
        (let* ((v1-8 (-> s5-1 1 trans))
               (f0-3 (+ (* (-> v1-8 x) (-> v1-8 x)) (* (-> v1-8 z) (-> v1-8 z))))
               (f1-3 4096.0)
               )
          (if (< f0-3 (* f1-3 f1-3))
              (set! (-> s5-1 2 uvec quad) (-> (the-as process-focusable s4-0) node-list data 0 bone transform fvec quad))
              )
          )
        (set! (-> s5-1 2 uvec y) 0.0)
        (vector-normalize! (-> s5-1 2 uvec) 1.0)
        (vector-rotate90-around-y! (-> s5-1 2 fvec) (-> s5-1 2 uvec))
        (cond
          (#f
            (if (logtest? (-> this sync-clock) 1)
                (vector-negate! (-> s5-1 2 fvec) (-> s5-1 2 fvec))
                )
            (set! (-> s5-1 3 uvec x) 12743.111)
            (set! (-> s5-1 3 uvec y) 286720.0)
            (vector+float*!
              (-> s5-1 2 trans)
              (-> (the-as process-focusable s4-0) root trans)
              (-> s5-1 2 uvec)
              (* 3.0 (-> s5-1 3 uvec y))
              )
            )
          (else
            (set! (-> s5-1 3 uvec y) 1228800.0)
            (set! (-> s5-1 3 uvec x) (rand-vu-float-range -5461.3335 5461.3335))
            (vector+float*!
              (-> s5-1 2 trans)
              (-> (the-as process-drawable s4-0) root trans)
              (-> s5-1 2 uvec)
              (* 0.5 (-> s5-1 3 uvec y))
              )
            )
          )
        (set! (-> s5-1 1 rvec quad) (-> (the-as process-drawable s4-0) root trans quad))
        (vector+float*!
          (the-as vector (-> s5-1 1))
          (the-as vector (-> s5-1 1))
          (-> s5-1 2 uvec)
          (* (cos (-> s5-1 3 uvec x)) (-> s5-1 3 uvec y))
          )
        (vector+float*!
          (the-as vector (-> s5-1 1))
          (the-as vector (-> s5-1 1))
          (-> s5-1 2 fvec)
          (* (sin (-> s5-1 3 uvec x)) (-> s5-1 3 uvec y))
          )
        (when (nav-mesh-method-11 (-> this nav-mesh) (the-as vector (-> s5-1 1)))
          (when (nav-mesh-method-12 (-> this nav-mesh) (the-as vector (-> s5-1 1)) 40960.0 (the-as nav-poly (-> s5-1 1 uvec)))
            (when (or (= (vector-vector-distance-squared (the-as vector (-> s5-1 1)) (-> s5-1 1 uvec)) 0.0)
                      (nav-mesh-method-11 (-> this nav-mesh) (-> s5-1 1 uvec))
                      )
              (let ((s4-5 (new 'stack-no-clear 'cquery-with-5vec)))
                (set! (-> s4-5 vec 0 quad) (-> s5-1 1 uvec quad))
                (set! (-> s4-5 vec 0 y) 614400.0)
                (set! (-> s4-5 cquery start-pos quad) (-> s4-5 vec 0 quad))
                (vector-reset! (-> s4-5 vec 1))
                (set! (-> s4-5 vec 1 y) 1.0)
                (vector-! (-> s4-5 vec 2) (-> s5-1 2 trans) (the-as vector (-> s4-5 vec)))
                (set! (-> s4-5 vec 2 y) 0.0)
                (vector-normalize! (-> s4-5 vec 2) 1.0)
                (set-vector! (-> s4-5 cquery move-dist) 0.0 -614400.0 0.0 1.0)
                (let ((v1-43 (-> s4-5 cquery)))
                  (set! (-> v1-43 radius) 1024.0)
                  (set! (-> v1-43 collide-with) (collide-spec backgnd))
                  (set! (-> v1-43 ignore-process0) #f)
                  (set! (-> v1-43 ignore-process1) #f)
                  (set! (-> v1-43 ignore-pat)
                        (new 'static 'pat-surface :noentity #x1 :nojak #x1 :probe #x1 :noendlessfall #x1 :board #x1)
                        )
                  (set! (-> v1-43 action-mask) (collide-action solid))
                  )
                (let ((f30-0 (fill-and-probe-using-line-sphere *collide-cache* (-> s4-5 cquery))))
                  (when (>= f30-0 0.0)
                    (vector+float*! (the-as vector (-> s4-5 vec)) (-> s4-5 cquery start-pos) (-> s4-5 cquery move-dist) f30-0)
                    (set! (-> s5-1 3 rvec quad) (-> s4-5 vec 0 quad))
                    (set! (-> s5-1 3 rvec w) 20480.0)
                    (let ((f0-31 1024000.0))
                      (when (or (< (* f0-31 f0-31) (vector-vector-distance-squared (-> s5-1 1 fvec) (the-as vector (-> s4-5 vec))))
                                (not (sphere-in-view-frustum? (the-as sphere (-> s5-1 3))))
                                )
                        (set! (-> s4-5 vec 1 quad) (-> s4-5 cquery best-other-tri normal quad))
                        (when (< (-> s4-5 vec 1 y) (cos 3640.889))
                          (vector-reset! (-> s4-5 vec 1))
                          (set! (-> s4-5 vec 1 y) 1.0)
                          )
                        (forward-up-nopitch->quaternion (the-as quaternion (-> s5-1 2)) (-> s4-5 vec 2) (-> s4-5 vec 1))
                        (spawn-unit this (the-as vector (-> s4-5 vec)) (the-as quaternion (-> s5-1 2)))
                        )
                      )
                    )
                  (if (< f30-0 0.0)
                      (format #t "was-squad-control::spawn-unit-offscreen: could not find ground~%")
                      )
                  )
                )
              )
            )
          )
        )
      )
    )
  0
  (none)
  )

(defmethod update ((this was-squad-control))
  (local-vars (a0-14 float))
  (rlet ((acc :class vf)
         (vf0 :class vf)
         (vf1 :class vf)
         (vf2 :class vf)
         )
    (init-vf0-vector)
    (set-sync-mask this)
    (set! (-> this nav-mesh) (find-nearest-nav-mesh (target-pos 0) (the-as float #x7f800000)))
    (if (not (-> this nav-mesh))
        (set! (-> this nav-mesh) (get-nav-mesh (the-as actor-id #xa7d6)))
        )
    (let* ((s5-1 (new 'stack-no-clear 'inline-array 'matrix 2))
           (s4-0 (handle->process (-> this alert-state target-status handle)))
           (v1-8 (if (type? s4-0 process-focusable)
                     s4-0
                     )
                 )
           )
      (when v1-8
        (set! (-> s5-1 0 uvec quad) (-> (the-as process-focusable v1-8) root trans quad))
        (set! (-> s5-1 0 fvec quad) (-> (the-as process-focusable v1-8) root transv quad))
        (let ((f0-0 8192.0))
          (.lvf vf1 (&-> (-> s5-1 0 fvec) quad))
          (.add.w.vf vf2 vf0 vf0 :mask #b1)
          (.mul.vf vf1 vf1 vf1)
          (.mul.x.vf acc vf2 vf1 :mask #b1)
          (.add.mul.y.vf acc vf2 vf1 acc :mask #b1)
          (.add.mul.z.vf vf1 vf2 vf1 acc :mask #b1)
          (.mov a0-14 vf1)
          (if (< f0-0 a0-14)
              (set! (-> s5-1 0 trans quad) (-> s5-1 0 fvec quad))
              (set! (-> s5-1 0 trans quad) (-> (the-as process-focusable v1-8) node-list data 0 bone transform fvec quad))
              )
          )
        (set! (-> s5-1 0 trans y) 0.0)
        (vector-normalize! (-> s5-1 0 trans) 1.0)
        (vector-rotate-around-y! (the-as vector (-> s5-1 1)) (-> s5-1 0 trans) 14563.556)
        (vector-rotate-around-y! (-> s5-1 1 uvec) (-> s5-1 0 trans) -14563.556)
        (set! (-> s5-1 1 rvec w) (- (vector-dot (the-as vector (-> s5-1 1)) (-> s5-1 0 uvec))))
        (set! (-> s5-1 1 uvec w) (- (vector-dot (-> s5-1 1 uvec) (-> s5-1 0 uvec))))
        (dotimes (s4-1 10)
          (let* ((s2-0 (handle->process (-> this units s4-1)))
                 (s3-0 (if (type? s2-0 process-focusable)
                           s2-0
                           )
                       )
                 )
            (when (and s3-0
                       (not (focus-test? (the-as process-focusable s3-0) dead))
                       (time-elapsed? (-> (the-as process-focusable s3-0) state-time) (seconds 2))
                       )
              (set! (-> s5-1 0 rvec quad) (-> (the-as process-focusable s3-0) root trans quad))
              (when (not (logtest? (-> (the-as process-focusable s3-0) draw status) (draw-control-status on-screen)))
                (let ((f0-8 614400.0))
                  (when (or (and (< (* f0-8 f0-8) (vector-vector-distance-squared (-> s5-1 0 uvec) (the-as vector (-> s5-1 0))))
                                 (or (< (vector4-dot (the-as vector (-> s5-1 1)) (the-as vector (-> s5-1 0))) 0.0)
                                     (< (vector4-dot (-> s5-1 1 uvec) (the-as vector (-> s5-1 0))) 0.0)
                                     )
                                 )
                            (zero? (-> this target-count))
                            )
                    (when (send-event s3-0 'go-die)
                      (+! (-> this reserve-count) 1)
                      (set! (-> this units s4-1) (the-as handle #f))
                      )
                    )
                  )
                )
              )
            )
          )
        )
      )
    (let ((s5-2 0)
          (s4-2 0)
          )
      (dotimes (s3-1 10)
        (let* ((s2-1 (handle->process (-> this units s3-1)))
               (v1-62 (if (type? s2-1 process-focusable)
                          s2-1
                          )
                      )
               )
          (when v1-62
            (+! s5-2 1)
            (if (not (focus-test? (the-as process-focusable v1-62) dead))
                (+! s4-2 1)
                )
            )
          )
        )
      (set! (-> this process-count) s5-2)
      (set! (-> this active-count) s4-2)
      )
    0
    (let* ((s5-3 (handle->process (-> this alert-state target-status handle)))
           (a1-20 (if (type? s5-3 process-focusable)
                      s5-3
                      )
                  )
           )
      (cond
        (a1-20
          (let ((v1-71 (new 'stack-no-clear 'matrix)))
            (set! (-> v1-71 rvec quad) (-> (the-as process-focusable a1-20) root trans quad))
            (cond
              ((and (< (-> this active-count) (-> this target-count))
                    (> (-> this reserve-count) 0)
                    (< (-> this process-count) 10)
                    (-> this nav-mesh)
                    (not (logtest? (-> this nav-mesh flags) (nav-mesh-flag water)))
                    (nav-mesh-method-11 (-> this nav-mesh) (-> v1-71 rvec))
                    )
               (let ((v1-73 (new 'stack-no-clear 'array 'uint32 1)))
                 (set! (-> v1-73 0) (the-as uint (current-time)))
                 (if (and (< (the-as uint 300) (- (-> v1-73 0) (-> this spawnable-time)))
                          (< (-> this spawn-delay) (- (-> v1-73 0) (-> this spawn-time)))
                          )
                     (spawn-unit-offscreen this)
                     )
                 )
               )
              (else
                (set! (-> this spawnable-time) (the-as uint (current-time)))
                )
              )
            )
          )
        (else
          (when *target*
            (format #t "was-squad-control::update: setting target~%")
            (set! (-> this alert-state target-status handle) (process->handle *target*))
            )
          )
        )
      )
    0
    (none)
    )
  )

(define *was-squad-control* (new 'static 'was-squad-control))

(define *was-squad-manager* (the-as object #f))

(deftype was-squad-manager (process)
  ((squad  squad-control)
   )
  (:state-methods
    idle
    )
  (:methods
    (was-squad-manager-method-15 (_type_) none)
    (was-squad-manager-method-16 (_type_) none)
    )
  )


;; WARN: Return type mismatch process vs was-squad-manager.
(defmethod relocate ((this was-squad-manager) (offset int))
  (set! *was-squad-manager* this)
  (if *was-squad-manager*
      (set! *was-squad-manager* (+ (the-as uint *was-squad-manager*) offset))
      )
  (the-as was-squad-manager ((method-of-type process relocate) this offset))
  )

(defmethod deactivate ((this was-squad-manager))
  "Make a process dead, clean it up, remove it from the active pool, and return to dead pool."
  (set! *was-squad-manager* (the-as object #f))
  ((method-of-type process deactivate) this)
  (none)
  )

(defmethod was-squad-manager-method-15 ((this was-squad-manager))
  (if (= (status-of-level-and-borrows *level* 'desert #f) 'active)
      (update (-> this squad))
      )
  0
  (none)
  )

(defmethod was-squad-manager-method-16 ((this was-squad-manager))
  (set! (-> this squad) *was-squad-control*)
  (initialize (-> this squad) this)
  (squad-control-method-10 (-> this squad))
  0
  (none)
  )

;; WARN: Return type mismatch symbol vs object.
(defbehavior was-squad-manager-event-handler was-squad-manager ((arg0 process) (arg1 int) (arg2 symbol) (arg3 event-message-block))
  #f
  )

(defbehavior was-squad-manager-init-by-other was-squad-manager ()
  (stack-size-set! (-> self main-thread) 128)
  (set! *was-squad-manager* self)
  (was-squad-manager-method-16 self)
  (set! (-> self event-hook) was-squad-manager-event-handler)
  (go-virtual idle)
  )

(defstate idle (was-squad-manager)
  :virtual #t
  :event was-squad-manager-event-handler
  :code sleep-code
  :post (behavior ()
    (was-squad-manager-method-15 self)
    )
  )

(defun was-squad-manager-start ((arg0 process))
  (kill-by-type was-squad-manager *active-pool*)
  (process-spawn was-squad-manager :name "was-squad-manager" :to arg0)
  )

;; WARN: Return type mismatch symbol vs none.
(defun was-squad-manager-kill ()
  (kill-by-type was-squad-manager *active-pool*)
  (none)
  )

(defun-debug wvh ()
  (execute-process-tree
    *active-pool*
    (lambda ((arg0 object)) (let ((a0-2 (if (type? arg0 wvehicle)
                                            arg0
                                            )
                                        )
                                  )
                              (if a0-2
                                  (send-event (the-as process-tree a0-2) 'go-hostile *target*)
                                  )
                              )
            )
    *kernel-context*
    )
  0
  (none)
  )