Move radar blips into own grouping

src/Dodge/Data.hs

@@ -32,8 +32,10 @@ module Dodge.Data
     , module Dodge.Data.ItemAmount
     , module Dodge.RoomCluster.Data
     , module Dodge.Data.Room
+    , module Dodge.Data.RadarBlip
     , module Dodge.Data.PathGraph
     ) where
+import Dodge.Data.RadarBlip
 import Dodge.Data.Room
 import Dodge.Data.PathGraph
 import Dodge.Data.Zoning
@@ -119,6 +121,7 @@ data World = World
     , _props                :: IM.IntMap Prop
     , _instantParticles     :: [Particle]
     , _particles            :: [Particle]
+    , _radarBlips           :: [RadarBlip]
     , _newBeams             :: WorldBeams
     , _beams                :: WorldBeams
     , _walls                :: IM.IntMap Wall
@@ -636,15 +639,6 @@ data Particle
         { _ptDraw   :: Particle -> Picture
         , _ptUpdate :: World -> Particle -> (World, Maybe Particle)
         }
-    | BlipParticle
-        { _ptDraw   :: Particle -> Picture
-        , _ptColor  :: Color
-        , _ptTimer  :: Int
-        , _ptMaxTime :: Int
-        , _ptUpdate :: World -> Particle -> (World, Maybe Particle)
-        , _ptRad    :: Float
-        , _ptPos    :: Point2
-        }
     | RadarCircleParticle
         { _ptDraw   :: Particle -> Picture
         , _ptUpdate :: World -> Particle -> (World, Maybe Particle)
@@ -661,6 +655,19 @@ data Particle
         , _ptPhaseV :: Float
         , _ptPoints :: [Point2]
         }
+    | PtTeslaArc 
+        { _ptDraw :: Particle -> Picture
+        , _ptUpdate :: World -> Particle -> (World, Maybe Particle)
+        , _ptPoints :: [Point2]
+        , _ptTimer :: Int
+        , _ptColor :: Color
+        }
+    | PtTargetLaser
+        { _ptDraw   :: Particle -> Picture
+        , _ptUpdate :: World -> Particle -> (World, Maybe Particle)
+        , _ptPoints :: [Point2]
+        , _ptColor  :: Color
+        }
     | LinearParticle 
         { _ptDraw :: Particle -> Picture
         , _ptUpdate :: World -> Particle -> (World, Maybe Particle)
@@ -680,6 +687,58 @@ data Particle
         , _ptTimer :: Int
         , _ptHitEff :: HitEffect
         }
+    | PtFlame  
+        { _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
+        , _ptOriginalVel :: Point2
+        }
+    | PtIncBall  
+        { _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
+        , _ptRot :: Float
+        }
+    | PtStaticBall  
+        { _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
+        }
+    | PtMuzFlare 
+        { _ptDraw   :: Particle -> Picture
+        , _ptUpdate :: World -> Particle -> (World, Maybe Particle)
+        , _ptPoly   :: [Point2]
+        , _ptColor  :: Color
+        , _ptTran3  :: Point3
+        }
+    | PtCircFlare 
+        { _ptDraw   :: Particle -> Picture
+        , _ptUpdate :: World -> Particle -> (World, Maybe Particle)
+        , _ptColor  :: Color
+        , _ptAlpha  :: Float
+        , _ptTran3  :: Point3
+        }
     | PtZ  
         { _ptDraw :: Particle -> Picture
         , _ptUpdate :: World -> Particle -> (World, Maybe Particle)
@@ -703,6 +762,17 @@ data Particle
         , _ptMaxTime    :: Int
         , _ptTimer      :: Int
         }
+    | PtInvShockwave
+        { _ptDraw       :: Particle -> Picture
+        , _ptUpdate     :: World -> Particle -> (World, Maybe Particle)
+        , _ptColor      :: Color
+        , _ptPos        :: Point2
+        , _ptRad        :: Float
+        , _ptDam        :: Int
+        , _ptPush       :: Float
+        , _ptMaxTime    :: Int
+        , _ptTimer      :: Int
+        }
     | ShockLine 
         { _ptDraw :: Particle -> Picture
         , _ptUpdate :: World -> Particle -> (World, Maybe Particle)

src/Dodge/Default/World.hs

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

src/Dodge/Item/Weapon/UseEffect.hs

@@ -23,10 +23,10 @@ aWallPulse = aRadarPulse wallBlips (blipAt 2) red
 
 {- | Creates an outwardly increasing circle that displays items.  -}
 anItemFindPulse :: Creature -> World -> World
-anItemFindPulse = aRadarPulse itemBlips (openBlipAt 6) blue
+anItemFindPulse = aRadarPulse itemBlips (blipAt 6) blue
 
 aRadarPulse :: (Point2 -> Float -> World -> [Point2]) 
-    -> (Point2 -> Color -> Int -> Particle)
+    -> (Point2 -> Color -> Int -> RadarBlip)
     -> Color
     -> Creature 
     -> World -> World
@@ -51,70 +51,17 @@ drawPulse col pt = setLayer DebugLayer $ pictures sweepPics
                 | otherwise = fromIntegral x / 10
     x = _ptTimer pt
 {- | Radar blip at a point.  -}
-blipAt :: Float -> Point2 -> Color -> Int -> Particle
+blipAt :: Float -> Point2 -> Color -> Int -> RadarBlip
-blipAt r p col i = BlipParticle
+blipAt r p col i = RadarBlip
-    {_ptDraw = drawBlip
+    {_rbColor = col
-    ,_ptUpdate = \w pt -> if _ptTimer pt <= 0 then (w,Nothing) else (w,Just $ pt & ptTimer -~ 1)
+    ,_rbTime = i
-    ,_ptColor = col
+    ,_rbMaxTime = i
-    ,_ptTimer = i
+    ,_rbRad = r
-    ,_ptMaxTime = i
+    ,_rbPos = p
-    ,_ptRad = r
-    ,_ptPos = p
     }
-drawBlip :: Particle -> Picture
-drawBlip pt = setDepth (-0.5)
-    . setLayer DebugLayer
-    . uncurryV translate p 
-    . color (withAlpha (fromIntegral t / fromIntegral maxt) col)
-    $ circleSolid r
-  where
-    p = _ptPos pt
-    t = _ptTimer pt
-    r = _ptRad pt
-    col = _ptColor pt
-    maxt = _ptMaxTime pt
-mvBlip :: Float
-    -> Point2 -> Color 
-    -> Int  -- ^ Max possible timer value
-    -> Int  -- ^ Current timer value
-    -> World -> Particle -> (World, Maybe Particle)
-mvBlip r p col maxt t w pt = case t of
-    0 -> (w, Nothing)
-    _ -> (w
-        , Just $ pt & ptUpdate .~ mvBlip r p col maxt (t-1)
-            & ptDraw .~ ( const 
-                . setDepth (-0.5)
-                . setLayer DebugLayer
-                . uncurryV translate p 
-                . color (withAlpha (fromIntegral t / fromIntegral maxt) col)
-                $ circleSolid r )
-        )
-{- | Radar blip at a point.  -}
-openBlipAt :: Float -> Point2 -> Color -> Int -> Particle
-openBlipAt r p col i = Particle
-    {_ptDraw = const blank
-    ,_ptUpdate = mvOpenBlip r p col i i
-    }
-mvOpenBlip :: Float
-    -> Point2 -> Color 
-    -> Int  -- ^ Max possible timer value
-    -> Int  -- ^ Current timer value
-    -> World -> Particle -> (World, Maybe Particle)
-mvOpenBlip r p col maxt t w pt = case t of
-    0 -> (w, Nothing)
-    _ -> (w
-        , Just $ pt & ptUpdate .~ mvOpenBlip r p col maxt (t-1)
-            & ptDraw .~ ( const 
-                . setDepth (-0.5)
-                . setLayer DebugLayer
-                . uncurryV translate p 
-                . color (withAlpha (fromIntegral t / fromIntegral maxt) col)
-                $ thickCircle r 3)
-        )
-
 mvRadar 
     :: (Point2 -> Float -> World -> [Point2])
-    -> (Point2 -> Color -> Int -> Particle)
+    -> (Point2 -> Color -> Int -> RadarBlip)
     -> Color
     -> Point2   -- ^ Center of expanding circle
     -> World -> Particle -> (World, Maybe Particle)
@@ -126,7 +73,7 @@ mvRadar blipsF bf col p w pt
         )
   where
     x = _ptTimer pt
-    putBlips = over worldEvents ( over instantParticles (blips ++) . )
+    putBlips = radarBlips .++~ blips
     blips = map (\bp -> bf bp (withAlpha (0.5*globalAlpha) col) 50) circPoints
     circPoints = blipsF p r w
     r = fromIntegral (400 - x*4)

src/Dodge/Render/ShapePicture.hs

@@ -2,6 +2,7 @@ module Dodge.Render.ShapePicture
     ( worldSPic
     ) where
 import Dodge.Creature.Picture.Awareness
+import Dodge.RadarBlip
 import Dodge.ShortShow
 import Dodge.Config.Data
 import Dodge.Render.InfoBox
@@ -81,6 +82,7 @@ cullPoint cfig w p
 extraPics :: Configuration -> World -> Picture
 extraPics cfig w = pictures (_decorations w)
     <> concatMapPic (dbArg _ptDraw) (_particles    w)
+    <> concatMapPic drawBlip (_radarBlips    w)
     <> concatMapPic (dbArg _bmDraw) (_positronBeams $ _beams w)
     <> concatMapPic (dbArg _bmDraw) (_electronBeams $ _beams w)
     <> concatMapPic (dbArg _lsPict) (_lightSources w)

src/Dodge/Update.hs

@@ -5,6 +5,7 @@ Description : Simulation update
 -}
 module Dodge.Update ( updateUniverse ) where
 import Dodge.Data
+import Dodge.RadarBlip
 import Dodge.Menu
 import Dodge.CullBox
 --import Dodge.Block
@@ -47,6 +48,7 @@ updateUniverse u = case _menuLayers u of
         | otherwise -> u & menuLayers %~ ( (WaitScreen s (i-1) :) . tail )
     (OptionScreen {_scOptionFlag = GameOverOptions} : _) -> u & uvWorld %~
         ( updateParticles 
+        . (radarBlips .~ [])
         . updateIMl _props _pjUpdate 
         . updateLightSources
         . updateClouds )
@@ -75,6 +77,7 @@ functionalUpdate cfig w = checkEndGame
     . dbArg _worldEvents
     . updateIMl _modifications _mdUpdate
     . updateParticles 
+    . updateRadarBlips 
     . updateBeams
     . updateIMl _props _pjUpdate  
     . updateLightSources
@@ -199,6 +202,9 @@ updateLightSources w = over tempLightSources f w
   where 
     f = mapMaybe (\b -> _tlsUpdate b w b)
 
+updateRadarBlips :: World -> World
+updateRadarBlips = radarBlips %~ mapMaybe updateRadarBlip
+
 {- Apply internal particle updates, delete 'Nothing's.  -}
 updateParticles :: World -> World
 updateParticles w = updateInstantParticles $ set particles (catMaybes ps) w'

src/Dodge/WorldEvent/SpawnParticle.hs

@@ -33,7 +33,7 @@ aFlameParticle
     -> Point2   -- ^ Velocity
     -> Maybe Int -- ^ Creature id
     -> Particle
-aFlameParticle t pos vel maycid = PtZ
+aFlameParticle t pos vel maycid = PtFlame
     { _ptDraw       = drawFlame vel
     , _ptUpdate     = moveFlame vel
     , _ptVel        = vel
@@ -44,6 +44,7 @@ aFlameParticle t pos vel maycid = PtZ
     , _ptTimer      = t
     , _ptHitEff     = expireAndDamage $ simpleDam FLAMING 20
     , _ptZ           = 20
+    , _ptOriginalVel = vel
     }
 drawFlame
     :: Point2 -- ^ Rotate direction