Add extra debug options for viewing room clipping

src/Dodge/Config/Data.hs

@@ -22,7 +22,7 @@ data Configuration = Configuration
     , _debug_noclip         :: Bool
     , _debug_cr_status      :: Bool
     , _debug_view_boundaries :: Bool
-    , _debug_view_clip_bounds :: Bool
+    , _debug_view_clip_bounds :: RoomClipping
     , _debug_pathing        :: Bool
     }
   deriving (Generic, Show)
@@ -31,6 +31,11 @@ data ResFactor = FullRes | HalfRes | QuarterRes
 instance ToJSON ResFactor where
   toEncoding = genericToEncoding defaultOptions
 instance FromJSON ResFactor
+data RoomClipping = NoRoomClipBoundaries | AllRoomClipBoundaries | IntersectingRoomClipBoundaries
+  deriving (Generic, Show, Eq, Ord, Enum, Bounded)
+instance ToJSON RoomClipping where
+  toEncoding = genericToEncoding defaultOptions
+instance FromJSON RoomClipping
 resFactorNum :: ResFactor -> Int
 resFactorNum rf = case rf of
     FullRes     -> 1
@@ -62,6 +67,6 @@ defaultConfig = Configuration
     , _debug_noclip         = False
     , _debug_cr_status      = False
     , _debug_view_boundaries = False
-    , _debug_view_clip_bounds = False
+    , _debug_view_clip_bounds = NoRoomClipBoundaries
     , _debug_pathing    = False
     }

src/Dodge/Initialisation.hs

@@ -10,7 +10,6 @@ import Dodge.Creature
 import Dodge.WorldEvent.Cloud
 import Dodge.SoundLogic
 import Geometry.Data
-import Geometry.ConvexPoly
 
 import System.Random
 import qualified Data.Set as S
@@ -43,7 +42,8 @@ initialWorld = defaultWorld
 
 testStringInit :: World -> [String]
 --testStringInit = map (concatMap $ \(_,ct,_,_) -> show ct) . invertListInvMult . yourInv
-testStringInit w = [show $ f $ _roomClipping w]
-  where
-    f (x:xs) = any (convexPolysOverlap x) xs || f xs
-    f [] = False
+testStringInit = const []
+--    w = [show $ f $ _roomClipping w]
+--  where
+--    f (x:xs) = any (convexPolysOverlap x) xs || f xs
+--    f [] = False

src/Dodge/Menu.hs

@@ -79,7 +79,7 @@ debugMenuOptions =
     , doption ScancodeC debug_noclip "NOCLIP" _debug_noclip
     , doption ScancodeS debug_cr_status "SHOW CREATURE STATUS" _debug_cr_status
     , doption ScancodeV debug_view_boundaries "SHOW VIEW BOUNDARIES" _debug_view_boundaries
-    , doption ScancodeB debug_view_clip_bounds "SHOW ROOM CLIP BOUNDARIES" _debug_view_clip_bounds
+    , makeEnumOption ScancodeB debug_view_clip_bounds "SHOW ROOM CLIP" return
     , doption ScancodeP debug_pathing "SHOW PATHING" _debug_pathing
     ]
   where

src/Dodge/Render/ShapePicture.hs

@@ -113,8 +113,9 @@ viewBoundaries cfig w
 
 viewClipBounds :: Configuration -> World -> Picture
 viewClipBounds cfig w
-    | _debug_view_clip_bounds cfig 
---         = setLayer 5 $ color green $ concatMap (polygonWire . _cpPoints) (_roomClipping w)
+    | _debug_view_clip_bounds cfig == AllRoomClipBoundaries
+         = setLayer 5 $ color green $ concatMap (polygonWire . _cpPoints) (_roomClipping w)
+    | _debug_view_clip_bounds cfig == IntersectingRoomClipBoundaries
         = setLayer 5 $ f (_roomClipping w)
     | otherwise = []
   where

src/Dodge/Room/Procedural.hs

@@ -170,8 +170,6 @@ quarterRoomTri w = do
             ]
         , _rmBound  = [[V2 0 0,V2 w w,V2 (-w) w]]
         }
---  where
---    w' = w -10
 
 quarterRoomSquare :: RandomGen g => Float -> State g Room
 quarterRoomSquare w = do
@@ -211,8 +209,6 @@ quarterRoomSquare w = do
         --, _rmBound = [map toV2 [(w,w),(0,2*w),(-w,w)]]
         , _rmBound = [ map toV2 [(0,0),(w,w),(0,2*w),(-w,w)] ]
         }
---  where
---    w' = w - 10
 {- | Randomise the ordering of placements in a room.
 Useful for randomising the position of generic placements such as 'PutNothing'. -}
 shufflePlacements :: RandomGen g => Room -> State g Room