Add bullet damages field, move bullet data into own file

src/Dodge/Bullet.hs

@@ -1,5 +1,5 @@
 module Dodge.Bullet where
-import Dodge.Particle.Damage
+import Dodge.WorldEvent.SpawnParticle
 import Dodge.Creature.Test
 import Dodge.Data
 import Dodge.Particle.HitEffect.ExpireAndDamage
@@ -14,6 +14,8 @@ import qualified Streaming.Prelude as S
 import Data.Maybe
 import Dodge.Movement.Turn
 import Dodge.WorldEvent.ThingsHit
+import Control.Monad.State
+import System.Random
 
 --import Data.Bifunctor
 
@@ -33,8 +35,9 @@ aBulAt
     -> BulletTrajectory
     -> BulletEffect
     -> BulletSpawn
+    -> [Damage]
     -> Bullet
-aBulAt vfact pos vel drag width butraj be bs = Bullet
+aBulAt vfact pos vel drag width butraj be bs dams = Bullet
     { _buState = bulstate
     , _buSpawn = bs
     , _buEffect = be
@@ -46,6 +49,7 @@ aBulAt vfact pos vel drag width butraj be bs = Bullet
     , _buOldPos = pos
     , _buWidth = width
     , _buTimer = 100
+    , _buDamages = dams
     }
   where
     bulstate = maybe NormalBulletState DelayedBullet vfact
@@ -60,6 +64,7 @@ useAmmoParams vfact it cr w = w & instantBullets .:~ aBulAt
     thetraj
     (_amBulEffect bultype)
     (_amBulSpawn bultype)
+    (_amBulDams bultype)
   where
     sp = _crPos cr +.+ (muzlength + 10) *.* unitVectorAtAngle dir
     dir = _crDir cr
@@ -87,15 +92,21 @@ useAmmoParams vfact it cr w = w & instantBullets .:~ aBulAt
 mvBullet :: World -> Bullet -> (World, Maybe Bullet)
 mvBullet w bt' 
     | t <= 0 || magV (_buVel bt) < 1 = (w,Nothing)
-    | otherwise = bimap maybebounce (fmap dodrag) $ 
+    | otherwise = bimap (maybespawn . maybebounce) (fmap dodrag) $ 
         hiteff bt hitstream w
   where
+    maybespawn w' = fromMaybe w' $ do
+        (hp,_) <- runIdentity (S.head_ hitstream)
+        partspawn <- bulletSpawn bt'
+        let (thepart,g) = runState (partspawn hp) $ _randGen w'
+        return $ w' & instantParticles .:~ thepart
+            & randGen .~ g
     maybebounce = case _buEffect bt' of
         BounceBullet -> case runIdentity (S.head_ hitstream) of
             Just (hp, Left cr) | crIsArmouredFrom hp cr -> instantBullets .:~ bouncer
               where
                 bouncer = (aBulAt Nothing pOut reflectVel (_buDrag bt) (_buWidth bt) 
-                            BasicBulletTrajectory (_buEffect bt) (_buSpawn bt)
+                            BasicBulletTrajectory (_buEffect bt) (_buSpawn bt) (_buDamages bt)
                           ) {_buTimer = _buTimer bt - 1}
                 pOut = hp +.+ 2 *.* newDir
                 reflectVel = magV bulVel *.* newDir
@@ -106,7 +117,7 @@ mvBullet w bt'
                 reflectVel = reflVelWall wl (_buVel bt)
                 thebouncer = aBulAt Nothing --id 
                     pOut reflectVel (_buDrag bt) (_buWidth bt) BasicBulletTrajectory (_buEffect bt)
-                        (_buSpawn bt)
+                        (_buSpawn bt) (_buDamages bt)
                     & buTimer .~ _buTimer bt - 1
                 pOut = hp +.+ squashNormalizeV (p -.- hp)
             _ -> id
@@ -125,31 +136,23 @@ mvBullet w bt'
     vel     = _buVel bt
     hiteff  = hitEffFromBul
     t       = _buTimer bt
-    --BounceBullet bt -> w & instantBullets .:~ thebouncer
+
-    --  where
+bulletSpawn :: Bullet -> Maybe (Point2 -> State StdGen Particle)
-    --    reflectVel = reflVelWall wl (_buVel bt)
+bulletSpawn bu = case _buSpawn bu of
-    --    thebouncer = aBulAt Nothing --id 
+    BulSpark -> Nothing
-    --        pOut reflectVel (_buDrag bt) (_buHitEff bt) (_buWidth bt) BasicBulletTrajectory
+    BulBall IncBall -> Just incBall
-    --        & buTimer .~ _buTimer bt - 1
+    BulBall ConcBall -> Just concBall
-    --    pOut = p +.+ squashNormalizeV (sp -.- p)
+    BulBall TeslaBall -> Just aStaticBall
-    --    p = _dmAt dm
-    --    sp = _dmFrom dm
---    BounceBullet bt | crIsArmouredFrom p cr -> w & instantBullets .:~ bouncer
---      where
---        bouncer = (aBulAt Nothing pOut reflectVel (_buDrag bt) (_buHitEff bt) (_buWidth bt) 
---                    BasicBulletTrajectory
---                  ) {_buTimer = _buTimer bt - 1}
---        pOut = p +.+ 2 *.* newDir
---        reflectVel = magV bulVel *.* newDir
---        newDir = squashNormalizeV (p -.- _crPos cr)
---        bulVel = _buVel bt
---    BounceBullet _ -> w
 
 hitEffFromBul :: Bullet
     -> Stream (Of (Point2, Either Creature Wall)) Identity ()
     -> World 
     -> (World,Maybe Bullet)
-hitEffFromBul = expireAndDamage' basicBulDams
+hitEffFromBul = expireAndDamage' setfromtodams
+  where
+    setfromtodams bu p = map f (_buDamages bu)
+      where
+        f = (dmFrom .~ _buPos bu) . (dmAt .~ p) . (dmTo .~ _buPos bu +.+ _buVel bu)
 
 mvBulletSlow :: Float -> World -> Bullet -> (World, Maybe Bullet)
 mvBulletSlow x w bt' 

src/Dodge/Combine/Module.hs

@@ -1,8 +1,6 @@
 module Dodge.Combine.Module where
 import Dodge.Data
 import Dodge.Tesla
-import Dodge.WorldEvent.SpawnParticle
-import Dodge.Particle.Damage
 import Dodge.Item.Weapon.ExtraEffect
 import Dodge.Item.Weapon.Launcher
 import Dodge.Item.Weapon.TriggerType
@@ -19,10 +17,10 @@ moduleModification imt = case imt of
     DRUMMAG     -> itConsumption . laMax .~ 45
     BELTMAG     -> itConsumption . laMax .~ 150
     MAGNETMAG   -> itUse . useDelay . rateMax .~ 4
-    INCENDBUL   -> f $ spawnAtBulDams incBall
+    INCENDBUL   -> itConsumption . laAmmoType . amBulSpawn .~ BulBall IncBall
     BOUNCEBUL   -> itConsumption . laAmmoType . amBulEffect .~ BounceBullet 
-    STATICBUL   -> f $ spawnAtBulDams aStaticBall
+    STATICBUL   -> itConsumption . laAmmoType . amBulSpawn .~ BulBall TeslaBall
-    CONCUSBUL   -> f $ spawnAtBulDams concBall
+    CONCUSBUL   -> itConsumption . laAmmoType . amBulSpawn .~ BulBall ConcBall
     TARGCR      -> itTargeting .~ targetRBCreature
     TARGLAS     -> itTargeting .~ targetLaser
     TARGPOS     -> itTargeting .~ targetRBPress
@@ -39,7 +37,6 @@ moduleModification imt = case imt of
     EXTRABATTERY -> itConsumption . laMax +~ 1000
     ATTACHTORCH  -> id
   where
-    f ameff = itConsumption . laAmmoType . amBulDams .~ ameff
     makeDirectedTele it = it 
         & itTargeting .~ targetRBPress
         & itUse . useMods .:~ withPosDirWallCheck directedTelPos

src/Dodge/Creature.hs

@@ -238,6 +238,8 @@ inventoryX c = case c of
         , makeTypeCraftNum 1 HEATSENSOR
         , makeTypeCraftNum 1 BOUNCEMODULE
         , makeTypeCraftNum 1 INCENDIARYMODULE
+        , makeTypeCraftNum 1 CONCUSSMODULE
+        , makeTypeCraftNum 1 STATICMODULE
         ]
     _ -> []
 

src/Dodge/Creature/Damage.hs

@@ -7,8 +7,6 @@ import Color
 import Geometry
 import LensHelp
 
-import Control.Monad.State
---import System.Random
 import Data.List
 
 applyNoDamage :: [Damage] -> Creature -> World -> World
@@ -39,17 +37,13 @@ applyDamageEffect dm de cr w = case de of
             | dist (_crPos cr) fromDir == 0 = 0
             | otherwise = min 5 $ (push*5*pushRad / (dist (_crPos cr) fromDir * _crMass cr))**pushexp
     PushBackDamage pback -> w
-        & creatures . ix (_crID cr) . crPos .+.+~ (1/_crMass cr) *.* pback
+        & creatures . ix (_crID cr) . crPos .+.+~ (pback/_crMass cr) *.* (_dmTo dm -.- fromDir)
     TorqueDamage rot -> w
         & creatures . ix (_crID cr) . crDir +~ rot
-    DamageSpawn f -> w & instantParticles .:~ thepart
+--    DamageSpawn f -> w & instantParticles .:~ thepart
-        & randGen .~ g
+--        & randGen .~ g
-      where
+--      where
-        (thepart,g) = runState (f (Left cr) dm) $ _randGen w
+--        (thepart,g) = runState (f (Left cr) dm) $ _randGen w
-    DamageSpawn' f -> w & instantBullets .:~ thepart
-        & randGen .~ g
-      where
-        (thepart,g) = runState (f (Left cr) dm) $ _randGen w
     NoDamageEffect -> w
   where
     fromDir = _dmFrom dm

src/Dodge/Creature/Inanimate.hs

@@ -96,7 +96,7 @@ damToExpBarrel' dm cr = case _dmType dm of
         $ cr & crHP -~ div amount 200
     POISONDAM   -> cr
     SPARKING    -> cr
-    PUSHDAM     -> cr LensHelp.& crPos .+.+~ (1 / _crMass cr *.* _dePushBack (_dmEffect dm))
+--    PUSHDAM     -> cr LensHelp.& crPos .+.+~ (1 / _crMass cr *.* _dePushBack (_dmEffect dm))
     _  -> cr LensHelp.& crHP -~ amount
   where
     amount = _dmAmount dm

src/Dodge/Data.hs

@@ -10,6 +10,7 @@ circular imports are probably not a good idea.
 {-# LANGUAGE DerivingStrategies #-}
 module Dodge.Data 
     ( module Dodge.Data
+    , module Dodge.Data.Bullet
     , module Dodge.Data.Door
     , module Dodge.Data.Item
     , module Dodge.Data.HUD
@@ -46,6 +47,7 @@ module Dodge.Data
     , module Dodge.Data.RadarBlip
     , module Dodge.Data.PathGraph
     ) where
+import Dodge.Data.Bullet
 import Dodge.Data.Door
 import Dodge.Data.Item
 import Dodge.Data.HUD
@@ -524,34 +526,6 @@ data BeamType
         {_beamCombine :: (Point2 , (Point2,Point2,Beam) , (Point2,Point2,Beam)) -> World -> World}
     | BeamSimple
 
-data BulletState = NormalBulletState
-    | DyingBulletState
-    | DelayedBullet Float
-data BulletUpdateMod = NoBulletUpdateMod
-
-data BulletEffect = DestroyBullet
-    | BounceBullet
-    | PenetrateBullet
-data BulletSpawn = BulBall EnergyBall | BulSpark
-
-data Bullet = Bullet
-    { _buState  :: BulletState
-    , _buEffect :: BulletEffect
-    , _buSpawn  :: BulletSpawn
-    , _buUpdateMod :: BulletUpdateMod
-    , _buTrajectory :: BulletTrajectory
-    , _buVel    :: Point2
-    , _buDrag   :: Float
-    , _buPos    :: Point2
-    , _buOldPos :: Point2
-    , _buWidth  :: Float 
-    , _buTimer  :: Int
---    , _buEffect :: BulletEffect
---    , _buHitEff :: HitEffect'
-    }
-
-data EnergyBall = IncBall | TeslaBall | ConcBall
-
 {- Objects without ids.
 Update themselves, perhaps with side effects.  -}
 data Particle
@@ -655,17 +629,6 @@ type HitEffect = Particle
     -> World 
     -> (World,Maybe Particle)
 
---type HitEffect' = Bullet 
---    -> Stream (Of (Point2, Either Creature Wall)) Identity ()
---    -> World 
---    -> (World,Maybe Bullet)
-
-data BulletTrajectory
-    = BasicBulletTrajectory
-    | BezierTrajectory Point2 Point2 Point2
-    | FlechetteTrajectory Point2
-    | MagnetTrajectory Point2
-
 data AmmoType
     = ProjectileAmmo
         { _amPayload :: Point2 -> World -> World
@@ -677,7 +640,7 @@ data AmmoType
     | BulletAmmo
         { _amString :: String 
 --        , _amBulEff :: HitEffect'
-        , _amBulDams :: Bullet -> Point2 -> [Damage]
+        , _amBulDams :: [Damage]
         , _amBulWth :: Float
         , _amBulVel :: Point2
         , _amBulTraj :: BulletTrajectory
@@ -1260,39 +1223,6 @@ data Goal
     | SentinelAt Point2 Float
   deriving (Show)
 
-data DamageEffect
-    = PushDamage 
-        { _dePush :: Float 
-        , _dePushExp :: Float
-        , _dePushRadius :: Float
-        }
-    | TorqueDamage { _deTorque :: Float }
-    | PushBackDamage {_dePushBack :: Point2 }
-    | DamageSpawn {_spawnFunc 
-        :: Either Creature Wall -> Damage -> State StdGen Particle}
-    | DamageSpawn' {_spawnFunc' 
-        :: Either Creature Wall -> Damage -> State StdGen Bullet}
-    | NoDamageEffect
---  deriving (Eq,Ord,Show)
-
-data Damage = Damage 
-    { _dmType :: DamageType
-    , _dmAmount :: Int , _dmFrom :: Point2 , _dmAt :: Point2 , _dmTo :: Point2 
-    , _dmEffect :: DamageEffect
-    }
---  deriving (Eq,Ord,Show)
-
-isElectrical :: Damage -> Bool
-isElectrical dm = case _dmType dm of
-    ELECTRICAL -> True
-    _ -> False
-
-isMovementDam :: Damage -> Bool
-isMovementDam dm = case _dmType dm of
-    TORQUEDAM -> True
-    PUSHDAM -> True
-    _ -> False
-
 data CreatureState = CrSt 
     { _csDamage  :: [Damage]
     , _csSpState :: CrSpState
@@ -1413,8 +1343,6 @@ data InPlacement = InPlacement
     }
 
 makeLenses ''CreatureState
-makeLenses ''Damage
-makeLenses ''DamageEffect
 makeLenses ''World
 makeLenses ''Creature
 makeLenses ''Item
@@ -1427,7 +1355,6 @@ makeLenses ''TweakParam
 makeLenses ''Prop
 makeLenses ''Modification
 makeLenses ''Particle
-makeLenses ''Bullet
 makeLenses ''PressPlate
 makeLenses ''Button
 makeLenses ''ActionPlan

src/Dodge/Data/Bullet.hs

@@ -0,0 +1,38 @@
+{-# LANGUAGE TemplateHaskell #-}
+{-# LANGUAGE StrictData #-}
+module Dodge.Data.Bullet where
+import Dodge.Data.DamageType
+import Geometry.Data
+import Control.Lens
+data Bullet = Bullet
+    { _buState      :: BulletState
+    , _buEffect     :: BulletEffect
+    , _buSpawn      :: BulletSpawn
+    , _buUpdateMod  :: BulletUpdateMod
+    , _buTrajectory :: BulletTrajectory
+    , _buVel        :: Point2
+    , _buDrag       :: Float
+    , _buPos        :: Point2
+    , _buOldPos     :: Point2
+    , _buWidth      :: Float 
+    , _buTimer      :: Int
+    , _buDamages    :: [Damage]
+    }
+data EnergyBall = IncBall | TeslaBall | ConcBall
+data BulletState = NormalBulletState
+    | DyingBulletState
+    | DelayedBullet Float
+data BulletUpdateMod = NoBulletUpdateMod
+
+data BulletEffect = DestroyBullet
+    | BounceBullet
+    | PenetrateBullet
+data BulletSpawn = BulBall EnergyBall | BulSpark
+
+data BulletTrajectory
+    = BasicBulletTrajectory
+    | BezierTrajectory Point2 Point2 Point2
+    | FlechetteTrajectory Point2
+    | MagnetTrajectory Point2
+
+makeLenses ''Bullet

src/Dodge/Data/DamageType.hs

@@ -1,9 +1,12 @@
+{-# LANGUAGE TemplateHaskell #-}
 {-# LANGUAGE StrictData #-}
 {- 
 Datatypes describing the type of damage effects that are to be applied to
 creatures.
 -}
 module Dodge.Data.DamageType where
+import Geometry.Data
+import Control.Lens
 data DamageType 
     = PIERCING 
     | BLUNT    
@@ -21,3 +24,33 @@ data DamageType
     | POISONDAM 
     | ENTERREMENT
   deriving (Eq,Ord,Show,Read)
+data DamageEffect
+    = PushDamage 
+        { _dePush :: Float 
+        , _dePushExp :: Float
+        , _dePushRadius :: Float
+        }
+    | TorqueDamage { _deTorque :: Float }
+    | PushBackDamage {_dePushBack :: Float }
+    | NoDamageEffect
+  deriving (Eq,Ord,Show)
+
+data Damage = Damage 
+    { _dmType :: DamageType
+    , _dmAmount :: Int , _dmFrom :: Point2 , _dmAt :: Point2 , _dmTo :: Point2 
+    , _dmEffect :: DamageEffect
+    }
+  deriving (Eq,Ord,Show)
+
+isElectrical :: Damage -> Bool
+isElectrical dm = case _dmType dm of
+    ELECTRICAL -> True
+    _ -> False
+
+isMovementDam :: Damage -> Bool
+isMovementDam dm = case _dmType dm of
+    TORQUEDAM -> True
+    PUSHDAM -> True
+    _ -> False
+makeLenses ''Damage
+makeLenses ''DamageEffect

src/Dodge/Particle/Damage.hs

@@ -1,22 +1,6 @@
 module Dodge.Particle.Damage where
 import Dodge.Data
 import Geometry
---import LensHelp
-
-import System.Random
-import Control.Monad.State
-
--- TODO unify particle position in a sensible manner
-spawnAtBulDams :: (Point2 -> State StdGen Particle)
-    -> Bullet -> Point2 -> [Damage]
-spawnAtBulDams thespawn bt p =
-    [ Damage PIERCING 50 sp p ep (DamageSpawn $ \_ dm -> thespawn (_dmAt dm))
-    , Damage PUSHDAM   1 sp p ep . PushBackDamage $ 2 *.* bulVel
-    ]
-  where
-    sp = _buPos bt
-    bulVel = _buVel bt
-    ep = sp +.+ bulVel
 
 simpleDam :: DamageType -> Int -> Particle -> Point2 -> [Damage]
 simpleDam dt amount bt p = [ Damage dt amount sp p ep NoDamageEffect ]
@@ -31,25 +15,17 @@ simpleDam' dt amount bt p = [ Damage dt amount sp p ep NoDamageEffect ]
     bulVel = _buVel bt
     ep = sp +.+ bulVel
 
-heavyBulDams :: Bullet -> Point2 -> [Damage]
+heavyBulDams :: [Damage]
-heavyBulDams bt p =
+heavyBulDams =
-    [ Damage PIERCING 300 sp p ep NoDamageEffect
+    [ Damage PIERCING 300 0 0 0 NoDamageEffect
-    , Damage PUSHDAM    1 sp p ep . PushBackDamage $ 2 *.* bulVel
+    , Damage PUSHDAM    1 0 0 0 $ PushBackDamage 2
     ]
-  where
-    sp = _buPos bt
-    bulVel = _buVel bt
-    ep = sp +.+ bulVel
 
-basicBulDams :: Bullet -> Point2 -> [Damage]
+basicBulDams :: [Damage]
-basicBulDams bt p =
+basicBulDams =
-    [ Damage PIERCING 100 sp p ep NoDamageEffect
+    [ Damage PIERCING 100 0 0 0 NoDamageEffect
-    , Damage PUSHDAM    1 sp p ep . PushBackDamage $ 2 *.* bulVel
+    , Damage PUSHDAM    1 0 0 0 . PushBackDamage $ 2
     ]
-  where
-    sp = _buPos bt
-    bulVel = _buVel bt
-    ep = sp +.+ bulVel
 
 basicSparkDams :: Particle -> Point2 -> [Damage]
 basicSparkDams bt p = [ Damage SPARKING 1 sp p ep NoDamageEffect ]
@@ -58,18 +34,14 @@ basicSparkDams bt p = [ Damage SPARKING 1 sp p ep NoDamageEffect ]
     bulVel = _ptVel bt
     ep = sp +.+ bulVel
 
-hvBulDams :: Bullet -> Point2 -> [Damage]
+hvBulDams :: [Damage]
-hvBulDams bt p =
+hvBulDams =
-    [ Damage PIERCING  25 sp p ep NoDamageEffect
+    [ Damage PIERCING  25 0 0 0 NoDamageEffect
-    , Damage PIERCING  25 sp p ep NoDamageEffect
+    , Damage PIERCING  25 0 0 0 NoDamageEffect
-    , Damage PIERCING  25 sp p ep NoDamageEffect
+    , Damage PIERCING  25 0 0 0 NoDamageEffect
-    , Damage PIERCING  25 sp p ep NoDamageEffect
+    , Damage PIERCING  25 0 0 0 NoDamageEffect
-    , Damage PIERCING  25 sp p ep NoDamageEffect
+    , Damage PIERCING  25 0 0 0 NoDamageEffect
-    , Damage PIERCING  25 sp p ep NoDamageEffect
+    , Damage PIERCING  25 0 0 0 NoDamageEffect
-    , Damage TORQUEDAM  1 sp p ep $ TorqueDamage 0.7
+    , Damage TORQUEDAM  1 0 0 0 $ TorqueDamage 0.7
-    , Damage PUSHDAM    1 sp p ep . PushBackDamage $ 3 *.* (ep -.- sp)
+    , Damage PUSHDAM    1 0 0 0 $ PushBackDamage 3
     ] 
-  where
-    sp = _buPos bt
-    bulVel = _buVel bt
-    ep = sp +.+ bulVel

src/Dodge/Wall/DamageEffect.hs

@@ -7,11 +7,8 @@ import Dodge.Block
 import Geometry
 import LensHelp
 
-import Control.Monad.State
---import Data.Maybe
-
 defaultWallDamage :: Damage -> Wall -> World -> (World,Int)
-defaultWallDamage dm wl = flip (.) (wallDamageEffect dm wl) $ case _wlMaterial wl of
+defaultWallDamage dm wl = case _wlMaterial wl of
     Stone   -> stoneWallDamage dm wl
     Glass   -> windowWallDamage dm wl
     Dirt    -> dirtWallDamage dm wl
@@ -128,11 +125,3 @@ dirtWallDamage dm wl = case _dmType dm of
     sp = _dmFrom dm
     p = _dmAt dm
     outTo = p +.+ squashNormalizeV (sp -.- p)
-
-wallDamageEffect :: Damage -> Wall -> World -> World
-wallDamageEffect dm wl w = case _dmEffect dm of
-    DamageSpawn f -> w & instantParticles .:~ thepart
-        & randGen .~ g
-      where
-        (thepart,g) = runState (f (Right wl) dm) $ _randGen w
-    _ -> w

src/Dodge/WorldEvent/Shockwave.hs

@@ -74,10 +74,11 @@ mvShockwave is w pt
     damCr cr 
         | _crID cr `elem` is || dist (_crPos cr) p >= rad + _crRad cr  = cr
         | otherwise = cr & crState . csDamage .:~
-            Damage PUSHDAM dam cpos cpos cpos 
+            Damage PUSHDAM dam (cpos -.- v) cpos (cpos +.+ v)
-                (PushBackDamage (25 * push *.* squashNormalizeV (_crPos cr -.- p)))
+                (PushBackDamage (25 * push))
           where
             cpos = _crPos cr
+            v = normalizeV (cpos -.- p)
 {- Create a shockwave going from an outside circle into a center point.  -}
 inverseShockwaveAt 
     :: Point2   -- Center position
@@ -113,7 +114,8 @@ moveInverseShockwave w pt
     damCr cr 
         | dist (_crPos cr) p >= rad + _crRad cr = cr
         | otherwise = cr & crState . csDamage .:~
-            Damage PUSHDAM 1 cpos cpos cpos (PushBackDamage $ 25 *.* squashNormalizeV (p -.- cpos))
+            Damage PUSHDAM 1 (cpos +.+ v) cpos (cpos -.- v) (PushBackDamage 25)
           where
             cpos = _crPos cr
+            v = normalizeV (cpos -.- p)