Cleanup barrels

src/Dodge/Barreloid.hs

@@ -1,7 +1,7 @@
-module Dodge.Barreloid where
+module Dodge.Barreloid (updateBarreloid) where
 
-import Data.Maybe
 import Data.List
+import Data.Maybe
 import Dodge.Creature.State
 import Dodge.Data.World
 import Dodge.SoundLogic
@@ -13,7 +13,7 @@ import System.Random
 
 updateBarreloid :: Creature -> World -> World
 updateBarreloid cr = case cr ^?! crType . barrelType of
-    ExplosiveBarrel -> updateExpBarrel cr
+    ExplosiveBarrel{} -> updateExpBarrel cr
     PlainBarrel -> updateBarrel cr
 
 -- should generate the sparks externally using new random generators
@@ -31,11 +31,11 @@ updateExpBarrel cr w
             poss
             as
     as = randomRs (-0.7, 0.7) g
-    poss = _piercedPoints $ _csSpState $ _crState cr
+    poss = _piercedPoints $ _barrelType $ _crType cr
     newCr = Just $ applyFuseDamage $ set (crState . csDamage) [] $ damsToExpBarrel damages cr
     applyFuseDamage cr' =
         cr' & crHP
-            %~ subtract (length . _piercedPoints . _csSpState $ _crState cr')
+            %~ subtract (length . _piercedPoints . _barrelType $ _crType cr')
     hiss
         | null poss = id
         | otherwise = soundMultiFrom [BarrelHiss 0, BarrelHiss 1] (_crPos cr) foamSprayLoopS (Just 1)
@@ -47,17 +47,13 @@ updateBarrel cr
     | otherwise = cWorld . lWorld . creatures . at (_crID cr) .~ Nothing
 
 damsToExpBarrel :: [Damage] -> Creature -> Creature
-damsToExpBarrel ds cr = foldl' damToExpBarrel (foldl' damToExpBarrel cr pierceDam) otherDam
+damsToExpBarrel = flip $ foldl' damToExpBarrel
-  where
-    (pierceDam, otherDam) = partition isPierce ds
-    isPierce Piercing{} = True
-    isPierce _ = False
 
 damToExpBarrel :: Creature -> Damage -> Creature
 damToExpBarrel cr dm = case dm of
     Piercing x p _ ->
-        over (crState . csSpState . piercedPoints) ((:) $ p -.- _crPos cr) $
+        cr & crHP -~ div x 200
-            cr & crHP -~ div x 200
+            & crType . barrelType . piercedPoints .:~ (p - _crPos cr)
     Poison{} -> cr
     Sparking{} -> cr
-    _ -> cr LensHelp.& crHP -~ fromMaybe 0 (dm ^? dmAmount)
+    _ -> cr & crHP -~ fromMaybe 0 (dm ^? dmAmount)

src/Dodge/Bullet.hs

@@ -116,7 +116,7 @@ useBulletPayload bu = case _buPayload bu of
     BulFlak -> makeFlak bu
     BulFrag -> makeFragBullets
     BulGas -> (`makeGasCloud` V2 0 0)
-    BulBall ExplosiveBall -> \p -> cWorld . lWorld . shockwaves .:~ concBall p
+    BulBall ExplosiveBall -> makeMovingEB (_buVel bu) ExplosiveBall
     BulBall ElectricalBall{} -> makeMovingEB (_buVel bu) 
         (ElectricalBall (round $ bu ^. buPos . _1))
     BulBall FlashBall -> makeMovingEB (_buVel bu) FlashBall

src/Dodge/Creature.hs

@@ -285,6 +285,7 @@ inventoryX c = case c of
                 , ElectricalBall 0
                 , ExplosiveBall
                 , FlashBall ]]
+        <> [bulletModule (BulletModPayload BulGas)]
         <> [bulletModule (BulletModEffect x) | x <- [minBound .. maxBound]]
     _ -> []
 

src/Dodge/Creature/Inanimate.hs

@@ -21,8 +21,8 @@ barrel =
         , _crType = BarrelCrit PlainBarrel
         , _crState =
             defaultState
-                { _csSpState = Barrel []
+--                { _csSpState = Barrel []
-                }
+--                }
         , _crInv = IM.empty -- IM.fromList [(0,frontArmour)]
         }
 
@@ -30,11 +30,11 @@ explosiveBarrel :: Creature
 explosiveBarrel =
     defaultInanimate
         { _crHP = 400
-        , _crType = BarrelCrit ExplosiveBarrel
+        , _crType = BarrelCrit (ExplosiveBarrel [])
         , _crState =
             defaultState
-                { _csSpState = Barrel []
+--                { _csSpState = Barrel []
-                }
+--                }
         , _crInv = IM.empty -- IM.fromList [(0,frontArmour)]
         }
 --        & crMaterial .~ Crystal

src/Dodge/Data/Creature/Misc.hs

@@ -84,17 +84,23 @@ data CreatureShape
     | NonDrawnCreature
     deriving (Eq, Ord, Show, Read) --Generic, Flat)
 
-data BarrelType = PlainBarrel | ExplosiveBarrel
+data BarrelType
-    deriving (Eq, Ord, Show, Read) --Generic, Flat)
+    = PlainBarrel
+    | ExplosiveBarrel {_piercedPoints :: [Point2]}
+    deriving (Eq, Show, Read) --Generic, Flat)
 
 makeLenses ''Pulse
+makeLenses ''BarrelType
+
 --makeLenses ''CreatureStatistics
 makeLenses ''Vocalization
 makeLenses ''CrMvType
 makeLenses ''CreatureType
 deriveJSON defaultOptions ''Pulse
+
 --deriveJSON defaultOptions ''CreatureStatistics
 deriveJSON defaultOptions ''Vocalization
+
 --deriveJSON defaultOptions ''CrMvType
 deriveJSON defaultOptions ''HumanoidAI
 deriveJSON defaultOptions ''BarrelType

src/Dodge/Data/Creature/State.hs

@@ -11,18 +11,17 @@ import Data.Aeson
 import Data.Aeson.TH
 import qualified Data.IntSet as IS
 import Dodge.Data.Damage
-import Geometry.Data
 
 data CreatureState = CrSt
     { _csDamage :: [Damage]
-    , _csSpState :: CrSpState
+--    , _csSpState :: CrSpState
     }
     deriving (Eq, Ord, Show, Read) --Generic, Flat)
 
-data CrSpState
+--data CrSpState
-    = Barrel {_piercedPoints :: [Point2]}
+--    = Barrel -- {_piercedPoints :: [Point2]}
-    | GenCr
+--    | GenCr
-    deriving (Eq, Ord, Show, Read) --Generic, Flat)
+--    deriving (Eq, Ord, Show, Read) --Generic, Flat)
 
 data Faction
     = GenericFaction Int
@@ -46,9 +45,9 @@ data CrGroup
     deriving (Eq, Ord, Show, Read) --Generic, Flat)
 
 makeLenses ''CreatureState
-makeLenses ''CrSpState
+--makeLenses ''CrSpState
 makeLenses ''CrGroup
-deriveJSON defaultOptions ''CrSpState
+--deriveJSON defaultOptions ''CrSpState
 deriveJSON defaultOptions ''Faction
 deriveJSON defaultOptions ''CrGroup
 deriveJSON defaultOptions ''CreatureState

src/Dodge/Default/Creature.hs

@@ -112,6 +112,6 @@ defaultState :: CreatureState
 defaultState =
     CrSt
         { _csDamage = []
-        , _csSpState = GenCr
+--        , _csSpState = GenCr
 --        , _csDropsOnDeath = DropAll
         }

src/Dodge/EnergyBall.hs

@@ -39,9 +39,12 @@ updateEnergyBall w eb
     | _ebTimer eb <= 0 = (w, Nothing)
     | otherwise =
         ( ebEffect eb . ebFlicker eb $ damageCircle (_ebPos eb) (_ebEff eb) w
-        , Just $ eb & ebTimer -~ 1 & ebPos .~ bp & ebVel .~ 0.85 * bv
+        , Just $ eb & ebTimer -~ 1 & ebPos .~ bp & ebVel .~ drag * bv
         )
   where
+    drag = case eb ^. ebEff of
+        ExplosiveBall -> 0.9
+        _ -> 0.85
     p = eb ^. ebPos + eb ^. ebVel
     (bp, bv) = fromMaybe (p, eb ^. ebVel) $ bouncePoint (const True) 0 (eb ^. ebPos) p w
 
@@ -95,7 +98,7 @@ ebColor eb = case eb ^. ebEff of
     IncendiaryBall{} -> red
     FlameletBall{} -> red
     ElectricalBall{} -> cyan
-    ExplosiveBall -> yellow
+    ExplosiveBall -> white
     FlashBall -> white
 
 damageCircle :: Point2 -> EnergyBallType -> World -> World

src/Dodge/EnergyBall/Draw.hs

@@ -1,6 +1,4 @@
-module Dodge.EnergyBall.Draw (
+module Dodge.EnergyBall.Draw ( drawEnergyBall) where
-    drawEnergyBall,
-) where
 
 import Dodge.Data.EnergyBall
 import Geometry
@@ -11,12 +9,22 @@ drawEnergyBall eb = case _ebEff eb of
     FlameletBall x a -> drawFlamelet x a eb
     IncendiaryBall -> drawFlamelet 5 0 eb
     ElectricalBall{} -> drawStaticBall eb
-    ExplosiveBall -> mempty
+    ExplosiveBall -> drawExplosiveBall eb
     FlashBall -> mempty
 
-drawStaticBall ::
+drawExplosiveBall :: EnergyBall -> Picture
-    EnergyBall ->
+drawExplosiveBall eb =
-    Picture
+    setLayer BloomLayer
+        . setDepth 20
+        . uncurryV translate (_ebPos eb)
+        . color white
+        $ thickCircle r x
+  where
+    x = 1 + 3 * (1 - (1-y**2))
+    r = 15 - (12 * y)
+    y = fromIntegral (_ebTimer eb - 10) / 10
+
+drawStaticBall :: EnergyBall -> Picture
 drawStaticBall pt =
     setLayer BloomNoZWrite
         . setDepth 20

src/Dodge/Shockwave/Update.hs

@@ -1,8 +1,8 @@
-module Dodge.Shockwave.Update where
+module Dodge.Shockwave.Update (updateShockwave) where
 
-import Dodge.Creature.Radius
 import Data.Foldable
 import Dodge.Base.Collide
+import Dodge.Creature.Radius
 import Dodge.Data.World
 import Dodge.Wall.Damage
 import Dodge.Zoning.Wall
@@ -40,9 +40,10 @@ moveShockwave w sw
         | otherwise =
             cr & crState . csDamage
                 .:~ Explosive dam p
-      --where
+
-      --  cpos = _crPos cr
+--where
-      --  v = normalizeV (cpos -.- p)
+--  cpos = _crPos cr
+--  v = normalizeV (cpos -.- p)
 
 moveInverseShockwave ::
     World ->
@@ -63,6 +64,7 @@ moveInverseShockwave w sw
         | otherwise =
             cr & crState . csDamage
                 .:~ Explosive 1 p
-      --where
+
-      --  cpos = _crPos cr
+--where
-      --  v = normalizeV (cpos -.- p)
+--  cpos = _crPos cr
+--  v = normalizeV (cpos -.- p)

src/Dodge/Update.hs

@@ -267,8 +267,9 @@ functionalUpdate u =
         . over uvWorld updateRadarSweeps
         . over uvWorld updateFlames
         . over uvWorld updateShockwaves
-        . over uvWorld updateEnergyBalls
         . over uvWorld updateBullets
+        . over uvWorld updateEnergyBalls  -- energybs can be created by bullets, 
+                                          -- so should probably be updated before bullets
         . over uvWorld updateRadarBlips
         --        . over uvWorld updateBeams
         . over uvWorld updateLasers

src/Dodge/WorldEvent/SpawnParticle.hs

@@ -1,7 +1,6 @@
 -- | Creation of particles in the world.
 module Dodge.WorldEvent.SpawnParticle (
     makeGasCloud,
-    concBall,
 ) where
 
 import Dodge.Data.World
@@ -10,20 +9,6 @@ import LensHelp
 import Picture
 import RandomHelp
 
-concBall :: Point2 -> Shockwave
-concBall p =
-    Shockwave
-        { _swDirection = OutwardShockwave
-        , _swInvulnerableCrs = []
-        , _swColor = white
-        , _swPos = p
-        , _swRad = 15
-        , _swDam = 4
-        , _swPush = 1
-        , _swMaxTime = 10
-        , _swTimer = 10
-        }
-
 -- | At writing the radius is half the size of the effect area
 makeGasCloud ::
     -- | Position
@@ -41,7 +26,7 @@ makeGasCloud pos vel w =
         Cloud
             { _clPos = addZ 20 pos
             , _clVel = addZ 0 vel
-            , _clPict = CloudColor 3 50 (withAlpha 0.05 col)
+            , _clPict = CloudColor 3 50 (withAlpha 0.5 col)
             , _clRad = 10
             , _clAlt = 25
             , _clTimer = 400