Cleanup damages further

src/Dodge/Particle/Bullet/HitEffect.hs

@@ -1,20 +1,21 @@
 {- | Effects of bullets upon impact with walls or creatures.  -}
 module Dodge.Particle.Bullet.HitEffect 
-    ( bulHitCr
-    , bulHitWall
+    ( basicBulDams
+    , bounceBulDams
+    , spawnBulDams
     , hvBulHitCr
     , hvBulHitWall
     , bulletDestroySpawn
-    , bulBounceArmCr
-    , bulBounceWall
+    , bulletDestroyDamage
+    , bulBounceCr
+--    , bulBounceWall
     ) where
 import Dodge.Data
 import Dodge.Particle.Spark
 import Dodge.Wall.Damage
 import Dodge.WorldEvent
-import Dodge.Particle.Bullet.Spawn
+--import Dodge.WorldEvent.HitEffect
 import Dodge.RandomHelp
-import Dodge.Creature.Property
 import Dodge.Wall.Reflect
 import Geometry
 import Picture
@@ -23,48 +24,49 @@ import LensHelp
 import System.Random
 import Control.Monad.State
 
-crArmourSplit 
-    :: (Particle -> Point2 -> Creature -> World -> World)   -- | normal effect
-    -> (Particle -> Point2 -> Creature -> World -> World)   -- | armoured effect
-    -> Particle -> Point2 -> Creature -> World -> World
-crArmourSplit normalf armourf bt p cr
-    | crIsArmouredFrom p cr = armourf bt p cr
-    | otherwise             = normalf bt p cr
-
-
-bounceArmour :: Particle -> Point2 -> Creature -> World -> World
-bounceArmour bt p cr = addBouncer . addDamageArmoured
+spawnBulDams :: (Particle -> Either Creature Wall -> Damage -> State StdGen Particle)
+    -> Particle -> Point2 -> [Damage]
+spawnBulDams thespawn bt p =
+    [ Damage Piercing 50 sp p ep (DamageSpawn $ thespawn bt)
+    , Damage PushDam 1 sp p ep . PushBackDamage $ 2 *.* bulVel
+    ]
+  where
+    sp = head $ _ptTrail bt
+    bulVel = _ptVel bt
+    ep = sp +.+ bulVel
+
+basicBulDams :: Particle -> Point2 -> [Damage]
+basicBulDams bt p =
+    [ Damage Piercing 100 sp p ep NoDamageEffect
+    , Damage PushDam 1 sp p ep . PushBackDamage $ 2 *.* bulVel
+    ]
+  where
+    sp = head $ _ptTrail bt
+    bulVel = _ptVel bt
+    ep = sp +.+ bulVel
+
+bounceBulDams :: Particle -> Point2 -> [Damage]
+bounceBulDams bt p =
+    [ Damage Piercing 80 sp p ep (BounceBullet bt)
+    , Damage PushDam 1 sp p ep . PushBackDamage $ 2 *.* bulVel
+    ]
   where
     sp = head $ _ptTrail bt
     bulVel = _ptVel bt
     ep = sp +.+ bulVel
-    mvDams = [ Damage PushDam 1 sp p ep . PushBackDamage $ 2 *.* bulVel ]
-    addDamageArmoured = creatures . ix cid . crState . crDamage .++~ mvDams
-    cid = _crID cr
-    newDir = squashNormalizeV (p -.- _crPos cr)
-    pOut = p +.+ 2 *.* newDir
-    reflectVel = magV bulVel *.* newDir
-    addBouncer = instantParticles .:~ bouncer
-    bouncer = (aBulAt Nothing id (Just (_ptColor bt)) Nothing pOut reflectVel (_btDrag bt)
-                                      (_ptHitEff bt) (_ptWidth bt)
-              ) {_ptTimer = _ptTimer bt - 1}
 
 -- | Basic bullet hit creature effect.
-bulHitCr :: Particle -> Point2 -> Creature -> World -> World
-bulHitCr bt p cr = addDamage 
+bulBounceCr :: Particle -> Point2 -> Creature -> World -> World
+bulBounceCr bt p cr = addDamage 
   where
     sp = head $ _ptTrail bt
     bulVel = _ptVel bt
     ep = sp +.+ bulVel
     mvDams = [ Damage PushDam 1 sp p ep . PushBackDamage $ 2 *.* bulVel ]
     addDamage = creatures . ix cid . crState . crDamage .++~ 
-        (Damage Piercing 100 sp p ep NoDamageEffect : mvDams)
+        (Damage Piercing 100 sp p ep (BounceBullet bt) : mvDams)
     cid = _crID cr
 
-
-{- | Bounce off armoured creatures, otherwise do damage.  -}
-bulBounceArmCr :: Particle -> Point2 -> Creature -> World -> World
-bulBounceArmCr = crArmourSplit bulHitCr bounceArmour
 {- | Heavy bullet effects when hitting creature:
 piercing, blunt, twisting and pushback damage all applied.  -}
 hvBulHitCr :: Particle -> Point2 -> Creature -> World -> World
@@ -92,6 +94,25 @@ bulletDestroySpawn :: (Point2 -> State StdGen Particle)
     -> (World, Maybe Particle)
 bulletDestroySpawn f = destroyOnImpact (bulDestroyCr f) (bulDestroyWall f)
 
+bulletDestroyDamage :: (Particle -> Point2 -> [Damage])
+    -> Particle
+    -> [(Point2, Either Creature Wall)] 
+    -> World
+    -> (World, Maybe Particle)
+bulletDestroyDamage fdm bt hitThings w = case hitThings of
+    [] -> (w, mvPt bt)
+    ((p,Left cr):_) -> (creff cr p w, destroyAt p bt)
+    ((p,Right wl):_) -> (wleff wl p, destroyAt p bt)
+  where
+    creff cr p = addDamage 
+      where
+        dams = fdm bt p
+        addDamage = creatures . ix cid . crState . crDamage .++~ dams
+        cid = _crID cr
+    wleff wl p = foldr (\d -> damageWall d wl) w dams
+      where
+        dams = fdm bt p
+
 {- | Create a particle when hitting a creature.  -}
 bulDestroyCr :: (Point2 -> State StdGen Particle) 
     -> Particle -> Point2 -> Creature -> World -> World
@@ -123,19 +144,6 @@ bulDestroyWall f bt p wl w = w
     wallV = uncurry (-.-) (_wlLine wl)
     reflectVel = squashNormalizeV $ reflectIn wallV (_ptVel bt)
 
-{- | Hitting wall effects: create a spark, damage blocks.  -}
-bulHitWall :: Particle -> Point2 -> Wall -> World -> World
-bulHitWall bt p = damageWall (Damage Piercing 100 sp p ep NoDamageEffect)
-  where 
-    ep = sp +.+ _ptVel bt
-    sp = head $ _ptTrail bt
-{- | Bounce off walls, do damage to blocks.  -}
-bulBounceWall :: Particle -> Point2 -> Wall -> World -> World
-bulBounceWall bt p = damageWall (Damage Blunt 50 sp p ep (BounceBullet bt))
-  where 
-    ep = sp +.+ _ptVel bt
-    sp = head $ _ptTrail bt
-
 hvBulHitWall
     :: Particle 
     -> Point2   -- ^ Impact point