Commit before attempting to remove ptDraw field

src/Dodge/Data.hs

@@ -636,6 +636,15 @@ 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)

src/Dodge/Item/Weapon/UseEffect.hs

@@ -52,10 +52,27 @@ drawPulse col pt = setLayer DebugLayer $ pictures sweepPics
     x = _ptTimer pt
 {- | Radar blip at a point.  -}
 blipAt :: Float -> Point2 -> Color -> Int -> Particle
-blipAt r p col i = Particle
-    {_ptDraw = const blank
-    ,_ptUpdate = mvBlip r p col i i
+blipAt r p col i = BlipParticle
+    {_ptDraw = drawBlip
+    ,_ptUpdate = \w pt -> if _ptTimer pt <= 0 then (w,Nothing) else (w,Just $ pt & ptTimer -~ 1)
+    ,_ptColor = col
+    ,_ptTimer = i
+    ,_ptMaxTime = i
+    ,_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

src/Dodge/Render.hs

@@ -27,7 +27,7 @@ import Graphics.Rendering.OpenGL hiding (color,scale,translate,rotate)
 import qualified SDL
 import qualified Data.Vector.Unboxed.Mutable as UMV
 import Graphics.GL.Core43
-import qualified Streaming.Prelude as S
+--import qualified Streaming.Prelude as S
 
 doDrawing :: RenderData -> Universe -> IO Word32
 doDrawing pdata u = do

src/Dodge/Render/ShapePicture.hs

@@ -39,24 +39,25 @@ import qualified Streaming.Prelude as S
 import qualified Data.Graph.Inductive as FGL
 import qualified Data.Set as Set
 import Padding
---import Data.Foldable
+import Data.Foldable
 
+singleSPic :: SPic -> SPic
 singleSPic = id
 
 worldSPic :: Configuration -> World -> SPic
 worldSPic cfig w 
     =  singleSPic (mempty, extraPics cfig w)
-    <> f (dbArg _prDraw) (filtOn' _prPos _props)                             
-    <> f (shiftDraw _blPos _blDir _blDraw) (filtOn' _blPos _blocks)           
-    <> f (shiftDraw _fsPos _fsDir (const _fsSPic)) (filtOn' _fsPos _shapes)   
-    <> f (dbArg _cpPict) (filtOn' _cpPos _corpses)                            
-    <> f (dbArg _crPict) (filtOn' _crPos _creatures)                          
-    <> f floorItemSPic (filtOn' _flItPos _floorItems)                         
-    <> f btSPic (filtOn' _btPos _buttons)                                     
-    <> f mcSPic (filtOn' _mcPos _machines)                                    
+    <> foldup (dbArg _prDraw) (filtOn' _prPos _props)                             
+    <> foldup (shiftDraw _blPos _blDir _blDraw) (filtOn' _blPos _blocks)           
+    <> foldup (shiftDraw _fsPos _fsDir (const _fsSPic)) (filtOn' _fsPos _shapes)   
+    <> foldup (dbArg _cpPict) (filtOn' _cpPos _corpses)                            
+    <> foldup (dbArg _crPict) (filtOn' _crPos _creatures)                          
+    <> foldup floorItemSPic (filtOn' _flItPos _floorItems)                         
+    <> foldup btSPic (filtOn' _btPos _buttons)                                     
+    <> foldup mcSPic (filtOn' _mcPos _machines)                                    
     <> singleSPic (anyTargeting cfig w)
   where
-    f = foldMap
+    foldup = foldMap'
     filtOn' f g = IM.filter (pointIsClose . f) (g w)
     --filtOn' f g = S.filter (pointIsClose . f) $ S.each (g w)
     pointIsClose = cullPoint cfig w