Cleanup damages further

src/Dodge/Combine/Combinations.hs

@@ -2,7 +2,6 @@
 module Dodge.Combine.Combinations where
 import Geometry
 import Dodge.Data
-import Dodge.WorldEvent.HitEffect
 import Dodge.WorldEvent.SpawnParticle
 import Dodge.Particle.Bullet.HitEffect
 import Dodge.Item.Equipment
@@ -115,8 +114,9 @@ moduleCombinations =
         )
     ,   ( ModBullet
         ,   bulletWeapons
-        ,   [amod [INCENDIARYMODULE] "+INCENDIARY" (f $ bulletDestroySpawn incBall)
+--        ,   [amod [INCENDIARYMODULE] "+INCENDIARY" (f $ bulletDestroySpawn incBall)
-            ,amod [BOUNCEMODULE]     "+BOUNCE"     (f $ destroyOnImpact bulBounceArmCr bulBounceWall)
+        ,   [amod [INCENDIARYMODULE] "+INCENDIARY" (f $ bulletDestroyDamage $ spawnBulDams incBall')
+            ,amod [BOUNCEMODULE]     "+BOUNCE"     (f $ bulletDestroyDamage bounceBulDams)
             ,amod [STATICMODULE]     "+STATIC"     (f $ bulletDestroySpawn aStaticBall)
             ,amod [CONCUSSMODULE]    "+CONCUSS"    (f $ bulletDestroySpawn concBall)
             ]

src/Dodge/Creature/Damage.hs

@@ -7,6 +7,8 @@ import Color
 import Geometry
 import LensHelp
 
+import Control.Monad.State
+import System.Random
 import Data.List
 
 defaultApplyDamage :: [Damage] -> Creature -> (World -> World, Creature)
@@ -39,8 +41,9 @@ applyDamageEffect dm de (f,cr) = case de of
         reflectVel = magV bulVel *.* newDir
         newDir = squashNormalizeV (p -.- _crPos cr)
         bulVel = _ptVel bt
-    SparkBullet _ -> (f, cr) -- TODO
+    DamageSpawn f -> (instantParticles .:~ thepart, cr)
-    _ -> (f,cr)
+      where
+        thepart = evalState (f (Left cr) dm) $ mkStdGen 0
   where
     fromDir = _dmFrom dm
     p = _dmAt dm

src/Dodge/Data.hs

@@ -1013,6 +1013,8 @@ data DamageEffect
     | PushBackDamage {_dePushBack :: Point2 }
     | BounceBullet {_bulToBounce :: Particle}
     | SparkBullet {_bulToSpark :: Particle}
+    | DamageSpawn {_spawnFunc 
+        :: Either Creature Wall -> Damage -> State StdGen Particle}
     | NoDamageEffect
 --  deriving (Eq,Ord,Show)
 

src/Dodge/Item/Weapon/Bullet.hs

@@ -1,6 +1,5 @@
 module Dodge.Item.Weapon.Bullet
     ( basicBullet
-    , ltBullet
     , hvBullet
     ) where
 import Dodge.Data
@@ -11,19 +10,12 @@ import Geometry.Data
 basicBullet :: AmmoType
 basicBullet = BulletAmmo
     { _amString = "BASIC"
-    , _amBulEff = destroyOnImpact bulHitCr bulHitWall
+    --, _amBulEff = destroyOnImpact bulHitCr bulHitWall
+    , _amBulEff = bulletDestroyDamage basicBulDams
     , _amBulWth = 2
     , _amBulVel = V2 50 0
     , _amBulTraj = BasicBulletTrajectory
     }
-ltBullet :: AmmoType
-ltBullet = BulletAmmo
-    { _amString = "LTBULLET"
-    , _amBulEff = destroyOnImpact bulHitCr bulHitWall
-    , _amBulWth = 2
-    , _amBulVel = V2 40 0
-    , _amBulTraj = BasicBulletTrajectory
-    }
 hvBullet :: AmmoType
 hvBullet = BulletAmmo
     { _amString = "HVBULLET"

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
+    ( basicBulDams
-    , bulHitWall
+    , bounceBulDams
+    , spawnBulDams
     , hvBulHitCr
     , hvBulHitWall
     , bulletDestroySpawn
-    , bulBounceArmCr
+    , bulletDestroyDamage
-    , bulBounceWall
+    , 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 
+spawnBulDams :: (Particle -> Either Creature Wall -> Damage -> State StdGen Particle)
-    :: (Particle -> Point2 -> Creature -> World -> World)   -- | normal effect
+    -> Particle -> Point2 -> [Damage]
-    -> (Particle -> Point2 -> Creature -> World -> World)   -- | armoured effect
+spawnBulDams thespawn bt p =
-    -> Particle -> Point2 -> Creature -> World -> World
+    [ Damage Piercing 50 sp p ep (DamageSpawn $ thespawn bt)
-crArmourSplit normalf armourf bt p cr
+    , Damage PushDam 1 sp p ep . PushBackDamage $ 2 *.* bulVel
-    | crIsArmouredFrom p cr = armourf bt p cr
+    ]
-    | otherwise             = normalf bt p cr
+  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
 
-bounceArmour :: Particle -> Point2 -> Creature -> World -> World
+bounceBulDams :: Particle -> Point2 -> [Damage]
-bounceArmour bt p cr = addBouncer . addDamageArmoured
+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
+bulBounceCr :: Particle -> Point2 -> Creature -> World -> World
-bulHitCr bt p cr = addDamage 
+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

src/Dodge/Wall/DamageEffect.hs

@@ -8,6 +8,8 @@ import Geometry
 import Color
 import LensHelp
 
+import Control.Monad.State
+
 defaultWallDamage :: Damage -> Wall -> World -> World
 defaultWallDamage dm wl = wallDamageEffect dm wl . case _dmType dm of
     Lasering -> colSpark 8 lSparkCol outTo (reflDirWall sp p wl)
@@ -31,8 +33,8 @@ defaultWallDamage dm wl = wallDamageEffect dm wl . case _dmType dm of
     lSparkCol = V4 20 (-5) 0 1
 
 wallDamageEffect :: Damage -> Wall -> World -> World
-wallDamageEffect dm wl = case _dmEffect dm of
+wallDamageEffect dm wl w = case _dmEffect dm of
-    BounceBullet bt -> instantParticles .:~ thebouncer
+    BounceBullet bt -> w & instantParticles .:~ thebouncer
       where
         reflectVel = reflVelWall wl (_ptVel bt)
         thebouncer = (aBulAt Nothing id (Just (_ptColor bt)) Nothing pOut reflectVel (_btDrag bt) (_ptHitEff bt) (_ptWidth bt)
@@ -40,4 +42,8 @@ wallDamageEffect dm wl = case _dmEffect dm of
         pOut = p +.+ squashNormalizeV (sp -.- p)
         p = _dmAt dm
         sp = _dmFrom dm
-    _ -> id
+    DamageSpawn f -> w & instantParticles .:~ thepart
+        & randGen .~ g
+      where
+        (thepart,g) = runState (f (Right wl) dm) $ _randGen w
+    _ -> w

src/Dodge/WorldEvent/HitEffect.hs

@@ -1,6 +1,8 @@
 module Dodge.WorldEvent.HitEffect
     ( destroyOnImpact
     , penWalls
+    , mvPt
+    , destroyAt
     ) where
 import Dodge.Data
 import Geometry

src/Dodge/WorldEvent/SpawnParticle.hs

@@ -6,6 +6,7 @@ module Dodge.WorldEvent.SpawnParticle
     , aStaticBall
     , makeStaticBall
     , incBall
+    , incBall'
     , concBall
     ) where
 import Dodge.Data
@@ -83,16 +84,16 @@ moveFlame :: Point2   -- ^ Rotation direction
 moveFlame rotd w pt 
     | time <= 0 = (makeFlamerSmokeAt (addZ 20 ep) w, Nothing)
     | otherwise = case thingsHitExceptCr (_ptCrIgnore pt) sp ep w of
-        ((_,Left _):_)      -> (doSound $ damwls damcrs             , mvPt 0.7)
+        ((_,Left _):_)      -> (doSound $ damwls damcrs             , mvPt' 0.7)
         ((p,Right wl):_) -> (doSound $ damwls damcrs  , rfl wl p)
-        _                   -> (ptFlicker pt . damwls $ doSound damcrs    , mvPt 0.98)
+        _                   -> (ptFlicker pt . damwls $ doSound damcrs    , mvPt' 0.98)
   where 
     time = _ptTimer pt
     doSound = soundContinue Flame (V2 x y) fireLoudS (Just 2)
     sp@(V2 x y) = _ptPos pt
     vel = _ptVel pt
     ep = sp +.+ vel
-    mvPt speed = Just $ pt 
+    mvPt' speed = Just $ pt 
         { _ptTimer = time - 1
         , _ptPos = ep
         , _ptCrIgnore = Nothing
@@ -130,6 +131,24 @@ incBall vel = do
         , _ptZ          = 20
         }
 
+incBall' :: Particle -> Either Creature Wall -> Damage -> State StdGen Particle
+incBall' bt ecrwl dm = do
+    rot <- state $ randomR (0,3)
+    return PtZ 
+        { _ptDraw       = drawFlameletZ rot
+        , _ptUpdate     = moveFlamelet
+        , _ptVel        = vel
+        , _ptColor      = red
+        , _ptPos        = p
+        , _ptCrIgnore   = Nothing
+        , _ptWidth      = 3
+        , _ptTimer      = 20
+        , _ptHitEff     = damageBothTypeAmount Flaming 20
+        , _ptZ          = 20
+        }
+  where
+    vel = 0
+    p = _dmFrom dm
 concBall :: Point2 -> State g Particle
 concBall _ = return Shockwave
     { _ptDraw      = drawShockwave
@@ -284,9 +303,9 @@ Applies movement and attaches damage to nearby creatures.  -}
 moveFlamelet :: World -> Particle -> (World, Maybe Particle)
 moveFlamelet w pt 
     | _ptTimer pt <= 0 = (     w, Nothing)
-    | otherwise        = (ptFlicker pt $ damageInRadius 5 mvPt w,  Just mvPt)
+    | otherwise        = (ptFlicker pt $ damageInRadius 5 mvPt' w,  Just mvPt')
   where   
-    mvPt = pt 
+    mvPt' = pt 
         & ptTimer    -~ 1
         & ptPos      .~ _ptPos pt +.+ _ptVel pt
         & ptCrIgnore .~ Nothing