Cleanup

src/Dodge/WorldEvent/HitEffect.hs

@@ -1,4 +1,9 @@
 module Dodge.WorldEvent.HitEffect
+    ( destroyOnImpact
+    , doFlameDam
+    , noEff
+    , penWalls
+    )
     where
 import Dodge.Data
 import Dodge.Data.DamageType
@@ -13,21 +18,21 @@ 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
+--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 
@@ -38,20 +43,23 @@ destroyOnImpact
     -> World 
     -> (World, Maybe Particle)
 destroyOnImpact crEff wlEff ffEff pt hitThings w = case hitThings of
-        []              -> (              w, mvPt)
-        ((p,E3x1 cr):_) -> (crEff pt p cr w, destroyAt p)
-        ((p,E3x2 wl):_) -> (wlEff pt p wl w, destroyAt p)
-        ((p,E3x3 ff):_) -> (ffEff pt p ff w, destroyAt p)
-  where 
-    destroyAt hitp = Just $ pt 
-        & btTrail' .~ (hitp : trl)
-        & btTimer' .~ 3
-    mvPt = Just $ pt 
-        & btTrail' .~ (newP : trl)
-        & btTimer' %~ (\t -> t - 1)
-        & btPassThrough' .~ Nothing
-    trl = _btTrail' pt
-    newP = head trl +.+ _btVel' pt
+        []              -> (              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 
@@ -62,26 +70,16 @@ penWalls
     -> World 
     -> (World, Maybe Particle)
 penWalls crEff wlEff ffEff pt hitThings w = case hitThings of
-        []              -> (              w, mvPt)
-        ((p,E3x1 cr):_)  -> (crEff pt p cr w, destroyAt p)
-        ((p,E3x3 ff):_)  -> (ffEff pt p ff w, destroyAt p)
+        []              -> (              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):_)  | otherwise -> (wlEff pt p wl w, destroyAt p)
-  where 
-    destroyAt hitp = Just $ pt 
-        & btTrail' .~ (hitp : trl)
-        & btTimer' .~ 3
-    mvPt = Just $ pt 
-        & btTrail' .~ (newP : trl)
-        & btTimer' %~ (\t -> t - 1)
-        & btPassThrough' .~ Nothing
-    trl = _btTrail' pt
-    newP = head trl +.+ _btVel' pt
+                        -> 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 = over (creatures . ix (_crID cr) . crState . crDamage)
-    ((:) $ Flaming amount sp p ep)
+doFlameDam amount pt p cr = creatures . ix (_crID cr) . crState . crDamage %~
+    (Flaming amount sp p ep :)
   where 
     sp = _btPos' pt
     ep = sp +.+ _btVel' pt