Cleanup damages further

2022-03-25 11:37:16 +00:00
parent af6cdfd048
commit cb9bdf9c55
8 changed files with 102 additions and 70 deletions
@@ -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 [BOUNCEMODULE]     "+BOUNCE"     (f $ destroyOnImpact bulBounceArmCr bulBounceWall)
+--        ,   [amod [INCENDIARYMODULE] "+INCENDIARY" (f $ bulletDestroySpawn incBall)
+        ,   [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)
            ]
@@ -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
-    _ -> (f,cr)
+    DamageSpawn f -> (instantParticles .:~ thepart, cr)
+      where
+        thepart = evalState (f (Left cr) dm) $ mkStdGen 0
  where
    fromDir = _dmFrom dm
    p = _dmAt dm
@@ -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)

@@ -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"
@@ -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
@@ -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
-    BounceBullet bt -> instantParticles .:~ thebouncer
+wallDamageEffect dm wl w = case _dmEffect dm of
+    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
@@ -1,6 +1,8 @@
 module Dodge.WorldEvent.HitEffect
    ( destroyOnImpact
    , penWalls
+    , mvPt
+    , destroyAt
    ) where
 import Dodge.Data
 import Geometry
@@ -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