Start to move damage effects of bullets into a more sensible place

src/Dodge/Creature/Damage.hs

@@ -1,12 +1,12 @@
 module Dodge.Creature.Damage where
 import Dodge.Data
-import Dodge.SoundLogic
 import Dodge.Creature.Property
 import Dodge.Particle.Spark
+import Dodge.Particle.Bullet.Spawn
 import Color
 import Geometry
+import LensHelp
 
-import Control.Lens
 import Data.List
 
 defaultApplyDamage :: [Damage] -> Creature -> (World -> World, Creature)
@@ -18,34 +18,52 @@ defaultApplyDamage ds cr = over _2 doPoisonDam $ foldl' applyIndividualDamage (i
     poisonDam = quot (max 0 (sum (map _dmAmount ps))) 10
     doPoisonDam = crHP -~ poisonDam
 
-applyDamageEffect :: Damage -> DamageEffect -> Creature -> Creature
-applyDamageEffect dm de cr = case de of
-    NoDamageEffect -> cr
-    PushDamage push pushexp pushRad -> cr 
-        & crPos %~ (+.+ (pushAmount *.* squashNormalizeV (_crPos cr -.- fromDir))) 
+applyDamageEffect :: Damage -> DamageEffect -> (World->World,Creature) -> (World -> World, Creature)
+applyDamageEffect dm de (f,cr) = case de of
+    PushDamage push pushexp pushRad -> (f, cr 
+        & crPos %~ (+.+ (pushAmount *.* squashNormalizeV (_crPos cr -.- fromDir))) )
       where
         pushAmount
             | dist (_crPos cr) fromDir == 0 = 0
             | otherwise = min 5 $ (push*5*pushRad / (dist (_crPos cr) fromDir * _crMass cr))**pushexp
-    PushBackDamage pback -> cr
+    PushBackDamage pback -> (f, cr
         & crPos %~ (+.+ ((1/_crMass cr) *.* pback ))
-    TorqueDamage rot -> cr & crDir +~ rot
+        )
+    TorqueDamage rot -> (f, cr & crDir +~ rot)
+    BounceBullet bt | crIsArmouredFrom p cr -> (f . (instantParticles .:~ bouncer), cr) -- TODO
+      where
+        bouncer = (aBulAt Nothing id (Just (_ptColor bt)) Nothing pOut reflectVel (_btDrag bt)
+                                          (_ptHitEff bt) (_ptWidth bt)
+                  ) {_ptTimer = _ptTimer bt - 1}
+        pOut = p +.+ 2 *.* newDir
+        reflectVel = magV bulVel *.* newDir
+        newDir = squashNormalizeV (p -.- _crPos cr)
+        bulVel = _ptVel bt
+    SparkBullet _ -> (f, cr) -- TODO
+    _ -> (f,cr)
   where
     fromDir = _dmFrom dm
+    p = _dmAt dm
 
 applyIndividualDamage :: (World -> World, Creature) -> Damage -> (World -> World, Creature)
-applyIndividualDamage (f,cr) dm = case _dmType dm of
+applyIndividualDamage (f,cr) dm = applyDamageEffect dm (_dmEffect dm) (f . f', cr')
+  where
+    (f',cr') = applyIndividualDamage' (f,cr) dm
+
+--      & applyDamageEffect dm (_dmEffect dm)
+
+applyIndividualDamage' :: (World -> World, Creature) -> Damage -> (World -> World, Creature)
+applyIndividualDamage' (f,cr) dm = case _dmType dm of
     Piercing -> applyPiercingDamage cr dm & _1 %~ (. f)
     _ -> (f , newcr )
   where
     newcr = cr
       & crHP -~ _dmAmount dm
-      & applyDamageEffect dm (_dmEffect dm)
 
 applyPiercingDamage :: Creature -> Damage -> (World -> World, Creature)
 applyPiercingDamage cr dm
     | crIsArmouredFrom p cr = (colSpark 8 (brightX 10 1.5 orange) p1 (argV (p1 -.- p)) , cr) 
-    | otherwise = (id,cr & crHP -~ _dmAmount dm & applyDamageEffect dm (_dmEffect dm))
+    | otherwise = (id, cr & crHP -~ _dmAmount dm)
   where
     p = _dmAt dm
     p1 = p +.+ 2 *.* squashNormalizeV (p -.- _crPos cr)

src/Dodge/Creature/State/Data.hs

@@ -4,18 +4,10 @@ module Dodge.Creature.State.Data
   where
 --import Geometry
 import Geometry.Data
-import Dodge.Data.DamageType
 import Color
 
 import Control.Lens
 import qualified Data.IntSet as IS
-import qualified Data.Vector as V
-data CreatureState = CrSt 
-    { _crDamage  :: [Damage]
-    , _crPastDamage :: V.Vector [Damage]
-    , _crSpState :: CrSpState
-    , _crDropsOnDeath :: CreatureDropType
-    }
 data CreatureDropType
     = DropAll
     | DropAmount Int
@@ -43,5 +35,4 @@ data CrGroup
     | CrGroupID { _crGroupID :: Int }
     | ShieldGroup
   deriving (Eq, Show)
-makeLenses ''CreatureState
 makeLenses ''CrSpState