Improve static bullets

src/Dodge/Bullet.hs

@@ -2,11 +2,12 @@ module Dodge.Bullet
     ( updateBullet
     , useAmmoParams
     ) where
-import Dodge.WorldEvent.SpawnParticle
+import Dodge.EnergyBall
 import Dodge.Creature.Test
 import Dodge.Data
 import Dodge.Creature.HandPos
 import Dodge.Base.Coordinate
+import Dodge.WorldEvent.SpawnParticle
 import Geometry
 import LensHelp
 import StreamingHelp
@@ -17,8 +18,6 @@ import Data.Maybe
 import Dodge.Movement.Turn
 import Dodge.WorldEvent.ThingsHit
 import Control.Monad.State
-import System.Random
---import Data.Bifunctor
 
 updateBullet :: World -> Bullet -> (World,Maybe Bullet)
 updateBullet w bu = case _buState bu of
@@ -54,16 +53,17 @@ useAmmoParams it cr w = w & instantBullets .:~ (_amBullet bultype
 {- Update for a generic bullet.  -}
 mvBullet :: Float -> World -> Bullet -> (World, Maybe Bullet)
 mvBullet x w bt' 
-    | t <= 0 || magV (_buVel bt) < 1 = (w,Nothing)
+    | t <= 0 || magV (_buVel bt) < 1 = (endspawn w,Nothing)
     | otherwise = bimap (maybespawn . maybebounce) (fmap dodrag) $ 
         hiteff bt hitstream w
   where
+    endspawn w' = fromMaybe w' $ do
+        partspawn <- bulletSpawn bt'
+        return $ partspawn p w'
     maybespawn w' = fromMaybe w' $ do
         (hp,_) <- runIdentity (S.head_ hitstream)
         partspawn <- bulletSpawn bt'
-        let (thepart,g) = runState (partspawn hp) $ _randGen w'
+        return $ partspawn (hp +.+ normalizeV (_buPos bt' -.- hp)) w'
-        return $ w' & instantParticles .:~ thepart
-            & randGen .~ g
     maybebounce = fromMaybe id $ do
         guard (_buEffect bt' == BounceBullet)
         (hp,crwl) <- runIdentity (S.head_ hitstream)
@@ -95,12 +95,21 @@ bounceDir (_,Right wl) = Just $ uncurry (-.-) (_wlLine wl)
 bounceDir (p,Left  cr) | crIsArmouredFrom p cr = Just $ vNormal $ p -.- _crPos cr
 bounceDir _ = Nothing
 
-bulletSpawn :: Bullet -> Maybe (Point2 -> State StdGen Particle)
+bulletSpawn :: Bullet -> Maybe (Point2 -> World -> World)
 bulletSpawn bu = case _buSpawn bu of
     BulSpark -> Nothing
-    BulBall IncBall -> Just incBall
+    BulBall IncBall -> Just incBallAt
-    BulBall ConcBall -> Just concBall
+    BulBall ConcBall -> Just $ randParticleAt concBall
-    BulBall TeslaBall -> Just aStaticBall
+    BulBall TeslaBall -> Just makeStaticBall
+--  where
+--    dosatate st p w = w'
+--        & 
+--      where
+--        (pt,g) = runState do
+--        partspawn <- bulletSpawn bt'
+--        let (thepart,g) = runState (partspawn hp) $ _randGen w'
+--        return $ w' & instantParticles .:~ thepart
+--            & randGen .~ g
 
 hitEffFromBul :: Float -> Bullet
     -> Stream (Of (Point2, Either Creature Wall)) Identity ()

src/Dodge/Creature.hs

@@ -211,9 +211,11 @@ inventoryX c = case c of
         ]
     'G' ->
         [ autoPistol
+        , pistol
         , makeTypeCraftNum 2 HARDWARE
         , makeTypeCraftNum 2 MAGNET
         , makeTypeCraftNum 5 INCENDIARYMODULE
+        , makeTypeCraftNum 5 CONCUSSMODULE
         , makeTypeCraftNum 5 STATICMODULE
         ]
     'H' -> [ shatterGun ]

src/Dodge/Creature/State.hs

@@ -3,6 +3,7 @@ module Dodge.Creature.State
     , doDamage
     ) where
 import Dodge.Data
+import Dodge.EnergyBall
 import Dodge.Damage
 import Dodge.Hammer
 import Dodge.Reloading
@@ -14,7 +15,6 @@ import Dodge.Creature.Damage
 import Dodge.LightSource.Torch
 import Dodge.SoundLogic
 import RandomHelp
-import Dodge.WorldEvent
 import Dodge.Creature.Action
 import Geometry
 import Picture

src/Dodge/DamageCircle.hs

@@ -0,0 +1,29 @@
+module Dodge.DamageCircle 
+    ( damageCircle
+    ) where
+import Dodge.Data
+import Dodge.WorldEvent.ThingsHit
+import Geometry
+import LensHelp
+
+import qualified Streaming.Prelude as S
+import qualified IntMapHelp as IM
+damageCircle :: Float -> Point2 -> DamageType -> Int -> World -> World
+damageCircle r sp dt da w = w
+    & wallDamages %~ addwalldamages
+    & creatures %~ addcreaturedamages
+  where
+    addwalldamages wlds = runIdentity $ S.fold_ (damageWlCircle wldam) wlds id wlstodam
+    wlstodam = wlsHitRadial sp r w
+    wldam p = Damage dt da sp p (sp +.+ r *.* normalizeV (p -.- sp)) NoDamageEffect
+    addcreaturedamages crs = runIdentity $ S.fold_ (damageCrCircle crdam) crs id crstodam
+    crdam p cr = Damage dt da sp p (_crPos cr) NoDamageEffect
+    crstodam = crsHitRadial sp r w
+
+damageWlCircle :: (Point2 -> Damage) 
+    -> IM.IntMap [Damage] -> (Point2,Wall) -> IM.IntMap [Damage]
+damageWlCircle f wldams (p,wl) = IM.insertWith (++) (_wlID wl) [f p] wldams
+
+damageCrCircle :: (Point2 -> Creature -> Damage) 
+    -> IM.IntMap Creature -> (Point2,Creature) -> IM.IntMap Creature
+damageCrCircle crdam crs (p,cr) = crs & ix (_crID cr) . crState . csDamage .:~ crdam p cr

src/Dodge/Data.hs

@@ -10,6 +10,8 @@ circular imports are probably not a good idea.
 {-# LANGUAGE DerivingStrategies #-}
 module Dodge.Data 
     ( module Dodge.Data
+    , module Dodge.Data.PosEvent
+    , module Dodge.Data.EnergyBall
     , module Dodge.Data.Flame
     , module Dodge.Data.Magnet
     , module Dodge.Data.Spark
@@ -50,6 +52,8 @@ module Dodge.Data
     , module Dodge.Data.RadarBlip
     , module Dodge.Data.PathGraph
     ) where
+import Dodge.Data.PosEvent
+import Dodge.Data.EnergyBall
 import Dodge.Data.Flame
 import Dodge.Data.Magnet
 import Dodge.Data.Spark
@@ -153,6 +157,8 @@ data World = World
     , _bullets              :: [Bullet]
     , _instantParticles     :: [Particle]
     , _particles            :: [Particle]
+    , _energyBalls          :: [EnergyBall]
+    , _posEvents            :: [PosEvent]
     , _flames               :: [Flame]
     , _sparks               :: [Spark]
     , _radarBlips           :: [RadarBlip]
@@ -556,17 +562,6 @@ data Particle
         , _ptPoints :: [Point2]
         , _ptColor  :: Color
         }
-    | PtIncBall  
-        { _ptUpdate :: World -> Particle -> (World, Maybe Particle)
-        , _ptVel    :: Point2
-        , _ptColor  :: Color
-        , _ptPos :: Point2
-        , _ptWidth :: Float 
-        , _ptTimer :: Int
-        , _ptHitEff :: HitEffect
-        , _ptZ :: Float
-        , _ptRot :: Float
-        }
     | PtStaticBall  
         { _ptUpdate :: World -> Particle -> (World, Maybe Particle)
         , _ptVel    :: Point2

src/Dodge/Data/Bullet.hs

@@ -18,7 +18,7 @@ data Bullet = Bullet
     , _buTimer      :: Int
     , _buDamages    :: [Damage]
     }
-data EnergyBall = IncBall | TeslaBall | ConcBall
+data EnergyBallType = IncBall | TeslaBall | ConcBall
 data BulletState = NormalBulletState
     | DyingBulletState
     | DelayedBullet Float
@@ -28,7 +28,7 @@ data BulletEffect
     | BounceBullet
     | PenetrateBullet
   deriving (Eq,Ord,Show,Read,Enum,Bounded)
-data BulletSpawn = BulBall EnergyBall | BulSpark
+data BulletSpawn = BulBall EnergyBallType | BulSpark
 data BulletTrajectory
     = BasicBulletTrajectory
     | BezierTrajectory Point2 Point2 Point2

src/Dodge/Data/EnergyBall.hs

@@ -0,0 +1,19 @@
+{-# LANGUAGE TemplateHaskell #-}
+{-# LANGUAGE StrictData #-}
+module Dodge.Data.EnergyBall where
+import Geometry.Data
+import Color
+import Dodge.Data.Damage.Type
+import Control.Lens
+
+data EnergyBall = EnergyBall
+    { _ebVel    :: Point2
+    , _ebColor  :: Color
+    , _ebPos :: Point2
+    , _ebWidth :: Float 
+    , _ebTimer :: Int
+    , _ebEff :: (DamageType,Int)
+    , _ebZ :: Float
+    , _ebRot :: Float
+    }
+makeLenses ''EnergyBall

src/Dodge/Data/PosEvent.hs

@@ -0,0 +1,14 @@
+{-# LANGUAGE TemplateHaskell #-}
+{-# LANGUAGE StrictData #-}
+module Dodge.Data.PosEvent where
+import Geometry.Data
+import Control.Lens
+
+data PosEventType = SparkSpawner
+
+data PosEvent = PosEvent
+    { _pvType   :: PosEventType
+    , _pvTimer  :: Int
+    , _pvPos    :: Point2
+    }
+makeLenses ''PosEvent

src/Dodge/Default/World.hs

@@ -45,6 +45,8 @@ defaultWorld = World
     , _particles = []
     , _flames = []
     , _sparks = []
+    , _posEvents = []
+    , _energyBalls = []
     , _radarBlips = []
     , _flares = []
     , _newBeams = WorldBeams [] [] [] []

src/Dodge/EnergyBall.hs

@@ -0,0 +1,63 @@
+module Dodge.EnergyBall where
+import Dodge.Data
+import Dodge.DamageCircle
+import Dodge.LightSource
+import Geometry
+import Picture
+import LensHelp
+import RandomHelp
+
+makeFlamelet
+    :: Point2       -- ^ Position
+    -> Float        -- ^ z position
+    -> Point2       -- ^ Velocity
+    -> Float        -- ^ Size
+    -> Int          -- ^ Timer
+    -> World 
+    -> World
+makeFlamelet (V2 x y) z vel size time w = w
+    & randGen   .~ g
+    & energyBalls .:~ EnergyBall 
+        { _ebVel        = vel
+        , _ebColor      = red
+        , _ebPos        = V2 x y
+        , _ebWidth      = size
+        , _ebTimer      = time
+        , _ebEff     = (FLAMING,1)
+        , _ebZ = z
+        , _ebRot = rot
+        }
+  where
+    (rot ,g) = randomR (0,3) $ _randGen w
+moveEnergyBall :: World -> EnergyBall -> (World, Maybe EnergyBall)
+moveEnergyBall w eb 
+    | _ebTimer eb <= 0 = (     w, Nothing)
+    | otherwise        = 
+        ( ebFlicker eb $ uncurry (damageCircle 5 (_ebPos eb)) (_ebEff eb) w
+        , Just $ eb & ebTimer -~ 1 & ebPos .+.+~ _ebVel eb & ebVel .*.*~ 0.9
+        )
+
+
+incBallAt :: Point2 -> World -> World
+incBallAt p w = w & energyBalls .:~ theincball
+    & randGen .~ g
+  where
+    (theincball,g) = runState thestate (_randGen w)
+    thestate = do
+        rot <- state $ randomR (0,3)
+        return EnergyBall 
+            { _ebVel        = 0
+            , _ebColor      = red
+            , _ebPos        = p
+            , _ebWidth      = 3
+            , _ebTimer      = 20
+            , _ebEff     = (FLAMING,1)
+            , _ebZ          = 20
+            , _ebRot        = rot
+            }
+
+ebFlicker :: EnergyBall -> World -> World
+ebFlicker pt 
+    | _ebTimer pt `mod` 7 == 0 = tempLightSources 
+        .:~ tlsTimeRadColPos 1 70 (0.5 *.*.* xyzV4 (_ebColor pt)) (addZ 20 $ _ebPos pt)
+    | otherwise = id

src/Dodge/EnergyBall/Draw.hs

@@ -0,0 +1,52 @@
+module Dodge.EnergyBall.Draw where
+import Dodge.Data
+import Geometry
+import Picture
+
+
+drawEnergyBall :: EnergyBall -> Picture
+drawEnergyBall = drawFlameletEB
+
+drawFlameletEB :: EnergyBall -> Picture
+drawFlameletEB pt = pictures 
+    [ setLayer BloomLayer pic 
+    , setLayer BloomNoZWrite piu 
+    , setLayer BloomNoZWrite pi2 
+    ]
+  where
+    z = _ebZ pt
+    sp = _ebPos pt
+    vel = _ebVel pt
+    ep = sp +.+ vel
+    size = _ebWidth pt
+    siz2 = size + 0.2
+    time = _ebTimer pt
+    piu = setDepth (z + 25)
+        .  uncurryV translate ep 
+        . color (mixColors (fromIntegral (max 0 (time-2))) (10-fromIntegral time) 
+                           (V4 2 0 0 1)                          (V4 2 0 0 0)
+                   )
+        . rotate (negate (rot - 0.1 * fromIntegral time))
+        . scale s1 s1
+        $ polygon (rectNSWE siz2 (-siz2) (-siz2) siz2)
+    pi2 = setDepth (z + 25)
+        . uncurryV translate ep
+        . color (mixColors (fromIntegral (max 0 (time-2))) (10-fromIntegral time) 
+                           (V4 2 1 0 0.5)                          (V4 0 0 0 0)
+                   )
+        . rotate (negate (rot + 0.2 * fromIntegral time))
+        . scale s2 s2
+        $ polygon (rectNSWE siz2 (-siz2) (-siz2) siz2)
+    pic = setDepth (z + 20)
+        . uncurryV translate ep
+        . color (mixColors (fromIntegral (max 0 (time-2))) (10-fromIntegral time) 
+                           (V4 1 1 1 3)                           (V4 1 0 0 1)
+                )
+        . rotate (negate ( 0.1 * fromIntegral time + rot))
+        . scale (0.5* sc) (0.5 *sc)
+        $ polygon $ map toV2 [(-size,-size),(size,-size),(size,size),(-size,size)]
+    sc = (*) 2 $ log $ 1 + fromIntegral time / 20
+    s1 = (*) 2 $ log $ 2 + fromIntegral time / 40
+    s2 = 0.5 * (sc + s1)
+    rot = _ebRot pt
+

src/Dodge/Item/Weapon/Launcher.hs

@@ -6,7 +6,7 @@ module Dodge.Item.Weapon.Launcher
     ) where
 import Dodge.Data
 import Dodge.Reloading.Action
---import Dodge.Default
+import Dodge.EnergyBall
 import Dodge.Default.Weapon
 import Dodge.Item.Location
 import Dodge.SoundLogic.LoadSound
@@ -18,7 +18,6 @@ import Dodge.Movement.Turn
 import Dodge.Base
 import Dodge.Zone
 import Dodge.SoundLogic
-import Dodge.WorldEvent.SpawnParticle
 import Dodge.WorldEvent.Cloud
 import RandomHelp
 import Geometry

src/Dodge/Particle/Draw.hs

@@ -7,7 +7,6 @@ drawParticle :: Particle -> Picture
 drawParticle pt = case pt of
     Shockwave {} -> drawShockwave pt
     PtStaticBall {} -> drawStaticBall pt
-    PtIncBall {} -> drawFlameletZ pt
     PtInvShockwave {} -> drawInverseShockwave pt
     PtTeslaArc {} -> drawTeslaArc pt
     PtTargetLaser {} -> drawTargetLaser pt
@@ -36,50 +35,6 @@ drawStaticBall pt = setLayer BloomNoZWrite
     . uncurryV translate (_ptPos pt)
     $ circleSolidCol (_ptColor pt) (withAlpha 0.5 white) (_ptWidth pt+5)
 
-drawFlameletZ
-    :: Particle
-    -> Picture
-drawFlameletZ pt = pictures 
-    [ setLayer BloomLayer pic 
-    , setLayer BloomNoZWrite piu 
-    , setLayer BloomNoZWrite pi2 
-    ]
-  where
-    z = _ptZ pt
-    sp = _ptPos pt
-    vel = _ptVel pt
-    ep = sp +.+ vel
-    size = _ptWidth pt
-    siz2 = size + 0.2
-    time = _ptTimer pt
-    piu = setDepth (z + 25)
-        .  uncurryV translate ep 
-        . color (mixColors (fromIntegral (max 0 (time-2))) (10-fromIntegral time) 
-                           (V4 2 0 0 1)                          (V4 2 0 0 0)
-                   )
-        . rotate (negate (rot - 0.1 * fromIntegral time))
-        . scale s1 s1
-        $ polygon (rectNSWE siz2 (-siz2) (-siz2) siz2)
-    pi2 = setDepth (z + 25)
-        . uncurryV translate ep
-        . color (mixColors (fromIntegral (max 0 (time-2))) (10-fromIntegral time) 
-                           (V4 2 1 0 0.5)                          (V4 0 0 0 0)
-                   )
-        . rotate (negate (rot + 0.2 * fromIntegral time))
-        . scale s2 s2
-        $ polygon (rectNSWE siz2 (-siz2) (-siz2) siz2)
-    pic = setDepth (z + 20)
-        . uncurryV translate ep
-        . color (mixColors (fromIntegral (max 0 (time-2))) (10-fromIntegral time) 
-                           (V4 1 1 1 3)                           (V4 1 0 0 1)
-                )
-        . rotate (negate ( 0.1 * fromIntegral time + rot))
-        . scale (0.5* sc) (0.5 *sc)
-        $ polygon $ map toV2 [(-size,-size),(size,-size),(size,size),(-size,size)]
-    sc = (*) 2 $ log $ 1 + fromIntegral time / 20
-    s1 = (*) 2 $ log $ 2 + fromIntegral time / 40
-    s2 = 0.5 * (sc + s1)
-    rot = _ptRot pt
 
 drawInverseShockwave :: Particle -> Picture
 drawInverseShockwave  pt 

src/Dodge/PosEvent.hs

@@ -0,0 +1,25 @@
+module Dodge.PosEvent where
+import Dodge.Data
+import Dodge.Spark
+import Geometry.Data
+import Color
+import LensHelp
+
+import Control.Monad.State
+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 p = randSpark ELECTRICAL rspeed rcol rdir p
+  where
+    rspeed = state (randomR (3,6))
+    rcol = brightX 100 1.5 <$> takeOne [white,azure,blue,cyan]
+    rdir = state $ randomR (0,2*pi)

src/Dodge/Render/ShapePicture.hs

@@ -2,6 +2,7 @@ module Dodge.Render.ShapePicture
     ( worldSPic
     ) where
 import Dodge.Item.Draw.SPic
+import Dodge.EnergyBall.Draw
 import Dodge.Creature.Picture.Awareness
 import Dodge.Creature.Picture
 import Dodge.Particle.Draw
@@ -88,6 +89,7 @@ extraPics :: Configuration -> World -> Picture
 extraPics cfig w = pictures (_decorations w)
     <> concatMapPic drawParticle (_particles    w)
     <> concatMapPic drawFlame (_flames    w)
+    <> concatMapPic drawEnergyBall (_energyBalls    w)
     <> concatMapPic drawSpark (_sparks    w)
     <> concatMapPic drawBul (_bullets w)
     <> concatMapPic drawBlip (_radarBlips    w)

src/Dodge/Update.hs

@@ -5,7 +5,9 @@ Description : Simulation update
 -}
 module Dodge.Update ( updateUniverse ) where
 import Dodge.Data
+import Dodge.PosEvent
 import Dodge.Spark
+import Dodge.EnergyBall
 import Dodge.Flame
 import Dodge.Bullet
 import Dodge.Update.Cloud
@@ -84,7 +86,9 @@ functionalUpdate cfig w = checkEndGame
     . dbArg _worldEvents
     . updateIMl _modifications _mdUpdate
     . updateSparks 
+    . updatePosEvents 
     . updateFlames
+    . updateEnergyBalls
     . updateParticles 
     . updateBullets 
     . updateRadarBlips 
@@ -229,10 +233,20 @@ updateFlames w = w' & flames .~ catMaybes newflames
   where
     (w',newflames) = mapAccumR moveFlame w $ _flames w
 
+updateEnergyBalls :: World -> World
+updateEnergyBalls w = w' & energyBalls .~ catMaybes newebs
+  where
+    (w',newebs) = mapAccumR moveEnergyBall w $ _energyBalls w
+
 updateSparks :: World -> World
 updateSparks w = w' & sparks .~ catMaybes newsparks
   where
     (w',newsparks) = mapAccumR moveSpark w $ _sparks w
+updatePosEvents :: World -> World
+updatePosEvents w = w' & posEvents .~ catMaybes newposEvents
+  where
+    (w',newposEvents) = mapAccumR updatePosEvent w $ _posEvents w
+
 
 {- Apply internal particle updates, delete 'Nothing's.  -}
 updateParticles :: World -> World

src/Dodge/WorldEvent/Explosion.hs

@@ -8,6 +8,7 @@ module Dodge.WorldEvent.Explosion
     , makeTeslaExplosionAt
     ) where
 import Dodge.Data
+import Dodge.EnergyBall
 import Dodge.LightSource
 import Dodge.Flame
 import Dodge.Base.Collide

src/Dodge/WorldEvent/SpawnParticle.hs

@@ -1,10 +1,9 @@
 {- | Creation of particles in the world.  -}
 module Dodge.WorldEvent.SpawnParticle
     ( makeGasCloud
-    , makeFlamelet
+    , makeStaticBall
-    , aStaticBall
-    , incBall
     , concBall
+    , randParticleAt
     ) where
 import Dodge.Data
 import Dodge.Zone
@@ -21,6 +20,17 @@ import LensHelp
 import Data.Foldable
 import qualified Streaming.Prelude as S
 
+randParticleAt :: (Point2 -> State StdGen Particle) -> Point2 -> World -> World
+randParticleAt f p w = w
+    & instantParticles .:~ thepart
+    & randGen .~ g
+  where
+    (thepart,g) = runState (f p) (_randGen w)
+
+makeStaticBall :: Point2 -> World -> World
+makeStaticBall p = randParticleAt aStaticBall p . (posEvents .:~ thesparker)
+  where
+    thesparker = PosEvent SparkSpawner 10 p
 
 concBall :: Point2 -> State g Particle
 concBall p = return Shockwave
@@ -34,10 +44,9 @@ concBall p = return Shockwave
     , _ptTimer     = 10
     }
 
-
 aStaticBall :: Point2 -> State g Particle
 aStaticBall p = return PtStaticBall 
-    { _ptUpdate     = moveStaticBall
+    { _ptUpdate     = moveFlamelet
     , _ptVel        = 0
     , _ptColor      = blue
     , _ptPos        = p
@@ -47,48 +56,6 @@ aStaticBall p = return PtStaticBall
     , _ptZ = 20
     }
 
-makeFlamelet
-    :: Point2       -- ^ Position
-    -> Float        -- ^ z position
-    -> Point2       -- ^ Velocity
-    -> Float        -- ^ Size
-    -> Int          -- ^ Timer
-    -> World 
-    -> World
-makeFlamelet (V2 x y) z vel size time w = w
-    & randGen   .~ g
-    & instantParticles .:~ PtIncBall 
-        { _ptUpdate     = moveFlamelet
-        , _ptVel        = vel
-        , _ptColor      = red
-        , _ptPos        = V2 x y
-        , _ptWidth      = size
-        , _ptTimer      = time
-        , _ptHitEff     = expireAndDamage $ simpleDam FLAMING 1
-        , _ptZ = z
-        , _ptRot = rot
-        }
-  where
-    (rot ,g) = randomR (0,3) $ _randGen w
-
---damageBothTypeAmount :: DamageType
---    -> Int
---    -> Particle 
---    -> [(Point2, Either Creature Wall)] 
---    -> World 
---    -> (World, Maybe Particle)
---damageBothTypeAmount dt amount = destroyOnImpact
---    (\pt p cr -> creatures . ix (_crID cr) . crState . crDamage .:~ thedam pt p)
---    (\pt p -> damageWall (thedam pt p))
---  where
---    thedam pt p = Damage dt amount sp p ep NoDamageEffect
---      where
---        sp = _ptPos pt
---        ep = sp +.+ _ptVel pt
-
-moveStaticBall :: World -> Particle -> (World, Maybe Particle)
-moveStaticBall = moveFlamelet
-
 -- | Note damgeInRadius by itself never destroys the particle
 damageInRadius :: Float -> Particle -> World -> World
 damageInRadius size pt = damageInArea isClose closeWls pt
@@ -136,20 +103,6 @@ makeGasCloud pos vel w = w
     (col, g) = runState (takeOne [green,yellow]) $ _randGen w
 {- Attach poison cloud damage to creatures near cloud.  -}
 
-incBall :: RandomGen g => Point2 -> State g Particle
-incBall p = do
-    rot <- state $ randomR (0,3)
-    return PtIncBall 
-        { _ptUpdate     = moveFlamelet
-        , _ptVel        = 0
-        , _ptColor      = red
-        , _ptPos        = p
-        , _ptWidth      = 3
-        , _ptTimer      = 20
-        , _ptHitEff     = expireAndDamage $ simpleDam FLAMING 1
-        , _ptZ          = 20
-        , _ptRot        = rot
-        }
 
 {- Update of a flamelet.
 Applies movement and attaches damage to nearby creatures.  -}

src/Dodge/WorldEvent/ThingsHit.hs

@@ -1,4 +1,4 @@
---{-# LANGUAGE TupleSections #-}
+{-# LANGUAGE TupleSections #-}
 {- |
 Find which objects lie upon a line.
  -}
@@ -7,6 +7,8 @@ module Dodge.WorldEvent.ThingsHit
     , thingHit
     , thingHitFilt
     , thingsHitExceptCr
+    , crsHitRadial
+    , wlsHitRadial
     )
     where
 import Dodge.Data
@@ -15,6 +17,7 @@ import Dodge.Zone
 import Geometry
 
 --import Data.Maybe
+import Data.Functor
 import Data.Bifunctor
 import StreamingHelp
 import qualified Streaming.Prelude as S
@@ -66,3 +69,19 @@ wlsHit sp ep
     | otherwise = sortStreamOn (dist sp . fst)
         . overlapSegWalls sp ep
         . wlsNearSeg sp ep
+
+wlsHitRadial :: Point2 -> Float -> World -> StreamOf (Point2, Wall)
+wlsHitRadial p r = S.mapMaybe f . wlsInsideCirc p r
+  where
+    f wl = uncurry (intersectSegSeg p (p -.- r *.* v)) (_wlLine wl) <&> (,wl)
+      where
+        v = normalizeV $ vNormal $ uncurry (-.-) $ _wlLine wl
+
+crsHitRadial :: Point2 -> Float -> World -> StreamOf (Point2, Creature)
+crsHitRadial p r = S.mapMaybe f . crsInsideCirc p r
+  where
+    f cr 
+        | dist cpos p <= r = Just (cpos +.+ r *.* normalizeV (p -.- cpos), cr)
+        | otherwise = Nothing
+      where
+        cpos = _crPos cr