Further cleanup

src/Dodge/Combine/Combinations.hs

@@ -3,7 +3,8 @@ module Dodge.Combine.Combinations where
 import Geometry
 import Dodge.Data
 import Dodge.WorldEvent.SpawnParticle
-import Dodge.Particle.Bullet.HitEffect
+import Dodge.Particle.HitEffect.ExpireAndDamage
+import Dodge.Particle.Damage
 import Dodge.Item.Equipment
 import Dodge.Item.Craftable
 import Dodge.Item.Weapon.BulletGuns
@@ -114,11 +115,10 @@ moduleCombinations =
         )
     ,   ( ModBullet
         ,   bulletWeapons
---        ,   [amod [INCENDIARYMODULE] "+INCENDIARY" (f $ bulletDestroySpawn incBall)
+        ,   [amod [INCENDIARYMODULE] "+INCENDIARY" (f $ expireAndDamage $ spawnAtBulDams incBall)
-        ,   [amod [INCENDIARYMODULE] "+INCENDIARY" (f $ bulletDestroyDamage $ spawnBulDams incBall')
+            ,amod [BOUNCEMODULE]     "+BOUNCE"     (f $ expireAndDamage bounceBulDams)
-            ,amod [BOUNCEMODULE]     "+BOUNCE"     (f $ bulletDestroyDamage bounceBulDams)
+            ,amod [STATICMODULE]     "+STATIC"     (f $ expireAndDamage $ spawnAtBulDams aStaticBall)
-            ,amod [STATICMODULE]     "+STATIC"     (f $ bulletDestroySpawn aStaticBall)
+            ,amod [CONCUSSMODULE]    "+CONCUSS"    (f $ expireAndDamage $ spawnAtBulDams concBall)
-            ,amod [CONCUSSMODULE]    "+CONCUSS"    (f $ bulletDestroySpawn concBall)
             ]
         )
     ,   ( ModTarget

src/Dodge/Creature/Damage.hs

@@ -13,12 +13,13 @@ import Data.List
 
 defaultApplyDamage :: [Damage] -> Creature -> World -> World
 defaultApplyDamage ds cr w = foldl' (applyIndividualDamage cr) w ds'
+    & creatures . ix (_crID cr) %~ doPoisonDam
   where 
-    (_,ds') = partition isPoison ds
+    (ps,ds') = partition isPoison ds
     isPoison Damage{_dmType=PoisonDam} = True
     isPoison _ = False
---    poisonDam = quot (max 0 (sum (map _dmAmount ps))) 10
+    poisonDam = quot (max 0 (sum (map _dmAmount ps))) 10
---    doPoisonDam = crHP -~ poisonDam
+    doPoisonDam = crHP -~ poisonDam
 
 applyDamageEffect :: Damage -> DamageEffect -> Creature -> World -> World
 applyDamageEffect dm de cr w = case de of
@@ -54,8 +55,6 @@ applyDamageEffect dm de cr w = case de of
 applyIndividualDamage :: Creature -> World -> Damage -> World
 applyIndividualDamage cr w dm = applyDamageEffect dm (_dmEffect dm) cr $ applyIndividualDamage' cr w dm
 
---      & applyDamageEffect dm (_dmEffect dm)
-
 applyIndividualDamage' :: Creature -> World -> Damage -> World
 applyIndividualDamage' cr w dm = case _dmType dm of
     Piercing -> applyPiercingDamage cr dm w

src/Dodge/Data.hs

@@ -1012,7 +1012,6 @@ data DamageEffect
     | TorqueDamage { _deTorque :: Float }
     | PushBackDamage {_dePushBack :: Point2 }
     | BounceBullet {_bulToBounce :: Particle}
-    | SparkBullet {_bulToSpark :: Particle}
     | DamageSpawn {_spawnFunc 
         :: Either Creature Wall -> Damage -> State StdGen Particle}
     | NoDamageEffect

src/Dodge/Item/Weapon/Bullet.hs

@@ -3,15 +3,17 @@ module Dodge.Item.Weapon.Bullet
     , hvBullet
     ) where
 import Dodge.Data
-import Dodge.WorldEvent.HitEffect
+import Dodge.Particle.HitEffect
 import Dodge.Particle.Bullet.HitEffect
+import Dodge.Particle.Damage
+import Dodge.Particle.HitEffect.ExpireAndDamage
 
 import Geometry.Data
 basicBullet :: AmmoType
 basicBullet = BulletAmmo
     { _amString = "BASIC"
     --, _amBulEff = destroyOnImpact bulHitCr bulHitWall
-    , _amBulEff = bulletDestroyDamage basicBulDams
+    , _amBulEff = expireAndDamage basicBulDams
     , _amBulWth = 2
     , _amBulVel = V2 50 0
     , _amBulTraj = BasicBulletTrajectory

src/Dodge/Particle/Bullet/DestroyDamage.hs

@@ -1,40 +0,0 @@
-module Dodge.Particle.Bullet.DestroyDamage
-    ( bulletDestroyDamage
-    ) where
-import Dodge.Data
-import Dodge.WorldEvent.HitEffect
-import Dodge.Wall.Damage
-import Geometry
-import LensHelp
-
-bulletDestroyDamage :: DamageType
-    -> Int  -- | damage amount
-    -> Particle 
-    -> [(Point2, Either Creature Wall)] 
-    -> World 
-    -> (World, Maybe Particle)
-bulletDestroyDamage dt amount = destroyOnImpact 
-    (bulDamageCr dt amount) 
-    (bulDamageWall dt amount)
-
-bulDamageCr :: DamageType -> Int
-    -> Particle -> Point2 -> Creature -> World -> World
-bulDamageCr dt amount bt p cr w = w
-    & creatures . ix cid . crState . crDamage .:~ Damage dt amount sp p ep NoDamageEffect
-  where   
-    cid = _crID cr
-    sp = head $ _ptTrail bt
-    ep = sp +.+ _ptVel bt
-
-bulDamageWall :: DamageType
-    -> Int
-    -> Particle
-    -> Point2   -- Impact point
-    -> Wall 
-    -> World 
-    -> World
-bulDamageWall dt amount bt p wl w = w
-    & damageWall (Damage dt amount sp p ep NoDamageEffect) wl 
-  where   
-    ep = sp +.+ _ptVel bt
-    sp = head $ _ptTrail bt

src/Dodge/Particle/Bullet/HitEffect.hs

@@ -1,72 +1,17 @@
 {- | Effects of bullets upon impact with walls or creatures.  -}
 module Dodge.Particle.Bullet.HitEffect 
-    ( basicBulDams
+    ( hvBulHitCr
-    , bounceBulDams
-    , spawnBulDams
-    , hvBulHitCr
     , hvBulHitWall
-    , bulletDestroySpawn
-    , bulletDestroyDamage
-    , bulBounceCr
---    , bulBounceWall
     ) where
 import Dodge.Data
 import Dodge.Particle.Spark
 import Dodge.Wall.Damage
-import Dodge.WorldEvent
---import Dodge.WorldEvent.HitEffect
-import Dodge.RandomHelp
 import Dodge.Wall.Reflect
 import Geometry
 import Picture
 import LensHelp
 
 import System.Random
-import Control.Monad.State
-
-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
-
--- | Basic bullet hit creature effect.
-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 (BounceBullet bt) : mvDams)
-    cid = _crID cr
-
 {- | Heavy bullet effects when hitting creature:
 piercing, blunt, twisting and pushback damage all applied.  -}
 hvBulHitCr :: Particle -> Point2 -> Creature -> World -> World
@@ -87,62 +32,24 @@ damageGamut pdam bdam tor sp p ep =
     ,Damage PushDam 1 sp p ep . PushBackDamage $ 3 *.* (ep -.- sp)
     ] 
 
-bulletDestroySpawn :: (Point2 -> State StdGen Particle)
+--bulletDestroyDamage :: (Particle -> Point2 -> [Damage])
-    -> Particle 
+--    -> Particle
-    -> [(Point2, Either Creature Wall)] 
+--    -> [(Point2, Either Creature Wall)] 
-    -> World 
+--    -> World
-    -> (World, Maybe Particle)
+--    -> (World, Maybe Particle)
-bulletDestroySpawn f = destroyOnImpact (bulDestroyCr f) (bulDestroyWall f)
+--bulletDestroyDamage fdm bt hitThings w = case hitThings of
-
+--    [] -> (w, mvPt bt)
-bulletDestroyDamage :: (Particle -> Point2 -> [Damage])
+--    ((p,Left cr):_) -> (creff cr p w, destroyAt p bt)
-    -> Particle
+--    ((p,Right wl):_) -> (wleff wl p, destroyAt p bt)
-    -> [(Point2, Either Creature Wall)] 
+--  where
-    -> World
+--    creff cr p = addDamage 
-    -> (World, Maybe Particle)
+--      where
-bulletDestroyDamage fdm bt hitThings w = case hitThings of
+--        dams = fdm bt p
-    [] -> (w, mvPt bt)
+--        addDamage = creatures . ix cid . crState . crDamage .++~ dams
-    ((p,Left cr):_) -> (creff cr p w, destroyAt p bt)
+--        cid = _crID cr
-    ((p,Right wl):_) -> (wleff wl p, destroyAt p bt)
+--    wleff wl p = foldr (`damageWall` wl) w dams
-  where
+--      where
-    creff cr p = addDamage 
+--        dams = fdm bt p
-      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
-bulDestroyCr f bt p cr w = w
-    & instantParticles .:~ (pt & ptPos .~ p)
-    & creatures . ix cid . crState . crDamage .:~ Damage Piercing 60 sp p ep NoDamageEffect
-    & randGen .~ g
-  where   
-    (pt,g) = randInCirc 1 >>= f & runState $ _randGen w
-    cid = _crID cr
-    sp = head $ _ptTrail bt
-    ep = sp +.+ _ptVel bt
-
-bulDestroyWall :: (Point2 -> State StdGen Particle) 
-    -> Particle 
-    -> Point2   -- Impact point
-    -> Wall 
-    -> World 
-    -> World
-bulDestroyWall f bt p wl w = w
-    & damageWall (Damage Piercing 60 sp p ep NoDamageEffect) wl 
-    & (instantParticles .:~ (pt & ptPos .~ pOut))
-    & randGen .~ g
-  where   
-    (pt,g) = runState (f reflectVel) (_randGen w)
-    ep = sp +.+ _ptVel bt
-    sp = head $ _ptTrail bt
-    pOut = p +.+ squashNormalizeV (sp -.- p)
-    wallV = uncurry (-.-) (_wlLine wl)
-    reflectVel = squashNormalizeV $ reflectIn wallV (_ptVel bt)
 
 hvBulHitWall
     :: Particle 

src/Dodge/Particle/Spark.hs

@@ -3,12 +3,13 @@ module Dodge.Particle.Spark
     , colSparkRandDir
     , createBarrelSpark
     , randColDirTimeSpark
-    )
+    ) where
-    where
 import Dodge.Data
+import Dodge.Particle.HitEffect.ExpireAndDamage
 import Dodge.Particle.Bullet.Draw
+import Dodge.Particle.Damage
+--import Dodge.Particle.Bullet.HitEffect
 import Dodge.Particle.Bullet.Update
-import Dodge.Particle.Bullet.DestroyDamage
 --import Dodge.WorldEvent.HitEffect
 import Color
 import Geometry
@@ -29,7 +30,7 @@ createBarrelSpark pos dir maycid time colid = instantParticles .:~ BulletPt
     , _ptCrIgnore = maycid
     , _ptWidth = 1
     , _ptTimer = time
-    , _ptHitEff = bulletDestroyDamage SparkDam 1
+    , _ptHitEff = expireAndDamage basicSparkDams
     }
 colSpark :: Int -> Color -> Point2 -> Float -> World -> World
 colSpark = colSparkRandDir 0.7
@@ -60,7 +61,7 @@ randColDirTimeSpark randcol randdir randtime pos w = w
         , _ptCrIgnore = Nothing
         , _ptWidth = 1
         , _ptTimer = time
-        , _ptHitEff = bulletDestroyDamage SparkDam 1
+        , _ptHitEff = expireAndDamage basicSparkDams
         }
 
 colSparkRandDir :: Float -> Int -> Color -> Point2 -> Float -> World -> World
@@ -80,5 +81,5 @@ colSparkRandDir randDir time col pos baseDir w = w
         , _ptCrIgnore = Nothing
         , _ptWidth = 1
         , _ptTimer = time
-        , _ptHitEff = bulletDestroyDamage SparkDam 1
+        , _ptHitEff = expireAndDamage basicSparkDams
         }

src/Dodge/WorldEvent.hs

@@ -2,13 +2,11 @@ module Dodge.WorldEvent
     ( module Dodge.WorldEvent.Flash
     , module Dodge.WorldEvent.ThingsHit
     , module Dodge.WorldEvent.Cloud
-    , module Dodge.WorldEvent.HitEffect
     , module Dodge.WorldEvent.Explosion
     , module Dodge.WorldEvent.SpawnParticle
     ) where
 import Dodge.WorldEvent.Flash
 import Dodge.WorldEvent.ThingsHit
 import Dodge.WorldEvent.Cloud
-import Dodge.WorldEvent.HitEffect
 import Dodge.WorldEvent.Explosion
 import Dodge.WorldEvent.SpawnParticle

src/Dodge/WorldEvent/HitEffect.hs

@@ -1,62 +0,0 @@
-module Dodge.WorldEvent.HitEffect
-    ( destroyOnImpact
-    , penWalls
-    , mvPt
-    , destroyAt
-    ) where
-import Dodge.Data
-import Geometry
-import LensHelp
-
-import Data.Bifunctor
-
-type HitCreatureEffect   = Particle -> Point2 -> Creature   -> World -> World
-type HitWallEffect       = Particle -> Point2 -> Wall       -> World -> World
-
-destroyOnImpact 
-    :: HitCreatureEffect 
-    -> HitWallEffect 
-    -> Particle 
-    -> [(Point2, Either Creature Wall)] 
-    -> World 
-    -> (World, Maybe Particle)
-destroyOnImpact crEff wlEff pt hitThings w = case hitThings of
-        []              -> (              w, mvPt pt)
-        ((p,Left  cr):_) -> (crEff pt p cr w, destroyAt p pt)
-        ((p,Right wl):_) -> (wlEff pt p wl w, destroyAt p pt)
-
-mvPt :: Particle -> Maybe Particle
-mvPt pt = Just $ pt
-    & ptTrail %~ f
-    & ptTimer -~ 1
-    & ptCrIgnore .~ Nothing
-  where
-    f trl = head trl +.+ _ptVel pt : trl
-
-destroyAt :: Point2 -> Particle -> Maybe Particle
-destroyAt hitp pt = Just $ pt 
-    & ptUpdate .~ killBulletUpdate
-    & ptTrail  .:~ hitp
-    & ptTimer %~ (min 3 . subtract 1)
-
-killBulletUpdate :: World -> Particle -> (World,Maybe Particle)
-killBulletUpdate w pt 
-    | _ptTimer pt <= 0 = (w,Nothing)
-    | otherwise = (w
-        , Just $ pt & ptTimer -~ 1
-            & ptTrail %~ (\(x:xs) -> x:x:xs)
-        )
-
-penWalls 
-    :: HitCreatureEffect 
-    -> HitWallEffect 
-    -> Particle 
-    -> [(Point2, Either Creature Wall)] 
-    -> World 
-    -> (World, Maybe Particle)
-penWalls crEff wlEff pt hitThings w = case hitThings of
-    []              -> (              w, mvPt pt)
-    ((p,Left cr):_) -> (crEff pt p cr w, destroyAt p pt)
-    ((p,Right wl):hs) | _wlFireThrough wl 
-                    -> first (wlEff pt p wl) $ penWalls crEff wlEff pt hs w
-    ((p,Right wl):_) -> (wlEff pt p wl w, destroyAt p pt)

src/Dodge/WorldEvent/SpawnParticle.hs

@@ -4,22 +4,21 @@ module Dodge.WorldEvent.SpawnParticle
     , aFlameParticle
     , makeFlamelet
     , aStaticBall
-    , makeStaticBall
     , incBall
-    , incBall'
     , concBall
     ) where
 import Dodge.Data
 import Dodge.Base
 import Dodge.Zone
-import Dodge.WorldEvent.HitEffect
+import Dodge.Particle.HitEffect.ExpireAndDamage
+import Dodge.Particle.Damage
+--import Dodge.WorldEvent.HitEffect
 import Dodge.WorldEvent.ThingsHit
 import Dodge.WorldEvent.Cloud
 import Dodge.WorldEvent.Flash
 import Dodge.WorldEvent.Shockwave
 import Dodge.SoundLogic
 import Dodge.RandomHelp
-import Dodge.Wall.Damage
 import Picture
 import Geometry
 import qualified IntMapHelp as IM
@@ -43,7 +42,7 @@ aFlameParticle t pos vel maycid = PtZ
     , _ptCrIgnore   = maycid
     , _ptWidth      = 4
     , _ptTimer      = t
-    , _ptHitEff     = damageBothTypeAmount Flaming 20
+    , _ptHitEff     = expireAndDamage $ simpleDam Flaming 20
     , _ptZ           = 20
     }
 drawFlame
@@ -127,28 +126,10 @@ incBall vel = do
         , _ptCrIgnore   = Nothing
         , _ptWidth      = 3
         , _ptTimer      = 20
-        , _ptHitEff     = damageBothTypeAmount Flaming 20
+        , _ptHitEff     = expireAndDamage $ simpleDam Flaming 20
         , _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
@@ -173,34 +154,10 @@ aStaticBall vel = return PtZ
     , _ptCrIgnore   = Nothing
     , _ptWidth      = 3
     , _ptTimer      = 20
-    , _ptHitEff     = damageBothTypeAmount Electrical 20
+    , _ptHitEff     = expireAndDamage $ simpleDam Electrical 20
     , _ptZ = 20
     }
 
-
-makeStaticBall
-    :: Point2       -- ^ Position
-    -> Float        -- ^ z position
-    -> Point2       -- ^ Velocity
-    -> Maybe Int    -- ^ Ignore creature id
-    -> Float        -- ^ Size
-    -> Int          -- ^ Timer
-    -> World 
-    -> World
-makeStaticBall (V2 x y) z vel maycid size time w = w
-    & instantParticles .:~ PtZ 
-        { _ptDraw       = drawStaticBall
-        , _ptUpdate     = moveStaticBall
-        , _ptVel        = vel
-        , _ptColor      = blue
-        , _ptPos        = V2 x y
-        , _ptCrIgnore   = maycid
-        , _ptWidth      = size
-        , _ptTimer      = time
-        , _ptHitEff     = damageBothTypeAmount Electrical 20
-        , _ptZ = z
-        }
-
 makeFlamelet
     :: Point2       -- ^ Position
     -> Float        -- ^ z position
@@ -221,26 +178,26 @@ makeFlamelet (V2 x y) z vel maycid size time w = w
         , _ptCrIgnore   = maycid
         , _ptWidth      = size
         , _ptTimer      = time
-        , _ptHitEff     = damageBothTypeAmount Flaming 20
+        , _ptHitEff     = expireAndDamage $ simpleDam Flaming 20
         , _ptZ = z
         }
   where
     (rot ,g) = randomR (0,3) $ _randGen w
 
-damageBothTypeAmount :: DamageType
+--damageBothTypeAmount :: DamageType
-    -> Int
+--    -> Int
-    -> Particle 
+--    -> Particle 
-    -> [(Point2, Either Creature Wall)] 
+--    -> [(Point2, Either Creature Wall)] 
-    -> World 
+--    -> World 
-    -> (World, Maybe Particle)
+--    -> (World, Maybe Particle)
-damageBothTypeAmount dt amount = destroyOnImpact
+--damageBothTypeAmount dt amount = destroyOnImpact
-    (\pt p cr -> creatures . ix (_crID cr) . crState . crDamage .:~ thedam pt p)
+--    (\pt p cr -> creatures . ix (_crID cr) . crState . crDamage .:~ thedam pt p)
-    (\pt p -> damageWall (thedam pt p))
+--    (\pt p -> damageWall (thedam pt p))
-  where
+--  where
-    thedam pt p = Damage dt amount sp p ep NoDamageEffect
+--    thedam pt p = Damage dt amount sp p ep NoDamageEffect
-      where
+--      where
-        sp = _ptPos pt
+--        sp = _ptPos pt
-        ep = sp +.+ _ptVel pt
+--        ep = sp +.+ _ptVel pt
 
 drawStaticBall
     :: Particle