83 lines
2.5 KiB
Haskell
83 lines
2.5 KiB
Haskell
{-# LANGUAGE LambdaCase #-}
|
|
|
|
module Dodge.Damage (
|
|
damageInCircle,
|
|
damageCrWl,
|
|
damageDirection,
|
|
damageCrWlID,
|
|
maxDamageType,
|
|
damThingHitWith,
|
|
) where
|
|
|
|
import qualified Data.Map.Strict as M
|
|
import Dodge.Data.CrWlID
|
|
import Dodge.Data.Damage.Type
|
|
import Dodge.Data.World
|
|
import Dodge.WorldEvent.ThingsHit
|
|
import FoldableHelp
|
|
import Geometry.Data
|
|
import Geometry.Vector
|
|
import LensHelp
|
|
import ListHelp
|
|
|
|
damageCrWlID :: [Damage] -> CrWlID -> World -> World
|
|
damageCrWlID dam = \case
|
|
NothingID -> id
|
|
CrID cid -> cWorld . lWorld . creatures . ix cid . crDamage <>~ dam
|
|
WlID wlid -> cWorld . lWorld . wallDamages . at wlid . non mempty <>~ dam
|
|
|
|
damageCrWl :: [Damage] -> Either Creature Wall -> World -> World
|
|
damageCrWl dam = \case
|
|
Left cr -> damageCrWlID dam (CrID (_crID cr))
|
|
Right wl -> damageCrWlID dam (WlID (_wlID wl))
|
|
|
|
-- could sort for damage amount as well
|
|
damageDirection :: [Damage] -> Maybe Float
|
|
damageDirection ds = safeArgV =<< safeHead (ds ^.. each . dmVector)
|
|
|
|
dmType :: Damage -> DamageType
|
|
dmType = \case
|
|
Piercing{} -> PhysicalDamage
|
|
Blunt{} -> PhysicalDamage
|
|
Sparking{} -> CookingDamage
|
|
Crushing{} -> PhysicalDamage
|
|
Shattering{} -> PhysicalDamage
|
|
Flaming{} -> CookingDamage
|
|
Lasering{} -> CookingDamage
|
|
Flashing{} -> CookingDamage
|
|
Electrical{} -> CookingDamage
|
|
Explosive{} -> PhysicalDamage
|
|
Poison{} -> PoisonDamage
|
|
Enterrement{} -> PhysicalDamage
|
|
|
|
collectDamageTypes :: [Damage] -> M.Map DamageType Int
|
|
collectDamageTypes = foldl' (flip f) M.empty
|
|
where
|
|
f dm = at (dmType dm) . non 0 +~ _dmAmount dm
|
|
|
|
maxDamageType :: [Damage] -> Maybe (DamageType, Int)
|
|
maxDamageType = safeMinimumOn (negate . snd) . M.assocs . collectDamageTypes
|
|
|
|
damageInCircle :: (Point2 -> Damage) -> Point2 -> Float -> World -> World
|
|
damageInCircle f p r w =
|
|
w
|
|
& cWorld . lWorld . wallDamages %~ dowldams
|
|
& cWorld . lWorld . creatures %~ docrdams
|
|
where
|
|
dowldams wds = foldl' g wds (wlsHitRadial p r w)
|
|
docrdams crs = foldl' h crs (crsHitRadial p r w)
|
|
g wds (x, wl) = wds & at (_wlID wl) . non mempty .:~ f x
|
|
h crs (x, cr) = crs & ix (_crID cr) . crDamage .:~ f x
|
|
|
|
damThingHitWith ::
|
|
(Point2 -> Damage) ->
|
|
Maybe (Point2, Either Creature Wall) ->
|
|
World ->
|
|
World
|
|
damThingHitWith f = \case
|
|
Just (p, Left cr) ->
|
|
cWorld . lWorld . creatures . ix (_crID cr) . crDamage .:~ f p
|
|
Just (p, Right wl) ->
|
|
cWorld . lWorld . wallDamages . at (_wlID wl) . non mempty .:~ f p
|
|
Nothing -> id
|