Files
loop/src/Dodge/Wall/DamageEffect.hs
T

132 lines
4.2 KiB
Haskell

module Dodge.Wall.DamageEffect where
import Dodge.Base.Wall
import Dodge.Block
import Dodge.Data.World
import Dodge.Spark
import Dodge.Wall.Dust
import Geometry
import LensHelp
damageWallEffect :: Damage -> Wall -> World -> (World, Damage)
damageWallEffect dm wl = case _wlMaterial wl of
Stone -> stoneWallDamage dm wl
Glass -> glassWallDamage dm wl
Dirt -> dirtWallDamage dm wl
Crystal -> crystalWallDamage dm wl
Metal -> stoneWallDamage dm wl
Wood -> stoneWallDamage dm wl
Electronics -> stoneWallDamage dm wl
Flesh -> stoneWallDamage dm wl
-- there is quite a lot of duplication here, should be sorted out
stoneWallDamage :: Damage -> Wall -> World -> (World, Damage)
stoneWallDamage dm wl = case _dmType dm of
LASERING -> a 0 $ colSparkRandDir 0.2 lSparkCol outTo (reflDirWall sp p wl)
PIERCING -> a d $ colSparkRandDir 0.2 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, dm & dmAmount .~ 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
glassWallDamage :: Damage -> Wall -> World -> (World, Damage)
glassWallDamage dm wl w =
w & case _dmType dm of
LASERING -> a 0 $ colSparkRandDir 0.2 lSparkCol outTo (reflDirWall sp p wl)
PIERCING -> a d $ dosplint . colSparkRandDir 0.2 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
mbl = do
blid <- wl ^? wlStructure . wsBlock
w ^? cWorld . lWorld . blocks . ix blid
d :: Int
d = max 1 $ maybe 1 (subtract 1 . _blHP) mbl
a :: Int -> (World -> World) -> World -> (World, Damage)
a x f w' = (f w', dm & dmAmount .~ x)
dosplint = maybe id splinterBlock mbl
sp = _dmFrom dm
p = _dmAt dm
outTo = p +.+ squashNormalizeV (sp -.- p)
pSparkCol = V4 5 1 0.5 2
lSparkCol = V4 20 (-5) 0 1
crystalWallDamage :: Damage -> Wall -> World -> (World, Damage)
crystalWallDamage dm wl = case _dmType dm of
LASERING -> a 0 $ colSparkRandDir 0.2 lSparkCol outTo (reflDirWall sp p wl)
PIERCING -> a 0 $ colSparkRandDir 0.2 pSparkCol outTo (reflDirWall sp p wl) . wlDustAt wl outTo
BLUNT -> a 0 $ wlDustAt wl outTo
SHATTERING -> a d $ muchWlDustAt wl outTo
CRUSHING -> a 0 id
EXPLOSIVE -> a 0 id
CUTTING -> a 0 id
SPARKING -> a 0 id
FLAMING -> a 0 id
ELECTRICAL -> a 0 id
CONCUSSIVE -> a 0 id
TORQUEDAM -> a 0 id
PUSHDAM -> a 0 id
POISONDAM -> a 0 id
ENTERREMENT -> a 0 id
where
a x f w = (f w, dm & dmAmount .~ 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
dirtWallDamage :: Damage -> Wall -> World -> (World, Damage)
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 $ wlDustAt wl outTo
EXPLOSIVE -> a d $ muchWlDustAt wl outTo
CUTTING -> a d $ muchWlDustAt wl outTo
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, dm & dmAmount .~ x)
d = _dmAmount dm
sp = _dmFrom dm
p = _dmAt dm
outTo = p +.+ squashNormalizeV (sp -.- p)