From 7a36b69818facf252ae0d7f8ac326d04ca7dd5fb Mon Sep 17 00:00:00 2001 From: justin Date: Sun, 26 Mar 2023 23:09:16 +0100 Subject: [PATCH] Remove useless code --- src/Dodge/Data/Config.hs | 1 - src/Dodge/Data/Input.hs | 10 ++------ src/Dodge/Default/World.hs | 5 ---- src/Dodge/Render/ShapePicture.hs | 40 ++++++++++++-------------------- src/Dodge/Update.hs | 33 -------------------------- 5 files changed, 17 insertions(+), 72 deletions(-) diff --git a/src/Dodge/Data/Config.hs b/src/Dodge/Data/Config.hs index 69a3db537..e86d1e339 100644 --- a/src/Dodge/Data/Config.hs +++ b/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 diff --git a/src/Dodge/Data/Input.hs b/src/Dodge/Data/Input.hs index efd93457c..11ebeda5e 100644 --- a/src/Dodge/Data/Input.hs +++ b/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) - , _rLine :: (Point2, Point2) - , _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 + , _clickPos :: M.Map MouseButton Point2 -- updates on initial mouse button press + , _heldPos :: M.Map MouseButton Point2 -- updates while mouse button is held, lags one frame , _textInput :: [Either TermSignal Char] , _scrollTestFloat :: Float , _scrollTestInt :: Int diff --git a/src/Dodge/Default/World.hs b/src/Dodge/Default/World.hs index 4ca2a3006..cac4daac4 100644 --- a/src/Dodge/Default/World.hs +++ b/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 } diff --git a/src/Dodge/Render/ShapePicture.hs b/src/Dodge/Render/ShapePicture.hs index b13862daf..982a3ffcd 100644 --- a/src/Dodge/Render/ShapePicture.hs +++ b/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 = - setLayer DebugLayer (color orange $ line [a, b]) +drawCollisionTest w = fromMaybe mempty $ do + 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 = - setLayer DebugLayer $ +drawPathBetween w = fromMaybe mempty $ do + 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 = - setLayer DebugLayer (color orange $ line [a, b]) +drawInspectWalls w = fromMaybe mempty $ do + 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 diff --git a/src/Dodge/Update.hs b/src/Dodge/Update.hs index d12dd2290..939d654cc 100644 --- a/src/Dodge/Update.hs +++ b/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)