117 lines
3.7 KiB
Haskell
117 lines
3.7 KiB
Haskell
{-# LANGUAGE TupleSections #-}
|
|
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 = (,dm) . 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
|
|
stoneWallDamage dm wl = case dm of
|
|
Piercing _ p t -> makeSpark NormalSpark (outTo p t)
|
|
(reflDirWall p (p+t) wl) . wlDustAt wl (outTo p t)
|
|
Lasering _ p t -> makeSpark FireSpark (outTo p t) (reflDirWall p (p+t) wl)
|
|
Blunt _ p t -> wlDustAt wl (outTo p t)
|
|
Shattering _ p t -> muchWlDustAt wl (outTo p t)
|
|
Crushing {} -> id
|
|
Explosive {} -> id
|
|
Sparking {} -> id
|
|
Flaming {} -> id
|
|
Electrical {} -> id
|
|
Poison {} -> id
|
|
Enterrement {} -> id
|
|
Flashing {} -> id
|
|
where
|
|
outTo x y = x -.- squashNormalizeV y
|
|
-- d = _dmAmount dm
|
|
-- sp = _dmFrom dm
|
|
-- p = _dmAt dm
|
|
-- outTo = p +.+ squashNormalizeV (sp -.- p)
|
|
|
|
glassWallDamage :: Damage -> Wall -> World -> World
|
|
glassWallDamage dm wl w =
|
|
w & case dm of
|
|
Lasering _ p t -> makeSpark FireSpark (outTo p t) (reflDirWall p (p+t) wl)
|
|
Piercing _ p t -> dosplint . makeSpark NormalSpark (outTo p t) (reflDirWall p (p+t) wl) . wlDustAt wl (outTo p t)
|
|
Blunt _ p t -> dosplint . wlDustAt wl (outTo p t)
|
|
Shattering _ p t -> dosplint . muchWlDustAt wl (outTo p t)
|
|
Crushing {} -> dosplint
|
|
Explosive {} -> dosplint
|
|
Sparking {} -> id
|
|
Flaming {} -> id
|
|
Electrical {} -> id
|
|
Poison {} -> id
|
|
Enterrement {} -> id
|
|
Flashing {} -> 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
|
|
dosplint = maybe id splinterBlock mbl
|
|
-- sp = _dmFrom dm
|
|
-- p = _dmAt dm
|
|
--outTo = p +.+ squashNormalizeV (sp -.- p)
|
|
outTo p t = p -.- squashNormalizeV t
|
|
|
|
crystalWallDamage :: Damage -> Wall -> World -> World
|
|
crystalWallDamage dm wl = case dm of
|
|
Lasering _ p t -> makeSpark FireSpark (outTo p t) (reflDirWall p (p+t) wl)
|
|
Piercing _ p t -> makeSpark NormalSpark (outTo p t) (reflDirWall p (p+t) wl) . wlDustAt wl (outTo p t)
|
|
Blunt _ p t -> wlDustAt wl (outTo p t)
|
|
Shattering _ p t -> muchWlDustAt wl (outTo p t)
|
|
Crushing {} -> id
|
|
Explosive {} -> id
|
|
Sparking {} -> id
|
|
Flaming {} -> id
|
|
Electrical {} -> id
|
|
Poison {} -> id
|
|
Enterrement {} -> id
|
|
Flashing {} -> id
|
|
where
|
|
-- a x f w = (f w)
|
|
--d = _dmAmount dm
|
|
--sp = _dmFrom dm
|
|
--p = _dmAt dm
|
|
--outTo = p +.+ squashNormalizeV (sp -.- p)
|
|
outTo p t = p -.- squashNormalizeV t
|
|
|
|
dirtWallDamage :: Damage -> Wall -> World -> World
|
|
dirtWallDamage dm wl = case dm of
|
|
Lasering _ p t -> wlDustAt wl (outTo p t)
|
|
Piercing _ p t -> wlDustAt wl (outTo p t)
|
|
Blunt _ p t -> wlDustAt wl (outTo p t)
|
|
Shattering _ p t -> muchWlDustAt wl (outTo p t)
|
|
Crushing _ _ -> id
|
|
Explosive _ _ -> id
|
|
Sparking {} -> id
|
|
Flaming {} -> id
|
|
Electrical {} -> id
|
|
Poison {} -> id
|
|
Enterrement {} -> id
|
|
Flashing {} -> id
|
|
where
|
|
--a x f w = (f w)
|
|
--d = _dmAmount dm
|
|
--sp = _dmFrom dm
|
|
--p = _dmAt dm
|
|
--outTo = p +.+ squashNormalizeV (sp -.- p)
|
|
outTo p t = p -.- squashNormalizeV t
|