Move flares into own grouping

src/Dodge/Data.hs

@@ -11,6 +11,7 @@ circular imports are probably not a good idea.
 module Dodge.Data 
     ( module Dodge.Data
     , module Dodge.Data.Material
+    , module Dodge.Data.Flare
     , module Dodge.Data.LoadAction
     , module Dodge.Data.ForegroundShape
     , module Dodge.Data.Wall
@@ -37,6 +38,7 @@ module Dodge.Data
     ) where
 import Dodge.Data.RadarBlip
 import Dodge.Data.Room
+import Dodge.Data.Flare
 import Dodge.Data.PathGraph
 import Dodge.Data.Zoning
 import Dodge.Data.ForegroundShape
@@ -122,6 +124,7 @@ data World = World
     , _instantParticles     :: [Particle]
     , _particles            :: [Particle]
     , _radarBlips           :: [RadarBlip]
+    , _flares               :: [Flare]
     , _newBeams             :: WorldBeams
     , _beams                :: WorldBeams
     , _walls                :: IM.IntMap Wall
@@ -635,10 +638,6 @@ data BeamType
 {- Objects without ids.
 Update themselves, perhaps with side effects.  -}
 data Particle
---    = Particle
---        { _ptDraw   :: Particle -> Picture
---        , _ptUpdate :: World -> Particle -> (World, Maybe Particle)
---        }
     = RadarCircleParticle
         { _ptUpdate :: World -> Particle -> (World, Maybe Particle)
         , _ptTimer  :: Int
@@ -665,12 +664,6 @@ data Particle
         , _ptPoints :: [Point2]
         , _ptColor  :: Color
         }
---    | LinearParticle 
---        { _ptUpdate :: World -> Particle -> (World, Maybe Particle)
---        , _ptPoints :: [Point2]
---        , _ptTimer :: Int
---        , _ptColor :: Color
---        }
     | BulletPt
         { _ptUpdate :: World -> Particle -> (World, Maybe Particle)
         , _ptVel    :: Point2
@@ -717,30 +710,6 @@ data Particle
         , _ptHitEff :: HitEffect
         , _ptZ :: Float
         }
-    | PtMuzFlare 
-        { _ptUpdate :: World -> Particle -> (World, Maybe Particle)
-        , _ptPoly   :: [Point2]
-        , _ptColor  :: Color
-        , _ptTran3  :: Point3
-        }
-    | PtCircFlare 
-        { _ptUpdate :: World -> Particle -> (World, Maybe Particle)
-        , _ptColor  :: Color
-        , _ptAlpha  :: Float
-        , _ptTran3  :: Point3
-        }
---    | PtZ  
---        { _ptDraw :: Particle -> Picture
---        , _ptUpdate :: World -> Particle -> (World, Maybe Particle)
---        , _ptVel    :: Point2
---        , _ptColor  :: Color
---        , _ptPos :: Point2
---        , _ptCrIgnore :: Maybe Int
---        , _ptWidth :: Float 
---        , _ptTimer :: Int
---        , _ptHitEff :: HitEffect
---        , _ptZ :: Float
---        }
     | Shockwave
         { _ptUpdate     :: World -> Particle -> (World, Maybe Particle)
         , _ptColor      :: Color

src/Dodge/Default/World.hs

@@ -45,6 +45,7 @@ defaultWorld = World
     , _instantParticles = []
     , _particles = []
     , _radarBlips = []
+    , _flares = []
     , _newBeams = WorldBeams [] [] [] []
     , _beams = WorldBeams [] [] [] []
     , _walls = IM.empty

src/Dodge/Particle/Draw.hs

@@ -9,8 +9,6 @@ drawParticle pt = case pt of
     Shockwave {} -> drawShockwave pt
     PtStaticBall {} -> drawStaticBall pt
     PtIncBall {} -> drawFlameletZ pt
-    PtMuzFlare {} -> drawMuzFlare pt
-    PtCircFlare {} -> drawCircFlare pt
     PtInvShockwave {} -> drawInverseShockwave pt
     BulletPt {} -> drawBul pt
     PtTeslaArc {} -> drawTeslaArc pt
@@ -115,22 +113,6 @@ drawFlameletZ pt = pictures
     s2 = 0.5 * (sc + s1)
     rot = _ptRot pt
 
-drawMuzFlare :: Particle -> Picture
-drawMuzFlare pt = setLayer BloomNoZWrite . translate3 tranv $ theShape
-  where
-    tranv = _ptTran3 pt
-    col = _ptColor pt
-    poly = _ptPoly pt
-    theShape = color col $ polygon poly
-
-drawCircFlare :: Particle -> Picture
-drawCircFlare pt = setLayer BloomNoZWrite . translate3 tranv
-                        $ circleSolidCol (withAlpha 0 0) (withAlpha alphax col) 50
-  where
-    col = _ptColor pt
-    tranv = _ptTran3 pt
-    alphax = _ptAlpha pt
-
 drawInverseShockwave :: Particle -> Picture
 drawInverseShockwave  pt 
     = setLayer BloomLayer $ setDepth 20 $ uncurryV translate p 

src/Dodge/Render/ShapePicture.hs

@@ -4,6 +4,7 @@ module Dodge.Render.ShapePicture
 import Dodge.Creature.Picture.Awareness
 import Dodge.Particle.Draw
 import Dodge.RadarBlip
+import Dodge.Flare
 import Dodge.ShortShow
 import Dodge.Config.Data
 import Dodge.Render.InfoBox
@@ -84,6 +85,7 @@ extraPics :: Configuration -> World -> Picture
 extraPics cfig w = pictures (_decorations w)
     <> concatMapPic drawParticle (_particles    w)
     <> concatMapPic drawBlip (_radarBlips    w)
+    <> concatMapPic drawFlare (_flares    w)
     <> concatMapPic (dbArg _bmDraw) (_positronBeams $ _beams w)
     <> concatMapPic (dbArg _bmDraw) (_electronBeams $ _beams w)
     <> concatMapPic (dbArg _lsPict) (_lightSources w)

src/Dodge/Update.hs

@@ -6,6 +6,7 @@ Description : Simulation update
 module Dodge.Update ( updateUniverse ) where
 import Dodge.Data
 import Dodge.RadarBlip
+import Dodge.Flare
 import Dodge.Menu
 import Dodge.CullBox
 --import Dodge.Block
@@ -78,6 +79,7 @@ functionalUpdate cfig w = checkEndGame
     . updateIMl _modifications _mdUpdate
     . updateParticles 
     . updateRadarBlips 
+    . updateFlares 
     . updateBeams
     . updateIMl _props _pjUpdate  
     . updateLightSources
@@ -205,6 +207,9 @@ updateLightSources w = over tempLightSources f w
 updateRadarBlips :: World -> World
 updateRadarBlips = radarBlips %~ mapMaybe updateRadarBlip
 
+updateFlares :: World -> World
+updateFlares = flares %~ mapMaybe updateFlare
+
 {- Apply internal particle updates, delete 'Nothing's.  -}
 updateParticles :: World -> World
 updateParticles w = updateInstantParticles $ set particles (catMaybes ps) w'

src/Dodge/WorldEvent/Flash.hs

@@ -16,7 +16,6 @@ module Dodge.WorldEvent.Flash
     ) where
 import Dodge.Data
 import Dodge.LightSource
-import Dodge.WorldEvent.HelperParticle
 --import Dodge.Default
 import Picture
 import Geometry
@@ -25,25 +24,25 @@ import LensHelp
 import System.Random
 
 muzFlareAt :: Color -> Point3 -> Float -> World -> World
-muzFlareAt col tranv dir w = w & instantParticles .:~ PtMuzFlare
+muzFlareAt col tranv dir w = w & flares .:~ MuzFlare
-    { _ptUpdate = ptSimpleTime 2
+    { _flarePoly = map (rotateV dir)
-    , _ptPoly = map (rotateV dir)
         [ V2 0 0
         , V2 a (-b)
         , V2 c d
         ]
-    , _ptColor = col
+    , _flareColor = col
-    , _ptTran3 = tranv
+    , _flareTran3 = tranv
+    , _flareTime = 2
     }
   where
     (a:b:c:d:_) = randomRs (2,20) (_randGen w)
 
 flareCircleAt :: Color -> Float -> Point3 -> World -> World
-flareCircleAt col alphax tranv = instantParticles .:~ PtCircFlare
+flareCircleAt col alphax tranv = flares .:~ CircFlare
-    { _ptUpdate = ptSimpleTime 1
+    { _flareTime = 2
-    , _ptColor = col
+    , _flareColor = col
-    , _ptAlpha = alphax
+    , _flareAlpha = alphax
-    , _ptTran3 = tranv
+    , _flareTran3 = tranv
     }
 
 explosionFlashAt :: Point2 -> World -> World