Remove useless code

src/Dodge/Data/Config.hs

@@ -86,7 +86,6 @@ data DebugBool
     | Show_walls_near_point_cursor
     | Show_walls_near_point_you
     | Show_zone_near_point_cursor
-    | Show_select
     | Inspect_wall
     | Show_nodes_near_select
     | Show_path_between

src/Dodge/Data/Input.hs

@@ -23,14 +23,8 @@ data Input = Input
     , _mouseButtons :: M.Map MouseButton Int -- counts number of frames held down
     , _scrollAmount :: Int
     , _smoothScrollAmount :: Int
-    , _lLine :: (Point2, Point2)
+    , _clickPos :: M.Map MouseButton Point2 -- updates on initial mouse button press
-    , _rLine :: (Point2, Point2)
+    , _heldPos :: M.Map MouseButton Point2 -- updates while mouse button is held, lags one frame
-    , _lrLine :: (Point2, Point2)
-    , _lSelect :: Point2
-    , _rSelect :: Point2
-    , _clickPos :: M.Map MouseButton Point2 -- updates when mouse button is pressed
-    , _heldPos :: M.Map MouseButton Point2 -- updates when mouse button is held
-            -- lags ONE FRAME BEHIND the stored mouse position
     , _textInput :: [Either TermSignal Char]
     , _scrollTestFloat :: Float
     , _scrollTestInt :: Int

src/Dodge/Default/World.hs

@@ -22,11 +22,6 @@ defaultInput =
         , _mouseMoving = False
         , _scrollAmount = 0
         , _smoothScrollAmount = 0
-        , _lrLine = (0, 0)
-        , _lLine = (0, 0)
-        , _rLine = (0, 0)
-        , _lSelect = 0
-        , _rSelect = 0
         , _scrollTestFloat = 1
         , _scrollTestInt = 0
         }

src/Dodge/Render/ShapePicture.hs

@@ -2,6 +2,7 @@ module Dodge.Render.ShapePicture (
     worldSPic,
 ) where
 
+import SDL (MouseButton (..))
 import Control.Lens
 import Control.Monad (guard)
 import Data.Foldable
@@ -193,7 +194,6 @@ debugDraw' cfig w bl = case bl of
     Show_walls_near_point_cursor -> drawWallsNearCursor w
     Show_walls_near_point_you -> drawWallsNearYou w
     Show_zone_near_point_cursor -> drawZoneNearPointCursor w
-    Show_select -> drawWorldSelect w
     Inspect_wall -> drawInspectWalls w
     Cr_awareness -> drawCreatureDisplayTexts w
     Show_sound -> pictures $ M.map (soundPic cfig w) $ _playingSounds w
@@ -206,31 +206,30 @@ debugDraw' cfig w bl = case bl of
     Collision_test -> drawCollisionTest w
 
 drawCollisionTest :: World -> Picture
-drawCollisionTest w =
+drawCollisionTest w = fromMaybe mempty $ do
-    setLayer DebugLayer (color orange $ line [a, b])
+    a <- w ^. input . clickPos . at ButtonLeft
+    b <- w ^. input . clickPos . at ButtonRight
+    return $ setLayer DebugLayer (color orange $ line [a, b])
         <> foldMap (drawCross . fst) (crHit a b w)
         <> foldMap (drawCross . _crPos) (crsNearSeg a b w)
         <> foldMap (drawZoneCol green crZoneSize . zoneOfPoint crZoneSize) (xIntercepts crZoneSize a b)
         <> foldMap (drawZoneCol yellow crZoneSize . zoneOfPoint crZoneSize) (yIntercepts' crZoneSize a b)
         <> foldMap (drawLabCrossCol blue) (xIntercepts crZoneSize a b)
-  where
-    (a, b) = _lrLine (_input w)
 
 drawCreatureDisplayTexts :: World -> Picture
 drawCreatureDisplayTexts w = foldMap (creatureDisplayText w) (w ^. cWorld . lWorld . creatures)
 
 drawPathBetween :: World -> Picture
-drawPathBetween w =
+drawPathBetween w = fromMaybe mempty $ do
-    setLayer DebugLayer $
+    sp <- w ^. input . clickPos . at ButtonLeft
+    ep <- w ^. input . clickPos . at ButtonRight
+    let nodepos = (`getNodePos` w)
+        nodelist = makePathBetween sp ep w
+    return . setLayer DebugLayer $
         color rose (foldMap (arrowPath . mapMaybe nodepos) nodelist)
             <> foldMap (color green . arrow sp) (nodepos =<< walkableNodeNear w sp)
             <> foldMap (color cyan . flip arrow ep) (nodepos =<< walkableNodeNear w ep)
             <> foldMap (color orange . arrow sp) (pointTowardsImpulse sp ep w)
-  where
-    nodepos = (`getNodePos` w)
-    nodelist = makePathBetween sp ep w
-    sp = _lSelect (_input w)
-    ep = _rSelect (_input w)
 
 drawWallsNearYou :: World -> Picture
 drawWallsNearYou w = fromMaybe mempty $ do
@@ -250,15 +249,15 @@ drawWallsNearCursor w =
         (a, b) = _wlLine wl
 
 drawInspectWalls :: World -> Picture
-drawInspectWalls w =
+drawInspectWalls w = fromMaybe mempty $ do
-    setLayer DebugLayer (color orange $ line [a, b])
+    a <- w ^. input . clickPos . at ButtonLeft
+    b <- w ^. input . heldPos . at ButtonLeft
+    return $ setLayer DebugLayer (color orange $ line [a, b])
         <> foldMap
             (drawInspectWall w)
             ( filter (isJust . uncurry (intersectSegSeg a b) . _wlLine) $
                 IM.elems $ w ^. cWorld . lWorld . walls
             )
-  where
-    (a, b) = _lLine (_input w)
 
 drawInspectWall :: World -> Wall -> Picture
 drawInspectWall w wl =
@@ -285,15 +284,6 @@ obstacleColor eo = case eo of
     AutoDoorObstacle -> yellow
     BlockObstacle -> blue
 
-drawWorldSelect :: World -> Picture
-drawWorldSelect w =
-    setLayer DebugLayer $
-        color cyan (line [a, b])
-            <> color magenta (line [c, d])
-  where
-    (a, b) = _lLine (_input w)
-    (c, d) = _rLine (_input w)
-
 drawFarWallDetect :: World -> Picture
 drawFarWallDetect w =
     setLayer DebugLayer

src/Dodge/Update.hs

@@ -212,7 +212,6 @@ functionalUpdate :: Universe -> Universe
 functionalUpdate w =
     checkEndGame
         . over uvWorld (cWorld . lWorld . lClock +~ 1)
-        . over uvWorld updateWorldSelect'
         . over uvWorld updateDistortions
         . over uvWorld updateCreatureSoundPositions
         . over uvWorld ppEvents
@@ -296,38 +295,6 @@ updateLasers w =
 zoneClouds :: World -> World
 zoneClouds w = w & clZoning .~ foldl' (flip zoneCloud) mempty (w ^. cWorld . lWorld . clouds)
 
-updateWorldSelect' :: World -> World
-updateWorldSelect' w = over input (updateWorldSelect (w ^. wCam)) w
-
-updateWorldSelect :: Camera -> Input -> Input
-updateWorldSelect cam inp = f . g $ case (inp ^? mouseButtons . ix ButtonLeft, inp ^? mouseButtons . ix ButtonRight) of
-    (Just 1, Nothing) ->
-        inp & lLine . _1 .~ mwp
-            & lrLine . _1 .~ mwp
-    (Just _, Nothing) ->
-        inp & lLine . _2 .~ mwp
-            & lrLine . _1 .~ mwp
-    (Nothing, Just 1) ->
-        inp & rLine . _1 .~ mwp
-            & lrLine . _2 .~ mwp
-    (Nothing, Just _) ->
-        inp & rLine . _2 .~ mwp
-            & lrLine . _2 .~ mwp
-    _ -> inp
-  where
-    mwp = mouseWorldPos inp cam
-    f
-        | ButtonLeft `M.member` _mouseButtons inp = lSelect .~ mwp
-        | otherwise = id
-    g
-        | ButtonRight `M.member` _mouseButtons inp = rSelect .~ mwp
-        | otherwise = id
-
---mcChooseUpdate :: Machine -> Machine -> World -> World
---mcChooseUpdate mc mc'
---    | _mcHP mc > 0  = _mcUpdate mc mc'
---    | otherwise     = destroyMachine mc
-
 displayTerminalLineString :: TerminalLineString -> World -> (String, Color)
 displayTerminalLineString tls = case tls of
     TerminalLineConst str col -> const (str, col)