Modularise shockwaves, stop landing self damage when blinking

This commit is contained in:
jgk
2021-04-04 20:19:45 +02:00
parent b3649597fa
commit dfee9b2f37
8 changed files with 144 additions and 140 deletions
+1 -46
View File
@@ -19,6 +19,7 @@ import Dodge.WorldEvent.Cloud
import Dodge.WorldEvent.HitEffect
import Dodge.WorldEvent.Explosion
import Dodge.WorldEvent.SpawnParticle
import Dodge.WorldEvent.Shockwave
import Dodge.LightSources
import Dodge.Data
@@ -38,52 +39,6 @@ import Data.Function
import Data.List
import qualified Data.IntMap.Strict as IM
shockWaveDamage :: Point2 -> Float -> Int -> World -> World
shockWaveDamage p rad amount w = flip (foldr damageBlocks) hitBlocks $ over creatures (IM.map f) w
where f cr | dist (_crPos cr) p < rad + _crRad cr = over (crState . crDamage)
((:) $ Concussive amount p 2 0.5 rad) cr
| otherwise = cr
hitBlocks = wallsOnCirc p rad $ wallsNearPoint p w
damageBlocks wall w
= case wall ^? blHP of
Just hp -> foldr (\j -> over (walls . ix j . blHP) (\y -> y - (div amount 2)))
w
(_blIDs wall)
_ -> w
inverseShockwaveAt :: Point2 -> Float -> Int -> Float -> Float -> World -> World
inverseShockwaveAt p rad dam push pushexp = over particles' ((:) theShockwave)
where theShockwave
= Particle'
{ _ptDraw = const blank
, _ptUpdate' = moveInverseShockWave 10 p rad push pushexp
}
moveInverseShockWave :: Int -> Point2 -> Float -> Float -> Float -> 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 $ uncurry 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 damageBlocks) hitBlocks
hitBlocks = wallsOnCirc p rad $ wallsNearPoint p w
damageBlocks wall w
= case wall ^? blHP of
Just hp -> foldr (\j -> over (walls . ix j . blHP) (\y -> y - 1))
w
(_blIDs wall)
_ -> w
damCr cr | dist (_crPos cr) p < rad + _crRad cr
= over (crState . crDamage)
((:) $ PushDam 1 (25 *.* safeNormalizeV (p -.- _crPos cr)))
cr
| otherwise = cr
createBarrelSpark :: Int -> Int -> Point2 -> Float -> Maybe Int -> World -> World
createBarrelSpark time colid pos dir maycid w = over worldEvents
((.) $ ( over particles' ((:) spark)