Move radar blips into own grouping, work on data-ifying particles

src/Dodge/Data.hs

@@ -635,16 +635,17 @@ data BeamType
 {- Objects without ids.
 Update themselves, perhaps with side effects.  -}
 data Particle
-    = Particle
+--    = Particle
-        { _ptDraw   :: Particle -> Picture
+--        { _ptDraw   :: Particle -> Picture
-        , _ptUpdate :: World -> Particle -> (World, Maybe Particle)
+--        , _ptUpdate :: World -> Particle -> (World, Maybe Particle)
-        }
+--        }
-    | RadarCircleParticle
+    = RadarCircleParticle
         { _ptDraw   :: Particle -> Picture
         , _ptUpdate :: World -> Particle -> (World, Maybe Particle)
         , _ptTimer  :: Int
         , _ptRad    :: Float
         , _ptPos    :: Point2
+        , _ptColor  :: Color
         }
     | LaserParticle
         { _ptDraw   :: Particle -> Picture
@@ -668,13 +669,13 @@ data Particle
         , _ptPoints :: [Point2]
         , _ptColor  :: Color
         }
-    | LinearParticle 
+--    | LinearParticle 
-        { _ptDraw :: Particle -> Picture
+--        { _ptDraw :: Particle -> Picture
-        , _ptUpdate :: World -> Particle -> (World, Maybe Particle)
+--        , _ptUpdate :: World -> Particle -> (World, Maybe Particle)
-        , _ptPoints :: [Point2]
+--        , _ptPoints :: [Point2]
-        , _ptTimer :: Int
+--        , _ptTimer :: Int
-        , _ptColor :: Color
+--        , _ptColor :: Color
-        }
+--        }
     | BulletPt
         { _ptDraw   :: Particle -> Picture
         , _ptUpdate :: World -> Particle -> (World, Maybe Particle)
@@ -739,18 +740,18 @@ data Particle
         , _ptAlpha  :: Float
         , _ptTran3  :: Point3
         }
-    | PtZ  
+--    | PtZ  
-        { _ptDraw :: Particle -> Picture
+--        { _ptDraw :: Particle -> Picture
-        , _ptUpdate :: World -> Particle -> (World, Maybe Particle)
+--        , _ptUpdate :: World -> Particle -> (World, Maybe Particle)
-        , _ptVel    :: Point2
+--        , _ptVel    :: Point2
-        , _ptColor  :: Color
+--        , _ptColor  :: Color
-        , _ptPos :: Point2
+--        , _ptPos :: Point2
-        , _ptCrIgnore :: Maybe Int
+--        , _ptCrIgnore :: Maybe Int
-        , _ptWidth :: Float 
+--        , _ptWidth :: Float 
-        , _ptTimer :: Int
+--        , _ptTimer :: Int
-        , _ptHitEff :: HitEffect
+--        , _ptHitEff :: HitEffect
-        , _ptZ :: Float
+--        , _ptZ :: Float
-        }
+--        }
     | Shockwave
         { _ptDraw       :: Particle -> Picture
         , _ptUpdate     :: World -> Particle -> (World, Maybe Particle)

src/Dodge/Data/RadarBlip.hs

@@ -0,0 +1,16 @@
+{-# LANGUAGE TemplateHaskell #-}
+{-# LANGUAGE StrictData #-}
+module Dodge.Data.RadarBlip where
+import Color
+import Geometry
+import Control.Lens
+
+data RadarBlip = RadarBlip
+    { _rbColor      :: Color
+    , _rbTime       :: Int
+    , _rbMaxTime    :: Int
+    , _rbRad        :: Float
+    , _rbPos        :: Point2
+    }
+
+makeLenses ''RadarBlip

src/Dodge/Item/Weapon/Decoration.hs

@@ -14,14 +14,17 @@ makeLaserScope
     -> Point2   -- ^ End point
     -> Float    -- ^ Fraction of red/green
     -> Particle
-makeLaserScope p ep relFrac = Particle
+makeLaserScope p ep relFrac = PtTargetLaser
     {_ptDraw = const $ setLayer BloomLayer $ setDepth 20 $ pictures
         [lineAlphaThick 0.5 0.5
         ,lineAlphaThick 0.2 1.5
         ,lineAlphaThick 0.1 2
         ]
     ,_ptUpdate = \w pt -> (w, Just $ pt & ptUpdate .~ \w' _ -> (w',Nothing))
+        , _ptPoints = [p,ep]
+        , _ptColor = col
     }
   where
     lineAlphaThick a w = 
         color (withAlpha a $ mixColors relFrac (1-relFrac) red green) $ thickLine w [p,ep]
+    col = mixColors relFrac (1-relFrac) red green

src/Dodge/Item/Weapon/ExtraEffect.hs

@@ -198,12 +198,14 @@ targetLaserUpdate _ cr w t
     (mp, ps) = reflectLaserAlong 0.2 sp ep w
     sp = _crPos cr +.+ 15 *.* unitVectorAtAngle (_crDir cr)
     ep = sp +.+ 5000 *.* normalizeV (mouseWorldPos w -.- sp)
-    addLaserPic = instantParticles .:~ Particle
+    addLaserPic = instantParticles .:~ PtTargetLaser
         { _ptDraw = const $ setLayer BloomNoZWrite $ pictures
             [ setDepth 19   . color (brightX 0 0.5 col) $ thickLine 5 (sp:ps)
             , setDepth 19.5 . color (brightX 5 1 col)  $ thickLine 1  (sp:ps)
             ]
         , _ptUpdate = ptSimpleTime 1
+        , _ptPoints = (sp:ps)
+        , _ptColor = col
         }
     --wpammo = _itConsumption it
 --    reloadFrac 

src/Dodge/Item/Weapon/UseEffect.hs

@@ -36,6 +36,7 @@ aRadarPulse blipsF bf col cr = instantParticles .:~ RadarCircleParticle
     , _ptTimer  = 100
     , _ptRad    = 0
     , _ptPos    = _crPos cr
+    , _ptColor  = col
     }
 drawPulse :: Color -> Particle -> Picture
 drawPulse col pt = setLayer DebugLayer $ pictures sweepPics

src/Dodge/Particle/Draw.hs

@@ -0,0 +1,200 @@
+module Dodge.Particle.Draw where
+import Dodge.Data
+import Geometry
+import Picture
+
+drawParticle :: Particle -> Picture
+drawParticle pt = case pt of
+    PtFlame {} -> drawFlame pt
+    Shockwave {} -> drawShockwave pt
+    PtStaticBall {} -> drawStaticBall pt
+    PtIncBall {} -> drawFlameletZ pt
+    PtMuzFlare {} -> drawMuzFlare pt
+    PtCircFlare {} -> drawCircFlare pt
+    PtInvShockwave {} -> drawInverseShockwave pt
+    BulletPt {} -> drawBul pt
+    PtTeslaArc {} -> drawTeslaArc pt
+    PtTargetLaser {} -> drawTargetLaser pt
+    LaserParticle {} -> drawLaser pt
+    ShockLine {} -> drawSonicWave pt
+    RadarCircleParticle {} -> drawPulse pt
+
+drawFlame
+    :: Particle 
+    -> Picture
+drawFlame pt = pictures
+    [ glow 
+    , aPic BloomNoZWrite prot2 25 (V2 (scaleChange + 1)   2  ) $ V4 2 (-1) (-1) 0.5
+    , aPic BloomNoZWrite prot  22 (V2 (scaleChange + 0.5) 1  ) $ V4 1 0.5    0  2
+    , aPic BloomLayer prot3 20 (V2  scaleChange        0.5) $ V4 1 1      1  1
+    ]
+  where 
+    rotd = _ptOriginalVel pt -- rotate direction
+    ep = _ptPos pt
+    aPic :: Layer -> (Point2 -> Point2) -> Float -> Point2 -> Color -> Picture
+    aPic lay offset depth (V2 scalex scaley) col
+        = setLayer lay 
+        . setDepth depth 
+        . uncurryV translate (offset ep)
+        . rotate (pi * 0.5 + argV rotd)
+        . scale scalex scaley
+        . color col                 
+        $ circleSolid 5
+    glow = setLayer BloomNoZWrite $ setDepth 0.3 $ uncurryV translate ep
+        $ circleSolidCol (withAlpha 0 orange) (withAlpha 0.02 orange) 50
+    time = _ptTimer pt
+    scaleChange 
+        | time < 80 = 3
+        | otherwise = 3 - (fromIntegral time - 80) * 0.2
+    prot  p' = p' +.+ rotateV (fromIntegral time) (V2 0 1)
+    prot2 p' = p' +.+ rotateV (negate $ fromIntegral time) (V2 0 1)
+    prot3 p' = p' +.+ rotateV (2 + fromIntegral time * 0.1) (V2 0 2)
+
+drawShockwave :: Particle -> Picture
+drawShockwave pt = setDepth 20 
+    . setLayer BloomLayer
+    . uncurryV translate (_ptPos pt) 
+    . color (_ptColor pt) 
+    $ thickCircle rad thickness
+  where
+    r    = _ptRad pt
+    thickness = tFraction**2 * r 
+    rad = r - (3/4) * r * tFraction
+    tFraction = fromIntegral (_ptTimer pt) / fromIntegral (_ptMaxTime pt)
+
+drawStaticBall
+    :: Particle
+    -> Picture
+drawStaticBall pt = setLayer BloomNoZWrite
+    . setDepth (_ptZ pt + 20) 
+    . 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
+
+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 
+                          $ color cyan $ thickCircle rad thickness
+  where
+    p = _ptPos pt
+    r = _ptRad pt
+    t = _ptTimer pt
+    rad = r - 0.1 * r * fromIntegral (10 - t)
+    thickness = fromIntegral (10 - t) **2 * rad / 40
+
+drawBul :: Particle -> Picture
+drawBul pt = setLayer BloomNoZWrite
+    . setDepth 20 
+    . color (_ptColor pt) 
+    -- $ thickLine (_ptWidth pt) (take 3 $ _ptTrail pt)
+    $ thickLine (_ptWidth pt) (take 2 $ _ptTrail pt)
+
+drawTeslaArc :: Particle -> Picture
+drawTeslaArc pt = setLayer BloomNoZWrite $ pictures 
+    [ setDepth 20.5 $ color (brightX 2 1 $ _ptColor pt) $ thickLine  3 ps
+    , setDepth 20   $ color (V4 0 0 0 0.5)              $ thickLine 10 ps
+    ]
+  where
+    ps = _ptPoints pt
+
+drawTargetLaser :: Particle -> Picture
+drawTargetLaser pt = setLayer BloomNoZWrite $ pictures
+            [ setDepth 19   . color (brightX 0 0.5 col) $ thickLine 5 (sp:ps)
+            , setDepth 19.5 . color (brightX 5 1 col)  $ thickLine 1  (sp:ps)
+            ]
+  where
+    col = _ptColor pt
+    (sp:ps) = _ptPoints pt
+
+drawLaser :: Particle -> Picture
+--drawLaser pt = setLayer BloomNoZWrite $ pictures
+    --[ setDepth 19   . color (brightX 0 0.5 col) $ thickLine 20 ps
+drawLaser pt =
+    setLayer BloomNoZWrite $ pictures
+--    [ setDepth 19   . color (brightX 1 0.5 col) $ thickLine 20 ps
+    [ setDepth 19.5 . color (brightX 10 1 col)  $ thickLine 3  ps
+    ]
+  where
+    col = _ptColor pt
+    ps = _ptPoints pt
+
+drawSonicWave :: Particle -> Picture
+drawSonicWave pt = foldMap (color (_ptColor pt) . setLayer BloomNoZWrite . setDepth 20 
+    . lineThick 20
+    . map fst)
+    $ _ptPointDirs pt
+
+drawPulse :: Particle -> Picture
+drawPulse pt = setLayer DebugLayer $ pictures sweepPics
+  where
+    col = _ptColor pt
+    p = _ptPos pt
+    r = _ptRad pt
+    sweepPics = [colHelper 0.1 $ uncurryV translate p $ thickCircle r 15
+                ,colHelper 0.06 $ uncurryV translate p $ thickCircle (r-5) 5
+                ,colHelper 0.03 $ uncurryV translate p $ thickCircle (r-10) 5
+                ]
+    colHelper y = color (withAlpha (y * globalAlpha) col)
+    globalAlpha | x > 10 = 1
+                | otherwise = fromIntegral x / 10
+    x = _ptTimer pt

src/Dodge/Particle/TeslaArc.hs

@@ -20,7 +20,7 @@ import LensHelp
 --import Data.Maybe
 
 aTeslaArcAt :: Color -> [ArcStep] -> Particle
-aTeslaArcAt col thearc = LinearParticle
+aTeslaArcAt col thearc = PtTeslaArc
     { _ptPoints = map (^. asPos) thearc
     , _ptDraw = drawTeslaArc
     , _ptUpdate = moveTeslaArc thearc

src/Dodge/RadarBlip.hs

@@ -0,0 +1,23 @@
+module Dodge.RadarBlip where
+import Dodge.Data.RadarBlip
+import Geometry.Data
+import LensHelp
+import Picture
+
+updateRadarBlip :: RadarBlip -> Maybe RadarBlip
+updateRadarBlip rb 
+    | _rbTime rb <= 0   = Nothing
+    | otherwise         = Just $ rb & rbTime -~ 1
+
+drawBlip :: RadarBlip -> Picture
+drawBlip pt = setDepth (-0.5)
+    . setLayer DebugLayer
+    . uncurryV translate p 
+    . color (withAlpha (fromIntegral t / fromIntegral maxt) col)
+    $ circleSolid r
+  where
+    p = _rbPos pt
+    t = _rbTime pt
+    r = _rbRad pt
+    col = _rbColor pt
+    maxt = _rbMaxTime pt

src/Dodge/WorldEvent/Flash.hs

@@ -25,9 +25,16 @@ import LensHelp
 import System.Random
 
 muzFlareAt :: Color -> Point3 -> Float -> World -> World
-muzFlareAt col tranv dir w = w & instantParticles .:~ Particle
+muzFlareAt col tranv dir w = w & instantParticles .:~ PtMuzFlare
     { _ptDraw = const $ setLayer BloomNoZWrite . translate3 tranv $ theShape
     , _ptUpdate = ptSimpleTime 2
+    , _ptPoly = 
+        [ V2 0 0
+        , V2 a (-b)
+        , V2 c d
+        ]
+    , _ptColor = col
+    , _ptTran3 = tranv
     }
   where
     theShape = rotate dir . color col $ polygon
@@ -38,10 +45,13 @@ muzFlareAt col tranv dir w = w & instantParticles .:~ Particle
     (a:b:c:d:_) = randomRs (2,20) (_randGen w)
 
 flareCircleAt :: Color -> Float -> Point3 -> World -> World
-flareCircleAt col alphax tranv = instantParticles .:~ Particle
+flareCircleAt col alphax tranv = instantParticles .:~ PtCircFlare
     { _ptDraw = const . setLayer BloomNoZWrite . translate3 tranv
                         $ circleSolidCol (withAlpha 0 0) (withAlpha alphax col) 50
     , _ptUpdate = ptSimpleTime 1
+    , _ptColor = col
+    , _ptAlpha = alphax
+    , _ptTran3 = tranv
     }
 
 explosionFlashAt :: Point2 -> World -> World

src/Dodge/WorldEvent/SpawnParticle.hs

@@ -129,7 +129,7 @@ concBall p = return Shockwave
 
 
 aStaticBall :: Point2 -> State g Particle
-aStaticBall p = return PtZ 
+aStaticBall p = return PtStaticBall 
     { _ptDraw       = drawStaticBall
     , _ptUpdate     = moveStaticBall
     , _ptVel        = 0
@@ -153,7 +153,7 @@ makeFlamelet
     -> World
 makeFlamelet (V2 x y) z vel maycid size time w = w
     & randGen   .~ g
-    & instantParticles .:~ PtZ 
+    & instantParticles .:~ PtIncBall 
         { _ptDraw       = drawFlameletZ rot
         , _ptUpdate     = moveFlamelet
         , _ptVel        = vel
@@ -164,6 +164,7 @@ makeFlamelet (V2 x y) z vel maycid size time w = w
         , _ptTimer      = time
         , _ptHitEff     = expireAndDamage $ simpleDam FLAMING 20
         , _ptZ = z
+        , _ptRot = rot
         }
   where
     (rot ,g) = randomR (0,3) $ _randGen w
@@ -255,7 +256,7 @@ cloudPoisonDamage c w = w & dodamagesto (S.filter f $ crsNearPoint clpos w)
 incBall :: RandomGen g => Point2 -> State g Particle
 incBall p = do
     rot <- state $ randomR (0,3)
-    return PtZ 
+    return PtIncBall 
         { _ptDraw       = drawFlameletZ rot
         , _ptUpdate     = moveFlamelet
         , _ptVel        = 0
@@ -266,6 +267,7 @@ incBall p = do
         , _ptTimer      = 20
         , _ptHitEff     = expireAndDamage $ simpleDam FLAMING 20
         , _ptZ          = 20
+        , _ptRot        = rot
         }
 drawFlameletZ
     :: Float    -- ^ Rotation