Remove useless code

This commit is contained in:
2023-03-26 23:09:16 +01:00
parent 55e0b2217f
commit 7a36b69818
5 changed files with 17 additions and 72 deletions
+15 -25
View File
@@ -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