;;-*-Lisp-*-
(in-package goal)
(bundles "SNO.DGO" "SWA.DGO")
(require "levels/common/blocking-plane.gc")
(require "engine/common-obs/generic-obs.gc")
(require "engine/entity/ambient.gc")

;; DECOMP BEGINS

(if (not (nmember "flutp" *kernel-packages*)) (set! *kernel-packages* (cons "flutp" *kernel-packages*)))

(deftype flutflut (process-drawable)
  ((root            collide-shape-moving :override)
   (parent-override (pointer target) :overlay-at parent)
   (extra-trans     vector :inline)
   (condition       int32)
   (auto-get-off    symbol)
   (cell            handle)
   (path-data       path-control 2)
   (path-target     path-control :overlay-at (-> path-data 0))
   (path-flut       path-control :overlay-at (-> path-data 1))
   (touch-time      time-frame))
  :pack-me
  (:state-methods
   wait-for-start
   idle
   (pickup (state flutflut))
   wait-for-return))


(defmethod relocate ((this flutflut) (offset int))
  (countdown (v1-0 2)
    (if (-> this path-data v1-0) (&+! (-> this path-data v1-0) offset)))
  (the-as flutflut ((method-of-type process-drawable relocate) this offset)))

(define *flutflut-shadow-control*
  (new 'static
       'shadow-control
       :settings
       (new 'static
            'shadow-settings
            :flags (shadow-flags disable-fade shdf03)
            :shadow-dir
            (new 'static 'vector :y -1.0 :w 614400.0)
            :bot-plane
            (new 'static 'plane :y 1.0 :w 81920.0)
            :top-plane
            (new 'static 'plane :y 1.0 :w -2867.2))))

(defskelgroup *flutflut-sg*
  flut-saddle
  flut-saddle-lod0-jg
  -1
  ((flut-saddle-lod0-mg (meters 999999)))
  :bounds (static-spherem 0 0 0 3.5)
  :shadow flut-saddle-shadow-mg
  :sort 1)

(defbehavior flutflut-effect flutflut ()
  (spawn (-> self part) (-> self root trans))
  (update! (-> self sound))
  0
  (none))

(defstate wait-for-start (flutflut)
  :virtual #t
  :event
    (behavior ((proc process) (argc int) (message symbol) (block event-message-block))
      (case message
        (('trans) (vector+! (the-as vector (-> block param 0)) (-> self root trans) (-> self extra-trans)))
        (('notify) (let ((v0-1 (the-as structure #t))) (set! (-> self auto-get-off) (the-as symbol v0-1)) v0-1))
        (('touch 'attack) (set-time! (-> self touch-time)) #f)))
  :exit
    (behavior ()
      (set! (-> self root root-prim prim-core action) (collide-action))
      (set! (-> self root root-prim prim-core offense) (collide-offense no-offense))
      0)
  :code
    (behavior ()
      (loop
        (let ((v1-0 (-> self condition)))
          (cond
            ((or (zero? v1-0) (= v1-0 1))
             (if (or (and (task-complete? *game-info* (game-task beach-flutflut))
                          (or (and (zero? (-> self condition)) (task-closed? (game-task village2-levitator) (task-status need-hint)))
                              (and (= (-> self condition) 1) (task-closed? (game-task village3-button) (task-status need-hint)))))
                     (and *cheat-mode* (cpad-hold? 0 l3))
                     (and *target* (logtest? (-> *target* control root-prim prim-core action) (collide-action flut))))
               (goto cfg-75)))
            ((= v1-0 4)
             (if (and *target* (logtest? (-> *target* control root-prim prim-core action) (collide-action flut))) (goto cfg-75)))
            ((= v1-0 3)
             (cond
               ((and (task-complete? *game-info* (-> self entity extra perm task)) (not (handle->process (-> self cell))))
                (when (and (-> self auto-get-off) (send-event *target* 'end-mode))
                  (set! (-> self auto-get-off) #f)
                  (go-virtual pickup (method-of-object self idle)))
                (set! (-> self auto-get-off) #f)
                (if (= (-> self condition) 3) (goto cfg-75))
                (if (and *target*
                         (logtest? (-> *target* control root-prim prim-core action) (collide-action flut))
                         (not (time-elapsed? (-> self touch-time) (seconds 0.05))))
                  (go-virtual pickup (method-of-object self idle))))
               ((not (handle->process (-> self cell)))
                (set! (-> self cell)
                      (ppointer->handle (birth-pickup-at-point (vector+! (new 'stack-no-clear 'vector) (-> self root trans) (new 'static 'vector :y 8192.0 :w 1.0))
                                                               (pickup-type fuel-cell)
                                                               (the float (-> self entity extra perm task))
                                                               #f
                                                               self
                                                               (-> self fact)))))))
            (else (goto cfg-75))))
        (flutflut-effect)
        (suspend))
      (label cfg-75)
      (if (and *target* (logtest? (-> *target* control root-prim prim-core action) (collide-action flut)))
        (go-virtual wait-for-return)
        (go-virtual idle))))

(defstate idle (flutflut)
  :virtual #t
  :event
    (-> (method-of-type flutflut wait-for-start)
        event)
  :enter
    (behavior ()
      (blocking-plane-destroy)
      (blocking-plane-spawn (the-as curve-control (-> self path-target))))
  :exit
    (-> (method-of-type flutflut wait-for-start)
        exit)
  :code
    (behavior ()
      (ja-channel-set! 1)
      (ja :group! flut-saddle-flut-idle-ja)
      (set! (-> self root root-prim prim-core action) (collide-action solid attackable-unused))
      (set! (-> self root root-prim prim-core offense) (collide-offense indestructible))
      (loop
        (if (and *target* (logtest? (-> *target* control root-prim prim-core action) (collide-action flut)))
          (go-virtual wait-for-return))
        (when (logtest? (-> self draw status) (draw-status was-drawn))
          (if (and *target* (>= 40960.0 (vector-vector-distance (-> self root trans) (-> *target* control trans))))
            (level-hint-spawn (text-id swamp-flutflut-hint) "sksp0160" (the-as entity #f) *entity-pool* (game-task none))))
        (when (and (and *target* (>= 20480.0 (vector-vector-distance (-> self root trans) (-> *target* control trans))))
                   (not (movie?))
                   (not (level-hint-displayed?))
                   (!= (-> self condition) 4))
          (hide-hud)
          (level-hint-surpress!)
          (kill-current-level-hint '() '(sidekick voicebox) 'exit)
          (when (and (hud-hidden?) (can-grab-display? self))
            (let ((gp-0 (new 'stack 'font-context *font-default-matrix* 32 160 0.0 (font-color default) (font-flags shadow kerning))))
              (let ((v1-34 gp-0)) (set! (-> v1-34 width) (the float 440)))
              (let ((v1-35 gp-0)) (set! (-> v1-35 height) (the float 80)))
              (set! (-> gp-0 flags) (font-flags shadow kerning large))
              (print-game-text (lookup-text! *common-text* (text-id press-to-use) #f) gp-0 #f 128 22))
            (if (and (cpad-pressed? 0 circle) (send-event *target* 'change-mode 'flut self))
              (go-virtual pickup (method-of-object self wait-for-return)))))
        (flutflut-effect)
        (suspend)
        (ja :num! (loop!))))
  :post ja-post)

(defstate pickup (flutflut)
  :virtual #t
  :event
    (behavior ((proc process) (argc int) (message symbol) (block event-message-block))
      (case message
        (('draw)
         (ja-channel-set! 1)
         (ja :group! flut-saddle-flut-idle-ja)
         (set! (-> self root root-prim prim-core action) (collide-action solid attackable-unused))
         (set! (-> self root root-prim prim-core offense) (collide-offense indestructible))
         (transform-post))
        (('trans) (vector+! (the-as vector (-> block param 0)) (-> self root trans) (-> self extra-trans)))
        (('touch 'attack) #f)))
  :enter
    (behavior ((arg0 (state flutflut)))
      ((-> arg0 enter)))
  :code
    (behavior ((arg0 (state flutflut)))
      (ja-channel-set! 0)
      (ja-post)
      (while (zero? (ja-group-size))
        (if (or (not *target*) (< 24576.0 (vector-vector-distance (-> self root trans) (-> *target* control trans)))) (go arg0))
        (flutflut-effect)
        (suspend))
      (while (and *target* (logtest? (-> *target* control root-prim prim-core action) (collide-action flut)))
        (flutflut-effect)
        (suspend))
      (suspend-for (seconds 1) (flutflut-effect))
      (go arg0)))

(defstate wait-for-return (flutflut)
  :virtual #t
  :event
    (behavior ((proc process) (argc int) (message symbol) (block event-message-block))
      (if (and (or (= message 'touch) (= message 'attack)) (send-event *target* 'end-mode))
        (go-virtual pickup (method-of-object self idle)))
      (if (= message 'trans) (vector+! (the-as vector (-> block param 0)) (-> self root trans) (-> self extra-trans))))
  :enter
    (behavior ()
      (blocking-plane-destroy)
      (blocking-plane-spawn (the-as curve-control (-> self path-flut))))
  :code
    (behavior ()
      (ja-channel-set! 0)
      (ja-post)
      (loop
        (if (not (and *target* (logtest? (-> *target* control root-prim prim-core action) (collide-action flut))))
          (go-virtual idle))
        (flutflut-effect)
        (suspend))))

(defmethod init-from-entity! ((this flutflut) (arg0 entity-actor))
  (let ((s4-0 (new 'process 'collide-shape-moving this (collide-list-enum hit-by-player))))
    (set! (-> s4-0 dynam) (copy *standard-dynamics* 'process))
    (set! (-> s4-0 reaction) default-collision-reaction)
    (set! (-> s4-0 no-reaction) (the-as (function collide-shape-moving collide-shape-intersect vector vector none) nothing))
    (let ((s3-0 (new 'process 'collide-shape-prim-sphere s4-0 (the-as uint 0))))
      (set! (-> s3-0 prim-core collide-as) (collide-kind wall-object))
      (set! (-> s3-0 collide-with) (collide-kind target))
      (set-vector! (-> s3-0 local-sphere) 0.0 6144.0 0.0 6144.0)
      (set-root-prim! s4-0 s3-0))
    (set! (-> s4-0 nav-radius) (* 0.75 (-> s4-0 root-prim local-sphere w)))
    (backup-collide-with-as s4-0)
    (set! (-> this root) s4-0))
  (process-drawable-from-entity! this arg0)
  (set-yaw-angle-clear-roll-pitch! (-> this root) (res-lump-float arg0 'rotoffset))
  (initialize-skeleton this *flutflut-sg* '())
  (logior! (-> this skel status) (janim-status eye))
  (set! (-> this draw shadow-ctrl) *flutflut-shadow-control*)
  (let ((v1-24 (-> this node-list data)))
    (set! (-> v1-24 0 param0) cspace<-transformq+trans!)
    (set! (-> v1-24 0 param1) (the-as basic (-> this root trans)))
    (set! (-> v1-24 0 param2) (the-as basic (-> this extra-trans))))
  (dotimes (s4-2 2)
    (let ((v1-27 (new 'process 'curve-control this 'path (the float (+ s4-2 1)))))
      (set! (-> this path-data s4-2) v1-27)
      (if v1-27 (logior! (-> v1-27 flags) (path-control-flag display draw-line draw-point draw-text)))))
  (set! (-> this condition) (res-lump-value arg0 'index int))
  (set! (-> this fact) (new 'process 'fact-info this (pickup-type eco-pill-random) (-> *FACT-bank* default-pill-inc)))
  (set! (-> this part) (create-launch-control (-> *part-group-id-table* 120) this))
  (set! (-> this auto-get-off) #f)
  (move-to-ground (-> this root) 40960.0 40960.0 #t (collide-kind background))
  (set! (-> this cell) (the-as handle #f))
  (blocking-plane-spawn (the-as curve-control
                                (if (and *target* (logtest? (-> *target* control root-prim prim-core action) (collide-action flut)))
                                  (-> this path-flut)
                                  (-> this path-target))))
  (set! (-> this sound) (new 'process 'ambient-sound (static-sound-spec "zoom-teleport" :fo-max 30) (-> this root trans)))
  (go (method-of-object this wait-for-start))
  (none))
