Refactor damages

src/Dodge/Barreloid.hs

@@ -1,5 +1,6 @@
 module Dodge.Barreloid where
 
+import Data.Maybe
 import Data.List
 import Dodge.Creature.State
 import Dodge.Data.World
@@ -49,18 +50,14 @@ damsToExpBarrel :: [Damage] -> Creature -> Creature
 damsToExpBarrel ds cr = foldl' damToExpBarrel (foldl' damToExpBarrel cr pierceDam) otherDam
   where
     (pierceDam, otherDam) = partition isPierce ds
-    isPierce Damage{_dmType = PIERCING{}} = True
+    isPierce Piercing{} = True
     isPierce _ = False
 
 damToExpBarrel :: Creature -> Damage -> Creature
-damToExpBarrel cr dm = case _dmType dm of
-    PIERCING ->
-        over (crState . csSpState . piercedPoints) ((:) $ int -.- _crPos cr) $
-            cr & crHP -~ div amount 200
-    POISONDAM -> cr
-    SPARKING -> cr
-    --    PUSHDAM     -> cr LensHelp.& crPos .+.+~ (1 / _crMass cr *.* _dePushBack (_dmEffect dm))
-    _ -> cr LensHelp.& crHP -~ amount
-  where
-    amount = _dmAmount dm
-    int = _dmAt dm
+damToExpBarrel cr dm = case dm of
+    Piercing x p _ ->
+        over (crState . csSpState . piercedPoints) ((:) $ p -.- _crPos cr) $
+            cr & crHP -~ div x 200
+    Poison{} -> cr
+    Sparking{} -> cr
+    _ -> cr LensHelp.& crHP -~ fromMaybe 0 (dm ^? dmAmount)

src/Dodge/Bullet.hs

@@ -114,9 +114,9 @@ useBulletPayload bu = case _buPayload bu of
     BulFlak -> makeFlak bu
     BulFrag -> makeFragBullets
     BulGas -> (`makeGasCloud` V2 0 0)
-    BulBall IncBall -> incBallAt
-    BulBall ConcBall -> \p -> cWorld . lWorld . shockwaves .:~ concBall p
-    BulBall TeslaBall -> makeStaticBall
+    BulBall FlamingBall -> incBallAt
+    BulBall ExplosiveBall -> \p -> cWorld . lWorld . shockwaves .:~ concBall p
+    BulBall ElectricalBall -> makeStaticBall
     BulBall FlashBall -> makeFlashBall
 
 makeFragBullets :: Point2 -> World -> World
@@ -164,12 +164,12 @@ hitEffFromBul w bu = case _buEffect bu of
     hitstream = thingsHit sp (sp + _buVel bu) w
 
 setFromToDams :: Bullet -> Point2 -> [Damage]
-setFromToDams bu p = case _bu of
-    BullPlain x -> [Piercing x p v]
+setFromToDams bu p = case _buPayload bu of
+    BulPlain x -> [Piercing x p v]
     _ -> []
   where
     v = _buVel bu
-    f = (dmFrom .~ _buPos bu) . (dmAt .~ p) . (dmTo .~ _buPos bu +.+ _buVel bu)
+--    f = (dmFrom .~ _buPos bu) . (dmAt .~ p) . (dmTo .~ _buPos bu +.+ _buVel bu)
 
 damageThingHit :: Bullet -> (Point2, Either Creature Wall) -> World -> World
 damageThingHit bu (p, crwl) = case crwl of

src/Dodge/Creature.hs

@@ -22,6 +22,7 @@ module Dodge.Creature (
     module Dodge.Creature.YourControl,
 ) where
 
+import Dodge.Data.EnergyBall.Type
 import Dodge.Data.Magnet
 import Dodge.Item.Ammo
 import Dodge.Item.Scope
@@ -280,7 +281,11 @@ inventoryX c = case c of
         , megaTinMag 10200
         ] <>
 --        [bulletTargetingModule btt | btt <- [minBound .. maxBound]]
-        [bulletModule (BulletModPayload (BulBall x)) | x <- [minBound .. maxBound]]
+        [bulletModule (BulletModPayload (BulBall x)) | x <- [ FlamingBall
+                , FlameletBall 5
+                , ElectricalBall
+                , ExplosiveBall
+                , FlashBall ]]
         <> [bulletModule (BulletModEffect x) | x <- [minBound .. maxBound]]
     _ -> []
 

src/Dodge/Creature/Damage.hs

@@ -21,7 +21,7 @@ defaultApplyDamage ds cr w =
         & cWorld . lWorld . creatures . ix (_crID cr) %~ doPoisonDam
   where
     (ps, ds') = partition isPoison ds
-    isPoison Damage{_dmType = POISONDAM} = True
+    isPoison Poison{} = True
     isPoison _ = False
     poisonDam = quot (max 0 (sum (map _dmAmount ps))) 10
     doPoisonDam = crHP -~ poisonDam
@@ -49,7 +49,7 @@ applyIndividualDamage :: Creature -> World -> Damage -> World
 applyIndividualDamage cr w dm = applyIndividualDamage' cr w dm
 
 applyIndividualDamage' :: Creature -> World -> Damage -> World
-applyIndividualDamage' cr w dm = case _dmType dm of
+applyIndividualDamage' cr w dm = case dm of
     Piercing{} -> applyPiercingDamage cr dm w
     _ -> w & damageHP cr (_dmAmount dm)
 
@@ -61,7 +61,7 @@ applyPiercingDamage cr dm
     f = cWorld . lWorld . creatures . ix (_crID cr) . crPos -~ _dmVector dm
             / V2 x x
     x = crMass (_crType cr)
-    p = _dmAt dm
+    p = _dmPos dm
     p1 = p +.+ 2 *.* squashNormalizeV (p -.- _crPos cr)
 
 damageHP :: Creature -> Int -> World -> World

src/Dodge/Creature/Impulse.hs

@@ -87,6 +87,6 @@ followImpulse cr w imp = case imp of
     rr a = randomR (- a, a) $ _randGen w
     hitCr i =
         ( cWorld . lWorld . creatures . ix i . crState . csDamage
-            .:~ Damage BLUNT 100 cpos (posFromID i) (posFromID i)-- (PushBackDamage 5)
+            .:~ Blunt 100 (posFromID i) (posFromID i-cpos)-- (PushBackDamage 5)
         )
             . soundStart (CrSound cid) cpos hitS Nothing

src/Dodge/Creature/State.hs

@@ -108,9 +108,9 @@ checkDeath cr w
 -- could look at the amount of damage here (given by maxDamage) too
 corpseOrGib :: Creature -> World -> World
 corpseOrGib cr = case cr ^? crState . csDamage . to maxDamageType . _Just . _1 of
-    Just FLAMING -> plNew (cWorld . lWorld . corpses) cpID (thecorpse & cpSPic %~ scorchSPic)
-    Just ELECTRICAL -> plNew (cWorld . lWorld . corpses) cpID thecorpse
-    Just POISONDAM -> plNew (cWorld . lWorld . corpses) cpID (thecorpse & cpSPic %~ poisonSPic)
+    Just Flaming{} -> plNew (cWorld . lWorld . corpses) cpID (thecorpse & cpSPic %~ scorchSPic)
+    Just Electrical{} -> plNew (cWorld . lWorld . corpses) cpID thecorpse
+    Just Poison{} -> plNew (cWorld . lWorld . corpses) cpID (thecorpse & cpSPic %~ poisonSPic)
     _ | _crPastDamage cr > 200 -> addCrGibs cr
     _ -> plNew (cWorld . lWorld . corpses) cpID thecorpse
   where

src/Dodge/Damage.hs

@@ -6,11 +6,11 @@ module Dodge.Damage
     , maxDamageType
     ) where
 
-import qualified Data.Map.Strict as M
+--import qualified Data.Map.Strict as M
 import Dodge.Data.CrWlID
 import Dodge.Data.World
-import FoldableHelp
-import Geometry.Vector
+--import FoldableHelp
+--import Geometry.Vector
 import LensHelp
 import qualified IntMapHelp as IM
 
@@ -25,14 +25,16 @@ damageCrWl dt (Left cr) = cWorld . lWorld . creatures . ix (_crID cr) . crState
 damageCrWl dt (Right wl) = cWorld . lWorld . wallDamages %~ IM.insertWith (++) (_wlID wl) [dt]
 
 damageDirection :: [Damage] -> Maybe Float
-damageDirection ds = do
-    dm <- safeMinimumOn (negate . _dmAmount) ds
-    safeArgV (_dmTo dm -.- _dmFrom dm)
+damageDirection _ = Nothing
+--damageDirection ds = do
+--    dm <- safeMinimumOn (negate . _dmAmount) ds
+--    safeArgV (_dmTo dm -.- _dmFrom dm)
 
-collectDamageTypes :: [Damage] -> M.Map DamageType Int
-collectDamageTypes = foldl' (flip f) M.empty
-  where
-    f dm = M.insertWith (+) (_dmType dm) (_dmAmount dm)
-
-maxDamageType :: [Damage] -> Maybe (DamageType, Int)
-maxDamageType = safeMinimumOn (negate . snd) . M.assocs . collectDamageTypes
+--collectDamageTypes :: [Damage] -> M.Map DamageType Int
+--collectDamageTypes = foldl' (flip f) M.empty
+--  where
+--    f dm = M.insertWith (+) (_dmType dm) (_dmAmount dm)
+--
+maxDamageType :: [Damage] -> Maybe (Damage, Int)
+maxDamageType _ = Nothing
+--maxDamageType = safeMinimumOn (negate . snd) . M.assocs . collectDamageTypes

src/Dodge/Data/Damage.hs

@@ -20,7 +20,7 @@ data Damage
     = Piercing {_dmAmount :: Int, _dmPos :: Point2, _dmVector :: Point2}
     | Blunt {_dmAmount :: Int, _dmPos :: Point2, _dmVector :: Point2}
     | Sparking {_dmAmount :: Int}
-    | Crushing {_dmAmount :: Int}
+    | Crushing {_dmAmount :: Int, _dmVector :: Point2}
     | Shattering {_dmAmount :: Int, _dmPos :: Point2, _dmVector :: Point2}
     | Flaming {_dmAmount :: Int}
     | Lasering {_dmAmount :: Int, _dmPos :: Point2, _dmVector :: Point2}

src/Dodge/Data/EnergyBall/Type.hs

@@ -12,7 +12,7 @@ import Geometry.Data
 
 data EnergyBallType
     = FlamingBall
-    | FlameletBall
+    | FlameletBall Float
     | ElectricalBall
     | ExplosiveBall
     | FlashBall

src/Dodge/EnergyBall.hs

@@ -22,19 +22,21 @@ makeFlamelet ::
     Point2 ->
     -- | Velocity
     Point2 ->
+    -- | Size
+    Float ->
     -- | Timer
     Int ->
     World ->
     World
-makeFlamelet (V2 x y) vel time w =
+makeFlamelet (V2 x y) vel s t w =
     w
         & randGen .~ g
         & cWorld . lWorld . energyBalls
             .:~ EnergyBall
                 { _ebVel = vel
                 , _ebPos = V2 x y
-                , _ebTimer = time
-                , _ebEff = FlameletBall
+                , _ebTimer = t
+                , _ebEff = FlameletBall s
                 , _ebRot = rot
                 }
   where
@@ -96,7 +98,7 @@ ebFlicker pt
 ebColor :: EnergyBall -> Color
 ebColor eb = case eb ^. ebEff of
     FlamingBall -> red
-    FlameletBall -> red
+    FlameletBall {} -> red
     ElectricalBall -> cyan
     ExplosiveBall -> yellow
     FlashBall -> white
@@ -118,7 +120,7 @@ damageCircle sp dt w =
 ebtToDamage :: Point2 -> EnergyBallType -> Damage
 ebtToDamage p = \case
     FlamingBall -> Flaming 10
-    FlameletBall -> Flaming 1
+    FlameletBall _ -> Flaming 1
     ElectricalBall -> Electrical 10
     ExplosiveBall -> Explosive 10 p
     FlashBall -> Flashing 10 p

src/Dodge/EnergyBall/Draw.hs

@@ -2,16 +2,17 @@ module Dodge.EnergyBall.Draw (
     drawEnergyBall,
 ) where
 
-import Dodge.Data.Damage.Type
 import Dodge.Data.EnergyBall
 import Geometry
 import Picture
 
 drawEnergyBall :: EnergyBall -> Picture
 drawEnergyBall eb = case _ebEff eb of
-    (ELECTRICAL, _) -> drawStaticBall eb
-    (FLAMING, _) -> drawFlamelet eb
-    _ -> error "don't know how to draw an energy ball of this type"
+    FlamingBall -> drawFlamelet 5 eb
+    FlameletBall x -> drawFlamelet x eb
+    ElectricalBall -> drawStaticBall eb
+    ExplosiveBall -> mempty
+    FlashBall -> mempty
 
 drawStaticBall ::
     EnergyBall ->
@@ -21,10 +22,10 @@ drawStaticBall pt =
         . setDepth 20
         --        . setDepth (_ebZ pt + 20)
         . uncurryV translate (_ebPos pt)
-        $ circleSolidCol (_ebColor pt) (withAlpha 0.5 white) (_ebWidth pt + 5)
+        $ circleSolidCol blue (withAlpha 0.5 white) 8
 
-drawFlamelet :: EnergyBall -> Picture
-drawFlamelet pt =
+drawFlamelet :: Float -> EnergyBall -> Picture
+drawFlamelet size pt =
     fold
         [ setLayer BloomLayer pic
         , setLayer BloomNoZWrite piu
@@ -36,7 +37,7 @@ drawFlamelet pt =
     sp = _ebPos pt
     vel = _ebVel pt
     ep = sp +.+ vel
-    size = _ebWidth pt
+    --size = _ebWidth pt
     siz2 = size + 0.2
     time = _ebTimer pt
     piu =

src/Dodge/Flame.hs

@@ -4,10 +4,10 @@ module Dodge.Flame (
     updateFlame,
 ) where
 
-import Dodge.Creature.Radius
-import Dodge.Data.World
 import Data.Foldable
 import Data.Tuple
+import Dodge.Creature.Radius
+import Dodge.Data.World
 import Dodge.SoundLogic
 import Dodge.WorldEvent.Cloud
 import Dodge.WorldEvent.ThingsHit
@@ -38,34 +38,26 @@ aFlameParticle t pos vel =
         , _flOriginalVel = vel
         }
 
-simpleDamFL :: DamageType -> Int -> Flame -> Point2 -> [Damage]
-simpleDamFL dt amount bt p = [Damage dt amount sp p ep]
-  where
-    sp = _flPos bt
-    bulVel = _flVel bt
-    ep = sp +.+ bulVel
-
 expireAndDamageFL ::
-    (Flame -> Point2 -> [Damage]) ->
     Flame ->
     [(Point2, Either Creature Wall)] ->
     World ->
     (World, Maybe Flame)
-expireAndDamageFL fdm bt things w = case List.safeHead things of
+expireAndDamageFL bt things w = case List.safeHead things of
     Nothing -> (w, Just $ bt & flTimer -~ 1)
-    Just x -> (doDamagesFL fdm x bt w, Nothing)
+    Just x -> (doDamagesFL x bt w, Nothing)
 
 doDamagesFL ::
-    (Flame -> Point2 -> [Damage]) ->
     (Point2, Either Creature Wall) ->
     Flame ->
     World ->
     World
-doDamagesFL fdm (p, thhit) bt = case thhit of
-    Left cr -> cWorld . lWorld . creatures . ix (_crID cr) . crState . csDamage .++~ dams
-    Right wl -> cWorld . lWorld . wallDamages %~ IM.insertWith (++) (_wlID wl) dams
-  where
-    dams = fdm bt p
+doDamagesFL (p, thhit) bt = case thhit of
+    Left cr ->
+        cWorld . lWorld . creatures . ix (_crID cr) . crState . csDamage
+            .:~ Flaming 1
+    --Right wl -> cWorld . lWorld . wallDamages %~ IM.insertWith (++) (_wlID wl) dams
+    Right wl -> cWorld . lWorld . wallDamages . ix (_wlID wl) .:~ Flaming 1
 
 {- TODO: add generalised area damage particles/hiteffects.  -}
 updateFlame :: World -> Flame -> (World, Maybe Flame)
@@ -112,21 +104,21 @@ flDamageInArea :: (Creature -> Bool) -> (Wall -> Bool) -> Flame -> World -> Worl
 flDamageInArea crt wlt pt w = damwls damcrs
   where
     p = _flPos pt
-    damcrs = foldl' (flip $ \cr -> fst . hiteff [(p, Left cr)]) w $ IM.filter crt $ w ^. cWorld . lWorld . creatures--_creatures (_cWorld w)
+    damcrs = foldl' (flip $ \cr -> fst . hiteff [(p, Left cr)]) w $ IM.filter crt $ w ^. cWorld . lWorld . creatures --_creatures (_cWorld w)
     damwls w' =
         foldl'
             (flip $ \wl -> fst . hiteff [(p, Right wl)])
             w'
             . filter wlt
             $ wlsNearPoint p w'
-    hiteff = expireAndDamageFL (simpleDamFL FLAMING 1) pt
+    hiteff = expireAndDamageFL pt
 
 flFlicker :: Flame -> World -> World
 flFlicker pt
     | _flTimer pt `mod` 7 == 0 =
         cWorld . lWorld . lights
             .:~ LSParam (addZ 10 $ _flPos pt) 70 (0.5 *.*.* xyzV4 (_flColor pt))
---            .:~ tlsTimeRadColPos 1 70 (0.5 *.*.* xyzV4 (_flColor pt)) (addZ 10 $ _flPos pt)
+    --            .:~ tlsTimeRadColPos 1 70 (0.5 *.*.* xyzV4 (_flColor pt)) (addZ 10 $ _flPos pt)
     | otherwise = id
 
 makeFlame :: Point2 -> Point2 -> World -> World

src/Dodge/Item/Weapon/Shatter.hs

@@ -35,4 +35,4 @@ shatterWall w sp ep p wl =
             (_wlMaterial wl)
             (_wlColor wl)
             p
-        & damageWall (Damage SHATTERING 1000 sp p ep) wl
+        & damageWall (Shattering 1000 p (ep - sp)) wl

src/Dodge/Laser/Update.hs

@@ -16,7 +16,7 @@ updateLaser w pt =
     ( case _lpType pt of
         DamageLaser dam ->
             damThingHitWith
-                (\p1 p2 p3 -> Damage LASERING dam p1 p2 p3)
+                (\p1 p2 p3 -> Lasering dam p2 (p3 - p2))
                 sp
                 xp
                 thHit

src/Dodge/Machine/Update.hs

@@ -56,7 +56,7 @@ updateTurret rotSpeed mc w =
   where
     dodamage =
         cWorld . lWorld . machines . ix mcid
-            %~ ( (mcDamage .~ [Damage ELECTRICAL (min 2500 $ max 0 (elecDam - 10)) 0 0 0])
+            %~ ( (mcDamage .~ [Electrical (min 2500 $ max 0 (elecDam - 10))])
                     . (mcHP -~ dam)
                )
     elecDamBranch
@@ -78,8 +78,8 @@ updateTurret rotSpeed mc w =
         | otherwise = cWorld . lWorld . machines . ix mcid . mcType . _McTurret . tuFireTime %~ (max 0 . subtract 1)
 
 isElectrical :: Damage -> Bool
-isElectrical dm = case _dmType dm of
-    ELECTRICAL -> True
+isElectrical dm = case dm of
+    Electrical{} -> True
     _ -> False
 
 mcUseItem :: Machine -> World -> World
@@ -168,19 +168,32 @@ senseDamage threshold dt mc =
         | x > 0 = x
         | otherwise = -5
       where
-        f d = d `elem` sensorTypeDamages dt
-        x = sum . map _dmAmount $ filter (f . _dmType) (_mcDamage mc)
+        f = sensorTypeDamages dt
+        x = sum . map _dmAmount $ filter f (_mcDamage mc)
     ni = fromIntegral (mc ^?! mcType . _McSensor . sensAmount) / fromIntegral threshold
     updatels = fromMaybe id $ do
         lsid <- mc ^? mcMounts . ix ObLightSource
         return $ cWorld . lWorld . lightSources . ix lsid . lsParam . lsCol .~ V3 ni ni ni
 
-sensorTypeDamages :: SensorType -> [DamageType]
+sensorTypeDamages :: SensorType -> Damage -> Bool
 sensorTypeDamages = \case
-    LaserSensor -> [LASERING]
-    ElectricSensor -> [ELECTRICAL]
-    ThermalSensor -> [FLAMING,SPARKING,EXPLOSIVE]
-    PhysicalSensor -> [PIERCING,BLUNT,CUTTING,CRUSHING,EXPLOSIVE,CONCUSSIVE]
+    LaserSensor -> \case 
+        Lasering{} -> True
+        _ -> False
+    ElectricSensor -> \case
+        Electrical {} -> True
+        _ -> False
+    ThermalSensor -> \case
+        Flaming {} -> True
+        Sparking {} -> True
+        Explosive {} -> True
+        _ -> False
+    PhysicalSensor -> \case
+        Piercing {} -> True
+        Blunt {} -> True
+        Crushing {} -> True
+        Explosive {} -> True
+        _ -> False
     
 
 --damageUsing :: DamageType -> Damage -> Either Int Int

src/Dodge/Material/Damage.hs

@@ -18,27 +18,22 @@ defDamageMaterial :: Damage -> Float -> World -> (Int, World)
 defDamageMaterial dm _ w = (_dmAmount dm, w)
 
 damageStone :: Damage -> Float -> World -> (Int, World)
-damageStone dm dir = case _dmType dm of
-    LASERING -> a 0 $ makeSpark NormalSpark outTo (argV $ reflectIn (p -.- sp) v)
-    PIERCING -> a d $ makeSpark FireSpark outTo (argV $ reflectIn (p -.- sp) v)
-    BLUNT -> a d id
-    SHATTERING -> a d id
-    CRUSHING -> a d id
-    EXPLOSIVE -> a d id
-    CUTTING -> a d id
-    SPARKING -> a 0 id
-    FLAMING -> a 0 id
-    ELECTRICAL -> a 0 id
-    CONCUSSIVE -> a d id
-    POISONDAM -> a 0 id
-    ENTERREMENT -> a 0 id
+damageStone dm dir = case dm of
+    Lasering x p t -> a 0 $ makeSpark FireSpark (outTo p t) (argV $ reflectIn t v)
+    Piercing x p t -> a x $ makeSpark NormalSpark (outTo p t) (argV $ reflectIn t v)
+    Blunt x p t -> a x $ makeSpark NormalSpark (outTo p t) (argV $ reflectIn t v)
+    Shattering {} -> a 0 id
+    Crushing {} -> a 0 id
+    Explosive {} -> a 0 id
+    Sparking {} -> a 0 id
+    Flaming {} -> a 0 id
+    Electrical {} -> a 0 id
+    Poison {} -> a 0 id
+    Enterrement {} -> a 0 id
   where
     v = unitVectorAtAngle dir
     a x f w = (x, f w)
-    d = _dmAmount dm
-    sp = _dmFrom dm
-    p = _dmAt dm
-    outTo = p +.+ squashNormalizeV (sp -.- p)
+    outTo x t = x -.- squashNormalizeV t
 
 --damageGlass :: Damage -> Float -> World -> (World,Int)
 --damageGlass dm dir w = w & case _dmType dm of

src/Dodge/Prop/Moving.hs

@@ -23,7 +23,8 @@ fallSmallBounceDamage pr w =
     dodamage' cr
         | dist (_crPos cr) p < crRad (cr ^. crType) + 5 =
             cr & crState . csDamage
-                .:~ Damage CRUSHING (floor . (* 10) . max 0 . subtract 5 . abs $ _prVelZ pr) (p -.- v) p (p +.+ v)
+                .:~ Crushing (floor . (* 10) . max 0 . subtract 5 . abs $ _prVelZ pr) v
+                    --(p -.- v) p (p +.+ v)
         | otherwise = cr
 
 fallSmallBounce :: Prop -> World -> World

src/Dodge/Shockwave/Update.hs

@@ -30,7 +30,7 @@ moveShockwave w sw
     doDams w' =
         over (cWorld . lWorld . creatures) (IM.map damCr) $
             foldl'
-                (flip $ damageWall (Damage EXPLOSIVE 1000 p p p))
+                (flip $ damageWall (Explosive 1000 p))
                 w'
                 hitBlocks
     hitBlocks = map snd . overlapCircWalls p rad $ wlsNearCirc p rad w
@@ -39,12 +39,7 @@ moveShockwave w sw
         | _crID cr `elem` is || dist (_crPos cr) p >= rad + crRad (cr ^. crType) = cr
         | otherwise =
             cr & crState . csDamage
-                .:~ Damage
-                    CONCUSSIVE
-                    dam
-                    (cpos -.- v)
-                    cpos
-                    (cpos +.+ v)
+                .:~ Explosive dam p
       where
         cpos = _crPos cr
         v = normalizeV (cpos -.- p)
@@ -67,7 +62,7 @@ moveInverseShockwave w sw
         | dist (_crPos cr) p >= rad + crRad (cr ^. crType) = cr
         | otherwise =
             cr & crState . csDamage
-                .:~ Damage CONCUSSIVE 1 (cpos +.+ v) cpos (cpos -.- v)
+                .:~ Explosive 1 p
       where
         cpos = _crPos cr
         v = normalizeV (cpos -.- p)

src/Dodge/Spark.hs

@@ -39,13 +39,13 @@ sparkDam' ::
 sparkDam' sk sp ep mayEiCrWl = case mayEiCrWl of
     (hitp, eicrwl) -> damageCrWl (thedam hitp) eicrwl
   where
-    thedam hitp = Damage (sparkToDamage sk) 10 sp hitp ep -- NoDamageEffect
+    thedam hitp = sparkToDamage sk
 
-sparkToDamage :: Spark -> DamageType
+sparkToDamage :: Spark -> Damage
 sparkToDamage sp = case _skType sp of
-     ElectricSpark ->ELECTRICAL
-     FireSpark -> FLAMING
-     NormalSpark -> SPARKING
+     ElectricSpark -> Electrical 10
+     FireSpark -> Flaming 1
+     NormalSpark -> Sparking 10
 
 createBarrelSpark :: Point2 -> Float -> World -> World
 createBarrelSpark pos dir = sparkRandDir 0.1 pos dir

src/Dodge/Update.hs

@@ -575,10 +575,7 @@ updateTeslaArc w pt
             , randWallReflect ld' wl
             )
         | ArcStep lp' ld' _ <- last thearc = (lp', rp ld')
-    damthings (ArcStep p dir crwl) = damageCrWlID (thedamage p dir) crwl
-    thedamage p dir = Damage ELECTRICAL 50 (p -.- q) p (p +.+ q)
-      where
-        q = 5 *.* unitVectorAtAngle dir
+    damthings (ArcStep _ _ crwl) = damageCrWlID (Electrical 50) crwl
 
 randWallReflect :: RandomGen g => Float -> Wall -> State g Float
 randWallReflect a wl = randPeaked a1 outa a2

src/Dodge/Update/Cloud.hs

@@ -14,6 +14,6 @@ cloudPoisonDamage c w = w & dodamagesto (filter f $ crsNearPoint clpos w)
     dodamagesto scrs mcrs = foldl' (flip doDam) mcrs scrs
     doDam cr =
         cWorld . lWorld . creatures . ix (_crID cr) . crState . csDamage
-            .:~ Damage POISONDAM 1 clpos clpos clpos
+            .:~ Poison 1
     f cr = dist3 (addZ 20 $ _crPos cr) (_clPos c) < crRad (cr ^. crType) + _clRad c + 10
     clpos = stripZ $ _clPos c

src/Dodge/Wall/DamageEffect.hs

@@ -1,3 +1,4 @@
+{-# LANGUAGE TupleSections #-}
 module Dodge.Wall.DamageEffect where
 
 import Dodge.Base.Wall
@@ -9,7 +10,7 @@ import Geometry
 import LensHelp
 
 damageWallEffect :: Damage -> Wall -> World -> (World, Damage)
-damageWallEffect dm wl = case _wlMaterial wl of
+damageWallEffect dm wl = (,dm) . case _wlMaterial wl of
     Stone -> stoneWallDamage dm wl
     Glass -> glassWallDamage dm wl
     Dirt -> dirtWallDamage dm wl
@@ -21,97 +22,94 @@ damageWallEffect dm wl = case _wlMaterial wl of
 
 -- there is quite a lot of duplication here, should be sorted out
 
-stoneWallDamage :: Damage -> Wall -> World -> (World, Damage)
-stoneWallDamage dm wl = case _dmType dm of
-    PIERCING -> a d $ makeSpark NormalSpark outTo (reflDirWall sp p wl) . wlDustAt wl outTo
-    LASERING -> a 0 $ makeSpark FireSpark outTo (reflDirWall sp p wl)
-    BLUNT -> a d $ wlDustAt wl outTo
-    SHATTERING -> a d $ muchWlDustAt wl outTo
-    CRUSHING -> a d id
-    EXPLOSIVE -> a d id
-    CUTTING -> a d id
-    SPARKING -> a 0 id
-    FLAMING -> a 0 id
-    ELECTRICAL -> a 0 id
-    CONCUSSIVE -> a d id
-    POISONDAM -> a 0 id
-    ENTERREMENT -> a 0 id
+stoneWallDamage :: Damage -> Wall -> World -> World
+stoneWallDamage dm wl = case dm of
+    Piercing d p t -> a d $ makeSpark NormalSpark (outTo p t) 
+        (reflDirWall p (p+t) wl) . wlDustAt wl (outTo p t)
+    Lasering d p t -> a 0 $ makeSpark FireSpark (outTo p t) (reflDirWall p (p+t) wl)
+    Blunt d p t -> a d $ wlDustAt wl (outTo p t)
+    Shattering d p t -> a d $ muchWlDustAt wl (outTo p t)
+    Crushing d _ -> a d id
+    Explosive d _ -> a d id
+    Sparking {} -> a 0 id
+    Flaming {} -> a 0 id
+    Electrical {} -> a 0 id
+    Poison {} -> a 0 id
+    Enterrement {} -> a 0 id
   where
-    a x f w = (f w, dm & dmAmount .~ x)
-    d = _dmAmount dm
-    sp = _dmFrom dm
-    p = _dmAt dm
-    outTo = p +.+ squashNormalizeV (sp -.- p)
+    a x f w = (f w)
+    outTo x y = x -.- squashNormalizeV y
+--    d = _dmAmount dm
+--    sp = _dmFrom dm
+--    p = _dmAt dm
+--    outTo = p +.+ squashNormalizeV (sp -.- p)
 
-glassWallDamage :: Damage -> Wall -> World -> (World, Damage)
+glassWallDamage :: Damage -> Wall -> World -> World
 glassWallDamage dm wl w =
-    w & case _dmType dm of
-        LASERING -> a 0 $ makeSpark FireSpark outTo (reflDirWall sp p wl)
-        PIERCING -> a d $ dosplint . makeSpark NormalSpark outTo (reflDirWall sp p wl) . wlDustAt wl outTo
-        BLUNT -> a d $ dosplint . wlDustAt wl outTo
-        SHATTERING -> a d $ dosplint . muchWlDustAt wl outTo
-        CRUSHING -> a d dosplint
-        EXPLOSIVE -> a d dosplint
-        CUTTING -> a d dosplint
-        SPARKING -> a 0 id
-        FLAMING -> a 0 id
-        ELECTRICAL -> a 0 id
-        CONCUSSIVE -> a 0 dosplint
-        POISONDAM -> a 0 id
-        ENTERREMENT -> a 0 id
+    w & case dm of
+        Lasering d p t -> a 0 $ makeSpark FireSpark (outTo p t) (reflDirWall p (p+t) wl)
+        Piercing d p t -> a d $ dosplint . makeSpark NormalSpark (outTo p t) (reflDirWall p (p+t) wl) . wlDustAt wl (outTo p t)
+        Blunt d p t -> a d $ dosplint . wlDustAt wl (outTo p t)
+        Shattering d p t -> a d $ dosplint . muchWlDustAt wl (outTo p t)
+        Crushing {} -> a d dosplint
+        Explosive {} -> a d dosplint
+        Sparking {} -> a 0 id
+        Flaming {} -> a 0 id
+        Electrical {} -> a 0 id
+        Poison {} -> a 0 id
+        Enterrement {} -> a 0 id
   where
     mbl = do
         blid <- wl ^? wlStructure . wsBlock
         w ^? cWorld . lWorld . blocks . ix blid
     d :: Int
     d = max 1 $ maybe 1 (subtract 1 . _blHP) mbl
-    a :: Int -> (World -> World) -> World -> (World, Damage)
-    a x f w' = (f w', dm & dmAmount .~ x)
+    a :: Int -> (World -> World) -> World -> (World)
+    a x f w' = (f w')
     dosplint = maybe id splinterBlock mbl
-    sp = _dmFrom dm
-    p = _dmAt dm
-    outTo = p +.+ squashNormalizeV (sp -.- p)
+--    sp = _dmFrom dm
+--    p = _dmAt dm
+    --outTo = p +.+ squashNormalizeV (sp -.- p)
+    outTo p t = p -.- squashNormalizeV t
 
-crystalWallDamage :: Damage -> Wall -> World -> (World, Damage)
-crystalWallDamage dm wl = case _dmType dm of
-    LASERING -> a 0 $ makeSpark FireSpark outTo (reflDirWall sp p wl)
-    PIERCING -> a 0 $ makeSpark NormalSpark outTo (reflDirWall sp p wl)-- . wlDustAt wl outTo
-    BLUNT -> a 0 $ wlDustAt wl outTo
-    SHATTERING -> a d $ muchWlDustAt wl outTo
-    CRUSHING -> a 0 id
-    EXPLOSIVE -> a 0 id
-    CUTTING -> a 0 id
-    SPARKING -> a 0 id
-    FLAMING -> a 0 id
-    ELECTRICAL -> a 0 id
-    CONCUSSIVE -> a 0 id
-    POISONDAM -> a 0 id
-    ENTERREMENT -> a 0 id
+crystalWallDamage :: Damage -> Wall -> World -> World
+crystalWallDamage dm wl = case dm of
+    Lasering d p t -> a 0 $ makeSpark FireSpark (outTo p t) (reflDirWall p (p+t) wl)
+    Piercing d p t -> a 0 $ makeSpark NormalSpark (outTo p t) (reflDirWall p (p+t) wl) . wlDustAt wl (outTo p t)
+    Blunt d p t -> a 0 $ wlDustAt wl (outTo p t)
+    Shattering d p t -> a d $ muchWlDustAt wl (outTo p t)
+    Crushing {} -> a 0 id
+    Explosive {} -> a 0 id
+    Sparking {} -> a 0 id
+    Flaming {} -> a 0 id
+    Electrical {} -> a 0 id
+    Poison {} -> a 0 id
+    Enterrement {} -> a 0 id
   where
-    a x f w = (f w, dm & dmAmount .~ x)
-    d = _dmAmount dm
-    sp = _dmFrom dm
-    p = _dmAt dm
-    outTo = p +.+ squashNormalizeV (sp -.- p)
+    a x f w = (f w)
+    --d = _dmAmount dm
+    --sp = _dmFrom dm
+    --p = _dmAt dm
+    --outTo = p +.+ squashNormalizeV (sp -.- p)
+    outTo p t = p -.- squashNormalizeV t
 
-dirtWallDamage :: Damage -> Wall -> World -> (World, Damage)
-dirtWallDamage dm wl = case _dmType dm of
-    LASERING -> a d $ wlDustAt wl outTo
-    PIERCING -> a d $ wlDustAt wl outTo
-    BLUNT -> a d $ wlDustAt wl outTo
-    SHATTERING -> a d $ muchWlDustAt wl outTo
-    CRUSHING -> a d $ wlDustAt wl outTo
-    EXPLOSIVE -> a d $ muchWlDustAt wl outTo
-    CUTTING -> a d $ muchWlDustAt wl outTo
-    SPARKING -> a 0 id
-    FLAMING -> a 0 id
-    ELECTRICAL -> a 0 id
-    CONCUSSIVE -> a d id
-    POISONDAM -> a 0 id
-    ENTERREMENT -> a 0 id
+dirtWallDamage :: Damage -> Wall -> World -> World
+dirtWallDamage dm wl = case dm of
+    Lasering d p t -> a d $ wlDustAt wl (outTo p t)
+    Piercing d p t -> a d $ wlDustAt wl (outTo p t)
+    Blunt d p t -> a d $ wlDustAt wl (outTo p t)
+    Shattering d p t -> a d $ muchWlDustAt wl (outTo p t)
+    Crushing d _ -> a d id
+    Explosive d _ -> a d id
+    Sparking {} -> a 0 id
+    Flaming {} -> a 0 id
+    Electrical {} -> a 0 id
+    Poison {} -> a 0 id
+    Enterrement {} -> a 0 id
   where
-    a x f w = (f w, dm & dmAmount .~ x)
-    d = _dmAmount dm
-    sp = _dmFrom dm
-    p = _dmAt dm
-    outTo = p +.+ squashNormalizeV (sp -.- p)
+    a x f w = (f w)
+    --d = _dmAmount dm
+    --sp = _dmFrom dm
+    --p = _dmAt dm
+    --outTo = p +.+ squashNormalizeV (sp -.- p)
+    outTo p t = p -.- squashNormalizeV t

src/Dodge/WorldEvent/SpawnParticle.hs

@@ -43,12 +43,9 @@ aStaticBall p =
     return
         EnergyBall
             { _ebVel = 0
-            , _ebColor = blue
             , _ebPos = p
-            , _ebWidth = 3
             , _ebTimer = 20
-            , _ebEff = (ELECTRICAL, 10)
---            , _ebZ = 20
+            , _ebEff = ElectricalBall
             , _ebRot = 0
             }