Cleanup

src/Dodge/Combine/Data.hs

@@ -159,7 +159,7 @@ data HeldItemType
 --    | LASGUNWIDEPULSE
     | LASWIDE {_xNum :: Int}
     -- | LASGUNFOCUS Int
-    | SONICGUN
+    -- | SONICGUN
     | TRACTORGUN
     | LAUNCHER
     | LAUNCHERX {_xNum :: Int}

src/Dodge/Creature.hs

@@ -250,8 +250,8 @@ testInventory = IM.fromList $ zip [0..]
     ]
 stackedInventory :: IM.IntMap Item
 stackedInventory = IM.fromList $ zip [0..] 
-    [sonicGun
-    ,burstRifle
+    [--sonicGun
+    burstRifle
     , pipe
     ,rewindGun
     ,tractorGun

src/Dodge/Data.hs

@@ -218,8 +218,8 @@ data World = World
     , _projectiles      :: IM.IntMap Proj
     , _instantBullets   :: [Bullet]
     , _bullets          :: [Bullet]
-    , _instantParticles :: [Particle]
-    , _particles        :: [Particle]
+--    , _instantParticles :: [Particle]
+--    , _particles        :: [Particle]
     , _radarSweeps      :: [RadarSweep]
     , _energyBalls      :: [EnergyBall]
     , _posEvents        :: [PosEvent]
@@ -292,7 +292,7 @@ data World = World
     , _lSelect          :: Point2
     , _rSelect          :: Point2
     }
-  --deriving (Eq,Ord,Show,Read)
+--  deriving (Eq,Ord,Show,Read)
 data WorldHammer
     = SubInvHam
     | DoubleMouseHam
@@ -385,18 +385,18 @@ data WorldBeams = WorldBeams
 
 {- Objects without ids.
 Update themselves, perhaps with side effects.  -}
-data Particle
-    = ShockLine 
-        { _ptUpdate :: World -> Particle -> (World, Maybe Particle)
-        , _ptPointDirs :: [[(Point2,Float)]]
-        , _ptTimer :: Int
-        , _ptColor :: Color
-        , _ptCenter :: Point2
-        }
-type HitEffect = Particle 
-    -> Stream (Of (Point2, Either Creature Wall)) Identity ()
-    -> World 
-    -> (World,Maybe Particle)
+--data Particle = DPart
+--    = ShockLine 
+--        { _ptUpdate :: World -> Particle -> (World, Maybe Particle)
+--        , _ptPointDirs :: [[(Point2,Float)]]
+--        , _ptTimer :: Int
+--        , _ptColor :: Color
+--        , _ptCenter :: Point2
+--        }
+--type HitEffect = Particle 
+--    -> Stream (Of (Point2, Either Creature Wall)) Identity ()
+--    -> World 
+--    -> (World,Maybe Particle)
 type HitEffect' = Flame 
     -> Stream (Of (Point2, Either Creature Wall)) Identity ()
     -> World 
@@ -593,7 +593,7 @@ data InPlacement = InPlacement
     }
 makeLenses ''World
 makeLenses ''FloorItem
-makeLenses ''Particle
+--makeLenses ''Particle
 makeLenses ''Door
 makeLenses ''Terminal
 makeLenses ''Machine

src/Dodge/Data/Item/HeldUse.hs

@@ -15,7 +15,6 @@ data HeldUse = HeldDoNothing
     | HeldCircleLaser
     | HeldDualLaser
     | HeldTractor
-    | HeldSonicWave
     | HeldForceField
     | HeldShatter
   deriving (Eq,Ord,Show,Read)

src/Dodge/Data/Projectile.hs

@@ -32,4 +32,5 @@ data Proj
         , _prjUpdates :: [ProjectileUpdate]
         , _prjMITID :: Maybe Int
         }
+  deriving (Eq,Ord,Show,Read)
 makeLenses ''Proj

src/Dodge/Default/World.hs

@@ -34,8 +34,8 @@ defaultWorld = World
     , _projectiles      = IM.empty
     , _instantBullets   = []
     , _bullets          = []
-    , _instantParticles = []
-    , _particles        = []
+--    , _instantParticles = []
+--    , _particles        = []
     , _flames           = []
     , _radarSweeps      = []
     , _sparks           = []

src/Dodge/HeldUse.hs

@@ -9,7 +9,6 @@ import Dodge.WorldEvent.Flash
 import Dodge.Item.Location
 import Dodge.Item.Weapon.Radar
 import Dodge.Item.Weapon.BatteryGuns
-import Dodge.Item.Weapon.SonicGuns
 import Dodge.Item.Weapon.Utility
 import Dodge.Item.Weapon.Shatter
 import Dodge.Item.Weapon.Launcher
@@ -340,7 +339,7 @@ useHeld hu = case hu of
     HeldCircleLaser -> circleLaser
     HeldDualLaser -> shootDualLaser
     HeldTractor -> aTractorBeam
-    HeldSonicWave -> aSonicWave
+--    HeldSonicWave -> aSonicWave
     HeldForceField -> useForceFieldGun
     HeldShatter -> shootShatter
     HeldExplodeRemoteShell itid pjid -> const $ const $ explodeRemoteRocket itid pjid

src/Dodge/Item.hs

@@ -105,7 +105,7 @@ itemFromHeldType ht = case ht of
 --    LASGUNWIDEPULSE     -> lasWidePulse
     LASWIDE i  -> lasWide i
     --LASGUNFOCUS i     -> lasFocus i
-    SONICGUN    -> sonicGun
+--    SONICGUN    -> sonicGun
     TRACTORGUN  -> tractorGun
     LAUNCHER    -> launcher
     LAUNCHERX i   -> launcherX  i

src/Dodge/Item/Draw/SPic.hs

@@ -91,7 +91,7 @@ heldItemSPic ht it = case ht of
     LASCIRCLE       -> lasGunPic it
     DUALBEAM        -> dualBeamPic it
     LASWIDE _       -> lasGunPic it
-    SONICGUN        -> noPic baseSonicShape
+    --SONICGUN        -> noPic baseSonicShape
     TRACTORGUN      -> tractorGunPic it
     LAUNCHER        -> launcherPic it
     LAUNCHERX _     -> launcherPic it

src/Dodge/Item/Weapon.hs

@@ -1,7 +1,6 @@
 {- | Rexport all weapons -}
 module Dodge.Item.Weapon 
     ( module Dodge.Item.Weapon.BulletGuns
-    , module Dodge.Item.Weapon.SonicGuns
     , module Dodge.Item.Weapon.Shatter
     , module Dodge.Item.Weapon.TriggerType
     , module Dodge.Item.Weapon.ExtraEffect
@@ -19,7 +18,6 @@ import Dodge.Item.Weapon.Utility
 import Dodge.Item.Weapon.BulletGuns
 import Dodge.Item.Weapon.Drone
 import Dodge.Item.Weapon.TriggerType
-import Dodge.Item.Weapon.SonicGuns
 import Dodge.Item.Weapon.Shatter
 import Dodge.Item.Weapon.ExtraEffect
 import Dodge.Item.Weapon.Remote

src/Dodge/Item/Weapon/SonicGuns.hs

@@ -1,133 +1,133 @@
 module Dodge.Item.Weapon.SonicGuns where
-import Dodge.Data
-import Dodge.Reloading.Action
-import Dodge.Creature.HandPos
-import Dodge.Default.Weapon
---import Dodge.Item.Attachment
---import Dodge.WorldEvent.HelperParticle
---import Dodge.Base
---import Dodge.Zone
-import Geometry
-import Picture
-import LensHelp
-
---import Data.Maybe
---import Data.List
---import Data.Bifunctor
---import System.Random
---import Data.Tuple
---import qualified IntMapHelp as IM
-
-sonicGun :: Item
-sonicGun = defaultAutoGun 
-    { _itConsumption = defaultLoadable
-        & laMax .~ 10
-        & laCycle .~ [loadEject 10, loadInsert 10 , loadPrime 60]
-    , _itParams = NoParams
-    , _itTweaks = NoTweaks
-    }
-    & itDimension . dimRad .~ 10
-    & itDimension . dimCenter .~ V3 15 0 0
-    & itUse . useDelay . rateMax .~ 8 
-    & itUse . rUse .~ HeldSonicWave --aSonicWave
-    & itUse . useMods .~ AmmoHammerTimeUseOneMod
-    & itUse . useAim . aimWeight .~ 6
-    & itUse . useAim . aimRange .~ 1
-    & itUse . useAim . aimStance .~ TwoHandTwist
-    & itUse . useAim . aimMuzPos .~ 25
-    & itType . iyBase .~ HELD SONICGUN
-
-aSonicWave :: Item -> Creature -> World -> World
-aSonicWave it cr = instantParticles .:~ sonicWave pos dir cpos
-  where 
-    pos = _crPos cr +.+ aimingMuzzlePos cr it *.* unitVectorAtAngle dir
-    cpos = _crPos cr
-    dir = _crDir cr
-
-sonicWave :: Point2 -> Float -> Point2 -> Particle
-sonicWave pos dir cpos = ShockLine
-    { _ptUpdate = mvSonicWave
-    , _ptPointDirs = [[makePointDir $ pos +.+ clockOrth,makePointDir $ pos -.- clockOrth]]
-    , _ptTimer = 1000
-    , _ptColor = white
-    , _ptCenter = cpos
-    }
-  where
-    clockOrth = 10 *.* unitVectorAtAngle (dir + pi*0.5)
-    makePointDir p = (p, argV $ p -.- cpos)
-
-drawSonicWave :: Particle -> Picture
-drawSonicWave pt = foldMap (color (_ptColor pt) . setLayer BloomNoZWrite . setDepth 20 
-    . lineThick 20
-    . map fst)
-    $ _ptPointDirs pt
-
-mvSonicWave :: World -> Particle -> (World, Maybe Particle)
-mvSonicWave w pt
-    | _ptTimer pt <= 0 = (w,Nothing)
-    | otherwise = (w, Just $ pt & ptTimer -~ 1)
---    | otherwise = (w, Just pt')
---  where
---    mvPointDir (p,a) = case wallsHit p ep w of
---        [] -> Just ((ep, a), (True,True))
---        (hp,wl):_ -> reflectShockLine wl p hp ep
---      where
---        ep = p +.+ 5 *.* unitVectorAtAngle a
---    dividePointDir (x:y:xs) = f x y ++ dividePointDir (y:xs)
---    dividePointDir xs = xs
---    f (p,a) (q,b)
---        | dist p q > 10 = [(p,a),(0.5 *.* (p +.+ q),mixAngles 0.5 a b)]
---        | otherwise = [(p,a)]
---    combineClose ((p,a):(q,b):pairs)
---        | dist p q < 5 = combineClose (( 0.5 *.* (p+.+q), mixa) : pairs)
---        | otherwise = (p,a) : combineClose ((q,b):pairs)
---      where
---        mixa = mixAngles 0.5 a b
---    combineClose pairs = pairs
---    pt' = pt & ptTimer -~ 10
---        -- & ptPointDirs %~ (map dividePointDir . filter (not . null) . dosplit . map mvPointDir)
---        & ptPointDirs %~ (map (dividePointDir . combineClose) . filter (not . null) 
---            . concatMap (dosplit . map mvPointDir))
---    --    & ptPointDirs %~ (filter (not . null) . concatMap (dosplit . map mvPointDir))
---    dosplit :: [Maybe ((Point2,Float),(Bool,Bool))] -> [[(Point2,Float)]]
---    dosplit (x:xs) = case x of
---        Nothing -> [] : dosplit xs
---        Just (pair,(True,True))  -> overHead (pair:) $ dosplit xs
---        Just (pair,(False,True)) -> [] : overHead (pair:) (dosplit xs)
---        Just (pair,(True,False)) -> [pair] : dosplit xs
---        Just (_,(False,False)) -> [] : dosplit xs
---    dosplit [] = [[]]
-
-overHead :: (a -> a) -> [a] -> [a]
-overHead f (x:xs) = f x: xs
-overHead _ [] = []
-        
-        
-reflectShockLine :: Wall -> Point2 -> Point2 -> Point2 -> Maybe ((Point2,Float),(Bool,Bool))
-reflectShockLine wl sp hitp ep
-    | angleVV wlV v < pi/3 = Just (pair, (False,True))
-    | angleVV wlV v < 2 *pi/3 = Nothing
-    | otherwise = Just (pair, (True,False))
-  where
-    reflv = reflectIn wlV (ep -.- hitp)
-    np = hitp +.+ reflv
-    pair = (np, argV reflv)
-    wlV = uncurry (-.-) $ _wlLine wl
-    v = hitp -.- sp
-
-reflectShockLine' :: Wall -> Point2 -> Point2 -> Point2 -> Maybe ((Point2,Float),(Bool,Bool))
-reflectShockLine' wl sp hitp ep
-    | angleVV wlV v < pi/3 = Just ((np +.+ wlVN,argV wlV), (False,True))
-    | angleVV wlV v < 2 *pi/3 = Nothing
-    | otherwise = Just ((np -.- wlVN,argV $ V2 0 0 -.- wlV), (True,False))
-  where
-    np = hitp +.+ normalizeV (sp -.- hitp)
-    wlV = uncurry (-.-) $ _wlLine wl
-    wlVN = dist hitp ep *.* normalizeV wlV
-    v = hitp -.- sp
-
-dividePoly :: Float -> [Point2] -> [Point2]
-dividePoly x (a:b:bs) = init (divideLine x a b) ++ dividePoly x (b:bs)
-dividePoly _ [a] = [a]
-dividePoly _ _ = []
-    
+--import Dodge.Data
+--import Dodge.Reloading.Action
+--import Dodge.Creature.HandPos
+--import Dodge.Default.Weapon
+----import Dodge.Item.Attachment
+----import Dodge.WorldEvent.HelperParticle
+----import Dodge.Base
+----import Dodge.Zone
+--import Geometry
+--import Picture
+--import LensHelp
+--
+----import Data.Maybe
+----import Data.List
+----import Data.Bifunctor
+----import System.Random
+----import Data.Tuple
+----import qualified IntMapHelp as IM
+--
+----sonicGun :: Item
+----sonicGun = defaultAutoGun 
+----    { _itConsumption = defaultLoadable
+----        & laMax .~ 10
+----        & laCycle .~ [loadEject 10, loadInsert 10 , loadPrime 60]
+----    , _itParams = NoParams
+----    , _itTweaks = NoTweaks
+----    }
+----    & itDimension . dimRad .~ 10
+----    & itDimension . dimCenter .~ V3 15 0 0
+----    & itUse . useDelay . rateMax .~ 8 
+----    & itUse . rUse .~ HeldSonicWave --aSonicWave
+----    & itUse . useMods .~ AmmoHammerTimeUseOneMod
+----    & itUse . useAim . aimWeight .~ 6
+----    & itUse . useAim . aimRange .~ 1
+----    & itUse . useAim . aimStance .~ TwoHandTwist
+----    & itUse . useAim . aimMuzPos .~ 25
+----    & itType . iyBase .~ HELD SONICGUN
+--
+----aSonicWave :: Item -> Creature -> World -> World
+----aSonicWave it cr = instantParticles .:~ sonicWave pos dir cpos
+----  where 
+----    pos = _crPos cr +.+ aimingMuzzlePos cr it *.* unitVectorAtAngle dir
+----    cpos = _crPos cr
+----    dir = _crDir cr
+--
+----sonicWave :: Point2 -> Float -> Point2 -> Particle
+----sonicWave pos dir cpos = ShockLine
+----    { _ptUpdate = mvSonicWave
+----    , _ptPointDirs = [[makePointDir $ pos +.+ clockOrth,makePointDir $ pos -.- clockOrth]]
+----    , _ptTimer = 1000
+----    , _ptColor = white
+----    , _ptCenter = cpos
+----    }
+----  where
+----    clockOrth = 10 *.* unitVectorAtAngle (dir + pi*0.5)
+----    makePointDir p = (p, argV $ p -.- cpos)
+--
+----drawSonicWave :: Particle -> Picture
+----drawSonicWave pt = foldMap (color (_ptColor pt) . setLayer BloomNoZWrite . setDepth 20 
+----    . lineThick 20
+----    . map fst)
+----    $ _ptPointDirs pt
+----
+----mvSonicWave :: World -> Particle -> (World, Maybe Particle)
+----mvSonicWave w pt
+----    | _ptTimer pt <= 0 = (w,Nothing)
+----    | otherwise = (w, Just $ pt & ptTimer -~ 1)
+------    | otherwise = (w, Just pt')
+------  where
+------    mvPointDir (p,a) = case wallsHit p ep w of
+------        [] -> Just ((ep, a), (True,True))
+------        (hp,wl):_ -> reflectShockLine wl p hp ep
+------      where
+------        ep = p +.+ 5 *.* unitVectorAtAngle a
+------    dividePointDir (x:y:xs) = f x y ++ dividePointDir (y:xs)
+------    dividePointDir xs = xs
+------    f (p,a) (q,b)
+------        | dist p q > 10 = [(p,a),(0.5 *.* (p +.+ q),mixAngles 0.5 a b)]
+------        | otherwise = [(p,a)]
+------    combineClose ((p,a):(q,b):pairs)
+------        | dist p q < 5 = combineClose (( 0.5 *.* (p+.+q), mixa) : pairs)
+------        | otherwise = (p,a) : combineClose ((q,b):pairs)
+------      where
+------        mixa = mixAngles 0.5 a b
+------    combineClose pairs = pairs
+------    pt' = pt & ptTimer -~ 10
+------        -- & ptPointDirs %~ (map dividePointDir . filter (not . null) . dosplit . map mvPointDir)
+------        & ptPointDirs %~ (map (dividePointDir . combineClose) . filter (not . null) 
+------            . concatMap (dosplit . map mvPointDir))
+------    --    & ptPointDirs %~ (filter (not . null) . concatMap (dosplit . map mvPointDir))
+------    dosplit :: [Maybe ((Point2,Float),(Bool,Bool))] -> [[(Point2,Float)]]
+------    dosplit (x:xs) = case x of
+------        Nothing -> [] : dosplit xs
+------        Just (pair,(True,True))  -> overHead (pair:) $ dosplit xs
+------        Just (pair,(False,True)) -> [] : overHead (pair:) (dosplit xs)
+------        Just (pair,(True,False)) -> [pair] : dosplit xs
+------        Just (_,(False,False)) -> [] : dosplit xs
+------    dosplit [] = [[]]
+--
+----overHead :: (a -> a) -> [a] -> [a]
+----overHead f (x:xs) = f x: xs
+----overHead _ [] = []
+----        
+----        
+----reflectShockLine :: Wall -> Point2 -> Point2 -> Point2 -> Maybe ((Point2,Float),(Bool,Bool))
+----reflectShockLine wl sp hitp ep
+----    | angleVV wlV v < pi/3 = Just (pair, (False,True))
+----    | angleVV wlV v < 2 *pi/3 = Nothing
+----    | otherwise = Just (pair, (True,False))
+----  where
+----    reflv = reflectIn wlV (ep -.- hitp)
+----    np = hitp +.+ reflv
+----    pair = (np, argV reflv)
+----    wlV = uncurry (-.-) $ _wlLine wl
+----    v = hitp -.- sp
+----
+----reflectShockLine' :: Wall -> Point2 -> Point2 -> Point2 -> Maybe ((Point2,Float),(Bool,Bool))
+----reflectShockLine' wl sp hitp ep
+----    | angleVV wlV v < pi/3 = Just ((np +.+ wlVN,argV wlV), (False,True))
+----    | angleVV wlV v < 2 *pi/3 = Nothing
+----    | otherwise = Just ((np -.- wlVN,argV $ V2 0 0 -.- wlV), (True,False))
+----  where
+----    np = hitp +.+ normalizeV (sp -.- hitp)
+----    wlV = uncurry (-.-) $ _wlLine wl
+----    wlVN = dist hitp ep *.* normalizeV wlV
+----    v = hitp -.- sp
+----
+----dividePoly :: Float -> [Point2] -> [Point2]
+----dividePoly x (a:b:bs) = init (divideLine x a b) ++ dividePoly x (b:bs)
+----dividePoly _ [a] = [a]
+----dividePoly _ _ = []
+--    

src/Dodge/Particle/Draw.hs

@@ -2,9 +2,9 @@ module Dodge.Particle.Draw where
 import Dodge.Data
 import Picture
 
-drawParticle :: Particle -> Picture
-drawParticle pt = case pt of
-    ShockLine {} -> drawSonicWave pt
+--drawParticle :: Particle -> Picture
+--drawParticle pt = case pt of
+--    ShockLine {} -> drawSonicWave pt
 --
 --drawShockwave :: Particle -> Picture
 --drawShockwave pt = setDepth 20 
@@ -46,9 +46,9 @@ drawTargetLaser pt = setLayer BloomNoZWrite $ pictures
     col = _laColor pt
     (sp:ps) = _laPoints pt
 
-drawSonicWave :: Particle -> Picture
-drawSonicWave pt = foldMap (color (_ptColor pt) . setLayer BloomNoZWrite . setDepth 20 
-    . lineThick 20
-    . map fst)
-    $ _ptPointDirs pt
+--drawSonicWave :: Particle -> Picture
+--drawSonicWave pt = foldMap (color (_ptColor pt) . setLayer BloomNoZWrite . setDepth 20 
+--    . lineThick 20
+--    . map fst)
+--    $ _ptPointDirs pt
 

src/Dodge/Render/ShapePicture.hs

@@ -19,7 +19,6 @@ import Dodge.Item.Draw.SPic
 import Dodge.EnergyBall.Draw
 import Dodge.Creature.Picture.Awareness
 import Dodge.Creature.Picture
-import Dodge.Particle.Draw
 import Dodge.Flame.Draw
 import Dodge.Bullet.Draw
 import Dodge.Spark.Draw
@@ -137,7 +136,7 @@ extraPics cfig w = pictures (_decorations w)
     <> concatMapPic drawShockwave (_shockwaves w)
     <> concatMapPic drawLaser (_lasersToDraw w)
     <> concatMapPic drawTeslaArc (_teslaArcs w)
-    <> concatMapPic drawParticle (_particles    w)
+--    <> concatMapPic drawParticle (_particles    w)
     <> concatMapPic drawRadarSweep (_radarSweeps    w)
     <> concatMapPic drawFlame (_flames    w)
     <> concatMapPic drawEnergyBall (_energyBalls    w)

src/Dodge/Update.hs

@@ -62,8 +62,8 @@ updateUniverse u = case _menuLayers u of
         | i < 1     -> u & over uvWorld doWorldEvents
         | otherwise -> u & menuLayers %~ ( (WaitScreen s (i-1) :) . tail )
     (OptionScreen {_scOptionFlag = GameOverOptions} : _) -> u & uvWorld %~
-        ( updateParticles 
-        . (radarBlips .~ [])
+        ( --updateParticles 
+         (radarBlips .~ [])
 --        . updateIMl _props _pjUpdate 
         . updateLightSources
         . updateClouds )
@@ -96,7 +96,7 @@ functionalUpdate w = checkEndGame
     . over uvWorld updateFlames
     . over uvWorld updateShockwaves
     . over uvWorld updateEnergyBalls
-    . over uvWorld updateParticles
+--    . over uvWorld updateParticles
     . over uvWorld updateBullets
     . over uvWorld updateRadarBlips
     . over uvWorld updateFlares
@@ -285,10 +285,10 @@ updatePosEvents w = w' & posEvents .~ catMaybes newposEvents
 
 
 {- Apply internal particle updates, delete 'Nothing's.  -}
-updateParticles :: World -> World
-updateParticles w = updateInstantParticles $ set particles (catMaybes ps) w'
-  where 
-    (w',ps) = mapAccumR (\a b -> _ptUpdate b a b) w $ _particles w
+--updateParticles :: World -> World
+--updateParticles w = updateInstantParticles $ set particles (catMaybes ps) w'
+--  where 
+--    (w',ps) = mapAccumR (\a b -> _ptUpdate b a b) w $ _particles w
 updateBeams :: World -> World
 updateBeams w = w
     & newBeams .~ WorldBeams [] [] [] []
@@ -365,11 +365,11 @@ updateInstantBullets w = case _instantBullets w of
     ps -> let (w',ps') = mapAccumR updateBullet (w {_instantBullets=[]}) ps
         in updateInstantBullets $ w' & bullets .++~ catMaybes ps'
 
-updateInstantParticles :: World -> World
-updateInstantParticles w = case _instantParticles w of
-    [] -> w
-    ps -> let (w',ps') = mapAccumR (\a b -> _ptUpdate b a b) (w {_instantParticles=[]}) ps
-        in updateInstantParticles $ w' & particles .++~ catMaybes ps'
+--updateInstantParticles :: World -> World
+--updateInstantParticles w = case _instantParticles w of
+--    [] -> w
+--    ps -> let (w',ps') = mapAccumR (\a b -> _ptUpdate b a b) (w {_instantParticles=[]}) ps
+--        in updateInstantParticles $ w' & particles .++~ catMaybes ps'
 
 updateMIM :: ASetter' World (IM.IntMap a) -> (a -> a -> Maybe a) -> World -> World
 updateMIM f up = f %~ IM.mapMaybe (dbArg up)

src/Dodge/WorldEvent/HelperParticle.hs

@@ -1,10 +0,0 @@
-{- Helper functions for particles.  -}
-module Dodge.WorldEvent.HelperParticle
-    ( ptSimpleTime
-    ) where
-import Dodge.Data
-
-{- A simple timer update for particles.  -}
-ptSimpleTime :: Int -> World -> Particle -> (World, Maybe Particle)
-ptSimpleTime 0 w _ = (w, Nothing)
-ptSimpleTime n w pt = (w, Just $ pt {_ptUpdate = ptSimpleTime (n-1)})

src/Dodge/WorldEvent/SpawnParticle.hs

@@ -3,7 +3,7 @@ module Dodge.WorldEvent.SpawnParticle
     ( makeGasCloud
     , makeStaticBall
     , concBall
-    , randParticleAt
+--    , randParticleAt
     ) where
 import Dodge.Data
 import RandomHelp
@@ -11,12 +11,12 @@ import Picture
 import Geometry
 import LensHelp
 
-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)
+--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)
 randEnergyBallAt :: (Point2 -> State StdGen EnergyBall) -> Point2 -> World -> World
 randEnergyBallAt f p w = w
     & energyBalls .:~ thepart