Simplify lasers

src/Dodge/Data/LWorld.hs

@@ -114,7 +114,7 @@ data LWorld = LWorld
     , _teslaArcs :: [TeslaArc]
     , _shockwaves :: [Shockwave]
     , _lasers :: [LaserStart]
-    , _lasersToDraw :: [Laser]
+--    , _lasersToDraw :: [Laser]
     , _linearShockwaves :: IM.IntMap LinearShockwave
     , _tractorBeams :: [TractorBeam]
     , _walls :: IM.IntMap Wall

src/Dodge/Data/Laser.hs

@@ -27,16 +27,16 @@ data LaserStart = LaserStart
     }
     deriving (Eq, Ord, Show, Read) --Generic, Flat)
 
-data Laser = Laser
-    { _lzColor :: Color
-    , _lzPoints :: [Point2]
-    , _lzType :: LaserType
-    }
-    deriving (Eq, Ord, Show, Read) --Generic, Flat)
+--data Laser = Laser
+--    { _lzColor :: Color
+--    , _lzPoints :: [Point2]
+--    , _lzType :: LaserType
+--    }
+--    deriving (Eq, Ord, Show, Read) --Generic, Flat)
 
-makeLenses ''Laser
+--makeLenses ''Laser
 makeLenses ''LaserStart
 makeLenses ''LaserType
 deriveJSON defaultOptions ''LaserType
 deriveJSON defaultOptions ''LaserStart
-deriveJSON defaultOptions ''Laser
+--deriveJSON defaultOptions ''Laser

src/Dodge/Default/World.hs

@@ -118,7 +118,7 @@ defaultLWorld =
           _teslaArcs = []
         , _shockwaves = []
         , _lasers = []
-        , _lasersToDraw = []
+--        , _lasersToDraw = []
         , _tractorBeams = mempty
         , _linearShockwaves = mempty
         , _walls = IM.empty

src/Dodge/Draw.hs

@@ -9,7 +9,6 @@ module Dodge.Draw (
     module Dodge.Button.Draw,
     module Dodge.EnergyBall.Draw,
     module Dodge.Flame.Draw,
-    module Dodge.Laser.Draw,
     module Dodge.LightSource.Draw,
     module Dodge.LinearShockwave.Draw,
     module Dodge.Machine.Draw,
@@ -30,7 +29,6 @@ import Dodge.Bullet.Draw
 import Dodge.Button.Draw
 import Dodge.EnergyBall.Draw
 import Dodge.Flame.Draw
-import Dodge.Laser.Draw
 import Dodge.LightSource.Draw
 import Dodge.LinearShockwave.Draw
 import Dodge.Machine.Draw

src/Dodge/Laser/Draw.hs

@@ -1,12 +0,0 @@
-module Dodge.Laser.Draw where
-
-import Dodge.Data.Laser
-import Picture
-
-drawLaser :: Laser -> Picture
-drawLaser pt =
-    setLayer BloomNoZWrite $
-             setDepth 19.5 . color (brightX 10 1 col) $ thickLine 3 ps
-  where
-    col = _lzColor pt
-    ps = _lzPoints pt

src/Dodge/Laser/Update.hs

@@ -1,22 +1,28 @@
-module Dodge.Laser.Update 
-    ( updateLaser
-    ) where
+module Dodge.Laser.Update (
+    updateLaser,
+) where
 
-import Dodge.Item.Location
 import Control.Lens
 --import Data.Maybe
 import Dodge.Data.World
+import Dodge.Item.Location
 import Dodge.Item.Weapon.LaserPath
 import Dodge.WorldEvent.Damage
 import Geometry
+import Picture.Base
 
-updateLaser :: World -> LaserStart -> (World, Laser)
+updateLaser :: World -> LaserStart -> (World, Picture)
 updateLaser w pt =
     ( case _lpType pt of
-        DamageLaser dam -> damThingHitWith 
-            (\p1 p2 p3 -> Damage LASERING dam p1 p2 p3 NoDamageEffect) sp xp thHit w
+        DamageLaser dam ->
+            damThingHitWith
+                (\p1 p2 p3 -> Damage LASERING dam p1 p2 p3 NoDamageEffect)
+                sp
+                xp
+                thHit
+                w
         TargetingLaser itid -> w & pointerToItemID itid . itTargeting . itTgPos ?~ last ps
-    , Laser{_lzPoints = sp : ps, _lzColor = _lpColor pt, _lzType = _lpType pt}
+    , drawLaser (_lpColor pt) (sp : ps)
     )
   where
     phasev = _lpPhaseV pt
@@ -24,3 +30,10 @@ updateLaser w pt =
     dir = _lpDir pt
     xp = sp +.+ 800 *.* unitVectorAtAngle dir
     (thHit, ps) = reflectLaserAlong phasev sp xp w
+
+drawLaser :: Color -> [Point2] -> Picture
+drawLaser col =
+    setLayer BloomNoZWrite
+        . setDepth 19.5
+        . color (brightX 10 1 col)
+        . thickLine 3

src/Dodge/ListDisplayParams.hs

@@ -3,7 +3,7 @@ module Dodge.ListDisplayParams (
     invCursorParams,
     secondColumnParams,
     subInvX,
-    optionListDisplayParams,
+    menuDisplayParams,
 ) where
 
 import Control.Lens
@@ -51,8 +51,8 @@ subInvX = 10 * fromIntegral topInvW + 70
 topInvW :: Int
 topInvW = 15
 
-optionListDisplayParams :: ListDisplayParams
-optionListDisplayParams =
+menuDisplayParams :: ListDisplayParams
+menuDisplayParams =
     defaultListDisplayParams
         & ldpPos . spPixelOff .~ V2 11 (-70)
         & ldpScale .~ 2

src/Dodge/Menu/Option.hs

@@ -24,8 +24,7 @@ initializeOptionMenu title ops pmo u =
         , _scPositionedMenuOption = pmo
         , _scOptionFlag = NormalOptions
         , _scSelectionList = optionsToSelections 10 u ops pmo
-        , _scAvailableLines = getAvailableListLines optionListDisplayParams (u ^. uvConfig)
---        , _scListDisplayParams = optionListDisplayParams
+        , _scAvailableLines = getAvailableListLines menuDisplayParams (u ^. uvConfig)
         , _scDisplayTime = 0
         }
 

src/Dodge/Render/MenuScreen.hs

@@ -3,20 +3,20 @@ module Dodge.Render.MenuScreen (
     drawMenuScreen,
 ) where
 
-import Dodge.ListDisplayParams
-import Dodge.ScreenPos
-import Dodge.Data.CardinalPoint
 import Control.Lens
-import Dodge.Render.List
 import Dodge.Base.Window
+import Dodge.Data.CardinalPoint
 import Dodge.Data.SelectionList
 import Dodge.Data.Universe
+import Dodge.ListDisplayParams
+import Dodge.Render.List
+import Dodge.ScreenPos
 import Picture
 
 drawMenuScreen :: Configuration -> Maybe Int -> ScreenLayer -> Picture
 drawMenuScreen cfig spos screen = case screen of
     OptionScreen{_scTitle = titf, _scSelectionList = slist} ->
-        drawOptions optionListDisplayParams cfig titf spos slist
+        drawOptions cfig titf spos slist
     InputScreen inputstr help -> drawInputMenu cfig ('>' : inputstr) help
 
 drawInputMenu ::
@@ -33,25 +33,21 @@ drawInputMenu cfig title footer =
         , drawFooterText cfig red footer
         ]
 
-drawOptions ::
-    ListDisplayParams ->
-    Configuration ->
-    -- | Title
-    String ->
-    Maybe Int ->
-    [SelectionItem a] ->
-    Picture
-drawOptions ldps cfig title msel sl =
+drawOptions :: Configuration -> String -> Maybe Int -> [SelectionItem a] -> Picture
+drawOptions cfig title msel sl =
     darkenBackground cfig
         <> drawTitle cfig title
-        <> drawSelectionList ldps cfig sl
-        <> translateScreenPos cfig (ldps ^. ldpPos) (drawCursorAt
+        <> drawSelectionList menuDisplayParams cfig sl
+        <> translateScreenPos
+            cfig
+            (menuDisplayParams ^. ldpPos)
+            ( drawCursorAt
                 msel
                 sl
-                ldps
+                menuDisplayParams
                 50
                 (BoundaryCursor [North, South])
-                )
+            )
 
 darkenBackground :: Configuration -> Picture
 darkenBackground = color (withAlpha 0.5 black) . polygon . reverse . screenBox

src/Dodge/Render/ShapePicture.hs

@@ -87,7 +87,7 @@ extraPics cfig u =
         <> foldMap drawTractorBeam (_tractorBeams lw)
         <> foldMap drawLinearShockwave (_linearShockwaves lw)
         <> foldMap drawShockwave (_shockwaves lw)
-        <> foldMap drawLaser (_lasersToDraw lw)
+--        <> foldMap drawLaser (_lasersToDraw lw)
         <> foldMap drawTeslaArc (_teslaArcs lw)
         <> foldMap drawRadarSweep (_radarSweeps lw)
         <> foldMap drawFlame (_flames lw)

src/Dodge/Update.hs

@@ -370,12 +370,8 @@ getMenuMouseContext :: ScreenLayer -> Universe -> MouseContext
 getMenuMouseContext screen u = case screen ^. scOptions of
     [] -> NoMouseContext
     _ -> fromMaybe MouseMenuCursor $ do
-        let ymax = maybe 0 length $ screen ^? scSelectionList
-        yi <-
-            ldpVerticalSelection
-                (u ^. uvConfig)
-                optionListDisplayParams
-                (u ^. uvWorld . input . mousePos)
+        ymax <- length <$> screen ^? scSelectionList
+        yi <- ldpVerticalSelection (u ^. uvConfig) menuDisplayParams (u ^. uvWorld . input . mousePos)
         guard (yi >= 0 && yi < ymax)
         return $ case u ^? uvScreenLayers . _head . scSelectionList . ix yi . siIsSelectable of
             Just True -> MouseMenuClick yi
@@ -406,9 +402,9 @@ advanceScrollAmount =
         . (uvWorld . input . smoothScrollAmount %~ advanceSmoothScroll)
 
 updatePastWorlds :: World -> World
-updatePastWorlds w = w & pastWorlds %~ (forceFoldable . take 100 . ((w ^. cWorld . lWorld) :))
+updatePastWorlds w = w 
+    & pastWorlds %~ (forceFoldable . take 100 . ((w ^. cWorld . lWorld) :))
 
---updatePastWorlds w = w & pastWorlds %~ (forceFoldable . take 600 . ((w ^. cWorld . lWorld) :))
 
 doWorldEvents :: World -> World
 doWorldEvents w =
@@ -421,7 +417,7 @@ updateLasers :: World -> World
 updateLasers w =
     w'
         & cWorld . lWorld . lasers .~ []
-        & cWorld . lWorld . lasersToDraw .~ ls
+        & cWorld . lWorld . flares <>~ concat ls
   where
     (w', ls) = mapAccumR updateLaser w (w ^. cWorld . lWorld . lasers)
 

src/Dodge/Update/Input/ScreenLayer.hs

@@ -85,4 +85,4 @@ ldpVerticalSelection cfig ldp (V2 _ y)
 
 setSelectionListRestriction :: Configuration -> ScreenLayer -> ScreenLayer
 setSelectionListRestriction cfig = 
-    scAvailableLines %~ const (getAvailableListLines optionListDisplayParams cfig)
+    scAvailableLines .~ getAvailableListLines menuDisplayParams cfig