Remove explicit muzzle flares for picture updated every frame

ghcidOutput

@@ -1 +1 @@
-All good (600 modules, at 00:59:03)
+All good (598 modules, at 01:27:16)

src/Dodge/Data/Flare.hs

@@ -1,30 +0,0 @@
-{-# LANGUAGE DeriveGeneric #-}
-{-# LANGUAGE DeriveAnyClass #-}
-{-# LANGUAGE StrictData #-}
-{-# LANGUAGE TemplateHaskell #-}
-
-module Dodge.Data.Flare where
-
-import Color
-import Control.Lens
-import Data.Aeson
-import Data.Aeson.TH
-import Geometry
-
-data Flare
-    = MuzFlare
-        { _flarePoly :: [Point2]
-        , _flareColor :: Color
-        , _flareTran3 :: Point3
-        , _flareTime :: Int
-        }
-    | CircFlare
-        { _flareColor :: Color
-        , _flareAlpha :: Float
-        , _flareTran3 :: Point3
-        , _flareTime :: Int
-        }
-    deriving (Eq, Ord, Show, Read) --Generic, Flat)
-
-makeLenses ''Flare
-deriveJSON defaultOptions ''Flare

src/Dodge/Data/LWorld.hs

@@ -19,7 +19,6 @@ module Dodge.Data.LWorld (
     module Dodge.Data.Door,
     module Dodge.Data.EnergyBall,
     module Dodge.Data.Flame,
-    module Dodge.Data.Flare,
     module Dodge.Data.FloorItem,
     module Dodge.Data.ForegroundShape,
     module Dodge.Data.Gust,
@@ -65,7 +64,6 @@ import Dodge.Data.Distortion
 import Dodge.Data.Door
 import Dodge.Data.EnergyBall
 import Dodge.Data.Flame
-import Dodge.Data.Flare
 import Dodge.Data.FloorItem
 import Dodge.Data.ForegroundShape
 import Dodge.Data.Gust
@@ -111,7 +109,7 @@ data LWorld = LWorld
     , _flames :: [Flame]
     , _sparks :: [Spark]
     , _radarBlips :: [RadarBlip]
-    , _flares :: [Flare]
+    , _flares :: Picture  -- picture drawn for one frame
     , _teslaArcs :: [TeslaArc]
     , _shockwaves :: [Shockwave]
     , _lasers :: [LaserStart]

src/Dodge/Flare.hs

@@ -1,35 +0,0 @@
-module Dodge.Flare (
-    drawFlare,
-    updateFlare,
-) where
-
-import Dodge.Data.Flare
-import LensHelp
-import Picture
-
-updateFlare :: Flare -> Maybe Flare
-updateFlare rb
-    | _flareTime rb <= 0 = Nothing
-    | otherwise = Just $ rb & flareTime -~ 1
-
-drawFlare :: Flare -> Picture
-drawFlare fl = case fl of
-    MuzFlare{} -> drawMuzFlare fl
-    CircFlare{} -> drawCircFlare fl
-
-drawMuzFlare :: Flare -> Picture
-drawMuzFlare pt = setLayer BloomNoZWrite . translate3 tranv $ theShape
-  where
-    tranv = _flareTran3 pt
-    col = _flareColor pt
-    poly = _flarePoly pt
-    theShape = color col $ polygon poly
-
-drawCircFlare :: Flare -> Picture
-drawCircFlare pt =
-    setLayer BloomNoZWrite . translate3 tranv $
-        circleSolidCol (withAlpha 0 0) (withAlpha alphax col) 50
-  where
-    col = _flareColor pt
-    tranv = _flareTran3 pt
-    alphax = _flareAlpha pt

src/Dodge/HeldUse.hs

@@ -26,6 +26,7 @@ import Dodge.Tesla.Arc
 import Geometry
 import LensHelp
 import ListHelp
+import Picture.Base
 import RandomHelp
 import qualified SDL
 
@@ -39,7 +40,6 @@ hammerCheck f it cr w = case it ^? ldtValue . itUse . heldTriggerType of
         _ -> w
     _ -> f it cr w
 
-
 heldEffectMuzzles :: LabelDoubleTree ComposeLinkType Item -> Creature -> World -> World
 heldEffectMuzzles t cr w =
     uncurry (applyCME (_ldtValue t) cr) cmew
@@ -164,32 +164,25 @@ makeMuzzleFlare mz itmtree cr = case mz ^. mzFlareType of
 muzFlareAt :: Color -> Point3 -> Float -> World -> World
 muzFlareAt col tranv dir w =
     w & randGen .~ g
-        & cWorld . lWorld . flares
-        .:~ MuzFlare
-            { _flarePoly =
-                map
-                    (rotateV dir)
-                    [ V2 0 0
-                    , V2 a (- b)
-                    , V2 c d
-                    ]
-            , _flareColor = col
-            , _flareTran3 = tranv
-            , _flareTime = 2
-            }
+        & cWorld . lWorld . flares <>~ thepic
   where
-    thestate = replicateM 4 $ state $ randomR (2,20)
+    thepic =
+        setLayer BloomNoZWrite . translate3 tranv . color col . rotate dir . polygon $
+                [ V2 0 0
+                , V2 a (- b)
+                , V2 c d
+                ]
+    thestate = replicateM 4 $ state $ randomR (2, 20)
     (a : b : c : d : _, g) = runState thestate $ _randGen w -- randomRs (2, 20) (_randGen w)
 
 flareCircleAt :: Color -> Float -> Point3 -> World -> World
 flareCircleAt col alphax tranv =
     cWorld . lWorld . flares
-        .:~ CircFlare
-            { _flareTime = 2
-            , _flareColor = col
-            , _flareAlpha = alphax
-            , _flareTran3 = tranv
-            }
+        <>~ setLayer
+            BloomNoZWrite
+            ( translate3 tranv $
+                circleSolidCol (withAlpha 0 0) (withAlpha alphax col) 50
+            )
 
 getLaserPhaseV :: LabelDoubleTree ComposeLinkType Item -> Float
 getLaserPhaseV = const 1
@@ -207,7 +200,6 @@ basicMuzFlare pos dir =
         . muzFlareAt (V4 10 10 1 3) (pos `v2z` 20) dir
         . muzFlareAt (V4 10 10 1 3) (pos `v2z` 20) dir
 
-
 isAmmoIntLink :: Int -> ComposeLinkType -> Bool
 isAmmoIntLink i (AmmoInLink j _) = i == j
 isAmmoIntLink _ _ = False
@@ -313,8 +305,15 @@ lasRayAt col dam phasev pos dir =
 removeAmmoFromMag :: Int -> Maybe Int -> Creature -> World -> World
 removeAmmoFromMag x mid cr = fromMaybe id $ do
     magid <- mid
-    return $ cWorld . lWorld . creatures 
-        . ix (_crID cr) . crInv . ix magid . itUse . amagLoadStatus . iaLoaded -~ x
+    return $
+        cWorld . lWorld . creatures
+            . ix (_crID cr)
+            . crInv
+            . ix magid
+            . itUse
+            . amagLoadStatus
+            . iaLoaded
+            -~ x
 
 getBulletType ::
     LabelDoubleTree ComposeLinkType Item ->

src/Dodge/Lampoid.hs

@@ -1,4 +1,4 @@
-module Dodge.Lampoid where
+module Dodge.Lampoid (updateLampoid) where
 
 import Dodge.Creature.State
 import Dodge.Data.World

src/Dodge/Render/ShapePicture.hs

@@ -18,7 +18,6 @@ import Dodge.Creature.Picture
 import Dodge.Data.Universe
 import Dodge.Debug.Picture
 import Dodge.Draw
-import Dodge.Flare
 import Dodge.RadarBlip
 import Dodge.Render.Picture
 import Geometry
@@ -142,7 +141,7 @@ extraPics cfig u =
         <> foldMap drawSpark (_sparks lw)
         <> foldMap drawBul (_bullets lw)
         <> foldMap drawBlip (_radarBlips lw)
-        <> foldMap drawFlare (_flares lw)
+        <> _flares lw
 --        <> foldMap (dbArg (drawBeam . _bmDraw)) (_positronBeams $ _beams lw)
 --        <> foldMap (dbArg (drawBeam . _bmDraw)) (_electronBeams $ _beams lw)
         <> foldMap (dbArg (drawLightSource . _lsPict)) (_lightSources lw)

src/Dodge/Update.hs

@@ -30,8 +30,6 @@ import Dodge.Distortion
 import Dodge.DrWdWd
 import Dodge.EnergyBall
 import Dodge.Flame
-import Dodge.Flare
---import Dodge.InputFocus
 import Dodge.Inventory
 import Dodge.Item.Location
 import Dodge.Laser.Update
@@ -250,7 +248,6 @@ functionalUpdate w =
         . over uvWorld updateEnergyBalls
         . over uvWorld updateBullets
         . over uvWorld updateRadarBlips
-        . over uvWorld updateFlares
 --        . over uvWorld updateBeams
         . over uvWorld updateLasers
         . over uvWorld updateTeslaArcs
@@ -278,6 +275,7 @@ functionalUpdate w =
         . over uvWorld zoneClouds
         . over uvWorld zoneCreatures
         -- . over uvWorld updateInventorySelectionList
+        . set (uvWorld . cWorld . lWorld . flares) []
         $ over uvWorld updatePastWorlds w
 
 checkTermDist :: World -> World
@@ -422,9 +420,6 @@ updateLightSources = updateObjMapMaybe tempLightSources (\b -> updateTempLightSo
 updateRadarBlips :: World -> World
 updateRadarBlips = updateObjMapMaybe radarBlips updateRadarBlip
 
-updateFlares :: World -> World
-updateFlares = updateObjMapMaybe flares updateFlare
-
 {- Apply internal particle updates, delete 'Nothing's.  -}
 updateBullets :: World -> World
 updateBullets w = updateInstantBullets $ set (cWorld . lWorld . bullets) (catMaybes ps) w'