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

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

;; name: voicebox.gc
;; name in dgo: voicebox
;; dgos: ENGINE, GAME

;; DECOMP BEGINS

(defpartgroup group-talkbox-speak
  :id 77
  :flags (unk-4 unk-6)
  :bounds (static-bspherem 0 0 0 2)
  :rotate ((degrees 4) (degrees 0) (degrees 0))
  :parts ((sp-item 265 :flags (is-3d bit6 bit7) :period 130 :length 30)
    (sp-item 265 :flags (is-3d bit6 bit7) :period 150 :length 35 :offset 5)
    (sp-item 265 :flags (is-3d bit6 bit7) :period 330 :length 25 :offset 35)
    (sp-item 265 :flags (is-3d bit6 bit7) :period 250 :length 60 :offset 15)
    (sp-item 265 :flags (is-3d bit6 bit7) :period 465 :length 75 :offset 60)
    )
  )

(defpart 265
  :init-specs ((sp-tex spt-texture (new 'static 'texture-id :index #xcb :page #xc))
    (sp-func spt-birth-func 'birth-func-set-vel)
    (sp-rnd-flt spt-num 0.0 0.3 1.0)
    (sp-flt spt-y (meters 0.15))
    (sp-flt spt-z (meters 0.4))
    (sp-flt spt-scale-x (meters 0.1))
    (sp-copy-from-other spt-scale-y -4)
    (sp-flt spt-r 255.0)
    (sp-flt spt-g 255.0)
    (sp-flt spt-b 255.0)
    (sp-flt spt-a 16.0)
    (sp-rnd-flt spt-vel-y (meters 0.006666667) (meters 0.0033333334) 1.0)
    (sp-rnd-flt spt-scalevel-x (meters 0.006666667) (meters 0.0033333334) 1.0)
    (sp-copy-from-other spt-scalevel-y -4)
    (sp-flt spt-fade-a 0.32)
    (sp-int spt-timer 100)
    (sp-cpuinfo-flags sp-cpuinfo-flag-2 sp-cpuinfo-flag-3 left-multiply-quat)
    (sp-int spt-next-time 50)
    (sp-launcher-by-id spt-next-launcher 266)
    (sp-flt spt-rotate-y (degrees 0.0))
    )
  )

(defpart 266
  :init-specs ((sp-flt spt-fade-a -0.64))
  )

(deftype camera-remote (camera-slave)
  ()
  :heap-base #xa20
  :method-count-assert 14
  :size-assert         #xa94
  :flag-assert         #xe0a200a94
  )


(deftype remote (process-drawable)
  ((parent-override (pointer camera-slave)         :offset         16)
   (base-trans      vector                 :inline :offset-assert 208)
   (focus           focus                  :inline :offset-assert 224)
   (seeker          cam-float-seeker       :inline :offset-assert 236)
   (start-time      time-frame                     :offset-assert 264)
   (blend           float                          :offset-assert 272)
   (twist           float                          :offset-assert 276)
   (speak-effect?   basic                          :offset-assert 280)
   )
  :heap-base #xa0
  :method-count-assert 26
  :size-assert         #x11c
  :flag-assert         #x1a00a0011c
  (:methods
    (enter () _type_ :state 20)
    (idle () _type_ :state 21)
    (exit () _type_ :state 22)
    (init (_type_) none 23)
    (get-track-pt-and-scale (_type_ vector) float 24)
    (post-common (_type_) none 25)
    )
  )


(defskelgroup skel-voicebox talk-box talk-box-lod0-jg talk-box-idle-ja
              ((talk-box-lod0-mg (meters 999999)))
              :bounds (static-spherem 0 0 0 4)
              :texture-level 6
              :sort 1
              )

(defmethod get-track-pt-and-scale remote ((obj remote) (arg0 vector))
  (let ((s4-0 (handle->process (-> obj focus handle))))
    (when s4-0
      (set! (-> arg0 quad) (-> (get-trans (the-as process-focusable s4-0) 3) quad))
      (let ((a0-7 (vector-z-quaternion! (new 'stack-no-clear 'vector) (get-quat (the-as process-focusable s4-0) 0))))
        (vector+float*! arg0 arg0 a0-7 (* -16384.0 (- 1.0 (-> obj blend))))
        )
      )
    )
  (lerp-scale 1.0 0.0 (-> obj blend) 0.8 1.0)
  )

(defmethod post-common remote ((obj remote))
  (with-pp
    (rlet ((acc :class vf)
           (vf0 :class vf)
           (vf4 :class vf)
           (vf5 :class vf)
           (vf6 :class vf)
           (vf7 :class vf)
           )
      (init-vf0-vector)
      (ja-post)
      (if (type? (-> obj root) collide-shape)
          (update-transforms (the-as collide-shape (-> obj root)))
          )
      (when (and (nonzero? (-> obj part)) (and (or (and (-> obj next-state) (= (-> obj next-state name) 'idle))
                                                   (and (-> obj next-state) (= (-> obj next-state name) 'enter))
                                                   )
                                               (-> obj speak-effect?)
                                               )
                 )
        (let ((v1-15 (vector-float*!
                       (new 'stack-no-clear 'vector)
                       (-> obj parent-override 0 velocity)
                       (-> pp clock frames-per-second)
                       )
                     )
              (a0-8 *particle-vel*)
              )
          (let ((a1-4 (-> obj node-list data 3 bone transform vector 2)))
            (let ((a2-1 20480.0))
              (.mov vf7 a2-1)
              )
            (.lvf vf5 (&-> a1-4 quad))
            )
          (.lvf vf4 (&-> v1-15 quad))
          (.add.x.vf vf6 vf0 vf0 :mask #b1000)
          (.mul.x.vf acc vf5 vf7 :mask #b111)
          (.add.mul.w.vf vf6 vf4 vf0 acc :mask #b111)
          (.svf (&-> a0-8 quad) vf6)
          )
        (let ((v1-16 *particle-vel*)
              (a0-9 *particle-vel*)
              (f0-2 300.0)
              )
          (vector-float*! v1-16 a0-9 (/ 1.0 f0-2))
          )
        (spawn-with-cspace (-> obj part) (-> obj node-list data 3))
        )
      0
      (none)
      )
    )
  )

(defbehavior remote-track remote ()
  (let ((gp-0 (handle->process (-> self focus handle)))
        (s5-0 (new 'stack-no-clear 'vector))
        )
    (set! (-> s5-0 quad) (-> self parent-override 0 trans quad))
    (let ((f30-0 (get-track-pt-and-scale self s5-0)))
      (let ((a1-2 (new 'stack-no-clear 'vector)))
        (set! (-> a1-2 quad) (-> self parent-override 0 trans quad))
        (vector-lerp! (-> self root trans) a1-2 s5-0 (-> self blend))
        )
      (+! (-> self root trans y)
          (* 1638.4 (sin (* 54.613335 (the float (mod (-> self clock frame-counter) 1200)))))
          )
      (let ((s5-1 (new 'stack-no-clear 'quaternion)))
        (forward-up->quaternion
          s5-1
          (vector-normalize! (vector-! (new 'stack-no-clear 'vector) (target-pos 8) (-> self root trans)) 1.0)
          (new 'static 'vector :y 1.0 :w 1.0)
          )
        (rotate-toward-orientation! (-> self root) s5-1 65536.0 5461.3335 150 150 0.0)
        )
      (when gp-0
        (let* ((gp-1 (-> (the-as process-drawable gp-0) root))
               (s4-1 (-> self root trans))
               (f0-6
                 (deg-diff (y-angle gp-1) (vector-y-angle (vector-! (new 'stack-no-clear 'vector) s4-1 (-> gp-1 trans))))
                 )
               )
          (if (< 0.0 f0-6)
              (seek! (-> self twist) -0.4 (* 0.3 (-> self clock seconds-per-frame)))
              (seek! (-> self twist) 0.4 (* 0.3 (-> self clock seconds-per-frame)))
              )
          )
        (let ((a1-9 (new 'stack-no-clear 'event-message-block)))
          (set! (-> a1-9 from) (process->ppointer self))
          (set! (-> a1-9 num-params) 0)
          (set! (-> a1-9 message) 'blocked-side?)
          (case (send-event-function (ppointer->process (-> self parent-override)) a1-9)
            ((1)
             (set! (-> self twist) 0.5)
             )
            ((2)
             (set! (-> self twist) -0.5)
             )
            ((3)
             (set! (-> self twist) 0.0)
             )
            )
          )
        (send-event (ppointer->process (-> self parent-override)) 'joystick (-> self twist) -1082130432)
        )
      (set! (-> self root scale x) f30-0)
      (set! (-> self root scale y) f30-0)
      (set! (-> self root scale z) f30-0)
      )
    )
  0
  (none)
  )

(defstate enter (remote)
  :virtual #t
  :event (behavior ((proc process) (arg1 int) (event-type symbol) (event event-message-block))
    (case event-type
      (('die)
       (go-virtual exit)
       )
      (('speak-effect)
       (let ((v0-0 (the-as object (-> event param 0))))
         (set! (-> self speak-effect?) (the-as basic v0-0))
         v0-0
         )
       )
      )
    )
  :enter (behavior ()
    (set! (-> self start-time) (-> *display* game-clock frame-counter))
    (let* ((gp-0 (ppointer->process (-> self parent-override 0 parent)))
           (a1-1 (if (type? gp-0 process-focusable)
                     gp-0
                     )
                 )
           )
      (if a1-1
          (try-update-focus (-> self focus) (the-as process-focusable a1-1))
          )
      )
    (none)
    )
  :trans (behavior ()
    (remote-track)
    (let ((a0-1 (handle->process (-> self focus handle))))
      (if (and a0-1 (< 0.1 (-> self blend)))
          (point-toward-point-clear-roll-pitch! (-> self root) (get-trans (the-as process-focusable a0-1) 0))
          )
      )
    (none)
    )
  :code (behavior ()
    (let* ((gp-0 (ppointer->process (-> self parent-override 0 parent)))
           (a0-1 (if (type? gp-0 process-focusable)
                     (the-as process-focusable gp-0)
                     )
                 )
           )
      (if (and a0-1 (logtest? (focus-status pilot) (-> a0-1 focus-status)))
          (send-event
            (ppointer->process (-> self parent-override))
            'set-dist
            (new 'static 'vector :z 8192.0 :w 1.0)
            (new 'static 'vector :y 20480.0 :z 12288.0 :w 1.0)
            )
          (send-event
            (ppointer->process (-> self parent-override))
            'set-dist
            (new 'static 'vector :z 16384.0 :w 1.0)
            (new 'static 'vector :y 20480.0 :z 40960.0 :w 1.0)
            )
          )
      )
    (init (-> self seeker) 1.0 0.01 0.022222223 0.1)
    (set! (-> self seeker target) 0.0)
    (while (< 0.0001 (-> self blend))
      (update! (-> self seeker) 0.0)
      (set! (-> self blend) (-> self seeker value))
      (suspend)
      )
    (set! (-> self blend) 0.0)
    (go-virtual idle)
    (none)
    )
  :post (behavior ()
    (post-common self)
    (none)
    )
  )

(defstate idle (remote)
  :virtual #t
  :event (-> (method-of-type remote enter) event)
  :trans remote-track
  :code (behavior ()
    (while (handle->process (-> self focus handle))
      (suspend)
      (ja :num! (loop!))
      )
    (go-virtual exit)
    (none)
    )
  :post (-> (method-of-type remote enter) post)
  )

(defstate exit (remote)
  :virtual #t
  :trans remote-track
  :code (behavior ()
    (set! (-> self blend) 1.0)
    (send-event (ppointer->process (-> self parent-override)) 'change-state empty-state)
    (suspend)
    0
    (none)
    )
  :post (-> (method-of-type remote enter) post)
  )

;; WARN: Return type mismatch remote vs none.
(defmethod init remote ((obj remote))
  (reset-to-collide-spec (-> obj focus) (collide-spec jak player-list))
  (initialize-skeleton
    obj
    (the-as skeleton-group (art-group-get-by-name *level* "skel-voicebox" (the-as (pointer uint32) #f)))
    (the-as pair 0)
    )
  (set! (-> obj blend) 1.0)
  (set! (-> obj draw light-index) (the-as uint 30))
  (set! (-> obj speak-effect?) #f)
  (set! (-> obj part) (create-launch-control (-> *part-group-id-table* 77) obj))
  (none)
  )

(defstate cam-remote (camera-slave)
  :event (-> cam-string event)
  :enter (-> cam-string enter)
  :trans (behavior ()
    (if (or (not *camera*)
            (not (logtest? (-> *camera* master-options) (cam-master-options-u32 HAVE_TARGET)))
            (not (-> self child))
            )
        (deactivate self)
        )
    (none)
    )
  :code (-> cam-string code)
  )

(deftype voicebox (remote)
  ((hint handle  :offset-assert 288)
   )
  :heap-base #xb0
  :method-count-assert 26
  :size-assert         #x128
  :flag-assert         #x1a00b00128
  )


(defstate exit (voicebox)
  :virtual #t
  :code (behavior ()
    (remove-setting! 'sound-flava)
    (set! (-> self state-time) (-> self clock frame-counter))
    (set! (-> self seeker target) 1.0)
    (while (and (< (-> self blend) 0.9999)
                (not (and (not (handle->process (-> self hint)))
                          (>= (- (-> self clock frame-counter) (-> self state-time)) (seconds 0.05))
                          (-> *setting-control* user-current hint)
                          )
                     )
                )
      (update! (-> self seeker) 0.0)
      (set! (-> self blend) (-> self seeker value))
      (suspend)
      )
    (set! (-> self blend) 1.0)
    (send-event (ppointer->process (-> self parent-override)) 'change-state empty-state)
    (suspend)
    (cleanup-for-death self)
    (none)
    )
  )

;; WARN: Return type mismatch object vs none.
(defbehavior voicebox-init-by-other voicebox ((arg0 vector) (arg1 handle))
  (set! (-> self hint) arg1)
  (set! (-> self root) (new 'process 'trsqv))
  (set! (-> self root trans quad) (-> arg0 quad))
  (set! (-> self base-trans quad) (-> arg0 quad))
  (init self)
  (set! (-> self event-hook) (-> (method-of-object self enter) event))
  (go-virtual enter)
  (none)
  )

(defun voicebox-spawn ((arg0 process-drawable) (arg1 vector))
  (with-pp
    (when *camera*
      (let ((s3-0 (process-spawn camera-remote :init cam-slave-init cam-remote #f :from *camera-dead-pool* :to arg0)))
        (if s3-0
            (process-spawn voicebox arg1 (process->handle pp) :to (ppointer->process s3-0))
            )
        )
      )
    )
  )

(deftype judge (remote)
  ((total-time time-frame  :offset-assert 288)
   (beep-time  time-frame  :offset-assert 296)
   (hud-timer  handle      :offset-assert 304)
   (score      uint8       :offset-assert 312)
   )
  :heap-base #xc0
  :method-count-assert 28
  :size-assert         #x139
  :flag-assert         #x1c00c00139
  (:methods
    (wait () _type_ :state 26)
    (setup-collision (_type_) none 27)
    )
  )


(defmethod get-track-pt-and-scale judge ((obj judge) (arg0 vector))
  (set! (-> arg0 quad) (-> obj base-trans quad))
  1.0
  )

(defmethod post-common judge ((obj judge))
  (ja-post)
  (if (type? (-> obj root) collide-shape)
      (update-transforms (the-as collide-shape (-> obj root)))
      )
  (when (and (-> obj next-state) (let ((v1-6 (-> obj next-state name)))
                                   (or (= v1-6 'idle) (= v1-6 'enter))
                                   )
             )
    (if *target*
        (set! (-> *game-info* score) (-> *target* fact-override trick-point))
        )
    (let ((v1-15 (the-as int (- (-> obj total-time) (- (-> *display* game-clock frame-counter) (-> obj start-time))))))
      (if (< (the-as time-frame v1-15) 0)
          (set! v1-15 0)
          )
      (set! (-> *game-info* timer) (the-as time-frame v1-15))
      )
    )
  0
  (none)
  )

(defstate wait (judge)
  :virtual #t
  :event (behavior ((proc process) (arg1 int) (event-type symbol) (event event-message-block))
    (case event-type
      (('die)
       (sound-play "judge-stop")
       (go-virtual exit)
       )
      (('touch 'attack)
       (let ((s4-0 (process-spawn camera-remote :init cam-slave-init cam-remote #f :from *camera-dead-pool* :to proc))
             (s5-2 (if (type? proc process-focusable)
                       (the-as process-focusable proc)
                       )
                   )
             )
         (when (and s4-0
                    (begin (send-event s5-2 'change-mode 'board #f) (logtest? (focus-status board) (-> s5-2 focus-status)))
                    )
           (change-parent self (ppointer->process s4-0))
           (try-update-focus (-> self focus) s5-2)
           (go-virtual enter)
           )
         )
       )
      (('waiting)
       #t
       )
      )
    )
  :code (behavior ()
    (transform-post)
    (logior! (-> self mask) (process-mask sleep))
    (suspend)
    0
    (none)
    )
  )

(defstate enter (judge)
  :virtual #t
  :enter (behavior ()
    (set! (-> self start-time) (-> *display* game-clock frame-counter))
    (send-event *target* 'get-pickup 20 (the float (-> self total-time)))
    (sound-play "judge-start")
    (set! (-> self hud-timer) (ppointer->handle (process-spawn hud-timer :init hud-init-by-other :to self)))
    (none)
    )
  )

(defstate idle (judge)
  :virtual #t
  :event (behavior ((proc process) (arg1 int) (event-type symbol) (event event-message-block))
    (case event-type
      (('die)
       (sound-play "judge-stop")
       (go-virtual exit)
       )
      )
    )
  :code (behavior ()
    (while (let ((a0-2 (handle->process (-> self focus handle))))
             (and a0-2 (!= (send-event a0-2 'test-pickup 20) 0.0))
             )
      (suspend)
      (ja :num! (loop!))
      )
    (send-event (handle->process (-> self hud-timer)) 'hide-and-die)
    (go-virtual exit)
    (none)
    )
  )

(defmethod setup-collision judge ((obj judge))
  (let ((s5-0 (new 'process 'collide-shape obj (collide-list-enum hit-by-player))))
    (let ((v1-2 (new 'process 'collide-shape-prim-sphere s5-0 (the-as uint 0))))
      (set! (-> v1-2 prim-core collide-as) (collide-spec collectable))
      (set! (-> v1-2 prim-core collide-with) (collide-spec jak player-list tobot))
      (set-vector! (-> v1-2 local-sphere) 0.0 0.0 0.0 16384.0)
      (set! (-> s5-0 total-prims) (the-as uint 1))
      (set! (-> s5-0 root-prim) v1-2)
      )
    (set! (-> s5-0 nav-radius) (* 0.75 (-> s5-0 root-prim local-sphere w)))
    (let ((v1-5 (-> s5-0 root-prim)))
      (set! (-> s5-0 backup-collide-as) (-> v1-5 prim-core collide-as))
      (set! (-> s5-0 backup-collide-with) (-> v1-5 prim-core collide-with))
      )
    (set! (-> obj root) s5-0)
    )
  0
  (none)
  )

;; WARN: Return type mismatch object vs none.
(defmethod init-from-entity! judge ((obj judge) (arg0 entity-actor))
  (setup-collision obj)
  (init obj)
  (process-drawable-from-entity! obj arg0)
  (set! (-> obj root trans y) (+ 4096.0 (-> obj root trans y)))
  (set! (-> obj base-trans quad) (-> obj root trans quad))
  (set! (-> obj total-time) (seconds 90))
  (go (method-of-object obj wait))
  (none)
  )

;; WARN: Return type mismatch object vs none.
(defbehavior judge-init-by-other judge ((arg0 vector) (arg1 uint))
  (process-entity-set! self (the-as entity-actor #f))
  (set! (-> self score) arg1)
  (setup-collision self)
  (init self)
  (vector-identity! (-> self root scale))
  (quaternion-identity! (-> self root quat))
  (set! (-> self root trans quad) (-> arg0 quad))
  (set! (-> self base-trans quad) (-> self root trans quad))
  (set! (-> self total-time) (seconds 90))
  (go-virtual wait)
  (none)
  )

;; WARN: Return type mismatch (pointer process) vs (pointer judge).
(defun judge-spawn ((arg0 process-tree) (arg1 vector) (arg2 uint))
  (process-spawn judge arg1 arg2 :to arg0)
  )