diff --git a/src/Dodge/Creature/Damage.hs b/src/Dodge/Creature/Damage.hs index 5e5e241ed..e0555e7fc 100644 --- a/src/Dodge/Creature/Damage.hs +++ b/src/Dodge/Creature/Damage.hs @@ -1,36 +1,38 @@ module Dodge.Creature.Damage (applyCreatureDamage) where -import Linear +--import Linear import Dodge.Material.Damage import Data.List -import Dodge.Creature.Mass +--import Dodge.Creature.Mass import Dodge.Creature.Material -import Dodge.Creature.Test +--import Dodge.Creature.Test import Dodge.Data.World -import Dodge.Spark -import Geometry +--import Dodge.Spark +--import Geometry import LensHelp applyCreatureDamage :: [Damage] -> Creature -> World -> World applyCreatureDamage dms cr w = foldl' (applyIndividualDamage cr) w dms applyIndividualDamage :: Creature -> World -> Damage -> World -applyIndividualDamage cr w dm = damMatSideEffect dm (crMaterial (_crType cr)) (Left cr) $ - case dm of - Piercing{} -> applyPiercingDamage cr dm w - _ -> w & damageHP cr (_dmAmount dm) +applyIndividualDamage cr w dm = + let (i,w') = damMatSideEffect dm (crMaterial (_crType cr)) (Left cr) w + in w' & damageHP cr i +-- case dm of +-- Piercing{} -> applyPiercingDamage cr dm w +-- _ -> w & damageHP cr (_dmAmount dm) -applyPiercingDamage :: Creature -> Damage -> World -> World -applyPiercingDamage cr dm w - | crIsArmouredFrom (w ^. cWorld . lWorld . items) p cr - = f . makeSpark NormalSpark p1 (argV (p1 - p)) $ w - | otherwise = f . damageHP cr (_dmAmount dm) $ w - where - f = cWorld . lWorld . creatures . ix (_crID cr) . crPos . _xy +~ _dmVector dm - / V2 x x - x = crMass (_crType cr) - p = _dmPos dm - p1 = p + 2 *.* squashNormalizeV (p - cr ^. crPos . _xy) +--applyPiercingDamage :: Creature -> Damage -> World -> World +--applyPiercingDamage cr dm w +-- | crIsArmouredFrom (w ^. cWorld . lWorld . items) p cr +-- = f . makeSpark NormalSpark p1 (argV (p1 - p)) $ w +-- | otherwise = f . damageHP cr (_dmAmount dm) $ w +-- where +-- f = cWorld . lWorld . creatures . ix (_crID cr) . crPos . _xy +~ _dmVector dm +-- / V2 x x +-- x = crMass (_crType cr) +-- p = _dmPos dm +-- p1 = p + 2 *.* squashNormalizeV (p - cr ^. crPos . _xy) damageHP :: Creature -> Int -> World -> World damageHP cr x = diff --git a/src/Dodge/Data/Material.hs b/src/Dodge/Data/Material.hs index 05259cb2b..51d43a41a 100644 --- a/src/Dodge/Data/Material.hs +++ b/src/Dodge/Data/Material.hs @@ -6,6 +6,7 @@ module Dodge.Data.Material where import Data.Aeson import Data.Aeson.TH +-- consider having external and internal materials in some manner data Material = Wood | Dirt diff --git a/src/Dodge/Material/Damage.hs b/src/Dodge/Material/Damage.hs index a4577dad2..11bbd664c 100644 --- a/src/Dodge/Material/Damage.hs +++ b/src/Dodge/Material/Damage.hs @@ -1,3 +1,5 @@ +{-# LANGUAGE LambdaCase #-} +{-# LANGUAGE TupleSections #-} module Dodge.Material.Damage (damMatSideEffect) where import Linear @@ -11,8 +13,8 @@ import RandomHelp type ECW = Either Creature Wall -damMatSideEffect :: Damage -> Material -> ECW -> World -> World -damMatSideEffect dm mt = case mt of +damMatSideEffect :: Damage -> Material -> ECW -> World -> (Int,World) +damMatSideEffect dm = \case Stone -> damageStone dm Metal -> damageMetal dm Flesh -> damageFlesh dm @@ -20,28 +22,29 @@ damMatSideEffect dm mt = case mt of -- Glass -> damageGlass dm _ -> defDamageMaterial dm -defDamageMaterial :: Damage -> ECW -> World -> World -defDamageMaterial _ _ w = w +defDamageMaterial :: Damage -> ECW -> World -> (Int,World) +defDamageMaterial dm _ = (dm ^. dmAmount,) -damageStone :: Damage -> ECW -> World -> World -damageStone dm ecw w = - w & case dm of - Lasering _ p t -> makeSpark FireSpark (outTo p t) (rdir p t) - Piercing _ p t -> - makeSpark NormalSpark (outTo p t) (rdir p t) +damageStone :: Damage -> ECW -> World -> (Int,World) +damageStone dm ecw w = case dm of + Lasering _ p t -> f 0 $ makeSpark FireSpark (outTo p t) (rdir p t) + Piercing _ p t -> + f dmam $ makeSpark NormalSpark (outTo p t) (rdir p t) . makeDustAt Stone 200 (addZ 20 (outTo p t)) . randsound p [slapS, slap1S] - Blunt _ p t -> makeDustAt Stone 200 (addZ 20 (outTo p t)) - Shattering _ p t -> makeDustAt Stone 200 (addZ 20 (outTo p t)) - Crushing{} -> id - Explosive{} -> id - Sparking{} -> id - Flaming{} -> id - Electrical{} -> id - Poison{} -> id - Enterrement{} -> id - Flashing{} -> id + Blunt _ p t -> f dmam $ makeDustAt Stone 200 (addZ 20 (outTo p t)) + Shattering _ p t -> f dmam $ makeDustAt Stone 200 (addZ 20 (outTo p t)) + Crushing{} -> f dmam $ id + Explosive{} -> f dmam $ id + Sparking{} -> f 0 $ id + Flaming{} -> f 0 $ id + Electrical{} -> f 0 $ id + Poison{} -> f 0 $ id + Enterrement{} -> f 0 $ id + Flashing{} -> f 0 $ id where + f x g = (x, g w) + dmam = dm ^. dmAmount rdir p t = argV $ reflectIn v t where v = case ecw of @@ -53,26 +56,27 @@ damageStone dm ecw w = so = DamageHitSound (w ^. cWorld . lWorld . lClock) outTo x t = x -.- squashNormalizeV t -damageMetal :: Damage -> ECW -> World -> World -damageMetal dm ecw w = - w & case dm of - Lasering _ p t -> makeSpark FireSpark (outTo p t) (rdir p t) - Piercing _ p t -> +damageMetal :: Damage -> ECW -> World -> (Int,World) +damageMetal dm ecw w = case dm of + Lasering _ p t -> f 0 $ makeSpark FireSpark (outTo p t) (rdir p t) + Piercing _ p t -> f dmam $ makeSpark NormalSpark (outTo p t) (rdir p t) . randsound p [tingS, ting1S, ting2S, ting3S, ting4S, ting5S] - Blunt _ p t -> + Blunt _ p t -> f dmam $ makeSpark NormalSpark (outTo p t) (rdir p t) . randsound p [clangS,clang1S,clang2S] - Shattering {} -> id - Crushing{} -> id - Explosive{} -> id - Sparking{} -> id - Flaming{} -> id - Electrical{} -> id - Poison{} -> id - Enterrement{} -> id - Flashing{} -> id + Shattering {} -> f dmam $ id + Crushing{} -> f dmam $ id + Explosive{} -> f dmam $ id + Sparking{} -> f 0 $ id + Flaming{} -> f 0 $ id + Electrical{} -> f 0 $ id + Poison{} -> f 0 $ id + Enterrement{} -> f 0 $ id + Flashing{} -> f 0 $ id where + f x g = (x, g w) + dmam = dm ^. dmAmount rdir p t = argV $ reflectIn v t where v = case ecw of @@ -84,8 +88,8 @@ damageMetal dm ecw w = in soundStart so p x Nothing . set randGen g so = DamageHitSound (w ^. cWorld . lWorld . lClock) -damageFlesh :: Damage -> ECW -> World -> World -damageFlesh dm _ w = w & case dm of +damageFlesh :: Damage -> ECW -> World -> (Int,World) +damageFlesh dm _ w = (dm ^. dmAmount,) $ w & case dm of Lasering {} -> id Piercing _ p t -> randsound @@ -117,9 +121,9 @@ damageFlesh dm _ w = w & case dm of so = DamageHitSound (w ^. cWorld . lWorld . lClock) outTo x t = x -.- squashNormalizeV t -damageDirt :: Damage -> ECW -> World -> World +damageDirt :: Damage -> ECW -> World -> (Int,World) damageDirt dm _ w = - w & case dm of + (dm^. dmAmount,) $ w & case dm of Lasering _ p t -> -- makeSpark FireSpark (outTo p t) (rdir p t) makeDustAt Dirt 200 (addZ 20 (outTo p t)) Piercing _ p t -> diff --git a/src/Dodge/Wall/Damage.hs b/src/Dodge/Wall/Damage.hs index 28068242c..db1db79b6 100644 --- a/src/Dodge/Wall/Damage.hs +++ b/src/Dodge/Wall/Damage.hs @@ -13,17 +13,17 @@ damageWall :: Damage -> Wall -> World -> World damageWall dt wl w = case _wlStructure wl of MachinePart mcid -> w' & cWorld . lWorld . machines . ix mcid . mcDamage .:~ dt BlockPart blid -> - w' & cWorld . lWorld . blocks . ix blid . blHP -~ x + w' & cWorld . lWorld . blocks . ix blid . blHP -~ dmam & maybeDestroyBlock blid DoorPart drid -> - w' & cWorld . lWorld . doors . ix drid . drHP -~ x + w' & cWorld . lWorld . doors . ix drid . drHP -~ dmam -- & maybeDestroyDoor drid _ -> w' where - x = case dt of - Explosive y _ -> y * 100 - _ -> dt ^. dmAmount - w' = damMatSideEffect dt (_wlMaterial wl) (Right wl) w +-- x = case dt of +-- Explosive y _ -> y * 100 +-- _ -> dt ^. dmAmount + (dmam,w') = damMatSideEffect dt (_wlMaterial wl) (Right wl) w -- block destruction is convoluted... maybeDestroyBlock :: Int -> World -> World