120 lines
3.7 KiB
Haskell
120 lines
3.7 KiB
Haskell
module Dodge.WorldEvent.Shockwave
|
|
( makeShockwaveAt
|
|
, inverseShockwaveAt
|
|
, drawShockwave
|
|
, mvShockwave
|
|
) where
|
|
import Dodge.Data
|
|
import Dodge.Wall.Damage
|
|
import Dodge.Base
|
|
import Dodge.Zone
|
|
import Geometry
|
|
import Picture
|
|
import LensHelp
|
|
|
|
--import Data.Foldable
|
|
import qualified Data.IntMap.Strict as IM
|
|
import qualified Streaming.Prelude as S
|
|
-- currently very effective against walls
|
|
makeShockwaveAt
|
|
:: [Int] -- ^ IDs of invulnerable creatures.
|
|
-> Point2 -- ^ Center of shockwave.
|
|
-> Float -- ^ Maximal radius.
|
|
-> Int -- ^ Damage caused per frame.
|
|
-> Float -- ^ Amount of pushback per frame.
|
|
-> Color -- ^ Color of shockwave.
|
|
-> World -- ^ Start world.
|
|
-> World
|
|
makeShockwaveAt is p rad dam push col = instantParticles .:~ Shockwave
|
|
{ _ptUpdate = mvShockwave is
|
|
, _ptColor = col
|
|
, _ptPos = p
|
|
, _ptRad = rad
|
|
, _ptDam = dam
|
|
, _ptPush = push
|
|
, _ptMaxTime = 10
|
|
, _ptTimer = 10
|
|
}
|
|
{- Shockwave picture. -}
|
|
drawShockwave :: Particle -> Picture
|
|
drawShockwave pt = setDepth 20
|
|
. setLayer BloomLayer
|
|
. uncurryV translate (_ptPos pt)
|
|
. color (_ptColor pt)
|
|
$ thickCircle rad thickness
|
|
where
|
|
r = _ptRad pt
|
|
thickness = tFraction**2 * r
|
|
rad = r - (3/4) * r * tFraction
|
|
tFraction = fromIntegral (_ptTimer pt) / fromIntegral (_ptMaxTime pt)
|
|
|
|
mvShockwave
|
|
:: [Int] -- ^ IDs of invulnerable creatures.
|
|
-> World -> Particle -> (World, Maybe Particle)
|
|
mvShockwave is w pt
|
|
| _ptTimer pt <= 0 = ( w , Nothing)
|
|
| otherwise = (doDams w , Just $ pt & ptTimer -~ 1)
|
|
where
|
|
r = _ptRad pt
|
|
p = _ptPos pt
|
|
push = _ptPush pt
|
|
dam = _ptDam pt
|
|
t = _ptTimer pt
|
|
tFraction = fromIntegral t / fromIntegral (_ptMaxTime pt)
|
|
rad = r - (3/4) * r * tFraction
|
|
doDams w' = over creatures (IM.map damCr)
|
|
. runIdentity
|
|
$ S.fold_
|
|
(flip $ damageWall (Damage EXPLOSIVE 10000 p p p NoDamageEffect))
|
|
w'
|
|
id
|
|
hitBlocks
|
|
hitBlocks = S.map snd . overlapCircWalls p rad $ wlsInsideCirc p rad w
|
|
-- this is not expansive enough
|
|
damCr cr
|
|
| _crID cr `elem` is || dist (_crPos cr) p >= rad + _crRad cr = cr
|
|
| otherwise = cr & crState . csDamage .:~
|
|
Damage PUSHDAM dam cpos cpos cpos
|
|
(PushBackDamage (25 * push *.* squashNormalizeV (_crPos cr -.- p)))
|
|
where
|
|
cpos = _crPos cr
|
|
{- Create a shockwave going from an outside circle into a center point. -}
|
|
inverseShockwaveAt
|
|
:: Point2 -- Center position
|
|
-> Float -- Radius
|
|
-> Int -- Damage
|
|
-> Float -- Push amount
|
|
-> World
|
|
-> World
|
|
inverseShockwaveAt p rad dam push = instantParticles .:~ Shockwave
|
|
{ _ptUpdate = moveInverseShockwave
|
|
, _ptColor = cyan
|
|
, _ptPos = p
|
|
, _ptRad = rad
|
|
, _ptDam = dam
|
|
, _ptPush = push
|
|
, _ptMaxTime = 10
|
|
, _ptTimer = 10
|
|
}
|
|
moveInverseShockwave
|
|
:: World
|
|
-> Particle
|
|
-> (World, Maybe Particle)
|
|
moveInverseShockwave w pt
|
|
| t <= 0 = ( w, Nothing)
|
|
| otherwise = (dams w, Just $ ptTimer -~ 1 $ pt )
|
|
where
|
|
p = _ptPos pt
|
|
r = _ptRad pt
|
|
t = _ptTimer pt
|
|
rad = r - 0.1 * r * fromIntegral (10 - t)
|
|
dams = over creatures (IM.map damCr) -- . flip (foldr (damageBlocksBy 1)) hitBlocks
|
|
-- hitBlocks = wallsOnCirc' p rad $ wallsNearPoint' p w
|
|
damCr cr
|
|
| dist (_crPos cr) p >= rad + _crRad cr = cr
|
|
| otherwise = cr & crState . csDamage .:~
|
|
Damage PUSHDAM 1 cpos cpos cpos (PushBackDamage $ 25 *.* squashNormalizeV (p -.- cpos))
|
|
where
|
|
cpos = _crPos cr
|
|
|