mirror of
https://github.com/open-goal/jak-project.git
synced 2024-10-20 11:26:18 -04:00
889fdcd79c
Say goodbye to half of the laser needle shots spinning around doing nothing. This is toggleable with `fix-projectile-focus` in the pc settings.
619 lines
24 KiB
Common Lisp
619 lines
24 KiB
Common Lisp
;;-*-Lisp-*-
|
|
(in-package goal)
|
|
|
|
;; name: water-flow.gc
|
|
;; name in dgo: water-flow
|
|
;; dgos: GAME
|
|
|
|
;; DECOMP BEGINS
|
|
|
|
(defun ray-plane-equation-intersect ((arg0 vector) (arg1 vector) (arg2 vector) (arg3 vector))
|
|
(let* ((f0-1 (vector4-dot arg3 arg1))
|
|
(f1-1 (vector-dot arg3 arg2))
|
|
(f30-0 (/ (- f0-1) f1-1))
|
|
)
|
|
(vector-v*float+! arg0 arg1 arg2 f30-0)
|
|
f30-0
|
|
)
|
|
)
|
|
|
|
(deftype flow-section (structure)
|
|
((start vector :inline)
|
|
(trailing plane :inline)
|
|
(pull-dir vector :inline)
|
|
(radial-dir vector :inline)
|
|
(speed float)
|
|
)
|
|
)
|
|
|
|
|
|
(deftype flow-section-array (inline-array-class)
|
|
((data flow-section :inline :dynamic)
|
|
)
|
|
)
|
|
|
|
|
|
(set! (-> flow-section-array heap-base) (the-as uint 80))
|
|
|
|
(deftype flow-control (basic)
|
|
((path path-control)
|
|
(speed float)
|
|
(belt-radius float)
|
|
(sections flow-section-array)
|
|
(leading plane :inline)
|
|
(collide-bounds sphere :inline)
|
|
)
|
|
(:methods
|
|
(new (symbol type process-drawable res-lump) _type_)
|
|
(draw-path (_type_) none)
|
|
(setup (_type_ (pointer float) int) none)
|
|
(push-process (_type_ process-focusable) none)
|
|
(find-and-push-things (_type_) none)
|
|
(flow-control-method-13 (_type_ water-info vector) symbol)
|
|
)
|
|
)
|
|
|
|
|
|
(defmethod relocate ((this flow-control) (offset int))
|
|
(if (nonzero? (-> this sections))
|
|
(&+! (-> this sections) offset)
|
|
)
|
|
(if (nonzero? (-> this path))
|
|
(&+! (-> this path) offset)
|
|
)
|
|
(call-parent-method this offset)
|
|
)
|
|
|
|
(defmethod draw-path ((this flow-control))
|
|
(let ((a0-1 (-> this path)))
|
|
(if (nonzero? a0-1)
|
|
(debug-draw a0-1)
|
|
)
|
|
)
|
|
0
|
|
(none)
|
|
)
|
|
|
|
(defmethod flow-control-method-13 ((this flow-control) (arg0 water-info) (arg1 vector))
|
|
(local-vars (v0-7 symbol) (sv-192 vector) (sv-208 vector) (sv-224 flow-section))
|
|
(rlet ((acc :class vf)
|
|
(vf0 :class vf)
|
|
(vf4 :class vf)
|
|
(vf5 :class vf)
|
|
(vf6 :class vf)
|
|
(vf7 :class vf)
|
|
)
|
|
(init-vf0-vector)
|
|
(let ((s5-0 (new 'stack-no-clear 'vector)))
|
|
(set! (-> s5-0 quad) (-> arg1 quad))
|
|
(set! (-> s5-0 w) 1.0)
|
|
(when (>= (vector4-dot s5-0 (the-as vector (-> this leading))) 0.0)
|
|
(let* ((s1-0 (-> this sections))
|
|
(s2-0 (-> s1-0 length))
|
|
(a3-0 (the-as object (-> this leading)))
|
|
)
|
|
(dotimes (s4-0 s2-0)
|
|
(let ((s3-0 (-> s1-0 data s4-0)))
|
|
(when (< (vector4-dot s5-0 (the-as vector (-> s3-0 trailing))) 0.0)
|
|
(let ((v1-10 (new 'stack-no-clear 'vector)))
|
|
(vector-! v1-10 s5-0 (-> s3-0 start))
|
|
(when (>= (-> this belt-radius) (fabs (vector-dot v1-10 (-> s3-0 radial-dir))))
|
|
(let* ((f0-7 (vector-dot v1-10 (-> s3-0 pull-dir)))
|
|
(f0-9 (- (-> v1-10 y) (* (-> s3-0 pull-dir y) f0-7)))
|
|
)
|
|
(when (and (>= f0-9 -41984.0) (>= 41779.2 f0-9))
|
|
(let ((a0-11 (new 'stack-no-clear 'vector)))
|
|
(set! sv-192 (new 'stack-no-clear 'vector))
|
|
(let* ((f30-0 (ray-plane-equation-intersect a0-11 s5-0 (-> s3-0 pull-dir) (the-as vector a3-0)))
|
|
(t9-1 ray-plane-equation-intersect)
|
|
(a1-5 s5-0)
|
|
(a2-4 (-> s3-0 pull-dir))
|
|
(a3-1 (-> s3-0 trailing))
|
|
(f0-10 (t9-1 sv-192 a1-5 a2-4 a3-1))
|
|
)
|
|
(let ((a1-6 (new 'stack-no-clear 'vector)))
|
|
(let ((v1-16 (-> s3-0 start)))
|
|
(let ((a0-13 (-> s3-0 pull-dir)))
|
|
(let ((a2-6 12288.0))
|
|
(.mov vf7 a2-6)
|
|
)
|
|
(.lvf vf5 (&-> a0-13 quad))
|
|
)
|
|
(.lvf vf4 (&-> v1-16 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 (&-> a1-6 quad) vf6)
|
|
)
|
|
0
|
|
(let ((f0-12 (/ f30-0 (- f30-0 f0-10))))
|
|
(set! sv-208 (new 'stack-no-clear 'vector))
|
|
(displacement-between-two-points-normalized! (-> this path) sv-208 (+ (the float (if (= s4-0 (+ s2-0 -1))
|
|
(+ s4-0 -1)
|
|
s4-0
|
|
)
|
|
)
|
|
f0-12
|
|
)
|
|
)
|
|
)
|
|
)
|
|
)
|
|
(let ((v1-22 (new 'stack-no-clear 'vector)))
|
|
(let ((a0-15 v1-22)
|
|
(f0-15 (* (-> s3-0 speed) (seconds-per-frame)))
|
|
)
|
|
(vector-float*! a0-15 sv-208 f0-15)
|
|
)
|
|
(let ((a1-10 (new 'stack-no-clear 'vector)))
|
|
(let ((a0-17 s5-0))
|
|
(let ((a2-9 2048.0))
|
|
(.mov vf7 a2-9)
|
|
)
|
|
(.lvf vf5 (&-> v1-22 quad))
|
|
(.lvf vf4 (&-> a0-17 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 (&-> a1-10 quad) vf6)
|
|
)
|
|
)
|
|
0
|
|
(let ((s0-1 (-> s3-0 start)))
|
|
(set! sv-224 (-> s1-0 data (if (= s4-0 (+ s2-0 -1))
|
|
(+ s4-0 -1)
|
|
(+ s4-0 1)
|
|
)
|
|
)
|
|
)
|
|
(let ((s4-1 (new 'stack-no-clear 'vector)))
|
|
(let ((s2-1 (new 'stack-no-clear 'vector))
|
|
(s1-1 (new 'stack-no-clear 'vector))
|
|
)
|
|
(set! (-> s2-1 quad) (-> s3-0 pull-dir quad))
|
|
(vector-normalize! s2-1 1.0)
|
|
(vector-cross! s1-1 s2-1 *y-vector*)
|
|
(vector-normalize! s1-1 1.0)
|
|
(vector-cross! (-> arg0 normal) s2-1 s1-1)
|
|
)
|
|
(let ((t9-5 vector-segment-distance-point!)
|
|
(a3-2 s4-1)
|
|
)
|
|
(t9-5 s5-0 s0-1 (the-as vector sv-224) a3-2)
|
|
)
|
|
(set! (-> arg0 trans y) (-> s4-1 y))
|
|
)
|
|
)
|
|
(if (< (-> arg0 normal y) 0.0)
|
|
(vector-negate! (-> arg0 normal) (-> arg0 normal))
|
|
)
|
|
0
|
|
(return #t)
|
|
)
|
|
)
|
|
)
|
|
)
|
|
)
|
|
)
|
|
(set! a3-0 (+ (the-as uint (-> s1-0 data 0 trailing)) (* 80 s4-0)))
|
|
)
|
|
)
|
|
)
|
|
)
|
|
(return #f)
|
|
v0-7
|
|
)
|
|
)
|
|
|
|
;; WARN: Function (method 11 flow-control) has a return type of none, but the expression builder found a return statement.
|
|
(defmethod push-process ((this flow-control) (arg0 process-focusable))
|
|
(rlet ((acc :class vf)
|
|
(vf0 :class vf)
|
|
(vf4 :class vf)
|
|
(vf5 :class vf)
|
|
(vf6 :class vf)
|
|
(vf7 :class vf)
|
|
)
|
|
(init-vf0-vector)
|
|
(let ((s5-0 (new 'stack-no-clear 'vector)))
|
|
(set! (-> s5-0 quad) (-> (get-trans arg0 0) quad))
|
|
(set! (-> s5-0 w) 1.0)
|
|
(when (>= (vector4-dot s5-0 (the-as vector (-> this leading))) 0.0)
|
|
(let* ((v1-7 (-> this sections))
|
|
(a0-3 (-> v1-7 length))
|
|
(a3-0 (the-as object (-> this leading)))
|
|
)
|
|
(dotimes (s3-1 a0-3)
|
|
(let ((s2-0 (-> v1-7 data s3-1)))
|
|
(when (< (vector4-dot s5-0 (the-as vector (-> s2-0 trailing))) 0.0)
|
|
(let ((v1-8 (new 'stack-no-clear 'vector)))
|
|
(vector-! v1-8 s5-0 (-> s2-0 start))
|
|
(when (>= (-> this belt-radius) (fabs (vector-dot v1-8 (-> s2-0 radial-dir))))
|
|
(let* ((f0-7 (vector-dot v1-8 (-> s2-0 pull-dir)))
|
|
(f0-9 (- (-> v1-8 y) (* (-> s2-0 pull-dir y) f0-7)))
|
|
)
|
|
(when (and (>= f0-9 -41984.0) (>= 41779.2 f0-9))
|
|
(let* ((a0-11 (new 'stack-no-clear 'vector))
|
|
(s1-0 (new 'stack-no-clear 'vector))
|
|
(f30-0 (ray-plane-equation-intersect a0-11 s5-0 (-> s2-0 pull-dir) (the-as vector a3-0)))
|
|
(f0-10 (ray-plane-equation-intersect s1-0 s5-0 (-> s2-0 pull-dir) (-> s2-0 trailing)))
|
|
)
|
|
(let ((a1-13 (new 'stack-no-clear 'vector)))
|
|
(let ((v1-13 (-> s2-0 start)))
|
|
(let ((a0-13 (-> s2-0 pull-dir)))
|
|
(let ((a2-6 12288.0))
|
|
(.mov vf7 a2-6)
|
|
)
|
|
(.lvf vf5 (&-> a0-13 quad))
|
|
)
|
|
(.lvf vf4 (&-> v1-13 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 (&-> a1-13 quad) vf6)
|
|
)
|
|
0
|
|
(let ((f0-12 (/ f30-0 (- f30-0 f0-10)))
|
|
(s1-1 (new 'stack-no-clear 'vector))
|
|
)
|
|
(displacement-between-two-points-normalized! (-> this path) s1-1 (+ (the float s3-1) f0-12))
|
|
(let ((v1-17 (new 'stack-no-clear 'vector)))
|
|
(vector-float*! v1-17 s1-1 (* (-> s2-0 speed) (seconds-per-frame)))
|
|
(let ((a1-16 (new 'stack-no-clear 'vector)))
|
|
(let ((a0-17 v1-17))
|
|
(let ((a2-9 2048.0))
|
|
(.mov vf7 a2-9)
|
|
)
|
|
(.lvf vf5 (&-> a0-17 quad))
|
|
)
|
|
(.lvf vf4 (&-> s5-0 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 (&-> a1-16 quad) vf6)
|
|
)
|
|
0
|
|
(send-event arg0 'push-trans v1-17 (seconds 10))
|
|
)
|
|
)
|
|
)
|
|
)
|
|
)
|
|
)
|
|
)
|
|
(return #f)
|
|
)
|
|
)
|
|
(set! a3-0 (+ (the-as uint (-> v1-7 data 0 trailing)) (* 80 s3-1)))
|
|
)
|
|
)
|
|
)
|
|
)
|
|
0
|
|
(none)
|
|
)
|
|
)
|
|
|
|
(defmethod find-and-push-things ((this flow-control))
|
|
(local-vars (a0-10 float) (a2-5 float) (a2-12 float))
|
|
(rlet ((acc :class vf)
|
|
(vf0 :class vf)
|
|
(vf1 :class vf)
|
|
(vf2 :class vf)
|
|
(vf3 :class vf)
|
|
(vf4 :class vf)
|
|
)
|
|
(init-vf0-vector)
|
|
(set! *actor-list-length* 0)
|
|
(if #t
|
|
(set! *actor-list-length* (fill-actor-list-for-box *actor-hash* (-> this collide-bounds) *actor-list* 256))
|
|
)
|
|
(when #t
|
|
(let ((a0-2 (-> *collide-player-list* alive-list next0)))
|
|
*collide-player-list*
|
|
(let ((v1-11 (-> a0-2 next0)))
|
|
(b! #t cfg-9 :delay (nop!))
|
|
(label cfg-4)
|
|
(let* ((a0-3 (-> (the-as connection a0-2) param1))
|
|
(a1-1 (-> (the-as collide-shape a0-3) root-prim))
|
|
)
|
|
(when (logtest? (-> a1-1 prim-core collide-as) (collide-spec jak bot enemy hit-by-others-list player-list))
|
|
(let ((a1-2 (-> a1-1 prim-core)))
|
|
(let ((a2-4 a1-2)
|
|
(a3-1 (-> this collide-bounds))
|
|
)
|
|
(.lvf vf2 (&-> a2-4 world-sphere quad))
|
|
(.lvf vf3 (&-> a3-1 quad))
|
|
)
|
|
(.sub.vf vf1 vf3 vf2)
|
|
(.mul.vf vf1 vf1 vf1)
|
|
(.add.y.vf vf1 vf1 vf1 :mask #b1)
|
|
(.add.z.vf vf1 vf1 vf1 :mask #b1)
|
|
(.mov a2-5 vf1)
|
|
(let ((f0-0 a2-5)
|
|
(f1-1 (+ (-> a1-2 world-sphere w) (-> this collide-bounds r)))
|
|
)
|
|
(when (< f0-0 (* f1-1 f1-1))
|
|
(when (< *actor-list-length* 256)
|
|
(set! (-> *actor-list* *actor-list-length*) (the-as collide-shape a0-3))
|
|
(set! *actor-list-length* (+ *actor-list-length* 1))
|
|
)
|
|
)
|
|
)
|
|
)
|
|
)
|
|
)
|
|
(set! a0-2 v1-11)
|
|
*collide-player-list*
|
|
(set! v1-11 (-> v1-11 next0))
|
|
)
|
|
(label cfg-9)
|
|
(b! (!= a0-2 (-> *collide-player-list* alive-list-end)) cfg-4 :delay (nop!))
|
|
)
|
|
)
|
|
(when #f
|
|
(let ((a0-5 (-> *collide-hit-by-player-list* alive-list next0)))
|
|
*collide-hit-by-player-list*
|
|
(let ((v1-18 (-> a0-5 next0)))
|
|
(while (!= a0-5 (-> *collide-hit-by-player-list* alive-list-end))
|
|
(let* ((a0-6 (-> (the-as connection a0-5) param1))
|
|
(a1-13 (-> (the-as collide-shape a0-6) root-prim))
|
|
)
|
|
(when (logtest? (-> a1-13 prim-core collide-as) (collide-spec jak bot enemy hit-by-others-list player-list))
|
|
(let ((a1-14 (-> a1-13 prim-core)))
|
|
(let ((a2-11 a1-14)
|
|
(a3-2 (-> this collide-bounds))
|
|
)
|
|
(.lvf vf2 (&-> a2-11 world-sphere quad))
|
|
(.lvf vf3 (&-> a3-2 quad))
|
|
)
|
|
(.sub.vf vf1 vf3 vf2)
|
|
(.mul.vf vf1 vf1 vf1)
|
|
(.add.y.vf vf1 vf1 vf1 :mask #b1)
|
|
(.add.z.vf vf1 vf1 vf1 :mask #b1)
|
|
(.mov a2-12 vf1)
|
|
(let ((f0-1 a2-12)
|
|
(f1-5 (+ (-> a1-14 world-sphere w) (-> this collide-bounds r)))
|
|
)
|
|
(when (< f0-1 (* f1-5 f1-5))
|
|
(when (< *actor-list-length* 256)
|
|
(set! (-> *actor-list* *actor-list-length*) (the-as collide-shape a0-6))
|
|
(set! *actor-list-length* (+ *actor-list-length* 1))
|
|
)
|
|
)
|
|
)
|
|
)
|
|
)
|
|
)
|
|
(set! a0-5 v1-18)
|
|
*collide-hit-by-player-list*
|
|
(set! v1-18 (-> v1-18 next0))
|
|
)
|
|
)
|
|
)
|
|
)
|
|
(dotimes (s5-0 *actor-list-length*)
|
|
(let* ((v1-23 (-> *actor-list* s5-0))
|
|
(a0-9 (-> v1-23 root-prim))
|
|
)
|
|
(when (logtest? (-> a0-9 prim-core collide-as) (collide-spec jak bot enemy hit-by-others-list player-list))
|
|
(.lvf vf1 (&-> this collide-bounds quad))
|
|
(.lvf vf2 (&-> a0-9 prim-core world-sphere quad))
|
|
(.sub.vf vf3 vf1 vf2)
|
|
(.add.w.vf vf4 vf1 vf2 :mask #b1000)
|
|
(.mul.vf vf3 vf3 vf3 :mask #b111)
|
|
(.mul.w.vf vf4 vf4 vf4 :mask #b1000)
|
|
(.mul.x.vf acc vf0 vf3 :mask #b1000)
|
|
(.add.mul.y.vf acc vf0 vf3 acc :mask #b1000)
|
|
(.add.mul.z.vf vf3 vf0 vf3 acc :mask #b1000)
|
|
(.sub.w.vf vf3 vf3 vf4 :mask #b1000)
|
|
(let ((f0-2 0.0))
|
|
(.add.w.vf vf3 vf0 vf3 :mask #b1)
|
|
(.mov a0-10 vf3)
|
|
(let ((s4-0 (-> v1-23 process)))
|
|
(b! (< f0-2 a0-10) cfg-30)
|
|
(let ((a1-29 (if (type? s4-0 process-focusable)
|
|
s4-0
|
|
)
|
|
)
|
|
)
|
|
(if (and a1-29 (not (logtest? (focus-status board) (-> (the-as process-focusable a1-29) focus-status))))
|
|
(push-process this (the-as process-focusable a1-29))
|
|
)
|
|
)
|
|
)
|
|
)
|
|
(label cfg-30)
|
|
0
|
|
)
|
|
)
|
|
)
|
|
0
|
|
(none)
|
|
)
|
|
)
|
|
|
|
(defmethod setup ((this flow-control) (arg0 (pointer float)) (arg1 int))
|
|
(local-vars (sv-32 int) (sv-48 flow-section) (sv-64 int) (sv-80 flow-section))
|
|
(let* ((s5-0 (-> this path))
|
|
(s4-0 (-> s5-0 curve num-cverts))
|
|
(s3-0 (new 'stack-no-clear 'vector))
|
|
)
|
|
(let ((s0-0 (new 'process 'flow-section-array (+ s4-0 -1))))
|
|
(set! (-> this sections) s0-0)
|
|
(set! (-> this collide-bounds quad) (the-as uint128 0))
|
|
(get-point-in-path! s5-0 s3-0 0.0 'interp)
|
|
(vector+! (the-as vector (-> this collide-bounds)) (the-as vector (-> this collide-bounds)) s3-0)
|
|
(set! sv-32 (+ s4-0 -1))
|
|
(set! sv-48 (the-as flow-section #f))
|
|
(set! sv-64 0)
|
|
(while (< sv-64 sv-32)
|
|
(set! sv-80 (-> s0-0 data sv-64))
|
|
(let ((f0-0 1.0))
|
|
(if (< sv-64 arg1)
|
|
(set! f0-0 (-> arg0 sv-64))
|
|
)
|
|
(if arg0
|
|
(set! (-> sv-80 speed) (* f0-0 (-> this speed)))
|
|
(set! (-> sv-80 speed) (-> this speed))
|
|
)
|
|
)
|
|
(set! (-> sv-80 start quad) (-> s3-0 quad))
|
|
(get-point-in-path! s5-0 s3-0 (the float (+ sv-64 1)) 'interp)
|
|
(vector+! (the-as vector (-> this collide-bounds)) (the-as vector (-> this collide-bounds)) s3-0)
|
|
(vector-! (-> sv-80 pull-dir) s3-0 (-> sv-80 start))
|
|
(vector-normalize! (-> sv-80 pull-dir) 1.0)
|
|
(set! (-> sv-80 trailing quad) (-> sv-80 pull-dir quad))
|
|
(set! (-> sv-80 trailing y) 0.0)
|
|
(vector-normalize! (-> sv-80 trailing) 1.0)
|
|
(set-vector! (-> sv-80 radial-dir) (- (-> sv-80 trailing z)) 0.0 (-> sv-80 trailing x) 1.0)
|
|
(set! (-> sv-80 trailing w) (- (vector-dot s3-0 (the-as vector (-> sv-80 trailing)))))
|
|
(when sv-48
|
|
(vector+!
|
|
(the-as vector (-> sv-48 trailing))
|
|
(the-as vector (-> sv-48 trailing))
|
|
(the-as vector (-> sv-80 trailing))
|
|
)
|
|
(vector-normalize! (-> sv-48 trailing) 1.0)
|
|
(set! (-> sv-48 trailing w) (- (vector-dot (-> sv-80 start) (the-as vector (-> sv-48 trailing)))))
|
|
)
|
|
(set! sv-48 sv-80)
|
|
sv-48
|
|
(set! sv-64 (+ sv-64 1))
|
|
)
|
|
)
|
|
(let ((s2-1 (-> this sections data)))
|
|
(set! (-> this leading quad) (-> s2-1 0 pull-dir quad))
|
|
(set! (-> this leading y) 0.0)
|
|
(vector-normalize! (-> this leading) 1.0)
|
|
(set! (-> this leading w) (- (vector-dot (the-as vector (-> s2-1 0)) (the-as vector (-> this leading)))))
|
|
)
|
|
(let ((f0-22 (/ 1.0 (the float s4-0)))
|
|
(f30-0 0.0)
|
|
)
|
|
(vector-float*! (the-as vector (-> this collide-bounds)) (the-as vector (-> this collide-bounds)) f0-22)
|
|
(dotimes (s2-2 s4-0)
|
|
(get-point-in-path! s5-0 s3-0 (the float s2-2) 'interp)
|
|
(let ((f0-25 (vector-vector-distance-squared s3-0 (-> this collide-bounds))))
|
|
(if (< f30-0 f0-25)
|
|
(set! f30-0 f0-25)
|
|
)
|
|
)
|
|
)
|
|
(set! (-> this collide-bounds r) (+ (sqrtf f30-0) (-> this belt-radius)))
|
|
)
|
|
)
|
|
0
|
|
(none)
|
|
)
|
|
|
|
(defmethod new flow-control ((allocation symbol) (type-to-make type) (arg0 process-drawable) (arg1 res-lump))
|
|
(local-vars (sv-16 res-tag))
|
|
(if (not arg1)
|
|
(set! arg1 (-> arg0 entity))
|
|
)
|
|
(let ((gp-0 (object-new allocation type-to-make (the-as int (-> type-to-make size)))))
|
|
(when (nonzero? gp-0)
|
|
(let ((v1-6 (new 'process 'curve-control arg0 'flow -1000000000.0)))
|
|
(cond
|
|
((nonzero? v1-6)
|
|
(set! (-> gp-0 path) v1-6)
|
|
(logior! (-> v1-6 flags) (path-control-flag display draw-line draw-point draw-text))
|
|
(if (< (-> v1-6 curve num-cverts) 2)
|
|
(go process-drawable-art-error "bad flow path")
|
|
)
|
|
(set! (-> gp-0 speed) (res-lump-float arg1 'speed :default 12288.0))
|
|
(set! (-> gp-0 belt-radius) (res-lump-float arg1 'extra-radius :default 16384.0))
|
|
(set! sv-16 (new 'static 'res-tag))
|
|
(let ((a1-6 (res-lump-data arg1 'scale-factor pointer :tag-ptr (& sv-16))))
|
|
(setup gp-0 (the-as (pointer float) a1-6) (the-as int (-> sv-16 elt-count)))
|
|
)
|
|
)
|
|
(else
|
|
(go process-drawable-art-error "no flow path")
|
|
)
|
|
)
|
|
)
|
|
)
|
|
gp-0
|
|
)
|
|
)
|
|
|
|
(deftype water-flow (process)
|
|
((root collide-shape)
|
|
(flow flow-control)
|
|
)
|
|
(:state-methods
|
|
idle
|
|
)
|
|
)
|
|
|
|
|
|
;; WARN: Return type mismatch process vs water-flow.
|
|
(defmethod relocate ((this water-flow) (offset int))
|
|
(if (nonzero? (-> this flow))
|
|
(&+! (-> this flow) offset)
|
|
)
|
|
(the-as water-flow ((method-of-type process relocate) this offset))
|
|
)
|
|
|
|
(defmethod run-logic? ((this water-flow))
|
|
"Should this process be run? Checked by execute-process-tree."
|
|
#t
|
|
)
|
|
|
|
(defstate idle (water-flow)
|
|
:virtual #t
|
|
:event (behavior ((proc process) (argc int) (message symbol) (block event-message-block))
|
|
(case message
|
|
(('water-info)
|
|
(let* ((gp-0 (-> block param 0))
|
|
(s5-0 proc)
|
|
(a0-2 (if (type? s5-0 process-focusable)
|
|
s5-0
|
|
)
|
|
)
|
|
)
|
|
(if (and a0-2 (focus-test? (the-as process-focusable a0-2) board))
|
|
#f
|
|
(flow-control-method-13 (-> self flow) (the-as water-info gp-0) (the-as vector (+ gp-0 0)))
|
|
)
|
|
)
|
|
)
|
|
(('touch-water)
|
|
(let* ((gp-1 (-> self flow))
|
|
(s5-1 proc)
|
|
(a1-8 (if (type? s5-1 process-focusable)
|
|
s5-1
|
|
)
|
|
)
|
|
)
|
|
(if (and (nonzero? gp-1) (and a1-8 (!= (-> a1-8 type) target) (< 0.0 (-> gp-1 speed))))
|
|
(push-process gp-1 (the-as process-focusable a1-8))
|
|
)
|
|
)
|
|
)
|
|
)
|
|
)
|
|
:code sleep-code
|
|
:post (behavior ()
|
|
(draw-path (-> self flow))
|
|
(if (and *target*
|
|
(focus-test? *target* touch-water)
|
|
(not (logtest? (focus-status board) (-> *target* focus-status)))
|
|
)
|
|
(push-process (-> self flow) *target*)
|
|
)
|
|
)
|
|
)
|
|
|
|
(defmethod init-from-entity! ((this water-flow) (arg0 entity-actor))
|
|
(set! (-> this root) (the-as collide-shape (new 'process 'trsqv)))
|
|
(process-drawable-from-entity! (the-as process-drawable this) arg0)
|
|
(set! (-> this flow) (new 'process 'flow-control (the-as process-drawable this) (the-as res-lump #f)))
|
|
(go (method-of-object this idle))
|
|
)
|