Add damage origins

src/Dodge/Barreloid.hs

@@ -29,7 +29,7 @@ updateExpBarrel ps cr w = case cr ^. crHP of
             & flip (foldl' f) ps
     HP _ ->
         w
-            & makeExplosionAt ((cr ^. crPos) & _z +~ 20) 0
+            & makeExplosionAt (CrIndirectO (cr ^. crID)) ((cr ^. crPos) & _z +~ 20) 0
             & cWorld . lWorld . creatures . ix (_crID cr) . crHP .~ CrDestroyed Gibbed
     _ -> w
   where
@@ -51,7 +51,7 @@ damsToExpBarrel = flip $ foldl' damToExpBarrel
 
 damToExpBarrel :: Creature -> Damage -> Creature
 damToExpBarrel cr dm = case dm of
-    Piercing x p _ ->
+    Piercing x p _ _ ->
         cr & crHP . _HP -~ div x 200
             & crType . barrelType . piercedPoints .:~ (p - cr ^. crPos . _xy)
     Poison{} -> cr

src/Dodge/Base/Collide.hs

@@ -36,6 +36,7 @@ module Dodge.Base.Collide (
     crHeight,
 ) where
 
+import AesonHelp
 import Control.Applicative
 import Data.Foldable
 import qualified Data.IntMap.Strict as IM
@@ -195,7 +196,8 @@ crHeight cr = case cr ^. crHP of
         SlimeCrit {_slimeRad = r} -> min 15 r
         BeeCrit {} -> 10
         HiveCrit {} -> 25
-        _ -> error "Need to define crHeight for this crType"
+        BarrelCrit{} -> 20
+        _ -> error $ "Need to define crHeight for this crType:\n" <> unlines (prettyShort (cr ^. crType))
     CrIsCorpse{} -> Just 5
     CrDestroyed{} -> Nothing
 

src/Dodge/Bullet.hs

@@ -119,15 +119,17 @@ useBulletPayload bu = case _buPayload bu of
     BulPlain _ -> const id
     BulFlak -> makeFlak bu
     BulFrag -> makeFragBullets
-    BulGas -> (`makeGasCloud` V2 0 0)
+    BulGas -> (\p -> makeGasCloud o p (V2 0 0))
-    BulBall ExplosiveBall -> makeMovingEB (_buVel bu) ExplosiveBall
+    BulBall eb@ExplosiveBall{} -> makeMovingEB (_buVel bu) eb o
     BulBall ElectricalBall{} ->
         makeMovingEB
             (_buVel bu)
-            (ElectricalBall (round $ bu ^. buPos . _1))
+            (ElectricalBall (round $ bu ^. buPos . _1)) o
-    BulBall FlashBall -> makeMovingEB (_buVel bu) FlashBall
+    BulBall eb@FlashBall{} -> makeMovingEB (_buVel bu) eb o
-    BulBall (FlameletBall x) -> makeMovingEB (_buVel bu) (FlameletBall x)
+    BulBall eb@FlameletBall{} -> makeMovingEB (_buVel bu) eb o
-    BulBall IncendiaryBall -> makeMovingEB (_buVel bu) IncendiaryBall
+    BulBall eb@IncendiaryBall{} -> makeMovingEB (_buVel bu) eb o
+  where
+    o = bu ^. buOrigin
 
 makeFragBullets :: Point2 -> World -> World
 makeFragBullets p w = w & cWorld . lWorld . bullets .++~ bus
@@ -172,8 +174,8 @@ hitEffFromBul w bu = case _buEffect bu of
 
 getBulHitDams :: Bullet -> Point2 -> [Damage]
 getBulHitDams bu p = case _buPayload bu of
-    BulPlain x -> [Piercing x p v
+    BulPlain x -> [Piercing x p v (bu ^. buOrigin)
-        ,Inertial 0 p v]
+        ,Inertial 0 p v (bu ^. buOrigin)]
     _ -> []
   where
     v = _buVel bu

src/Dodge/Creature/Action/Blink.hs

@@ -29,7 +29,7 @@ blinkActionMousePos cr w =
         & blinkDistortions cpos p3
         & cWorld . lWorld . creatures . ix cid . crPos . _xy .~ p3
         & blinkShockwave cid p3
-        & inverseShockwaveAt (cpos `v2z` 20) 40 2 2
+        & inverseShockwaveAt (cpos `v2z` 20) 40 2 2 (CrIndirectO cid)
   where
     cid = _crID cr
     p1 = w ^. cWorld . lWorld . lAimPos
@@ -63,11 +63,11 @@ unsafeBlinkAction cr w
             . blinkDistortions cpos mwp
             . set (cWorld . lWorld . creatures . ix cid . crPos . _xy) mwp
             . blinkShockwave cid mwp
-            $ inverseShockwaveAt (cpos `v2z` 20) 40 2 2 w
+            $ inverseShockwaveAt (cpos `v2z` 20) 40 2 2 (CrIndirectO cid) w 
     | otherwise =
         w
             & blinkActionFail cr
-            & cWorld . lWorld . creatures . ix cid . crDamage .:~ Enterrement 100000000
+            & cWorld . lWorld . creatures . ix cid . crDamage .:~ Enterrement 100000000 (CrIndirectO cid)
   where
     success = fromMaybe True $ do
         wl <- snd $ collidePointWallsFilter (const True) mwp cpos w
@@ -82,7 +82,7 @@ blinkShockwave ::
     Point2 ->
     World ->
     World
-blinkShockwave i p = makeShockwaveAt [i] (p `v2z` 20) 60 1 2 cyan
+blinkShockwave i p = makeShockwaveAt [i] (p `v2z` 20) 60 1 2 cyan (CrIndirectO i)
 
 -- | Like a blink action, but no ingoing distortion
 blinkActionFail :: Creature -> World -> World
@@ -91,7 +91,7 @@ blinkActionFail cr w =
         & soundMultiFrom [TeleSound 0, TeleSound 1] p3 teleS Nothing
 --        & cWorld . lWorld . distortions .:~ distortionBulge
         & cWorld . lWorld . creatures . ix cid . crPos . _xy .~ p3
-        & inverseShockwaveAt (cpos `v2z` 20) 40 2 2
+        & inverseShockwaveAt (cpos `v2z` 20) 40 2 2 (CrIndirectO cid)
   where
 --    distR = 120
 --    distortionBulge = RadialDistortion cpos (cpos +.+ V2 distR 0) (cpos +.+ V2 0 distR) 1.9

src/Dodge/Creature/Damage.hs

@@ -16,7 +16,7 @@ applyCreatureDamage :: [Damage] -> Creature -> World -> World
 applyCreatureDamage dms cr w = foldl' (applyIndividualDamage cr) w dms
 
 applyIndividualDamage :: Creature -> World -> Damage -> World
-applyIndividualDamage cr w (Inertial _ _ v) = w 
+applyIndividualDamage cr w (Inertial _ _ v _) = w 
     & cWorld . lWorld . creatures . ix (_crID cr) . crPos . _xy +~ fmap (/ crMass (cr ^. crType)) v
 applyIndividualDamage cr w dm = 
     let (i,w') = damMatSideEffect dm (crMaterial (_crType cr)) (Left cr) w

src/Dodge/Creature/Impulse.hs

@@ -91,9 +91,9 @@ followImpulse cid w = \case
     rr a = randomR (- a, a) $ _randGen w
     hitCr i =
         cWorld . lWorld . creatures . ix i . crDamage
-            .:~ Blunt 100 (posFromID i) (posFromID i - cpos)
+            .:~ Blunt 100 (posFromID i) (posFromID i - cpos) (CrMeleeO cid)
     hitCrd a i =
         cWorld . lWorld . creatures . ix i . crDamage
-            <>~ [Blunt 100 (posFromID i) (posFromID i - cpos)
+            <>~ [Blunt 100 (posFromID i) (posFromID i - cpos) (CrMeleeO cid)
-                , Inertial 0 (posFromID i) (50 * unitVectorAtAngle (cr ^. crDir + a))
+                , Inertial 0 (posFromID i) (50 * unitVectorAtAngle (cr ^. crDir + a)) (CrMeleeO cid)
                 ]

src/Dodge/Creature/State.hs

@@ -225,6 +225,7 @@ shineTargetLaser cr loc w = fromMaybe (w & pointittarg . itTgPos .~ Nothing) $ d
                     , _lpPos = pos
 --                    , _lpColor = col
                     , _lpType = TargetingLaser (_itID itm)
+                    , _lpOrigin = CrWeaponO $ cr ^. crID
                     }
   where
     o = locOrient loc cr

src/Dodge/Data/Bullet.hs

@@ -20,6 +20,7 @@ data Bullet = Bullet
     , _buDrag :: Float
     , _buPos :: Point2
     , _buOldPos :: Point2
+    , _buOrigin :: DamageOrigin
     }
     deriving (Show, Eq, Ord, Read) --Generic, Flat)
 

src/Dodge/Data/Cloud.hs

@@ -3,6 +3,7 @@
 
 module Dodge.Data.Cloud where
 
+import Dodge.Data.Damage
 import Dodge.Data.Material
 import Control.Lens
 import Data.Aeson
@@ -36,6 +37,7 @@ data Gas = Gas
     , _gsVel :: Point3
     , _gsTimer :: Int
     , _gsType :: GasType
+    , _gsOrigin :: DamageOrigin
     }
     deriving (Eq, Ord, Show, Read) --Generic, Flat)
 

src/Dodge/Data/Damage.hs

@@ -13,20 +13,32 @@ import Data.Aeson.TH
 import Geometry.Data
 
 data Damage
-    = Piercing {_dmAmount :: Int, _dmPos :: Point2, _dmVector :: Point2}
+    = Piercing {_dmAmount :: Int, _dmPos :: Point2, _dmVector :: Point2, _dmOrigin :: DamageOrigin}
-    | Blunt {_dmAmount :: Int, _dmPos :: Point2, _dmVector :: Point2}
+    | Blunt {_dmAmount :: Int, _dmPos :: Point2, _dmVector :: Point2, _dmOrigin :: DamageOrigin}
-    | Sparking {_dmAmount :: Int}
+    | Sparking {_dmAmount :: Int, _dmOrigin :: DamageOrigin}
-    | Crushing {_dmAmount :: Int, _dmVector :: Point2}
+    | Crushing {_dmAmount :: Int, _dmVector :: Point2, _dmOrigin :: DamageOrigin}
-    | Shattering {_dmAmount :: Int, _dmPos :: Point2, _dmVector :: Point2}
+    | Shattering {_dmAmount :: Int, _dmPos :: Point2, _dmVector :: Point2, _dmOrigin :: DamageOrigin}
-    | Flaming {_dmAmount :: Int}
+    | Flaming {_dmAmount :: Int, _dmOrigin :: DamageOrigin}
-    | Lasering {_dmAmount :: Int, _dmPos :: Point2, _dmVector :: Point2}
+    | Lasering {_dmAmount :: Int, _dmPos :: Point2, _dmVector :: Point2, _dmOrigin :: DamageOrigin}
-    | Flashing {_dmAmount :: Int, _dmPos :: Point2}
+    | Flashing {_dmAmount :: Int, _dmPos :: Point2, _dmOrigin :: DamageOrigin}
-    | Electrical {_dmAmount :: Int}
+    | Electrical {_dmAmount :: Int, _dmOrigin :: DamageOrigin}
-    | Explosive {_dmAmount :: Int, _dmCenter :: Point2}
+    | Explosive {_dmAmount :: Int, _dmOrigin :: DamageOrigin, _dmCenter :: Point2}
-    | Poison {_dmAmount :: Int}
+    | Poison {_dmAmount :: Int, _dmOrigin :: DamageOrigin}
-    | Enterrement {_dmAmount :: Int}
+    | Enterrement {_dmAmount :: Int, _dmOrigin :: DamageOrigin}
-    | Inertial {_dmAmount :: Int, _dmPos :: Point2, _dmVector :: Point2}
+    | Inertial {_dmAmount :: Int, _dmPos :: Point2, _dmVector :: Point2, _dmOrigin :: DamageOrigin}
+    deriving (Eq, Ord, Show, Read) --Generic, Flat)
+
+data DamageOrigin 
+    = CrMeleeO { _doCID :: Int}
+    | CrWeaponO { _doCID :: Int}
+    | CrIndirectO {_doCID :: Int}
+    | McMeleeO { _doMID :: Int}
+    | McWeaponO { _doMID :: Int}
+    | McIndirectO {_doMID :: Int}
+    | UnassignedO
     deriving (Eq, Ord, Show, Read) --Generic, Flat)
 
 makeLenses ''Damage
+makeLenses ''DamageOrigin
+deriveJSON defaultOptions ''DamageOrigin
 deriveJSON defaultOptions ''Damage

src/Dodge/Data/EnergyBall.hs

@@ -6,6 +6,7 @@ module Dodge.Data.EnergyBall (
     module Dodge.Data.EnergyBall.Type,
 ) where
 
+import Dodge.Data.Damage
 import Control.Lens
 import Data.Aeson
 import Data.Aeson.TH
@@ -17,6 +18,7 @@ data EnergyBall = EnergyBall
     , _ebPos :: Point3
     , _ebTimer :: Int
     , _ebType :: EnergyBallType
+    , _ebOrigin :: DamageOrigin
     }
     deriving (Eq, Ord, Show, Read) --Generic, Flat)
 

src/Dodge/Data/EnergyBall/Type.hs

@@ -8,11 +8,11 @@ import Data.Aeson
 import Data.Aeson.TH
 
 data EnergyBallType
-    = IncendiaryBall
+    = IncendiaryBall{}
     | FlameletBall {_fbSize :: Float}
     | ElectricalBall {_ebID :: Int}
-    | ExplosiveBall
+    | ExplosiveBall{}
-    | FlashBall
+    | FlashBall{}
     deriving (Eq, Ord, Show, Read) --Generic, Flat)
 
 makeLenses ''EnergyBallType

src/Dodge/Data/Flame.hs

@@ -3,6 +3,7 @@
 
 module Dodge.Data.Flame where
 
+import Dodge.Data.Damage
 import Control.Lens
 import Data.Aeson
 import Data.Aeson.TH
@@ -12,6 +13,7 @@ data Flame = Flame
     { _flTimer :: Int
     , _flPos :: Point2
     , _flVel :: Point2
+    , _flOrigin :: DamageOrigin
     }
     deriving (Eq, Ord, Show, Read) --Generic, Flat)
 

src/Dodge/Data/Laser.hs

@@ -3,6 +3,7 @@
 
 module Dodge.Data.Laser where
 
+import Dodge.Data.Damage
 import NewInt
 import Dodge.Data.Item.Location
 --import Color
@@ -21,6 +22,7 @@ data Laser = Laser
     , _lpPos :: Point2
     , _lpDir :: Float
     , _lpType :: LaserType
+    , _lpOrigin :: DamageOrigin
     }
     deriving (Eq, Ord, Show, Read) --Generic, Flat)
 

src/Dodge/Data/PlasmaBall.hs

@@ -1,10 +1,9 @@
 {-# LANGUAGE StrictData #-}
 {-# LANGUAGE TemplateHaskell #-}
 
-module Dodge.Data.PlasmaBall (
+module Dodge.Data.PlasmaBall (module Dodge.Data.PlasmaBall) where
-    module Dodge.Data.PlasmaBall
-) where
 
+import Dodge.Data.Damage
 import Control.Lens
 import Data.Aeson
 import Data.Aeson.TH
@@ -14,6 +13,7 @@ data PlasmaBall = PBall
     { _pbType :: PlasmaBallType
     , _pbVel :: Point2
     , _pbPos :: Point2
+    , _pbOrigin :: DamageOrigin
     }
     deriving (Show, Eq, Ord, Read) --Generic, Flat)
 

src/Dodge/Data/Projectile.hs

@@ -3,6 +3,7 @@
 
 module Dodge.Data.Projectile where
 
+import Dodge.Data.Damage
 import Control.Lens
 import Data.Aeson
 import Data.Aeson.TH
@@ -24,6 +25,7 @@ data Projectile = Shell
     , _pjType :: ProjectileType
     , _pjDetonatorID :: Maybe (NewInt ItmInt)
     , _pjScreenID :: Maybe (NewInt ItmInt)
+    , _pjOrigin :: DamageOrigin
     }
     deriving (Eq, Ord, Show, Read) --Generic, Flat)
 

src/Dodge/Data/PulseLaser.hs

@@ -3,6 +3,7 @@
 
 module Dodge.Data.PulseLaser where
 
+import Dodge.Data.Damage
 import Control.Lens
 import Data.Aeson
 import Data.Aeson.TH
@@ -14,6 +15,7 @@ data PulseLaser = PulseLaser
     , _pzDir :: Float
     , _pzDamage :: Int
     , _pzTimer :: Int
+    , _pzOrigin :: DamageOrigin
     }
     deriving (Eq, Ord, Show, Read) --Generic, Flat)
 
@@ -22,6 +24,7 @@ data PulseBall = PulseBall
     , _pzbPos :: Point2
     , _pzbTimer :: Int
     , _pzbID :: Int
+    , _pzbOrigin :: DamageOrigin
     }
     deriving (Eq, Ord, Show, Read) --Generic, Flat)
 

src/Dodge/Data/Shockwave.hs

@@ -3,6 +3,7 @@
 
 module Dodge.Data.Shockwave where
 
+import Dodge.Data.Damage
 import Color
 import Control.Lens
 import Data.Aeson
@@ -22,6 +23,7 @@ data Shockwave = Shockwave
     , _swPush :: Float
     , _swMaxTime :: Int
     , _swTimer :: Int
+    , _swOrigin :: DamageOrigin
     }
     deriving (Eq, Ord, Show, Read) --Generic, Flat)
 

src/Dodge/Data/TeslaArc.hs

@@ -6,6 +6,7 @@ module Dodge.Data.TeslaArc (
     module Dodge.Data.ArcStep,
 ) where
 
+import Dodge.Data.Damage
 import Color
 import Control.Lens
 import Data.Aeson
@@ -16,6 +17,7 @@ data TeslaArc = TeslaArc
     { _taTimer :: Int
     , _taArcSteps :: [ArcStep]
     , _taColor :: Color
+    , _taOrigin :: DamageOrigin
     }
     deriving (Eq, Ord, Show, Read) --Generic, Flat)
 

src/Dodge/EnergyBall.hs

@@ -18,33 +18,34 @@ import Linear.V3
 import Picture
 import RandomHelp
 
-makeFlamelet :: Point3 -> Point3 -> Float -> Int -> World -> World
+makeFlamelet :: DamageOrigin -> Point3 -> Point3 -> Float -> Int -> World -> World
-makeFlamelet p v s t =
+makeFlamelet o p v s t =
     cWorld . lWorld . energyBalls
         .:~ EnergyBall
             { _ebVel = v
             , _ebPos = p
             , _ebTimer = t
             , _ebType = FlameletBall s
+            , _ebOrigin = o
             }
 
 updateEnergyBall :: World -> EnergyBall -> (World, Maybe EnergyBall)
 updateEnergyBall w eb
     | _ebTimer eb <= 0 = (w, Nothing)
     | otherwise =
-        ( ebEffect eb . ebFlicker eb $ ebDamage (eb ^. ebPos) (_ebType eb) w
+        ( ebEffect eb . ebFlicker eb $ ebDamage eb w
         , Just $ eb & ebTimer -~ 1 & ebPos . _xy .~ bp & ebVel . _xy .~ drag * bv
         )
   where
     drag = case eb ^. ebType of
-        ExplosiveBall -> 0.9
+        ExplosiveBall{} -> 0.9
         _ -> 0.85
     p = (eb ^. ebPos + eb ^. ebVel) ^. _xy
     (bp, bv) = fromMaybe (p, eb ^. ebVel . _xy) $ bouncePoint (const True) 0 (eb ^. ebPos . _xy) p w
 
 ebEffect :: EnergyBall -> World -> World
 ebEffect eb = case _ebType eb of
-    ElectricalBall i ->
+    ElectricalBall {_ebID = i} ->
         soundContinue (EBSound i) (eb ^. ebPos . _xy) elecCrackleS (Just 2)
             . randSparkExtraVel
                 (eb ^. ebVel . _xy)
@@ -57,14 +58,15 @@ ebEffect eb = case _ebType eb of
             soundStart (EBSound (-1)) (eb ^. ebPos . _xy) fireFadeS Nothing
     _ -> id
 
-makeMovingEB :: Point2 -> EnergyBallType -> Point2 -> World -> World
+makeMovingEB :: Point2 -> EnergyBallType -> DamageOrigin -> Point2 -> World -> World
-makeMovingEB v ebt p =
+makeMovingEB v ebt o p =
     cWorld . lWorld . energyBalls
         .:~ EnergyBall
             { _ebVel = v `v2z` 0
             , _ebPos = p `v2z` 20
             , _ebTimer = 20
             , _ebType = ebt
+            , _ebOrigin = o
             }
 
 ebFlicker :: EnergyBall -> World -> World
@@ -79,21 +81,24 @@ ebColor eb = case eb ^. ebType of
     IncendiaryBall{} -> red
     FlameletBall{} -> red
     ElectricalBall{} -> cyan
-    ExplosiveBall -> white
+    ExplosiveBall{} -> white
-    FlashBall -> white
+    FlashBall{} -> white
 
-ebDamage :: Point3 -> EnergyBallType -> World -> World
+ebDamage :: EnergyBall -> World -> World
-ebDamage sp dt
+ebDamage eb
-    | z > 0 && z < 25 = damageInCircle (const $ ebtToDamage (sp ^. _xy) dt) (sp ^. _xy) r
+    | z > 0 && z < 25 = damageInCircle (const $ ebtToDamage (sp ^. _xy) o dt) (sp ^. _xy) r
     | otherwise = id
   where
+    sp = eb ^. ebPos
+    dt = eb ^. ebType
+    o = eb ^. ebOrigin
     z = sp ^. _z
     r = fromMaybe 5 $ dt ^? fbSize
 
-ebtToDamage :: Point2 -> EnergyBallType -> Damage
+ebtToDamage :: Point2 -> DamageOrigin -> EnergyBallType -> Damage
-ebtToDamage p = \case
+ebtToDamage p o = \case
-    FlameletBall{} -> Flaming 1
+    FlameletBall{} -> Flaming 1 o
-    IncendiaryBall{} -> Flaming 10
+    IncendiaryBall{} -> Flaming 10 o
-    ElectricalBall{} -> Electrical 10
+    ElectricalBall{} -> Electrical 10 o
-    ExplosiveBall -> Explosive 10 p
+    ExplosiveBall{} -> Explosive 10 o p
-    FlashBall -> Flashing 10 p
+    FlashBall{} -> Flashing 10 p o

src/Dodge/EnergyBall/Draw.hs

@@ -6,11 +6,11 @@ import Picture
 
 drawEnergyBall :: EnergyBall -> Picture
 drawEnergyBall eb = case _ebType eb of
-    FlameletBall x -> drawFlamelet x eb
+    FlameletBall {_fbSize=x} -> drawFlamelet x eb
-    IncendiaryBall -> drawFlamelet 5 eb
+    IncendiaryBall{} -> drawFlamelet 5 eb
     ElectricalBall{} -> drawStaticBall eb
-    ExplosiveBall -> drawExplosiveBall eb
+    ExplosiveBall{} -> drawExplosiveBall eb
-    FlashBall -> mempty
+    FlashBall{} -> mempty
 
 drawExplosiveBall :: EnergyBall -> Picture
 drawExplosiveBall eb =

src/Dodge/Flame.hs

@@ -29,7 +29,7 @@ updateFlame w pt
     reflame wl = pt & flTimer -~ 1 & flVel %~ reflVelWallDamp 0.9 wl
     doupdate =
         soundContinue FlameSound sp fireLoudS (Just 2) $
-            damageInCircle (const $ Flaming 1) ep r w
+            damageInCircle (const $ Flaming 1 (pt ^. flOrigin)) ep r w
     thit = List.safeHead $ thingsHit sp ep w
     sp = _flPos pt
     ep = sp + _flVel pt
@@ -43,10 +43,10 @@ flFlicker pt
             .:~ LSParam (addZ 10 $ _flPos pt) 70 (0.5 *.*.* xyzV4 red)
     | otherwise = id
 
-makeFlame :: Point2 -> Point2 -> World -> World
+makeFlame :: Point2 -> Point2 -> DamageOrigin -> World -> World
-makeFlame pos vel w =
+makeFlame pos vel d w =
     w
-        & cWorld . lWorld . flames .:~ Flame t pos vel
+        & cWorld . lWorld . flames .:~ Flame t pos vel d
         & randGen .~ g
   where
     (t, g) = randomR (99, 102) (_randGen w)

src/Dodge/Gas.hs

@@ -14,11 +14,11 @@ createGas gc = case gc of
 
 aGasCloud :: Float -> Point2 -> Float -> Creature -> World -> World
 aGasCloud pressure pos dir cr =
-    makeGasCloud pos $
+    makeGasCloud (CrWeaponO (cr ^. crID)) pos $
         (cr ^. crPos . _xy - cr ^. crOldPos . _xy) + pressure *^ unitVectorAtAngle dir
 
 aFlame :: Float -> Point2 -> Float -> Creature -> World -> World
-aFlame pressure pos dir cr = makeFlame pos vel
+aFlame pressure pos dir cr = makeFlame pos vel (CrWeaponO (cr ^. crID))
   where
     --w & instantParticles .:~ aFlameParticle t pos vel Nothing -- (Just $ _crID cr)
 

src/Dodge/HeldUse.hs

@@ -743,11 +743,11 @@ useLoadedAmmo
 useLoadedAmmo loc cr mz m w =
     makeMuzzleFlare pq loc (mz ^. mzFlareType) $ case _mzEffect mz of
         MuzzleShootBullet -> shootBullets loc cr (mz, x, magtree) w
-        MuzzleLaser -> creatureShootLaser pq' loc (w & randGen .~ g)
+        MuzzleLaser -> creatureShootLaser (CrWeaponO (cr ^. crID)) pq' loc (w & randGen .~ g)
         MuzzlePulseLaser -> creatureShootPulseLaser pq' cr (w & randGen .~ g)
-        MuzzlePulseBall -> shootPulseBall pq' (w & randGen .~ g)
+        MuzzlePulseBall -> shootPulseBall o pq' (w & randGen .~ g)
-        MuzzlePlasmaBall -> shootPlasmaBall pq' (w & randGen .~ g)
+        MuzzlePlasmaBall -> shootPlasmaBall o pq' (w & randGen .~ g)
-        MuzzleTesla -> shootTeslaArc pq' loc (w & randGen .~ g)
+        MuzzleTesla -> shootTeslaArc o pq' loc (w & randGen .~ g)
         MuzzleTractor -> shootTractorBeam cr w
         MuzzleRLauncher -> createProjectileR pq loc magtree cr w
         MuzzleGLauncher ->
@@ -776,6 +776,7 @@ useLoadedAmmo loc cr mz m w =
         MuzzleStopper -> useStopWatch itm cr w
         MuzzleScroller -> useTimeScrollGun itm cr w
   where
+    o = CrWeaponO $ cr ^. crID
     pq = muzzlePos loc cr mz
     (pq', g) = muzzleRandPos loc cr mz `runState` (w ^. randGen)
     itmtree = loc ^. locDT
@@ -856,9 +857,10 @@ tractorBeamAt pos outpos dir power =
         , _tbTime = 10
         }
 
-creatureShootLaser :: Point3Q -> LocationDT OItem -> World -> World
+creatureShootLaser :: DamageOrigin -> Point3Q -> LocationDT OItem -> World -> World
-creatureShootLaser (p, q) loc =
+creatureShootLaser o (p, q) loc =
     shootLaser
+        o
         (ItemSound (loc ^. locDT . dtValue . _1 . itID . unNInt) 0)
         (getLaserDamage loc)
         (getLaserPhaseV loc)
@@ -866,6 +868,7 @@ creatureShootLaser (p, q) loc =
         (Q.qToAng q)
 
 shootLaser ::
+    DamageOrigin ->
     SoundOrigin ->
     LaserType ->
     Float ->
@@ -873,13 +876,14 @@ shootLaser ::
     Float ->
     World ->
     World
-shootLaser so lt pv p dir =
+shootLaser o so lt pv p dir =
     ( cWorld . lWorld . lasers
         .:~ Laser
             { _lpType = lt
             , _lpPhaseV = pv
             , _lpPos = p
             , _lpDir = dir
+            , _lpOrigin = o
             }
     )
         . soundContinue so p tone440sawtoothquietS (Just 2)
@@ -887,12 +891,13 @@ shootLaser so lt pv p dir =
 creatureShootPulseLaser :: Point3Q -> Creature -> World -> World
 creatureShootPulseLaser (p, q) cr =
     shootPulseLaser
+        (CrWeaponO $ cr ^. crID)
         (CrWeaponSound (_crID cr) 0)
         (p ^. _xy)
         (Q.qToAng q)
 
-shootPulseLaser :: SoundOrigin -> Point2 -> Float -> World -> World
+shootPulseLaser :: DamageOrigin -> SoundOrigin -> Point2 -> Float -> World -> World
-shootPulseLaser so p dir w =
+shootPulseLaser o so p dir w =
     w
         & cWorld . lWorld . pulseLasers
             .:~ PulseLaser
@@ -901,23 +906,25 @@ shootPulseLaser so p dir w =
                 , _pzDir = dir
                 , _pzDamage = 101
                 , _pzTimer = 5
+                , _pzOrigin = o
                 }
         & soundStart so p lasPulseS Nothing
 
-shootPlasmaBall :: Point3Q -> World -> World
+shootPlasmaBall :: DamageOrigin -> Point3Q -> World -> World
-shootPlasmaBall (p, q) w =
+shootPlasmaBall o (p, q) w =
     w
         & cWorld . lWorld . plasmaBalls .:~
             PBall
                 { _pbPos = p ^. _xy
                 , _pbVel = 6 * unitVectorAtAngle (Q.qToAng q)
                 , _pbType = DefaultPlasma
+                , _pbOrigin = o
                 }
 --        & soundStart (PBSound i) (p ^. _xy) energyReleaseS Nothing
 
 
-shootPulseBall :: Point3Q -> World -> World
+shootPulseBall :: DamageOrigin -> Point3Q -> World -> World
-shootPulseBall (p, q) w =
+shootPulseBall o (p, q) w =
     w
         & cWorld . lWorld . pulseBalls . at i
             ?~ PulseBall
@@ -925,6 +932,7 @@ shootPulseBall (p, q) w =
                 , _pzbVel = 3.5 * unitVectorAtAngle (Q.qToAng q)
                 , _pzbTimer = 200
                 , _pzbID = i
+                , _pzbOrigin = o
                 }
         & soundStart (PBSound i) (p ^. _xy) energyReleaseS Nothing
   where
@@ -990,7 +998,8 @@ shootBullets
     :: LocationDT OItem -> Creature -> (Muzzle, Int, DTree OItem) -> World -> World
 shootBullets loc cr (mz, x, magtree) w = fromMaybe w $ do
     thebullet <- getBulletType magtree
-    return $ foldl' (&) w (replicate x (shootBullet thebullet loc cr mz))
+    let bu = thebullet & buOrigin .~ CrWeaponO (cr ^. crID)
+    return $ foldl' (&) w (replicate x (shootBullet bu loc cr mz))
 
 shootBullet :: Bullet -> LocationDT OItem -> Creature -> Muzzle -> World -> World
 shootBullet bu loc cr mz w = makeBullet bu itm pq . (randGen .~ g) $ w
@@ -1180,7 +1189,7 @@ doGenFloat (UniRandFloat x y) g = randomR (x, y) g
 
 mcShootLaser :: Item -> Machine -> World -> World
 mcShootLaser _ mc =
-    shootLaser (MachinePrimarySound (_mcID mc)) (DamageLaser 11) 1 pos dir
+    shootLaser (McWeaponO (mc ^. mcID)) (MachinePrimarySound (_mcID mc)) (DamageLaser 11) 1 pos dir
   where
     pos = _mcPos mc +.+ 20 *.* unitVectorAtAngle dir
     dir = (mc ^?! mcType . mctTurret . tuDir)
@@ -1203,14 +1212,14 @@ mcShootAuto itm mc w
 --    dir = mc ^?! mcType . _McTurret . tuDir
 
 -- | assumes that the item is held
-shootTeslaArc :: Point3Q -> LocationDT OItem -> World -> World
+shootTeslaArc :: DamageOrigin -> Point3Q -> LocationDT OItem -> World -> World
-shootTeslaArc (p, q) loc w =
+shootTeslaArc o (p, q) loc w =
     w' & cWorld . lWorld . items . ix itid . itParams .~ ip
         & soundContinue (ItemSound itid 0) pos elecCrackleS (Just 2)
   where
     itm = loc ^. locDT . dtValue . _1
     itid = itm ^. itID . unNInt
-    (w', ip) = makeTeslaArc (itm ^. itParams) pos (Q.qToAng q) w
+    (w', ip) = makeTeslaArc o (itm ^. itParams) pos (Q.qToAng q) w
     pos = p ^. _xy
 
 determineProjectileTracking :: DTree OItem -> DTree OItem -> RocketHoming

src/Dodge/Item/Weapon/Bullet.hs

@@ -16,6 +16,7 @@ defaultBullet =
         , _buDrag = 1
         , _buPos = 0
         , _buOldPos = 0
+        , _buOrigin = UnassignedO
         }
 
 --basicBulDams :: [Damage]

src/Dodge/Laser/Update.hs

@@ -14,7 +14,7 @@ updateLaser w pt =
     ( case _lpType pt of
         DamageLaser dam ->
             damThingHitWith
-                (\p2 -> Lasering dam p2 (xp - sp))
+                (\p2 -> Lasering dam p2 (xp - sp) (pt ^. lpOrigin))
                 thHit
                 w
         TargetingLaser itid -> w & pointerToItemID itid . itTargeting . itTgPos ?~ last ps

src/Dodge/Machine/Destroy.hs

@@ -16,7 +16,7 @@ destroyMachine mc =
     (cWorld . lWorld . machines %~ IM.delete (_mcID mc))
         . deleteWallIDs (IM.keysSet $ _mcFootPrint mc)
         . makeMachineDebris mc
-        . makeSmallExplosionAt (20 & _xy .~ _mcPos mc) 0
+        . makeSmallExplosionAt (McIndirectO (mc ^. mcID)) (20 & _xy .~ _mcPos mc) 0
         . mcKillTerm mc
         . mcKillBut mc
         . destroyMcType (mc ^. mcType) mc

src/Dodge/Material/Damage.hs

@@ -40,14 +40,14 @@ laserSpark = makeSpark FireSpark
 
 damageStone :: Damage -> ECW -> World -> (Int,World)
 damageStone dm ecw w = case dm of
-        Lasering _ p t -> f 0 $ laserSpark (outTo p t) (rdir p t)
+        Lasering _ p t _ -> f 0 $ laserSpark (outTo p t) (rdir p t)
-        Piercing _ p t -> 
+        Piercing _ p t _ -> 
             f dmam $ makeSpark NormalSpark (outTo p t) (rdir p t)
                 . makeDustAt Stone 200 (addZ 20 (outTo p t))
 --                . randsound p [slapS, slap1S,slap2S,slap3S,slap4S,slap5S,slap6S,slap7S]
                 . randsound p [slapS, slap1S, slap2S]
-        Blunt _ p t -> f dmam $ makeDustAt Stone 200 (addZ 20 (outTo p t))
+        Blunt _ p t _ -> f dmam $ makeDustAt Stone 200 (addZ 20 (outTo p t))
-        Shattering _ p t -> f dmam $ makeDustAt Stone 200 (addZ 20 (outTo p t))
+        Shattering _ p t _ -> f dmam $ makeDustAt Stone 200 (addZ 20 (outTo p t))
         Crushing{} -> f dmam  id
         Explosive{} -> f dmam  id
         Sparking{} -> f 0  id
@@ -91,14 +91,14 @@ damagePiezoelectric = damageStone
 
 damagePhotovoltaic :: Damage -> ECW -> World -> (Int,World)
 damagePhotovoltaic dm ecw w = case dm of
-        Lasering _ p t -> f (10*dmam) $ laserSpark (outTo p t) (rdir p t)
+        Lasering _ p t _ -> f (10*dmam) $ laserSpark (outTo p t) (rdir p t)
-        Piercing _ p t -> 
+        Piercing _ p t _ -> 
             f dmam $ makeSpark NormalSpark (outTo p t) (rdir p t)
                 . makeDustAt Stone 200 (addZ 20 (outTo p t))
 --                . randsound p [slapS, slap1S,slap2S,slap3S,slap4S,slap5S,slap6S,slap7S]
                 . randsound p [slapS, slap1S, slap2S]
-        Blunt _ p t -> f dmam $ makeDustAt Stone 200 (addZ 20 (outTo p t))
+        Blunt _ p t _ -> f dmam $ makeDustAt Stone 200 (addZ 20 (outTo p t))
-        Shattering _ p t -> f dmam $ makeDustAt Stone 200 (addZ 20 (outTo p t))
+        Shattering _ p t _ -> f dmam $ makeDustAt Stone 200 (addZ 20 (outTo p t))
         Crushing{} -> f dmam  id
         Explosive{} -> f dmam  id
         Sparking{} -> f 0  id
@@ -124,11 +124,11 @@ damagePhotovoltaic dm ecw w = case dm of
 
 damageMetal :: Damage -> ECW -> World -> (Int,World)
 damageMetal dm ecw w = case dm of
-        Lasering _ p t -> f 0 $ laserSpark (outTo p t) (rdir p t)
+        Lasering _ p t _ -> f 0 $ laserSpark (outTo p t) (rdir p t)
-        Piercing _ p t -> f dmam $
+        Piercing _ p t _ -> f dmam $
             makeSpark NormalSpark (outTo p t) (rdir p t)
                 . randsound p [tingS, ting1S, ting2S, ting3S, ting4S, ting5S]
-        Blunt _ p t -> f dmam $
+        Blunt _ p t _ -> f dmam $
             makeSpark NormalSpark (outTo p t) (rdir p t)
                 . randsound p [clangS,clang1S,clang2S]
         Shattering {} -> f dmam  id
@@ -158,7 +158,7 @@ damageMetal dm ecw w = case dm of
 damageFlesh :: Damage -> ECW -> World -> (Int,World)
 damageFlesh dm _ w = (dm ^. dmAmount,) $ w & case dm of
     Lasering {} -> id
-    Piercing _ p t ->
+    Piercing _ p t _ ->
         randsound
             p
             [ bloodShort1S
@@ -171,7 +171,7 @@ damageFlesh dm _ w = (dm ^. dmAmount,) $ w & case dm of
             , bloodShort8S
             ]
                 . makeDustAt Flesh 50 (addZ 20 (outTo p t))
-    Blunt _ p _ -> randsound p [hitS]
+    Blunt _ p _ _ -> randsound p [hitS]
     Shattering {} -> id
     Crushing{} -> id
     Explosive{} -> id
@@ -192,14 +192,14 @@ damageFlesh dm _ w = (dm ^. dmAmount,) $ w & case dm of
 damageDirt :: Damage -> ECW -> World -> (Int,World)
 damageDirt dm _ w =
     (dm^. dmAmount,) $ w & case dm of
-        Lasering _ p t -> --  makeSpark FireSpark (outTo p t) (rdir p t)
+        Lasering _ p t _ -> --  makeSpark FireSpark (outTo p t) (rdir p t)
             makeDustAt Dirt 200 (addZ 20 (outTo p t))
-        Piercing _ p t ->
+        Piercing _ p t _ ->
             makeDustAt Dirt 200 (addZ 20 (outTo p t))
                 -- . randsound p [slapS, slap1S]
                 . randsound p [slapS, slap1S,slap2S,slap3S,slap4S,slap5S,slap6S,slap7S]
-        Blunt _ p t -> makeDustAt Dirt 200 (addZ 20 (outTo p t))
+        Blunt _ p t _ -> makeDustAt Dirt 200 (addZ 20 (outTo p t))
-        Shattering _ p t -> makeDustAt Dirt 200 (addZ 20 (outTo p t))
+        Shattering _ p t _ -> makeDustAt Dirt 200 (addZ 20 (outTo p t))
         Crushing{} -> id
         Explosive{} -> id
         Sparking{} -> id
@@ -219,16 +219,16 @@ damageDirt dm _ w =
 damageGlass :: Damage -> ECW -> World -> (Int,World)
 damageGlass dm ecw w = case dm of
         Lasering {} -> f 0  id
-        Piercing _ p t -> 
+        Piercing _ p t _ -> 
             f dmam $ makeSpark NormalSpark (outTo p t) (rdir p t)
 --                . makeDustAt Stone 200 (addZ 20 (outTo p t))
                  . randsound p [smallGlass1S, smallGlass2S, smallGlass3S, smallGlass4S]
-        Blunt _ p _ -> f dmam $ -- makeDustAt Stone 200 (addZ 20 (outTo p t))
+        Blunt _ p _ _ -> f dmam $ -- makeDustAt Stone 200 (addZ 20 (outTo p t))
                  randsound p [smallGlass1S, smallGlass2S, smallGlass3S, smallGlass4S]
-        Shattering _ p t -> f dmam $ makeDustAt Glass 200 (addZ 20 (outTo p t))
+        Shattering _ p t _ -> f dmam $ makeDustAt Glass 200 (addZ 20 (outTo p t))
                 . randsound p [smallGlass1S, smallGlass2S, smallGlass3S, smallGlass4S]
         Crushing{} -> f dmam  id
-        Explosive _ p -> f dmam  -- the sound comes from the explosion center, which is not correct...
+        Explosive _ _ p -> f dmam  -- the sound comes from the explosion center, which is not correct...
             $ randsound p [smallGlass1S, smallGlass2S, smallGlass3S, smallGlass4S]
         Sparking{} -> f 0  id
         Flaming{} -> f 0  id
@@ -286,14 +286,14 @@ damageGlass dm ecw w = case dm of
 damageCrystal :: Damage -> ECW -> World -> (Int,World)
 damageCrystal dm ecw w = case dm of
         Lasering {} -> f  id
-        Piercing _ p t -> 
+        Piercing _ p t _ -> 
             f $ makeSpark NormalSpark (outTo p t) (rdir p t)
                  . randsound p [marimbaC5S,marimbaE5S,marimbaG5S,marimbaB6S]
-        Blunt _ p _ -> f $ -- makeDustAt Stone 200 (addZ 20 (outTo p t))
+        Blunt _ p _ _ -> f $ -- makeDustAt Stone 200 (addZ 20 (outTo p t))
                  randsound p [marimbaC5S,marimbaE5S,marimbaG5S,marimbaB6S]
-        Shattering _ p _ -> f $ randsound p [marimbaC5S,marimbaE5S,marimbaG5S,marimbaB6S]
+        Shattering _ p _ _ -> f $ randsound p [marimbaC5S,marimbaE5S,marimbaG5S,marimbaB6S]
         Crushing{} -> f  id
-        Explosive _ p -> f  -- the sound comes from the explosion center, which is not correct...
+        Explosive _ _ p -> f  -- the sound comes from the explosion center, which is not correct...
             $ randsound p [smallGlass1S, smallGlass2S, smallGlass3S, smallGlass4S]
         Sparking{} -> f   id
         Flaming{} -> f   id

src/Dodge/Payload.hs

@@ -15,19 +15,20 @@ import Geometry.Data
 import LensHelp
 import Linear.V3
 
-usePayload :: Payload -> Point3 -> Point3 -> World -> World
+usePayload :: Payload -> DamageOrigin -> Point3 -> Point3 -> World -> World
 usePayload = \case
     ExplosionPayload -> makeExplosionAt
     ShrapnelBomb -> makeShrapnelAt
-    DudPayload -> const (const id)
+    DudPayload -> const (const (const id))
 
-makeShrapnelAt :: Point3 -> Point3 -> World -> World
+-- potential turn the origin indirect?
-makeShrapnelAt p' vel' w =
+makeShrapnelAt :: DamageOrigin -> Point3 -> Point3 -> World -> World
+makeShrapnelAt o p' vel' w =
     w
         & soundMultiFrom [Explosion 0, Explosion 1] p bangS Nothing
         & cWorld . lWorld . worldEvents
             .:~ MakeTempLight (LSParam p' 150 (V3 0.8 0.8 0.8)) 20
-        & makeShockwaveAt [] p' 50 5 0 white
+        & makeShockwaveAt [] p' 50 5 0 white o
         & cWorld . lWorld . bullets .++~ buls
   where
     p = p' ^. _xy
@@ -43,3 +44,4 @@ makeShrapnelAt p' vel' w =
         & buDrag .~ drag
         & buPos .~ (p - v)
         & buOldPos .~ (p - v)
+        & buOrigin .~ o

src/Dodge/Projectile/Create.hs

@@ -45,6 +45,7 @@ createShell (p, q) mdetonator mscreen stab pjtype payload cr w =
                 , _pjType = pjtype
                 , _pjDetonatorID = mdetonator
                 , _pjScreenID = mscreen
+                , _pjOrigin = CrWeaponO $ cr ^. crID
                 }
   where
     dir = Q.qToAng q

src/Dodge/Projectile/Update.hs

@@ -143,6 +143,7 @@ doThrust pj smoke w =
         %~ (\v -> accel + frict *^ v)
         & soundContinue (ShellSound i) (ep ^. _xy) missileLaunchS (Just 1)
         & makeFlamelet
+            (pj ^. pjOrigin)
             (sp - 0.5 *^ vel)
             (vel + rotateV (pi + sparkD) accel `v2z` 0)
             3
@@ -283,7 +284,7 @@ explodeShell pj w =
         & pjlens
         . pjTimer
         .~ 30
-        & usePayload (_pjPayload pj) (pj ^. pjPos) (pj ^. pjVel)
+        & usePayload (_pjPayload pj) (pj ^. pjOrigin) (pj ^. pjPos) (pj ^. pjVel)
         & stopSoundFrom (ShellSound pjid)
         & updatedetonator
   where

src/Dodge/Room/Tutorial.hs

@@ -57,6 +57,8 @@ tutAnoTree = do
     foldMTRS
         [ tToBTree "TutStartRez" . return . cleatOnward <$> tutRezBox
         , corDoor
+        , tToBTree "" . return . cleatOnward <$> slowDoorRoom
+        , corDoor
         --, tToBTree "" . return . cleatOnward <$> (xChasm 200 200
         , tToBTree "" . return . cleatOnward <$> ((putSingleLight =<< roomRectAutoLights 300 300)
             <&> rmPmnts <>~ [sps0 (PutCrit slimeCrit) & plSpot . psPos .~ V2 150 100

src/Dodge/Shockwave/Update.hs

@@ -25,7 +25,7 @@ moveShockwave w sw
     doDams 
         | (p ^. _z >= 0) && (p ^. _z < 25)
             && t > 5
-            = damageInCircle (Explosive dam) (p ^. _xy) rad
+            = damageInCircle (Explosive dam (sw ^. swOrigin)) (p ^. _xy) rad
         | otherwise = id
 
 moveInverseShockwave ::

src/Dodge/Spark.hs

@@ -39,9 +39,9 @@ sparkDam = damageCrWl . sparkToDamage
 
 sparkToDamage :: Spark -> [Damage]
 sparkToDamage sp = case _skType sp of
-    ElectricSpark -> [Electrical 10]
+    ElectricSpark -> [Electrical 10 UnassignedO]
-    FireSpark -> [Flaming 1]
+    FireSpark -> [Flaming 1 UnassignedO]
-    NormalSpark -> [Sparking 10]
+    NormalSpark -> [Sparking 10 UnassignedO]
 
 makeSpark :: SparkType -> Point2 -> Float -> World -> World
 makeSpark st p d =

src/Dodge/Tesla.hs

@@ -25,14 +25,15 @@ import Picture
 import RandomHelp
 --import Shape
 
-makeTeslaArc :: ItemParams -> Point2 -> Float -> World -> (World, ItemParams)
+makeTeslaArc :: DamageOrigin -> ItemParams -> Point2 -> Float -> World -> (World, ItemParams)
-makeTeslaArc ip pos dir w =
+makeTeslaArc o ip pos dir w =
     ( w & randGen .~ g
         & cWorld . lWorld . teslaArcs
             .:~ TeslaArc
                 { _taArcSteps = newarc
                 , _taTimer = 2
                 , _taColor = brightX 100 1.5 col
+                , _taOrigin = o
                 }
     , ip & currentArc .~ newarc
     )

src/Dodge/Update.hs

@@ -540,7 +540,7 @@ updatePlasmaBall w pb
     dodam = \case
         Left cr -> creatures . ix (_crID cr) . crDamage .:~ thedam
         Right wl -> wallDamages . at (_wlID wl) . non mempty .:~ thedam
-    thedam = Lasering 100 ep (pb ^. pbVel)
+    thedam = Lasering 100 ep (pb ^. pbVel) (pb ^. pbOrigin)
     sp = pb ^. pbPos
     ep = sp + pb ^. pbVel
     thit = thingHit sp ep w
@@ -560,7 +560,7 @@ updatePulseBall pb w
     dodam = \case
         Left cr -> creatures . ix (_crID cr) . crDamage .:~ thedam
         Right wl -> wallDamages . at (_wlID wl) . non mempty .:~ thedam
-    thedam = Lasering 100 ep (pb ^. pzbVel)
+    thedam = Lasering 100 ep (pb ^. pzbVel) (pb ^. pzbOrigin)
     sp = pb ^. pzbPos
     ep = sp + pb ^. pzbVel
     thit = listToMaybe $ thingsHitZ 20 sp ep w
@@ -718,7 +718,7 @@ updateTeslaArc w pt
             , randWallReflect ld' wl
             )
         | ArcStep lp' ld' _ <- last thearc = (lp', rp ld')
-    damthings (ArcStep _ _ crwl) = damageCrWlID [Electrical 50] crwl
+    damthings (ArcStep _ _ crwl) = damageCrWlID [Electrical 50 (pt ^. taOrigin)] crwl
 
 updatePulseLaser :: PulseLaser -> (Endo World, [PulseLaser])
 updatePulseLaser pz = case pz ^. pzTimer of
@@ -734,14 +734,14 @@ updatePulseLaser pz = case pz ^. pzTimer of
     dodam thit = case thit of
         ((p, OCreature cr) : _) ->
             cWorld . lWorld . creatures . ix (_crID cr) . crDamage
-                .:~ Lasering (pz ^. pzDamage) p (xp - sp)
+                .:~ Lasering (pz ^. pzDamage) p (xp - sp) (pz ^. pzOrigin)
         ((p, OWall wl) : _) ->
             cWorld . lWorld . wallDamages . at (_wlID wl) . non mempty
-                .:~ Lasering (pz ^. pzDamage) p (xp - sp)
+                .:~ Lasering (pz ^. pzDamage) p (xp - sp) (pz ^. pzOrigin)
         ((_, OPulseBall pb) : xs) ->
             dodam xs
                 . (cWorld . lWorld . pulseBalls . ix (_pzbID pb) . pzbTimer .~ 0)
-                . makeExplosionAt (_pzbPos pb `v2z` 20) 0
+                . makeExplosionAt (pb ^. pzbOrigin) (_pzbPos pb `v2z` 20) 0
         _ -> id
     phasev = _pzPhaseV pz
     sp = _pzPos pz

src/Dodge/Update/Cloud.hs

@@ -14,7 +14,7 @@ cloudPoisonDamage :: Gas -> World -> World
 cloudPoisonDamage c w = foldl' (flip doDam) w (filter f $ crsNearPoint clpos w)
   where
     doDam cr =
-        cWorld . lWorld . creatures . ix (_crID cr) . crDamage .:~ Poison 1
+        cWorld . lWorld . creatures . ix (_crID cr) . crDamage .:~ Poison 1 (c ^. gsOrigin)
     f cr = dist3 (_crPos cr & _z +~ 20) (_gsPos c) < crRad (cr ^. crType) + 20
         && isJust (cr ^? crHP . _HP)
     clpos = stripZ $ _gsPos c

src/Dodge/Wall/Damage.hs

@@ -50,7 +50,7 @@ damageMachine dam x mcid w = case w ^? cWorld . lWorld . machines . ix mcid of
         , sensorTypeDamages (se ^. sensType) dam
         -> (mempty,mcDamSensorUpdate' (_dmAmount dam) se mc w)
     Just mc | McTurret{} <- mc ^. mcType
-        , Electrical edam <- dam
+        , Electrical {_dmAmount=edam} <- dam
             -> (mempty, w & cWorld . lWorld . machines . ix mcid . mcType . mctTurretStun %~ (min 100 . (+ edam)))
     Just mc | _mcHP mc < x -> destroyMachine' mc w
     _ -> (mempty, w & cWorld . lWorld . machines . ix mcid . mcHP -~ x)

src/Dodge/WallCreatureCollisions.hs

@@ -45,7 +45,7 @@ pushCr w wls cr
 --        || wlsCrush' w (cr ^. crPos . _xy) twls =
     | wlsCrush' w (cr ^. crPos . _xy) twls =
         ecr
-            & crDamage <>~ [Crushing 1000 0]
+            & crDamage <>~ [Crushing 1000 0 UnassignedO]
             & crPos . _xy .~ ap
 --    | Just s <- wlsCrush w (cr ^. crPos . _xy) twls =
 --        ecr

src/Dodge/WorldEvent/Explosion.hs

@@ -22,14 +22,10 @@ import Linear
 import Picture
 import RandomHelp
 
-makePoisonExplosionAt ::
+makePoisonExplosionAt :: DamageOrigin -> Point2 -> World -> World
-    -- | Position
+makePoisonExplosionAt o p w =
-    Point2 ->
-    World ->
-    World
-makePoisonExplosionAt p w =
     soundMultiFrom [Explosion 0, Explosion 1] p bangS Nothing $
-        foldl' (flip $ makeGasCloud p) w $
+        foldl' (flip $ makeGasCloud o p) w $
             replicateM 25 (randInCirc 2) & evalState $ _randGen w
 
 -- just change the number after replicateM to get more or less clouds
@@ -53,47 +49,44 @@ makeTeslaExplosionAt = undefined
 --            (\i -> over projectiles (IM.insert (pks!!i) (makeTeslaArcAt (pks!!i) pos (xs!!i))))
 --            [1 .. 29]
 
-makeFlameExplosionAt ::
+makeFlameExplosionAt :: DamageOrigin -> Point2 -> World -> World
-    Point2 ->
+makeFlameExplosionAt o p w =
-    World ->
-    World
-makeFlameExplosionAt p w =
     soundMultiFrom [Explosion 0, Explosion 1] p bangS Nothing w
         & cWorld . lWorld . flames .++~ newFlames
   where
     newFlames = zipWith makeFlameWithVelAndTime velocities timers
-    makeFlameWithVelAndTime vel time = Flame time vel p
+    makeFlameWithVelAndTime vel time = Flame time vel p o
     velocities = replicateM 15 (randInCirc 1) & evalState $ _randGen w
     timers = randomRs (80, 100) $ _randGen w
 
-makeExplosionAt :: Point3 -> Point3 -> World -> World
+makeExplosionAt :: DamageOrigin -> Point3 -> Point3 -> World -> World
-makeExplosionAt p vel w =
+makeExplosionAt o p vel w =
     w
         & soundStart (Explosion (w ^. cWorld . lWorld . lClock)) (p ^. _xy) bangS Nothing
         & addFlames
         & cWorld . lWorld . worldEvents .:~ MakeTempLight (LSParam p 150 (V3 1 0.5 0)) 20
-        & makeShockwaveAt [] p 50 100 1 white
+        & makeShockwaveAt [] p 50 100 1 white o
   where
     fVs = fmap (`v2z` 0) $ replicateM 100 (randInCirc 8) & evalState $ _randGen w
     fdamps = replicateM 100 (state $ randomR (0, 1)) & evalState $ _randGen w
     sizes = randomRs (2, 9) $ _randGen w
     times = randomRs (15, 20) $ _randGen w
-    mF v damp = makeFlamelet p (v + damp *^ vel)
+    mF v damp = makeFlamelet o p (v + damp *^ vel)
     newFs = zipWith4 mF fVs fdamps sizes times
     addFlames w' = foldl' (&) w' newFs
 
-makeSmallExplosionAt :: Point3 -> Point3 -> World -> World
+makeSmallExplosionAt :: DamageOrigin -> Point3 -> Point3 -> World -> World
-makeSmallExplosionAt p vel w =
+makeSmallExplosionAt o p vel w =
     w
         & soundStart (Explosion (w ^. cWorld . lWorld . lClock)) (p ^. _xy) bangS Nothing
         & addFlames
         & cWorld . lWorld . worldEvents .:~ MakeTempLight (LSParam p 150 (V3 1 0.5 0)) 20
-        & makeShockwaveAt [] p 40 100 1 white
+        & makeShockwaveAt [] p 40 100 1 white o
   where
     fVs = fmap (`v2z` 0) $ replicateM 5 (randInCirc 2) & evalState $ _randGen w
     fdamps = replicateM 100 (state $ randomR (0, 1)) & evalState $ _randGen w
     sizes = randomRs (2, 9) $ _randGen w
     times = randomRs (15, 20) $ _randGen w
-    mF v damp = makeFlamelet p (v + damp *^ vel)
+    mF v damp = makeFlamelet o p (v + damp *^ vel)
     newFs = zipWith4 mF fVs fdamps sizes times
     addFlames w' = foldl' (&) w' newFs

src/Dodge/WorldEvent/Shockwave.hs

@@ -22,9 +22,10 @@ makeShockwaveAt ::
     -- | Color of shockwave.
     Color ->
     -- | Start world.
+    DamageOrigin ->
     World ->
     World
-makeShockwaveAt is p rad dam push col =
+makeShockwaveAt is p rad dam push col d =
     cWorld . lWorld . shockwaves
         .:~ Shockwave
             { _swInvulnerableCrs = is
@@ -36,6 +37,7 @@ makeShockwaveAt is p rad dam push col =
             , _swPush = push
             , _swMaxTime = 10
             , _swTimer = 10
+            , _swOrigin = d
             }
 
 {- Create a shockwave going from an outside circle into a center point.  -}
@@ -44,9 +46,10 @@ inverseShockwaveAt ::
     Float -> -- Radius
     Int -> -- Damage
     Float -> -- Push amount
+    DamageOrigin ->
     World ->
     World
-inverseShockwaveAt p rad dam push =
+inverseShockwaveAt p rad dam push d =
     cWorld . lWorld . shockwaves
         .:~ Shockwave
             { _swDirection = InwardShockwave
@@ -58,4 +61,5 @@ inverseShockwaveAt p rad dam push =
             , _swPush = push
             , _swMaxTime = 10
             , _swTimer = 10
+            , _swOrigin = d
             }

src/Dodge/WorldEvent/SpawnParticle.hs

@@ -9,17 +9,19 @@ import LensHelp
 
 -- | At writing the radius is half the size of the effect area
 makeGasCloud ::
+    DamageOrigin ->
     -- | Position
     Point2 ->
     -- | Velocity
     Point2 ->
     World ->
     World
-makeGasCloud pos vel = cWorld . lWorld . gasses .:~ Gas
+makeGasCloud o pos vel = cWorld . lWorld . gasses .:~ Gas
             { _gsPos = addZ 20 pos
             , _gsVel = addZ 0 vel
             , _gsTimer = 400
             , _gsType = PoisonGas
+            , _gsOrigin = o
             }
 
 {- Attach poison cloud damage to creatures near cloud.  -}