130 lines
4.3 KiB
Haskell
130 lines
4.3 KiB
Haskell
module Dodge.WorldEvent.Shockwave
|
|
( makeShockwaveAt
|
|
, inverseShockwaveAt
|
|
)
|
|
where
|
|
import Dodge.Data
|
|
import Dodge.WorldEvent.DamageBlock
|
|
import Dodge.Creature.State.Data
|
|
import Dodge.Base
|
|
import Dodge.Base.Zone
|
|
import Dodge.Picture.Layer
|
|
import Geometry
|
|
import Picture
|
|
|
|
import qualified Data.IntMap.Strict as IM
|
|
import Control.Lens
|
|
|
|
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 = over particles (theShockwave :)
|
|
where
|
|
theShockwave = shockwaveAt is p rad dam push col 10
|
|
|
|
shockwaveAt
|
|
:: [Int] -- ^ IDs of invulnerable creatures.
|
|
-> Point2 -> Float -> Int -> Float -> Color -> Int -> Particle
|
|
shockwaveAt is p rad dam push col maxtime
|
|
= Shockwave'
|
|
{ _ptDraw = drawShockwave
|
|
, _ptUpdate' = mvShockwave is
|
|
, _btColor' = col
|
|
, _btPos' = p
|
|
, _btRad' = rad
|
|
, _btDam' = dam
|
|
, _btPush' = push
|
|
, _btMaxTime' = maxtime
|
|
, _btTimer' = maxtime
|
|
}
|
|
|
|
{-
|
|
Shockwave picture.
|
|
-}
|
|
drawShockwave :: Particle -> Picture
|
|
drawShockwave pt = pic
|
|
where
|
|
pic = setDepth 20 . setLayer 1 . uncurryV translate p
|
|
$ color (_btColor' pt) $ thickCircle rad thickness
|
|
p = _btPos' pt
|
|
r = _btRad' pt
|
|
thickness = tFraction**2 * r
|
|
rad = r - (3/4) * r * tFraction
|
|
tFraction = fromIntegral t / fromIntegral (_btMaxTime' pt)
|
|
t = _btTimer' pt
|
|
|
|
mvShockwave
|
|
:: [Int] -- ^ IDs of invulnerable creatures.
|
|
-> World -> Particle -> (World, Maybe Particle)
|
|
mvShockwave is w pt
|
|
| _btTimer' pt <= 0 = (w, Nothing)
|
|
| otherwise
|
|
= (dams w , Just $ set btTimer' (t - 1) pt) -- $ set ptDraw (const pic) pt)
|
|
where
|
|
r = _btRad' pt
|
|
p = _btPos' pt
|
|
push = _btPush' pt
|
|
dam = _btDam' pt
|
|
t = _btTimer' pt
|
|
tFraction = fromIntegral t / fromIntegral (_btMaxTime' pt)
|
|
rad = r - (3/4) * r * tFraction
|
|
dams = over creatures (IM.map damCr) . flip (IM.foldr (damageBlocksBy 1)) hitBlocks
|
|
hitBlocks = wallsOnCirc p rad $ wallsNearPoint p w
|
|
damCr cr | _crID cr `elem` is = cr
|
|
| dist (_crPos cr) p < rad + _crRad cr
|
|
= over (crState . crDamage)
|
|
((:) $ PushDam dam (25 * push *.* safeNormalizeV (_crPos cr -.- p)))
|
|
cr
|
|
| otherwise = cr
|
|
|
|
-------------------------------------------------
|
|
|
|
{-
|
|
Create a shockwave going from an outside circle into a center point.
|
|
-}
|
|
inverseShockwaveAt
|
|
:: Point2 -- Center position
|
|
-> Float -- Radius
|
|
-> Int -- Damage
|
|
-> Float -- Push amount
|
|
-> Float -- Push amount parameter
|
|
-> World
|
|
-> World
|
|
inverseShockwaveAt p rad _ push pushexp = over particles (theShockwave :)
|
|
where
|
|
theShockwave = Particle
|
|
{ _ptDraw = const blank
|
|
, _ptUpdate' = moveInverseShockWave 10 p rad push pushexp
|
|
}
|
|
moveInverseShockWave
|
|
:: Int -- ^ Timer
|
|
-> Point2 -- ^ Center position
|
|
-> Float -- ^ Radius
|
|
-> Float -- ^ Push amount
|
|
-> Float -- ^ Push amount parameter
|
|
-> World
|
|
-> Particle
|
|
-> (World, Maybe Particle)
|
|
moveInverseShockWave 0 _ _ _ _ w _ = (w, Nothing)
|
|
moveInverseShockWave t p r push pushexp w pt
|
|
= (dams w, Just $ newupdate $ newpic pt )
|
|
where
|
|
newupdate = set ptUpdate' $ moveInverseShockWave (t-1) p r push pushexp
|
|
newpic = set ptDraw (const $ onLayer PtLayer $ uncurryV translate p
|
|
$ color cyan $ thickCircle rad thickness)
|
|
rad = r - (4/40) * r * fromIntegral (10 - t)
|
|
thickness = fromIntegral (10 - t) **2 * rad / 40
|
|
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
|
|
= over (crState . crDamage)
|
|
((:) $ PushDam 1 (25 *.* safeNormalizeV (p -.- _crPos cr)))
|
|
cr
|
|
| otherwise = cr
|