jak-project/test/decompiler/reference/jak2/levels/ruins/mechtest-obs_REF.gc

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

;; definition of type mechblock
(deftype mechblock (process-drawable)
  ((root            collide-shape-moving :override)
   (origin          vector                :inline)
   (unknown-quat    quaternion            :inline)
   (unknown-vector  vector                :inline)
   (drop-point      vector                :inline)
   (allow-drag?     symbol)
   (reset-on-land?  symbol)
   (hit-something?  symbol)
   (attack-id       uint32)
   (next-entity     entity)
   )
  (:state-methods
    idle
    carry
    drag
    fall
    wait
    )
  )

;; definition for method 3 of type mechblock
(defmethod inspect ((this mechblock))
  (when (not this)
    (set! this this)
    (goto cfg-4)
    )
  (let ((t9-0 (method-of-type process-drawable inspect)))
    (t9-0 this)
    )
  (format #t "~2Torigin: ~`vector`P~%" (-> this origin))
  (format #t "~2Tdrop-point: ~`vector`P~%" (-> this drop-point))
  (format #t "~2Tallow-drag?: ~A~%" (-> this allow-drag?))
  (format #t "~2Treset-on-land?: ~A~%" (-> this reset-on-land?))
  (format #t "~2Thit-something?: ~A~%" (-> this hit-something?))
  (format #t "~2Tattack-id: ~D~%" (-> this attack-id))
  (format #t "~2Tnext-entity: ~A~%" (-> this next-entity))
  (label cfg-4)
  this
  )

;; failed to figure out what this is:
(defstate idle (mechblock)
  :virtual #t
  :event (behavior ((proc process) (argc int) (message symbol) (block event-message-block))
    (case message
      (('carry? 'carry-info)
       (-> self carry)
       )
      (('pickup)
       (cond
         ((-> self allow-drag?)
          (carry!
            (the-as carry-info (-> block param 0))
            (-> self carry)
            (the-as vector (-> block param 1))
            (the-as vector (-> block param 2))
            )
          (go-virtual drag)
          )
         (else
           (drag! (the-as carry-info (-> block param 0)) (-> self carry))
           (go-virtual carry)
           )
         )
       )
      )
    )
  :code (behavior ()
    (logior! (-> self mask) (process-mask actor-pause))
    (dotimes (gp-0 2)
      (transform-post)
      (carry-info-method-9 (-> self carry))
      (suspend)
      )
    (logior! (-> self mask) (process-mask sleep))
    (suspend)
    0
    )
  )

;; failed to figure out what this is:
(defstate wait (mechblock)
  :virtual #t
  :exit (behavior ()
    (logclear! (-> self draw status) (draw-control-status no-draw))
    (let ((v1-3 (-> self root root-prim)))
      (set! (-> v1-3 prim-core collide-as) (-> self root backup-collide-as))
      (set! (-> v1-3 prim-core collide-with) (-> self root backup-collide-with))
      )
    )
  :trans (behavior ()
    (when (or (not *target*) (< 40960.0 (vector-vector-distance (-> self origin) (-> *target* control trans))))
      (move-to-point!
        (-> self root)
        (vector+! (new 'stack-no-clear 'vector) (-> self origin) (new 'static 'vector :y 81920.0 :w 1.0))
        )
      (quaternion-copy! (-> self root quat) (-> self unknown-quat))
      (set-vector! (-> self root transv) 0.0 -4096.0 0.0 1.0)
      (set! (-> self drop-point quad) (-> self origin quad))
      (go-virtual fall)
      )
    )
  :code (behavior ()
    (let ((v1-1 (-> self root root-prim)))
      (set! (-> v1-1 prim-core collide-as) (collide-spec))
      (set! (-> v1-1 prim-core collide-with) (collide-spec))
      )
    0
    (logior! (-> self draw status) (draw-control-status no-draw))
    (logior! (-> self mask) (process-mask sleep-code))
    (suspend)
    0
    )
  )

;; failed to figure out what this is:
(defstate carry (mechblock)
  :virtual #t
  :event (behavior ((proc process) (argc int) (message symbol) (block event-message-block))
    (case message
      (('carry? 'carry-info)
       (-> self carry)
       )
      (('drop)
       (set! (-> self root transv quad) (-> (the-as vector (-> block param 1)) quad))
       (set! (-> self drop-point quad) (-> self root trans quad))
       (go-virtual fall)
       )
      )
    )
  :code sleep-code
  :post (behavior ()
    (ja-post)
    (carry-info-method-9 (-> self carry))
    (carry-info-method-13 (-> self carry))
    (update-transforms (-> self root))
    )
  )

;; failed to figure out what this is:
(defstate drag (mechblock)
  :virtual #t
  :event (behavior ((proc process) (argc int) (message symbol) (block event-message-block))
    (local-vars (at-0 int))
    (rlet ((vf0 :class vf)
           (vf1 :class vf)
           (vf2 :class vf)
           )
      (init-vf0-vector)
      (case message
        (('carry? 'carry-info)
         (-> self carry)
         )
        (('drop)
         (if (handle->process (-> self carry other))
             (drop! (the-as carry-info (send-event (handle->process (-> self carry other)) 'carry-info)) (-> self carry))
             )
         (set! (-> self root transv quad) (-> (the-as vector (-> block param 1)) quad))
         (set! (-> self drop-point quad) (-> self root trans quad))
         (go-virtual fall)
         )
        (('move)
         (let ((s4-0 (-> self root))
               (s5-0 (new 'stack-no-clear 'vector))
               )
           (set! (-> s5-0 quad) (-> s4-0 trans quad))
           (set! (-> s4-0 transv quad) (-> (the-as vector (-> block param 0)) quad))
           (let ((s2-0 (-> self nav))
                 (s1-0 (-> s4-0 root-prim prim-core))
                 (s3-0 (new 'stack-no-clear 'vector))
                 )
             (.lvf vf1 (&-> (-> s4-0 transv) quad))
             (let ((f0-0 (seconds-per-frame)))
               (.mov at-0 f0-0)
               )
             (.mov vf2 at-0)
             (.mov.vf.w vf1 vf0)
             (.mul.x.vf.xyz vf1 vf1 vf2)
             (.svf (&-> s3-0 quad) vf1)
             (set! (-> s3-0 y) 0.0)
             (vector-float*! s3-0 s3-0 10.0)
             (when (nonzero? s2-0)
               (let ((v1-28 s2-0)
                     (a0-26 s1-0)
                     (a1-6 (new 'stack-no-clear 'nav-find-poly-parms))
                     )
                 (vector-! (-> a1-6 point) (-> a0-26 world-sphere) (-> v1-28 state mesh bounds))
                 (set! (-> a1-6 y-threshold) (-> v1-28 nearest-y-threshold))
                 (set! (-> a1-6 ignore) (the-as uint 2))
                 (let ((a2-4 (find-poly-containing-point-local (-> v1-28 state mesh) a1-6)))
                   (cond
                     (a2-4
                       (clamp-vector-to-mesh-cross-gaps
                         s2-0
                         (-> s1-0 world-sphere)
                         a2-4
                         s3-0
                         204.8
                         #f
                         (the-as clamp-travel-vector-to-mesh-return-info #f)
                         )
                       )
                     (else
                       )
                     )
                   )
                 )
               )
             (vector-float*! (-> s4-0 transv) s3-0 (/ (-> self clock frames-per-second) 10))
             )
           (let ((v1-35 (-> s4-0 root-prim)))
             (set! (-> v1-35 prim-core collide-as) (-> s4-0 backup-collide-as))
             (set! (-> v1-35 prim-core collide-with) (-> s4-0 backup-collide-with))
             )
           (set! (-> s4-0 root-prim type) collide-shape-prim-sphere)
           (let ((a2-5 (new 'stack-no-clear 'collide-query)))
             (set! (-> a2-5 collide-with)
                   (logclear (-> s4-0 root-prim prim-core collide-with) (collide-spec backgnd jak player-list tobot))
                   )
             (set! (-> a2-5 ignore-process0) self)
             (set! (-> a2-5 ignore-process1) #f)
             (set! (-> a2-5 ignore-pat) (-> s4-0 pat-ignore-mask))
             (set! (-> a2-5 action-mask) (collide-action solid))
             (fill-cache-integrate-and-collide s4-0 (-> s4-0 transv) a2-5 (meters 0))
             )
           (when (nonzero? (-> self nav))
             (let ((v1-44 (-> self nav))
                   (a0-41 (-> self root root-prim prim-core))
                   (a1-9 (new 'stack-no-clear 'nav-find-poly-parms))
                   )
               (vector-! (-> a1-9 point) (-> a0-41 world-sphere) (-> v1-44 state mesh bounds))
               (set! (-> a1-9 y-threshold) (-> v1-44 nearest-y-threshold))
               (set! (-> a1-9 ignore) (the-as uint 2))
               (let ((v1-46 (find-poly-containing-point-local (-> v1-44 state mesh) a1-9)))
                 (when v1-46
                   (when (< (-> self root trans y) (-> v1-46 vertex0 y))
                     (let* ((a0-47 (-> self root))
                            (t9-7 (method-of-object a0-47 move-by-vector!))
                            (a1-11 (new 'stack-no-clear 'vector))
                            )
                       (set! (-> a1-11 x) 0.0)
                       (set! (-> a1-11 y) (- (-> v1-46 vertex0 y) (-> self root trans y)))
                       (set! (-> a1-11 z) 0.0)
                       (set! (-> a1-11 w) 1.0)
                       (t9-7 a0-47 a1-11)
                       )
                     )
                   )
                 )
               )
             )
           (set! (-> s4-0 root-prim type) collide-shape-prim-mesh)
           (let ((v1-50 (-> s4-0 root-prim)))
             (set! (-> v1-50 prim-core collide-as) (collide-spec))
             (set! (-> v1-50 prim-core collide-with) (collide-spec))
             )
           0
           (vector-! (the-as vector (-> block param 1)) (-> s4-0 trans) s5-0)
           )
         )
        )
      )
    )
  :code sleep-code
  :post (behavior ()
    (ja-post)
    (carry-info-method-9 (-> self carry))
    (translate! (-> self carry))
    (update-transforms (-> self root))
    )
  )

;; failed to figure out what this is:
(defstate fall (mechblock)
  :virtual #t
  :event (behavior ((proc process) (argc int) (message symbol) (block event-message-block))
    (case message
      (('carry-info)
       (-> self carry)
       )
      (('carry? 'pickup)
       (the-as basic #f)
       )
      (('touched)
       (when (and (!= (-> proc type) target)
                  (send-event proc 'attack (-> block param 0) (static-attack-info ((id (-> self attack-id)) (mode 'crush))))
                  )
         (sound-play "block-hit")
         (let ((v0-0 (the-as basic (-> proc entity))))
           (set! (-> self hit-something?) (the-as symbol v0-0))
           v0-0
           )
         )
       )
      )
    )
  :enter (behavior ()
    (logclear! (-> self mask) (process-mask actor-pause))
    (set-time! (-> self state-time))
    (if (handle->process (-> self carry other))
        (drop-impl!
          (the-as carry-info (send-event (handle->process (-> self carry other)) 'carry-info))
          (-> self carry)
          )
        )
    (set! (-> self root status) (collide-status))
    (set! (-> self root root-prim local-sphere w) (-> self carry carry-radius))
    )
  :trans (behavior ()
    (when (or (and (logtest? (-> self root status) (collide-status on-surface)) (< 0.8 (-> self root surface-angle)))
              (time-elapsed? (-> self state-time) (seconds 5))
              )
      (vector-reset! (-> self root transv))
      (set! (-> self root root-prim local-sphere w) (-> self carry backup-radius))
      (cond
        ((and (-> self reset-on-land?)
              (and (or (< 12288.0 (vector-vector-distance (-> self drop-point) (-> self root trans)))
                       (time-elapsed? (-> self state-time) (seconds 5))
                       )
                   (and (-> self next-entity)
                        (not (logtest? (-> self next-entity extra perm status) (entity-perm-status subtask-complete)))
                        )
                   )
              )
         (sound-play "block-break")
         (part-tracker-spawn :to self :group group-crate-explode :mat-joint (-> self root trans))
         (go-virtual wait)
         )
        ((or (< 12288.0 (vector-vector-distance (-> self drop-point) (-> self root trans)))
             (time-elapsed? (-> self state-time) (seconds 5))
             )
         (sound-play "block-break")
         (part-tracker-spawn :to self :group group-crate-explode :mat-joint (-> self root trans))
         (go-virtual wait)
         )
        (else
          (go-virtual idle)
          )
        )
      )
    )
  :code sleep-code
  :post (behavior ()
    (vector-v++! (-> self root transv) (compute-acc-due-to-gravity (-> self root) (new-stack-vector0) 0.0))
    (let ((v1-2 (new-stack-vector0))
          (f0-1 (vector-dot (-> self root dynam gravity-normal) (-> self root transv)))
          )
      0.0
      (vector-! v1-2 (-> self root transv) (vector-float*! v1-2 (-> self root dynam gravity-normal) f0-1))
      (let* ((f1-2 (vector-length v1-2))
             (f2-0 f1-2)
             )
        (if (< f0-1 (- (-> self root dynam gravity-max)))
            (set! f0-1 (- (-> self root dynam gravity-max)))
            )
        (vector+!
          (-> self root transv)
          (vector-float*! (-> self root transv) (-> self root dynam gravity-normal) f0-1)
          (vector-float*! v1-2 v1-2 (/ f1-2 f2-0))
          )
        )
      )
    (let ((a2-8 (new 'stack-no-clear 'collide-query))
          (gp-1 (-> self root))
          )
      (set! (-> gp-1 root-prim type) collide-shape-prim-sphere)
      (set! (-> a2-8 collide-with)
            (logclear (-> gp-1 root-prim prim-core collide-with) (collide-spec jak player-list tobot))
            )
      (set! (-> a2-8 ignore-process0) self)
      (set! (-> a2-8 ignore-process1) #f)
      (set! (-> a2-8 ignore-pat) (-> gp-1 pat-ignore-mask))
      (set! (-> a2-8 action-mask) (collide-action solid))
      (fill-cache-integrate-and-collide gp-1 (-> gp-1 transv) a2-8 (meters 0))
      (set! (-> gp-1 root-prim type) collide-shape-prim-mesh)
      )
    (transform-post)
    (carry-info-method-9 (-> self carry))
    )
  )

;; definition of type throwblock
(deftype throwblock (mechblock)
  ()
  )

;; definition for method 3 of type throwblock
(defmethod inspect ((this throwblock))
  (when (not this)
    (set! this this)
    (goto cfg-4)
    )
  (let ((t9-0 (method-of-type mechblock inspect)))
    (t9-0 this)
    )
  (label cfg-4)
  this
  )

;; failed to figure out what this is:
(defskelgroup skel-throwblock throwblock throwblock-lod0-jg throwblock-idle-ja
              ((throwblock-lod0-mg (meters 999999)))
              :bounds (static-spherem 0 1.5 0 2.7)
              )

;; definition for method 11 of type throwblock
;; WARN: Return type mismatch object vs none.
(defmethod init-from-entity! ((this throwblock) (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"
  (let ((s4-0 (new 'process 'collide-shape-moving this (collide-list-enum usually-hit-by-player))))
    (set! (-> s4-0 dynam) (copy *standard-dynamics* 'process))
    (set! (-> s4-0 reaction) cshape-reaction-default)
    (set! (-> s4-0 no-reaction)
          (the-as (function collide-shape-moving collide-query vector vector object) nothing)
          )
    (set! (-> s4-0 penetrated-by) (penetrate))
    (let ((v1-6 (new 'process 'collide-shape-prim-mesh s4-0 (the-as uint 0) (the-as uint 0))))
      (set! (-> v1-6 prim-core collide-as) (collide-spec obstacle))
      (set! (-> v1-6 prim-core collide-with)
            (collide-spec backgnd jak crate obstacle hit-by-others-list player-list tobot)
            )
      (set! (-> v1-6 prim-core action) (collide-action solid))
      (set! (-> v1-6 transform-index) 3)
      (set-vector! (-> v1-6 local-sphere) 0.0 6144.0 0.0 11059.2)
      (set! (-> s4-0 total-prims) (the-as uint 1))
      (set! (-> s4-0 root-prim) v1-6)
      )
    (set! (-> s4-0 nav-radius) (* 0.75 (-> s4-0 root-prim local-sphere w)))
    (let ((v1-9 (-> s4-0 root-prim)))
      (set! (-> s4-0 backup-collide-as) (-> v1-9 prim-core collide-as))
      (set! (-> s4-0 backup-collide-with) (-> v1-9 prim-core collide-with))
      )
    (set! (-> s4-0 max-iteration-count) (the-as uint 4))
    (set! (-> s4-0 event-self) 'touched)
    (set! (-> this root) s4-0)
    )
  (process-drawable-from-entity! this arg0)
  (initialize-skeleton
    this
    (the-as skeleton-group (art-group-get-by-name *level* "skel-throwblock" (the-as (pointer uint32) #f)))
    (the-as pair 0)
    )
  (mem-copy! (the-as pointer (-> this origin)) (the-as pointer (-> this root trans)) 48)
  (set! (-> this allow-drag?) #f)
  (set! (-> this reset-on-land?) #t)
  (let* ((v1-18 *game-info*)
         (a0-16 (+ (-> v1-18 attack-id) 1))
         )
    (set! (-> v1-18 attack-id) a0-16)
    (set! (-> this attack-id) a0-16)
    )
  (set! (-> this hit-something?) #f)
  (set! (-> this next-entity) (entity-actor-lookup (-> this entity) 'next-actor 0))
  (let ((v1-20 (new 'process 'carry-info this 3 (new 'static 'vector :w 1.0) (new 'static 'vector :y 1.0 :w 1.0) 0.0))
        )
    (set! (-> v1-20 max-distance) 16384.0)
    (set! (-> v1-20 min-pull) 2048.0)
    (set! (-> v1-20 max-pull) 6963.2)
    (set! (-> v1-20 carry-radius) 6144.0)
    (set! (-> v1-20 mode) (carry-mode mech-carry))
    (set! (-> this carry) v1-20)
    )
  (go (method-of-object this idle))
  (none)
  )

;; definition of type pushblock
(deftype pushblock (mechblock)
  ()
  )

;; definition for method 3 of type pushblock
(defmethod inspect ((this pushblock))
  (when (not this)
    (set! this this)
    (goto cfg-4)
    )
  (let ((t9-0 (method-of-type mechblock inspect)))
    (t9-0 this)
    )
  (label cfg-4)
  this
  )

;; failed to figure out what this is:
(defskelgroup skel-pushblock pushblock pushblock-lod0-jg pushblock-idle-ja
              ((pushblock-lod0-mg (meters 999999)))
              :bounds (static-spherem 0 2 0 4)
              )

;; definition for method 11 of type pushblock
;; WARN: Return type mismatch object vs none.
(defmethod init-from-entity! ((this pushblock) (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"
  (let ((s4-0 (new 'process 'collide-shape-moving this (collide-list-enum usually-hit-by-player))))
    (set! (-> s4-0 dynam) (copy *standard-dynamics* 'process))
    (set! (-> s4-0 reaction) cshape-reaction-default)
    (set! (-> s4-0 no-reaction)
          (the-as (function collide-shape-moving collide-query vector vector object) nothing)
          )
    (set! (-> s4-0 penetrated-by) (penetrate))
    (let ((v1-6 (new 'process 'collide-shape-prim-mesh s4-0 (the-as uint 0) (the-as uint 0))))
      (set! (-> v1-6 prim-core collide-as) (collide-spec obstacle))
      (set! (-> v1-6 prim-core collide-with)
            (collide-spec backgnd jak crate obstacle hit-by-others-list player-list tobot)
            )
      (set! (-> v1-6 prim-core action) (collide-action solid))
      (set! (-> v1-6 transform-index) 0)
      (set-vector! (-> v1-6 local-sphere) 0.0 11264.0 0.0 22528.0)
      (set! (-> s4-0 total-prims) (the-as uint 1))
      (set! (-> s4-0 root-prim) v1-6)
      )
    (set! (-> s4-0 nav-radius) (* 0.75 (-> s4-0 root-prim local-sphere w)))
    (let ((v1-9 (-> s4-0 root-prim)))
      (set! (-> s4-0 backup-collide-as) (-> v1-9 prim-core collide-as))
      (set! (-> s4-0 backup-collide-with) (-> v1-9 prim-core collide-with))
      )
    (set! (-> s4-0 max-iteration-count) (the-as uint 4))
    (set! (-> this root) s4-0)
    )
  (process-drawable-from-entity! this arg0)
  (initialize-skeleton
    this
    (the-as skeleton-group (art-group-get-by-name *level* "skel-pushblock" (the-as (pointer uint32) #f)))
    (the-as pair 0)
    )
  (mem-copy! (the-as pointer (-> this origin)) (the-as pointer (-> this root trans)) 48)
  (set! (-> this reset-on-land?) #f)
  (set! (-> this allow-drag?) #t)
  (let* ((v1-17 *game-info*)
         (a0-15 (+ (-> v1-17 attack-id) 1))
         )
    (set! (-> v1-17 attack-id) a0-15)
    (set! (-> this attack-id) a0-15)
    )
  (set! (-> this next-entity) #f)
  (get-nav-control this (the-as nav-mesh #f))
  (let ((v1-19 (new
                 'process
                 'carry-info
                 this
                 3
                 (new 'static 'vector :y 819.2 :w 1.0)
                 (new 'static 'vector :y 1.0 :w 1.0)
                 0.0
                 )
               )
        )
    (set! (-> v1-19 max-distance) 22528.0)
    (set! (-> v1-19 min-pull) 10240.0)
    (set! (-> v1-19 max-pull) 14336.0)
    (set! (-> v1-19 carry-radius) 11264.0)
    (set! (-> v1-19 mode) (carry-mode mech-drag))
    (set! (-> this carry) v1-19)
    )
  (go (method-of-object this idle))
  (none)
  )