Control wall damage effects using the wall

This commit is contained in:
2021-11-01 16:50:09 +00:00
parent 7ddbbdda14
commit e4c73b9b8b
7 changed files with 93 additions and 57 deletions
+71
View File
@@ -0,0 +1,71 @@
{- | Controls a walls response to external damage.
- Indestructible walls may still produce sparks, dust etc
-}
module Dodge.Wall.Damage
( damageBlocksBy
, damageWall
) where
import Dodge.Data
import Dodge.Data.DamageType
import Dodge.WorldEvent.SpawnParticle
import Dodge.WorldEvent.Cloud
import Geometry
import Geometry.Vector3D
import Color
import Control.Lens
damageWall :: DamageType -> Wall -> World -> World
damageWall dt wl = case _wlStructure wl of
MachinePart mcid -> machines . ix mcid . mcDamage %~ (dt :)
BlockPart blid -> wallEff dt wl . (blocks . ix blid %~ damageBlockWith dt)
_ -> wallEff dt wl
{- | Damage effects on indestructible walls -}
-- TODO take into account damage amount for amount of dust/sparks?
wallEff :: DamageType -> Wall -> World -> World
wallEff dt wl = case dt of
Lasering _ sp p _ -> colSpark 8 lSparkCol (outTo sp p) (reflDirWall sp p wl)
Piercing _ sp p _ -> colSpark' 0.2 8 pSparkCol (outTo sp p) (reflDirWall sp p wl)
. smokeCloudAt dustcol 20 200 1 (addZ 20 (outTo sp p))
Blunt _ sp p _ -> smokeCloudAt dustcol 20 200 1 (addZ 20 (outTo sp p))
Cutting {} -> id
SparkDam {} -> id
Flaming {} -> id
Electrical {} -> id
Concussive {} -> id
TorqueDam {} -> id
PushDam {} -> id
PoisonDam {} -> id
where
outTo sp p = p +.+ safeNormalizeV (sp -.- p)
dustcol = _wlColor wl & _4 .~ 1
pSparkCol = brightX 100 1.5 white
lSparkCol = V4 20 (-5) 0 1
reflDirWall :: Point2 -> Point2 -> Wall -> Float
reflDirWall sp ep wl = argV (reflectIn (uncurry (-.-) (_wlLine wl)) (ep -.- sp))
damageBlockWith :: DamageType -> Block -> Block
damageBlockWith dt = case dt of
Piercing dam _ _ _ -> blHPs %~ reduceHead dam
Blunt dam _ _ _ -> blHPs %~ reduceHead dam
Cutting dam _ _ _ -> blHPs %~ reduceHead dam
Concussive dam _ _ _ _ -> blHPs %~ reduceHead dam
Lasering {} -> id
SparkDam {} -> id
Flaming {} -> id
Electrical {} -> id
TorqueDam {} -> id
PushDam {} -> id
PoisonDam {} -> id
reduceHead :: Int -> [Int] -> [Int]
reduceHead y (x:xs) = x-y:xs
reduceHead _ _ = []
damageBlocksBy :: Int -> Wall -> World -> World
damageBlocksBy x wl = case wl ^? wlStructure . wlStBlock of
Just blid -> blocks . ix blid . blHPs %~ reduceHeadBy x
Nothing -> id
where
reduceHeadBy y (z:zs) = z - y : zs
reduceHeadBy _ [] = []