jak-project/goal_src/jak3/engine/game/task/task-arrow.gc

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

;; name: task-arrow.gc
;; name in dgo: task-arrow
;; dgos: GAME

(deftype cquery-with-vec (structure)
  "task-arrow::23"
  ((cquery collide-query :inline)
   (vec0   vector        :inline)
   (vec1   vector        :inline)
   )
  )

;; DECOMP BEGINS

(defskelgroup skel-rod-of-god com-rod-of-god com-rod-of-god-lod0-jg com-rod-of-god-idle-ja
              ((com-rod-of-god-lod0-mg (meters 999999)))
              :bounds (static-spherem 0 0 0 4)
              :texture-level 10
              )

(deftype task-arrow (process-drawable)
  ((pos               vector      :inline)
   (theta             float)
   (phi               float)
   (dist              float)
   (smoothed-dist     float)
   (max-dist          float)
   (flags             task-arrow-flags)
   (map-icon          uint16)
   (minimap           connection-minimap)
   (hud-dist          handle)
   (base-quat         quaternion  :inline)
   (base-scale        float)
   (rod-of-god-scale  float)
   (moving            symbol)
   (death-pending?    symbol)
   (alpha             float)
   (choir-sound       ambient-sound)
   (draw-back         basic)
   )
  (:state-methods
    idle
    die
    leave
    )
  (:methods
    (task-arrow-method-23 (_type_ vector) none)
    (draw-arrow (_type_) none)
    )
  )


(defmethod deactivate ((this task-arrow))
  "Make a process dead, clean it up, remove it from the active pool, and return to dead pool."
  (send-event (handle->process (-> this hud-dist)) 'hide-and-die)
  (if (nonzero? (-> this choir-sound))
      (stop! (-> this choir-sound))
      )
  ((method-of-type process-drawable deactivate) this)
  0
  (none)
  )

(defmethod task-arrow-method-23 ((this task-arrow) (arg0 vector))
  (let ((s5-0 (new 'stack-no-clear 'cquery-with-vec)))
    (vector-copy! (-> s5-0 vec0) arg0)
    (vector-copy! (-> s5-0 cquery start-pos) (-> s5-0 vec0))
    (+! (-> s5-0 cquery start-pos y) 20480.0)
    (set-vector! (-> s5-0 cquery move-dist) 0.0 -81920.0 0.0 1.0)
    (let ((v1-4 (-> s5-0 cquery)))
      (set! (-> v1-4 radius) 1024.0)
      (set! (-> v1-4 collide-with) (collide-spec backgnd))
      (set! (-> v1-4 ignore-process0) #f)
      (set! (-> v1-4 ignore-process1) #f)
      (set! (-> v1-4 ignore-pat)
            (new 'static 'pat-surface :noentity #x1 :nojak #x1 :probe #x1 :noendlessfall #x1 :board #x1)
            )
      (set! (-> v1-4 action-mask) (collide-action solid))
      )
    (let ((f0-7 (fill-and-probe-using-line-sphere *collide-cache* (-> s5-0 cquery))))
      (if (>= f0-7 0.0)
          (vector+float*! (-> s5-0 vec0) (-> s5-0 cquery start-pos) (-> s5-0 cquery move-dist) f0-7)
          )
      )
    (vector-copy! arg0 (-> s5-0 vec0))
    )
  0
  (none)
  )

(defmethod draw-arrow ((this task-arrow))
  (when (not (logtest? (-> this flags) (task-arrow-flags taf7)))
    (if (or (-> this death-pending?)
            (logtest? (-> this flags) (task-arrow-flags taf4))
            (= (the int (-> this rod-of-god-scale)) 0)
            )
        (update-vol! (-> this choir-sound) (-> this rod-of-god-scale))
        (update-vol! (-> this choir-sound) 1.0)
        )
    (update! (-> this choir-sound))
    )
  (cond
    ((logtest? (-> this flags) (task-arrow-flags taf0))
     (if (and (not (handle->process (-> this hud-dist))) *target*)
         (set! (-> this hud-dist)
               (ppointer->handle (process-spawn hud-progress :init hud-init-by-other :name "hud-progress" :to *target*))
               )
         )
     (let ((s5-1 (get-trail-for-connection *minimap* (-> this minimap) #f)))
       (if (and s5-1 (nonzero? (-> s5-1 last-updated)))
           (set! (-> this dist) (get-distance-with-path s5-1 (target-pos 0) (-> this pos)))
           )
       )
     (if (= (-> this max-dist) 0.0)
         (set! (-> this max-dist) (-> this dist))
         )
     (let ((f0-7 (- (-> this dist) (-> this smoothed-dist))))
       (if (< (fabs f0-7) 40960.0)
           (+! (-> this smoothed-dist) (* 10.0 (seconds-per-frame) f0-7))
           (set! (-> this smoothed-dist) (-> this dist))
           )
       )
     (let ((f1-5 (/ (-> this smoothed-dist) (-> this max-dist))))
       (set! (-> *game-info* distance) (- 1.0 (fmax 0.0 (fmin 1.0 f1-5))))
       )
     )
    (else
      (let ((a0-20 (handle->process (-> this hud-dist))))
        (when a0-20
          (send-event a0-20 'hide-and-die)
          (set! (-> this hud-dist) (the-as handle #f))
          )
        )
      )
    )
  (cond
    ((logtest? (-> this flags) (task-arrow-flags taf2))
     )
    ((-> this moving)
     (cond
       ((logtest? (-> this flags) (task-arrow-flags taf6))
        (vector-copy! (-> this root trans) (-> this pos))
        (if (logtest? (-> this flags) (task-arrow-flags taf4))
            (seek! (-> this rod-of-god-scale) 0.0 (* 8.0 (seconds-per-frame)))
            (seek! (-> this rod-of-god-scale) 1.0 (* 8.0 (seconds-per-frame)))
            )
        )
       (else
         (set! (-> this rod-of-god-scale) (- (-> this rod-of-god-scale) (* 8.0 (seconds-per-frame))))
         (when (< (-> this rod-of-god-scale) 0.0)
           (set! (-> this rod-of-god-scale) 0.0)
           (set! (-> this moving) #f)
           (cond
             ((< (square 81920.0) (vector-vector-xz-distance-squared (-> this pos) (-> this root trans)))
              (kill-callback (-> *minimap* engine) (-> this minimap))
              (vector-copy! (-> this root trans) (-> this pos))
              (if (not (logtest? (-> this flags) (task-arrow-flags taf5)))
                  (set! (-> this minimap) (add-icon! *minimap* this (-> this map-icon) (the-as int #f) (the-as vector #t) 0))
                  )
              )
             (else
               (vector-copy! (-> this root trans) (-> this pos))
               )
             )
           )
         )
       )
     )
    (else
      (vector-copy! (-> this pos) (-> this root trans))
      (if (logtest? (-> this flags) (task-arrow-flags taf4))
          (seek! (-> this rod-of-god-scale) 0.0 (* 8.0 (seconds-per-frame)))
          (seek! (-> this rod-of-god-scale) 1.0 (* 8.0 (seconds-per-frame)))
          )
      (if (and (-> this death-pending?)
               (and (logtest? (-> this flags) (task-arrow-flags taf4)) (= (the int (-> this rod-of-god-scale)) 0))
               )
          (go (method-of-object this die))
          )
      )
    )
  (cond
    ((not (logtest? (-> this flags) (task-arrow-flags taf2)))
     (let ((f0-39 (-> this base-scale))
           (f30-1 (-> this rod-of-god-scale))
           )
       (set-vector! (-> this root scale) (* f30-1 f0-39) 600.0 (* f30-1 f0-39) 1.0)
       (set-vector! (-> this draw color-emissive) 0.5 0.5 0.3 1.0)
       (vector-float*!
         (the-as vector (-> this draw color-emissive))
         (the-as vector (-> this draw color-emissive))
         (* (-> this alpha) (rand-vu-float-range 0.55 0.7))
         )
       (set! (-> *part-id-table* 410 init-specs 9 initial-valuef)
             (* (-> this alpha) (rand-vu-float-range 80.0 96.0))
             )
       (set! (-> *part-id-table* 411 init-specs 9 initial-valuef)
             (* (-> this alpha) (rand-vu-float-range 80.0 96.0))
             )
       (let ((f1-18 (lerp-scale 18432.0 44236.8 (- (-> (math-camera-pos) y) (-> this root trans y)) 12288.0 49152.0))
             (f0-56 (* (/ (-> this base-scale) 6) f30-1))
             )
         (set! (-> *part-id-table* 410 init-specs 3 initial-valuef) (* f1-18 f0-56))
         (set! (-> *part-id-table* 410 init-specs 5 initial-valuef) (* 73728.0 f0-56))
         (set! (-> *part-id-table* 411 init-specs 3 initial-valuef) (* (/ f0-56 4) f1-18))
         (set! (-> *part-id-table* 411 init-specs 5 initial-valuef) (* 18432.0 f0-56))
         (if (or (not (logtest? (-> this flags) (task-arrow-flags taf4))) (< 0.0 f0-56))
             (spawn (-> this part) (-> this root trans))
             )
         )
       )
     )
    (else
      (+! (-> this theta) (* 32768.0 (seconds-per-frame)))
      (+! (-> this phi) (* 9102.223 (seconds-per-frame)))
      (vector-copy! (-> this root trans) (-> this pos))
      (set! (-> this root trans y) (+ 28672.0 (* 4096.0 (cos (-> this theta))) (-> this pos y)))
      )
    )
  (when (logtest? (-> this flags) (task-arrow-flags taf1))
    (quaternion-axis-angle! (-> this root quat) 0.0 1.0 0.0 (-> this phi))
    (quaternion-normalize! (quaternion*! (-> this root quat) (-> this base-quat) (-> this root quat)))
    )
  (transform-post)
  0
  (none)
  )

(defstate idle (task-arrow)
  :virtual #t
  :event (behavior ((proc process) (argc int) (message symbol) (block event-message-block))
    (local-vars (v0-2 object))
    (case message
      (('set-position)
       (let ((a0-3 (the-as object (-> block param 0))))
         (vector-copy! (-> self pos) (the-as vector a0-3))
         )
       (if (logtest? (-> self flags) (task-arrow-flags taf3))
           (task-arrow-method-23 self (-> self pos))
           )
       (when (< (square 4096.0) (vector-vector-xz-distance-squared (-> self pos) (-> self root trans)))
         (set! v0-2 #t)
         (set! (-> self moving) (the-as symbol v0-2))
         v0-2
         )
       )
      (('leave)
       (if (logtest? (-> self flags) (task-arrow-flags taf2))
           (go-virtual die)
           (go-virtual leave)
           )
       )
      (('set-scale)
       (set! (-> self base-scale) (the-as float (-> block param 0)))
       )
      (('set-alpha)
       (set! (-> self alpha) (the-as float (-> block param 0)))
       )
      (('hide-keep-minimap)
       (set! v0-2 (logior (-> self flags) (task-arrow-flags taf4)))
       (set! (-> self flags) (the-as task-arrow-flags v0-2))
       v0-2
       )
      (('hide 'die)
       (if (= message 'die)
           (set! (-> self death-pending?) #t)
           )
       (when (-> self minimap)
         (kill-callback (-> *minimap* engine) (-> self minimap))
         (set! (-> self minimap) #f)
         )
       (set! v0-2 (logior (-> self flags) (task-arrow-flags taf4)))
       (set! (-> self flags) (the-as task-arrow-flags v0-2))
       v0-2
       )
      (('show)
       (logclear! (-> self flags) (task-arrow-flags taf4))
       (when (and (not (-> self minimap)) (not (logtest? (-> self flags) (task-arrow-flags taf5))))
         (set! v0-2 (add-icon! *minimap* self (-> self map-icon) (the-as int #f) (the-as vector #t) 0))
         (set! (-> self minimap) (the-as connection-minimap v0-2))
         v0-2
         )
       )
      (('modify-flags)
       (let ((v1-35 (-> block param 0))
             (a1-6 (-> block param 1))
             )
         (set! v0-2 (logior (logclear (-> self flags) a1-6) v1-35))
         )
       (set! (-> self flags) (the-as task-arrow-flags v0-2))
       v0-2
       )
      (('map-icon)
       (kill-callback (-> *minimap* engine) (-> self minimap))
       (let ((a2-2 (-> block param 0)))
         (set! (-> self map-icon) a2-2)
         (set! v0-2 (add-icon! *minimap* self a2-2 (the-as int #f) (the-as vector #t) 0))
         )
       (set! (-> self minimap) (the-as connection-minimap v0-2))
       v0-2
       )
      )
    )
  :code sleep-code
  :post (behavior ()
    (when (logtest? (-> self flags) (task-arrow-flags taf8))
      (let ((f0-0 (vector-vector-xz-distance (target-pos 0) (-> self root trans))))
        0.0
        (set! (-> self alpha) (lerp-scale 0.0 1.0 f0-0 40960.0 122880.0))
        )
      )
    (let ((gp-1 (new 'stack-no-clear 'vector)))
      (vector-copy! gp-1 (-> (math-camera-matrix) fvec))
      (let ((s5-1 (vector-! (new 'stack-no-clear 'vector) (math-camera-pos) (-> self root trans))))
        (set! (-> gp-1 y) 0.0)
        (set! (-> s5-1 y) 0.0)
        (vector-normalize! gp-1 1.0)
        (vector-normalize! s5-1 1.0)
        (vector-negate-in-place! gp-1)
        (vector+! gp-1 gp-1 s5-1)
        )
      (vector-normalize! gp-1 1.0)
      (quaternion-look-at! (-> self root quat) gp-1 *up-vector*)
      )
    (draw-arrow self)
    )
  )

(defstate leave (task-arrow)
  :virtual #t
  :code (behavior ()
    (set! (-> self moving) #t)
    (while (-> self moving)
      (suspend)
      )
    (cleanup-for-death self)
    )
  :post (behavior ()
    (draw-arrow self)
    )
  )

(defstate die (task-arrow)
  :virtual #t
  :enter (behavior ()
    (when (-> self minimap)
      (kill-callback (-> *minimap* engine) (-> self minimap))
      (set! (-> self minimap) #f)
      )
    )
  :code (behavior ()
    (cleanup-for-death self)
    )
  )

(defbehavior task-arrow-init-by-other task-arrow ((arg0 task-arrow-params))
  (set! (-> self death-pending?) #f)
  (set! (-> self flags) (-> arg0 flags))
  (set! (-> self map-icon) (-> arg0 map-icon))
  (let ((s5-0 (new 'process 'collide-shape self (collide-list-enum usually-hit-by-player))))
    (let ((v1-4 (new 'process 'collide-shape-prim-sphere s5-0 (the-as uint 0))))
      (set! (-> v1-4 prim-core collide-as) (collide-spec camera-blocker))
      (set! (-> v1-4 prim-core action) (collide-action solid))
      (set! (-> v1-4 transform-index) 3)
      (set-vector! (-> v1-4 local-sphere) 0.0 0.0 0.0 40960.0)
      (set! (-> s5-0 total-prims) (the-as uint 1))
      (set! (-> s5-0 root-prim) v1-4)
      )
    (set! (-> s5-0 nav-radius) (* 0.75 (-> s5-0 root-prim local-sphere w)))
    (let ((v1-7 (-> s5-0 root-prim)))
      (set! (-> s5-0 backup-collide-as) (-> v1-7 prim-core collide-as))
      (set! (-> s5-0 backup-collide-with) (-> v1-7 prim-core collide-with))
      )
    (set! (-> self root) s5-0)
    )
  (vector-copy! (-> self pos) (-> arg0 pos))
  (if (logtest? (-> self flags) (task-arrow-flags taf3))
      (task-arrow-method-23 self (-> self pos))
      )
  (vector-copy! (-> self root trans) (-> self pos))
  (quaternion-copy! (-> self root quat) (-> arg0 quat))
  (quaternion-copy! (-> self base-quat) (-> arg0 quat))
  (set-vector! (-> self root scale) 1.0 1.0 1.0 1.0)
  (set! (-> self base-scale) 6.0)
  (set! (-> self alpha) 1.0)
  (set! (-> self hud-dist) (the-as handle #f))
  (set! (-> self max-dist) 0.0)
  (set! (-> self theta) 0.0)
  (set! (-> self phi) 0.0)
  (set! (-> self minimap) #f)
  (if (not (logtest? (-> self flags) (task-arrow-flags taf5)))
      (set! (-> self minimap) (add-icon! *minimap* self (-> arg0 map-icon) (the-as int #f) (the-as vector #t) 0))
      )
  (set! (-> self part) (create-launch-control group-rod-of-god self))
  (initialize-skeleton
    self
    (the-as skeleton-group (art-group-get-by-name *level* "skel-rod-of-god" (the-as (pointer level) #f)))
    (the-as pair 0)
    )
  (set! (-> self draw lod-set lod 0 dist) 4096000.0)
  (set! (-> self draw bounds w) 1228800.0)
  (set-vector! (-> self draw color-mult) 0.0 0.0 0.0 1.0)
  (when (not (logtest? (-> self flags) (task-arrow-flags taf7)))
    (set! (-> self choir-sound) (new 'process 'ambient-sound "god-rod" (-> self root trans) 0.0))
    (set-falloff-far! (-> self choir-sound) 163840.0)
    (update-vol! (-> self choir-sound) 1.0)
    (update-pitch-mod! (-> self choir-sound) 0.0)
    )
  (set! (-> self rod-of-god-scale) 0.0)
  (set! (-> self moving) #f)
  (logclear! (-> self mask) (process-mask actor-pause movie))
  (process-entity-status! self (entity-perm-status no-kill) #t)
  (set! (-> self event-hook) (-> (method-of-object self idle) event))
  (go-virtual idle)
  )

(defmethod relocate ((this task-arrow) (offset int))
  (if (nonzero? (-> this choir-sound))
      (&+! (-> this choir-sound) offset)
      )
  (call-parent-method this offset)
  )

(defun task-arrow-spawn ((arg0 task-arrow-params) (arg1 process-tree))
  (let ((gp-0 (the-as process #f)))
    (let ((v1-1 (process-spawn task-arrow arg0 :name "task-arrow" :to arg1)))
      (if v1-1
          (set! gp-0 (-> v1-1 0))
          )
      )
    gp-0
    )
  )