Make block damages slightly more logical
This commit is contained in:
+12
-24
@@ -6,35 +6,23 @@ module Dodge.Wall.Damage
|
||||
, damageWall
|
||||
) where
|
||||
import Dodge.Data
|
||||
import Dodge.Block
|
||||
import LensHelp
|
||||
import Dodge.Wall.DamageEffect
|
||||
|
||||
damageWall :: Damage -> Wall -> World -> World
|
||||
damageWall dt wl = case _wlStructure wl of
|
||||
MachinePart mcid -> defaultWallDamage dt wl . (machines . ix mcid . mcDamage .:~ dt)
|
||||
BlockPart blid -> defaultWallDamage dt wl . (blocks . ix blid %~ damageBlockWith dt)
|
||||
-- CreaturePart crid f -> f dt wl crid
|
||||
_ -> defaultWallDamage dt wl
|
||||
damageWall dt wl w = case _wlStructure wl of
|
||||
MachinePart mcid -> fst . defaultWallDamage dt wl $ w
|
||||
& machines . ix mcid . mcDamage .:~ dt
|
||||
BlockPart blid -> let (w',x) = defaultWallDamage dt wl w
|
||||
in w' & blocks . ix blid . blHP -~ x & maybeDestroyBlock blid
|
||||
_ -> fst $ defaultWallDamage dt wl w
|
||||
|
||||
damageBlockWith :: Damage -> Block -> Block
|
||||
damageBlockWith dm = case _dmType dm of
|
||||
PIERCING -> blHP -~ dam
|
||||
BLUNT -> blHP -~ dam
|
||||
CUTTING -> blHP -~ dam
|
||||
EXPLOSIVE -> blHP -~ dam
|
||||
CONCUSSIVE -> blHP -~ dam
|
||||
SHATTERING -> blHP -~ dam
|
||||
CRUSHING -> blHP -~ (dam `div` 4)
|
||||
LASERING -> id
|
||||
SPARKING -> id
|
||||
FLAMING -> id
|
||||
ELECTRICAL -> id
|
||||
TORQUEDAM -> id
|
||||
PUSHDAM -> id
|
||||
POISONDAM -> id
|
||||
ENTERREMENT -> id
|
||||
where
|
||||
dam = _dmAmount dm
|
||||
-- block destruction is convoluted...
|
||||
maybeDestroyBlock :: Int -> World -> World
|
||||
maybeDestroyBlock blid w = case w ^? blocks . ix blid of
|
||||
Just bl | _blHP bl < 1 -> destroyBlock bl w
|
||||
_ -> w
|
||||
|
||||
damageBlocksBy :: Int -> Wall -> World -> World
|
||||
damageBlocksBy x wl = case wl ^? wlStructure . wsBlock of
|
||||
|
||||
@@ -8,62 +8,103 @@ import Dodge.Block
|
||||
import Geometry
|
||||
import LensHelp
|
||||
|
||||
import Data.Bifunctor
|
||||
import Control.Monad.State
|
||||
import Data.Maybe
|
||||
--import Data.Maybe
|
||||
|
||||
defaultWallDamage :: Damage -> Wall -> World -> World
|
||||
defaultWallDamage dm wl = wallDamageEffect dm wl . case _dmType dm of
|
||||
LASERING -> colSparkRandDir 0.2 8 lSparkCol outTo (reflDirWall sp p wl)
|
||||
PIERCING -> colSparkRandDir 0.2 8 pSparkCol outTo (reflDirWall sp p wl) . wlDustAt wl outTo
|
||||
BLUNT -> wlDustAt wl outTo
|
||||
SHATTERING -> muchWlDustAt wl outTo
|
||||
CRUSHING -> id
|
||||
EXPLOSIVE -> id
|
||||
CUTTING -> id
|
||||
SPARKING -> id
|
||||
FLAMING -> id
|
||||
ELECTRICAL -> id
|
||||
CONCUSSIVE -> id
|
||||
TORQUEDAM -> id
|
||||
PUSHDAM -> id
|
||||
POISONDAM -> id
|
||||
ENTERREMENT -> id
|
||||
defaultWallDamage :: Damage -> Wall -> World -> (World,Int)
|
||||
defaultWallDamage dm wl = flip (.) (wallDamageEffect dm wl) $ case _wlMaterial wl of
|
||||
Stone -> stoneWallDamage dm wl
|
||||
Glass -> windowWallDamage dm wl
|
||||
Dirt -> dirtWallDamage dm wl
|
||||
_ -> second (const 0) . stoneWallDamage dm wl
|
||||
|
||||
stoneWallDamage :: Damage -> Wall -> World -> (World,Int)
|
||||
stoneWallDamage dm wl = case _dmType dm of
|
||||
LASERING -> a 0 $ colSparkRandDir 0.2 8 lSparkCol outTo (reflDirWall sp p wl)
|
||||
PIERCING -> a d $ colSparkRandDir 0.2 8 pSparkCol outTo (reflDirWall sp p wl) . wlDustAt wl outTo
|
||||
BLUNT -> a d $ wlDustAt wl outTo
|
||||
SHATTERING -> a d $ muchWlDustAt wl outTo
|
||||
CRUSHING -> a d $ id
|
||||
EXPLOSIVE -> a d $ id
|
||||
CUTTING -> a d $ id
|
||||
SPARKING -> a 0 $ id
|
||||
FLAMING -> a 0 $ id
|
||||
ELECTRICAL -> a 0 $ id
|
||||
CONCUSSIVE -> a d $ id
|
||||
TORQUEDAM -> a 0 $ id
|
||||
PUSHDAM -> a 0 $ id
|
||||
POISONDAM -> a 0 $ id
|
||||
ENTERREMENT -> a 0 $ id
|
||||
where
|
||||
a x f w = (f w,x)
|
||||
d = _dmAmount dm
|
||||
sp = _dmFrom dm
|
||||
p = _dmAt dm
|
||||
outTo = p +.+ squashNormalizeV (sp -.- p)
|
||||
pSparkCol = V4 5 1 0.5 2
|
||||
lSparkCol = V4 20 (-5) 0 1
|
||||
|
||||
windowWallDamage :: Damage -> Wall -> World -> World
|
||||
windowWallDamage dm wl = wallDamageEffect dm wl . case _dmType dm of
|
||||
LASERING -> colSparkRandDir 0.2 8 lSparkCol outTo (reflDirWall sp p wl)
|
||||
PIERCING -> dosplint . colSparkRandDir 0.2 8 pSparkCol outTo (reflDirWall sp p wl) . wlDustAt wl outTo
|
||||
BLUNT -> dosplint . wlDustAt wl outTo
|
||||
SHATTERING -> dosplint . muchWlDustAt wl outTo
|
||||
CRUSHING -> dosplint
|
||||
EXPLOSIVE -> dosplint
|
||||
CUTTING -> dosplint
|
||||
SPARKING -> id
|
||||
FLAMING -> id
|
||||
ELECTRICAL -> id
|
||||
CONCUSSIVE -> dosplint
|
||||
TORQUEDAM -> id
|
||||
PUSHDAM -> id
|
||||
POISONDAM -> id
|
||||
ENTERREMENT -> id
|
||||
windowWallDamage :: Damage -> Wall -> World -> (World,Int)
|
||||
windowWallDamage dm wl w = w & case _dmType dm of
|
||||
LASERING -> a 0 $ colSparkRandDir 0.2 8 lSparkCol outTo (reflDirWall sp p wl)
|
||||
PIERCING -> a d $ dosplint . colSparkRandDir 0.2 8 pSparkCol outTo (reflDirWall sp p wl) . wlDustAt wl outTo
|
||||
BLUNT -> a d $ dosplint . wlDustAt wl outTo
|
||||
SHATTERING -> a d $ dosplint . muchWlDustAt wl outTo
|
||||
CRUSHING -> a d $ dosplint
|
||||
EXPLOSIVE -> a d $ dosplint
|
||||
CUTTING -> a d $ dosplint
|
||||
SPARKING -> a 0 $ id
|
||||
FLAMING -> a 0 $ id
|
||||
ELECTRICAL -> a 0 $ id
|
||||
CONCUSSIVE -> a 0 $ dosplint
|
||||
TORQUEDAM -> a 0 $ id
|
||||
PUSHDAM -> a 0 $ id
|
||||
POISONDAM -> a 0 $ id
|
||||
ENTERREMENT -> a 0 $ id
|
||||
where
|
||||
dosplint w = fromMaybe w $ do
|
||||
mbl = do
|
||||
blid <- wl ^? wlStructure . wsBlock
|
||||
bl <- w ^? blocks . ix blid
|
||||
return $ splinterBlock bl w
|
||||
& blocks . ix blid . blHP %~ min 1
|
||||
w ^? blocks . ix blid
|
||||
d :: Int
|
||||
d = max 1 $ maybe 1 (subtract 1 . _blHP) mbl
|
||||
a :: Int -> (World -> World) -> World -> (World,Int)
|
||||
a x f w' = (f w',x)
|
||||
dosplint = maybe id splinterBlock mbl
|
||||
-- fromMaybe w $ do
|
||||
-- blid <- wl ^? wlStructure . wsBlock
|
||||
-- bl <- w ^? blocks . ix blid
|
||||
-- return $ splinterBlock bl w
|
||||
-- & blocks . ix blid . blHP %~ min 1
|
||||
sp = _dmFrom dm
|
||||
p = _dmAt dm
|
||||
outTo = p +.+ squashNormalizeV (sp -.- p)
|
||||
pSparkCol = V4 5 1 0.5 2
|
||||
lSparkCol = V4 20 (-5) 0 1
|
||||
|
||||
dirtWallDamage :: Damage -> Wall -> World -> (World,Int)
|
||||
dirtWallDamage dm wl = case _dmType dm of
|
||||
LASERING -> a d $ wlDustAt wl outTo
|
||||
PIERCING -> a d $ wlDustAt wl outTo
|
||||
BLUNT -> a d $ wlDustAt wl outTo
|
||||
SHATTERING -> a d $ muchWlDustAt wl outTo
|
||||
CRUSHING -> a d $ id
|
||||
EXPLOSIVE -> a d $ id
|
||||
CUTTING -> a d $ id
|
||||
SPARKING -> a 0 $ id
|
||||
FLAMING -> a 0 $ id
|
||||
ELECTRICAL -> a 0 $ id
|
||||
CONCUSSIVE -> a d $ id
|
||||
TORQUEDAM -> a 0 $ id
|
||||
PUSHDAM -> a 0 $ id
|
||||
POISONDAM -> a 0 $ id
|
||||
ENTERREMENT -> a 0 $ id
|
||||
where
|
||||
a x f w = (f w,x)
|
||||
d = _dmAmount dm
|
||||
sp = _dmFrom dm
|
||||
p = _dmAt dm
|
||||
outTo = p +.+ squashNormalizeV (sp -.- p)
|
||||
|
||||
wallDamageEffect :: Damage -> Wall -> World -> World
|
||||
wallDamageEffect dm wl w = case _dmEffect dm of
|
||||
|
||||
Reference in New Issue
Block a user