49 lines
1.4 KiB
Haskell
49 lines
1.4 KiB
Haskell
module Dodge.TractorBeam.Update where
|
|
|
|
import Control.Lens
|
|
import Dodge.Data.World
|
|
import Geometry
|
|
import qualified IntMapHelp as IM
|
|
|
|
updateTractorBeam :: World -> TractorBeam -> (World, Maybe TractorBeam)
|
|
updateTractorBeam w pj
|
|
| _tbTime pj <= 0 = (w, Nothing)
|
|
| otherwise =
|
|
( w
|
|
& cWorld . lWorld . creatures %~ IM.map (tractCr pullVel pos outpos)
|
|
& cWorld . lWorld . floorItems %~ IM.map (tractFlIt pullVel pos outpos)
|
|
, Just (pj & tbTime -~ 1)
|
|
)
|
|
where
|
|
pullVel = _tbVel pj
|
|
pos = _tbPos pj
|
|
outpos = _tbStartPos pj
|
|
|
|
tractFlIt :: Point2 -> Point2 -> Point2 -> FloorItem -> FloorItem
|
|
tractFlIt q p1 outpos it
|
|
| segOnCirc p1 outpos (_flItPos it) 10 = it & flItPos %~ tractorPullPos q p1
|
|
| otherwise = it
|
|
|
|
tractCr :: Point2 -> Point2 -> Point2 -> Creature -> Creature
|
|
tractCr q p1 outpos cr
|
|
| segOnCirc p1 outpos (_crPos cr) 10 = cr & crPos %~ tractorPullPos q p1
|
|
| otherwise = cr
|
|
|
|
tractorPullPos :: Point2 -> Point2 -> Point2 -> Point2
|
|
tractorPullPos q p1 p = p -.- m *.* (0.3 / x' *.* q +.+ g y *.* p4)
|
|
where
|
|
x' = abs y + 1
|
|
y = errorClosestPointOnLineParam 1 p1 p3 p
|
|
m
|
|
| dist p p1 < 350 = 1
|
|
| otherwise = (400 - dist p p1) / 50
|
|
g x
|
|
| x > 5 = (10 - x) / 250
|
|
| x > 1 = 0.02
|
|
| x > -1 = x * 0.02
|
|
| x > -5 = -0.02
|
|
| otherwise = (x - 10) / 250
|
|
--p4 = vNormal p5
|
|
p4 = vNormal $ squashNormalizeV q
|
|
p3 = p1 +.+ p4
|