Tweak energyballs

src/Dodge/Data/LWorld.hs

@@ -31,7 +31,6 @@ module Dodge.Data.LWorld (
     module Dodge.Data.Magnet,
     module Dodge.Data.Modification,
     --    module Dodge.Data.PathGraph,
-    module Dodge.Data.PosEvent,
     module Dodge.Data.PressPlate,
     module Dodge.Data.Projectile,
     module Dodge.Data.Prop,
@@ -78,7 +77,6 @@ import Dodge.Data.LinearShockwave
 import Dodge.Data.Machine
 import Dodge.Data.Magnet
 import Dodge.Data.Modification
-import Dodge.Data.PosEvent
 import Dodge.Data.PressPlate
 import Dodge.Data.Projectile
 import Dodge.Data.Prop
@@ -107,7 +105,6 @@ data LWorld = LWorld
     , _bullets :: [Bullet]
     , _radarSweeps :: [RadarSweep]
     , _energyBalls :: [EnergyBall]
-    , _posEvents :: [PosEvent]
     , _flames :: [Flame]
     , _sparks :: [Spark]
     , _radarBlips :: [RadarBlip]

src/Dodge/Data/PosEvent.hs

@@ -1,25 +0,0 @@
-{-# LANGUAGE DeriveGeneric #-}
-{-# LANGUAGE DeriveAnyClass #-}
-{-# LANGUAGE StrictData #-}
-{-# LANGUAGE TemplateHaskell #-}
-
-module Dodge.Data.PosEvent where
-
-import Control.Lens
-import Data.Aeson
-import Data.Aeson.TH
-import Geometry.Data
-
-data PosEventType = SparkSpawner
-    deriving (Eq, Ord, Show, Read) --Generic, Flat)
-
-data PosEvent = PosEvent
-    { _pvType :: PosEventType
-    , _pvTimer :: Int
-    , _pvPos :: Point2
-    }
-    deriving (Eq, Ord, Show, Read) --Generic, Flat)
-
-makeLenses ''PosEvent
-deriveJSON defaultOptions ''PosEventType
-deriveJSON defaultOptions ''PosEvent

src/Dodge/Data/SoundOrigin.hs

@@ -36,6 +36,7 @@ data SoundOrigin
     | LeverSound Int
     | Explosion Int
     | Tap Int
+    | EBSound Int
     deriving (Eq, Ord, Show, Read) --Generic, Flat)
 
 

src/Dodge/Default/World.hs

@@ -109,7 +109,6 @@ defaultLWorld =
         , _flames = []
         , _radarSweeps = []
         , _sparks = []
-        , _posEvents = []
         , _energyBalls = []
         , _radarBlips = []
         , _flares = []

src/Dodge/EnergyBall.hs

@@ -13,6 +13,7 @@ import Data.List (foldl')
 import Data.Maybe
 import Dodge.Base.Collide
 import Dodge.Data.World
+import Dodge.SoundLogic
 import Dodge.Spark
 import Dodge.WorldEvent.ThingsHit
 import Geometry
@@ -47,7 +48,9 @@ updateEnergyBall w eb
 
 ebEffect :: EnergyBall -> World -> World
 ebEffect eb = case _ebEff eb of
-    ElectricalBall -> randSparkExtraVel
+    ElectricalBall ->
+        soundContinue (EBSound 0) (_ebPos eb) elecCrackleS (Just 2)
+            . randSparkExtraVel
                 (_ebVel eb)
                 ElectricSpark
                 (state (randomR (3, 6)))
@@ -85,7 +88,7 @@ ebFlicker :: EnergyBall -> World -> World
 ebFlicker pt
     | _ebTimer pt `mod` 7 == 0 =
         cWorld . lWorld . lights
-            .:~ LSParam (addZ 20 $ _ebPos pt) 70 (0.5 * xyzV4 (ebColor pt))
+            .:~ LSParam (addZ 5 $ _ebPos pt) 70 (0.5 * xyzV4 (ebColor pt))
     | otherwise = id
 
 ebColor :: EnergyBall -> Color

src/Dodge/PosEvent.hs

@@ -1,23 +0,0 @@
-module Dodge.PosEvent (updatePosEvent) where
-
-import Control.Monad.State
-import Dodge.Data.World
-import Dodge.Spark
-import Geometry.Data
-import LensHelp
-import RandomHelp
-
-updatePosEvent :: World -> PosEvent -> (World, Maybe PosEvent)
-updatePosEvent w pv
-    | _pvTimer pv < 1 = (w, Nothing)
-    | otherwise = (posEventEffect pv w, Just $ pv & pvTimer -~ 1)
-
-posEventEffect :: PosEvent -> World -> World
-posEventEffect pv = case _pvType pv of
-    SparkSpawner -> spawnElectricalSparks (_pvPos pv)
-
-spawnElectricalSparks :: Point2 -> World -> World
-spawnElectricalSparks = randSpark ElectricSpark rspeed rdir
-  where
-    rspeed = state (randomR (3, 6))
-    rdir = state $ randomR (0, 2 * pi)

src/Dodge/Update.hs

@@ -37,7 +37,6 @@ import Dodge.LinearShockwave.Update
 import Dodge.Machine.Update
 import Dodge.Menu
 import Dodge.ModificationEffect
-import Dodge.PosEvent
 import Dodge.PressPlate
 import Dodge.Projectile.Update
 import Dodge.Prop.Update
@@ -266,7 +265,6 @@ functionalUpdate u =
             (doModificationEffect . _mdUpdate))
         . over uvWorld updateSparks
         . over uvWorld updateRadarSweeps
-        . over uvWorld updatePosEvents
         . over uvWorld updateFlames
         . over uvWorld updateShockwaves
         . over uvWorld updateEnergyBalls
@@ -604,9 +602,6 @@ updateRadarSweeps = updateObjCatMaybes radarSweeps updateRadarSweep
 updateSparks :: World -> World
 updateSparks = updateObjCatMaybes sparks updateSpark
 
-updatePosEvents :: World -> World
-updatePosEvents = updateObjCatMaybes posEvents updatePosEvent
-
 updateClouds :: World -> World
 updateClouds = updateObjCatMaybes clouds updateCloud
 

src/Dodge/WorldEvent/SpawnParticle.hs

@@ -1,7 +1,6 @@
 -- | Creation of particles in the world.
 module Dodge.WorldEvent.SpawnParticle (
     makeGasCloud,
-    makeStaticBall,
     concBall,
 ) where
 
@@ -11,19 +10,6 @@ import LensHelp
 import Picture
 import RandomHelp
 
-randEnergyBallAt :: (Point2 -> State StdGen EnergyBall) -> Point2 -> World -> World
-randEnergyBallAt f p w =
-    w
-        & cWorld . lWorld . energyBalls .:~ thepart
-        & randGen .~ g
-  where
-    (thepart, g) = runState (f p) (_randGen w)
-
-makeStaticBall :: Point2 -> World -> World
-makeStaticBall p = randEnergyBallAt aStaticBall p . (cWorld . lWorld . posEvents .:~ thesparker)
-  where
-    thesparker = PosEvent SparkSpawner 10 p
-
 concBall :: Point2 -> Shockwave
 concBall p =
     Shockwave
@@ -38,40 +24,6 @@ concBall p =
         , _swTimer = 10
         }
 
-aStaticBall :: Point2 -> State g EnergyBall
-aStaticBall p =
-    return
-        EnergyBall
-            { _ebVel = 0
-            , _ebPos = p
-            , _ebTimer = 20
-            , _ebEff = ElectricalBall
-            }
-
-{- | Note damgeInRadius by itself never destroys the particle
-damageInRadius :: Float -> Particle -> World -> World
-damageInRadius size pt = damageInArea isClose closeWls pt
-  where
-    p = _ptPos pt
-    closeWls wl = uncurry segOnCirc (_wlLine wl) p size
-    isClose cr = dist p (_crPos cr) < _crRad cr + size
--}
-
---damageInArea :: (Creature -> Bool) -> (Wall -> Bool) -> Particle -> World -> World
---{-# INLINE damageInArea #-}
---damageInArea crt wlt pt w = damwls damcrs
---  where
---    p = _ptPos pt
---    damcrs = foldl' (flip $ \cr -> fst . hiteff (S.yield (p,Left cr))) w $ IM.filter crt $ _creatures w
---    damwls w' = runIdentity
---        . S.fold_
---            (flip $ \wl -> fst . hiteff (S.yield (p,Right wl)))
---            w'
---            id
---        . S.filter wlt
---        $ wlsNearPoint p w'
---    hiteff = _ptHitEff pt pt
-
 -- | At writing the radius is half the size of the effect area
 makeGasCloud ::
     -- | Position
@@ -98,16 +50,3 @@ makeGasCloud pos vel w =
     (col, g) = runState (takeOne [green, yellow]) $ _randGen w
 
 {- Attach poison cloud damage to creatures near cloud.  -}
-
-{- Update of a flamelet.
-Applies movement and attaches damage to nearby creatures.  -}
--- This should be unified in many ways with moveFlame
---moveFlamelet :: World -> Particle -> (World, Maybe Particle)
---moveFlamelet w pt
---    | _ptTimer pt <= 0 = (     w, Nothing)
---    | otherwise        = (ptFlicker pt $ damageInRadius 5 mvPt' w,  Just mvPt')
---  where
---    mvPt' = pt
---        & ptTimer    -~ 1
---        & ptPos      .~ _ptPos pt +.+ _ptVel pt
---        & ptVel      .*.*~ 0.8