Files
loop/src/Dodge/WorldEvent/HitEffect.hs
T
2021-10-31 13:34:22 +00:00

89 lines
2.7 KiB
Haskell

module Dodge.WorldEvent.HitEffect
( destroyOnImpact
, doFlameDam
, noEff
, penWalls
)
where
import Dodge.Data
import Dodge.Data.DamageType
import Dodge.Creature.State.Data
import Geometry
import Data.Bifunctor
import Data.Maybe
import Control.Lens
type HitCreatureEffect = Particle -> Point2 -> Creature -> World -> World
type HitWallEffect = Particle -> Point2 -> Wall -> World -> World
type HitForceFieldEffect = Particle -> Point2 -> ForceField -> World -> World
--passThroughAll
-- :: HitCreatureEffect
-- -> HitWallEffect
-- -> HitForceFieldEffect
-- -> Particle
-- -> [(Point2, Either3 Creature Wall ForceField)] -- ^ hit things
-- -> World
-- -> (World, Maybe Particle)
--passThroughAll _ _ _ pt _ w = (w, mvPt)
-- where
-- mvPt = Just $ pt & btTrail' .~ (newP : trl)
-- & btTimer' %~ (\t -> t - 1)
-- & btPassThrough' .~ Nothing
-- trl = _btTrail' pt
-- newP = head trl +.+ _btVel' pt
destroyOnImpact
:: HitCreatureEffect
-> HitWallEffect
-> HitForceFieldEffect
-> Particle
-> [(Point2, Either3 Creature Wall ForceField)]
-> World
-> (World, Maybe Particle)
destroyOnImpact crEff wlEff ffEff pt hitThings w = case hitThings of
[] -> ( w, mvPt pt)
((p,E3x1 cr):_) -> (crEff pt p cr w, destroyAt p pt)
((p,E3x2 wl):_) -> (wlEff pt p wl w, destroyAt p pt)
((p,E3x3 ff):_) -> (ffEff pt p ff w, destroyAt p pt)
mvPt :: Particle -> Maybe Particle
mvPt pt = Just $ pt
& btTrail' %~ f
& btTimer' -~ 1
& btPassThrough' .~ Nothing
where
f trl = head trl +.+ _btVel' pt : trl
destroyAt :: Point2 -> Particle -> Maybe Particle
destroyAt hitp pt = Just $ pt
& btTrail' %~ (hitp :)
& btTimer' %~ (\t -> min 3 (t-1))
penWalls
:: HitCreatureEffect
-> HitWallEffect
-> HitForceFieldEffect
-> Particle
-> [(Point2, Either3 Creature Wall ForceField)]
-> World
-> (World, Maybe Particle)
penWalls crEff wlEff ffEff pt hitThings w = case hitThings of
[] -> ( w, mvPt pt)
((p,E3x1 cr):_) -> (crEff pt p cr w, destroyAt p pt)
((p,E3x3 ff):_) -> (ffEff pt p ff w, destroyAt p pt)
((p,E3x2 wl):hs) | isJust (wl ^? wlBlockID)
-> first (wlEff pt p wl) $ penWalls crEff wlEff ffEff pt hs w
((p,E3x2 wl):_) -> (wlEff pt p wl w, destroyAt p pt)
doFlameDam :: Int -> Particle -> Point2 -> Creature -> World -> World
doFlameDam amount pt p cr = creatures . ix (_crID cr) . crState . crDamage %~
(Flaming amount sp p ep :)
where
sp = _btPos' pt
ep = sp +.+ _btVel' pt
noEff :: a -> b -> c -> d -> d
noEff _ _ _ = id