Add view debug option

src/Dodge/Config/Data.hs

@@ -20,6 +20,7 @@ data Configuration = Configuration
     , _debug_seconds_frame  :: Bool
     , _debug_noclip         :: Bool
     , _debug_cr_status      :: Bool
+    , _debug_view_boundaries :: Bool
     }
   deriving (Generic, Show)
 makeLenses ''Configuration
@@ -44,4 +45,5 @@ defaultConfig = Configuration
     , _debug_seconds_frame  = True
     , _debug_noclip         = False
     , _debug_cr_status      = False
+    , _debug_view_boundaries = False
     }

src/Dodge/Layout.hs

@@ -44,7 +44,7 @@ generateLevelFromRoomList gr w
     . setupWorldBounds
 --    . initializeStaticWalls
 --    . setupForegroundEdgeVerxs
-    . flip (foldr $ flip placeSpot') plmnts
+    . flip (foldr $ flip placeSpot) plmnts
 --    . addRoomPolyDecorations rs
 --    . addRoomLinkDecorations rs
     $ w { _walls = wallsFromRooms rs

src/Dodge/LevelGen.hs

@@ -25,20 +25,17 @@ import qualified IntMapHelp as IM
 import Control.Monad.State
 import Control.Lens
 
-placeSpot' :: World -> ((Point2,Float) , Placement) -> World
-placeSpot' w (shift, plmnt) =
-    let (i,w') =  placeSpotID (shiftPSBy' shift (_placementSpot plmnt)) w
-    in  maybe w' (curry (placeSpot' w') shift) (_idPlacement plmnt i)
+placeSpot :: World -> ((Point2,Float) , Placement) -> World
+placeSpot w (shift, plmnt) =
+    let (i,w') =  placeSpotID (shiftPSBy shift (_placementSpot plmnt)) w
+    in  maybe w' (curry (placeSpot w') shift) (_idPlacement plmnt i)
 
 shiftPlacement :: (Point2,Float) -> Placement -> Placement
-shiftPlacement shift (Placement ps f) = Placement (shiftPSBy' shift ps)
+shiftPlacement shift (Placement ps f) = Placement (shiftPSBy shift ps)
      (fmap (fmap $ shiftPlacement shift) f)
 
-shiftPSBy'
-    :: (Point2,Float)
-    -> PlacementSpot
-    -> PlacementSpot
-shiftPSBy' (pos,rot) ps = ps
+shiftPSBy :: (Point2,Float) -> PlacementSpot -> PlacementSpot
+shiftPSBy (pos,rot) ps = ps
     & psPos %~ shiftPointBy (pos,rot)
     & psRot %~ (+ rot)
 

src/Dodge/Menu.hs

@@ -44,18 +44,18 @@ debugOptionsMenu  = OptionScreen
     }
 debugMenuOptions :: [MenuOption]
 debugMenuOptions =
-    [ Toggle 
-        ScancodeF 
+    [ Toggle ScancodeF 
         (Just . (config . debug_seconds_frame %~ not))
         (\w -> "SHOW SECONDS/FRAME:" ++ show (_debug_seconds_frame $ _config w))
-    , Toggle 
-        ScancodeC 
+    , Toggle ScancodeC 
         (Just . (config . debug_noclip %~ not))
         (\w -> "NOCLIP:" ++ show (_debug_noclip $ _config w))
-    , Toggle 
-        ScancodeS 
+    , Toggle ScancodeS 
         (Just . (config . debug_cr_status %~ not))
         (\w -> "SHOW CREATURE STATUS:" ++ show (_debug_cr_status $ _config w))
+    , Toggle ScancodeV
+        (Just . (config . debug_view_boundaries %~ not))
+        (\w -> "SHOW VIEW BOUNDARIES:" ++ show (_debug_view_boundaries $ _config w))
     ]
 gameplayOptionsMenu :: ScreenLayer
 gameplayOptionsMenu  = OptionScreen

src/Dodge/Render/Picture.hs

@@ -15,6 +15,8 @@ import Dodge.Render.MenuScreen
 import Dodge.Render.ShapePicture
 import Dodge.SoundLogic.LoadSound
 import Dodge.Config.Data
+import Dodge.GameRoom
+import Dodge.Update.Camera
 import Sound.Data
 import Geometry
 import Picture
@@ -40,6 +42,7 @@ worldPictures w = pictures
     ,concatMapPic btDraw $ _buttons w
     ,concatMapPic drawWallFloor $ wallFloorsToDraw w
     ,soundPics w
+    ,viewBoundaries w
     ]
   where
     crIsClose cr = dist (_crPos cr) camCen < winSize
@@ -74,12 +77,23 @@ testPic _ = []
 --    thepic = setDepth 20 . color green . polygon $ rectNSEW 5 (-5) (-5) (5)
 --testPic _ = blank
 --testPic w = color green . pictures . map (flip thickLine 5 . tflat2) . graphToEdges $ _pathGraph w
+viewBoundaries :: World -> Picture
+viewBoundaries w
+    | _debug_view_boundaries (_config w) 
+        = setLayer 5 $ color green (concatMap (polygonWire . _grBound) grs)
+        <> color yellow (concatMap (\q -> line [p,q]) $ farWallPoints p w)
+    | otherwise = []
+  where
+    p = _crPos $ you w
+    grs = filter (pointInOrOnPolygon p . _grBound) (_gameRooms w)
 
 soundPics :: World -> Picture
 soundPics w 
     | _show_sound (_config w) = pictures $ M.map (soundPic w) $ _playingSounds w
     | otherwise = []
 
+
+
 soundPic :: World -> Sound -> Picture
 soundPic w s = fixedSizePicClampArrow 50 50 thePic p w
   where

src/Dodge/Room/Link.hs

@@ -8,11 +8,9 @@ the outgoing links.
 module Dodge.Room.Link
     where
 import Dodge.LevelGen
-import Dodge.LevelGen.Data
 import Dodge.Room.Data
 import Dodge.RandomHelp
 import Geometry
---import Geometry.Data
 import Data.Tile
 
 import System.Random
@@ -84,15 +82,6 @@ shiftLinkBy
     -> (Point2,Float)
 shiftLinkBy (pos,rot) (p,r) = (shiftPointBy (pos,rot) p, r + rot)
 
-shiftPSBy  
-    :: (Point2,Float) 
-    -> Placement
-    -> Placement
-shiftPSBy (pos,rot) ps = ps
-    & placementSpot . psPos %~ shiftPointBy (pos,rot)
-    & placementSpot . psRot %~ (+ rot)
-    & idPlacement %~ fmap (fmap $ shiftPSBy (pos,rot))
-
 shiftPathPointBy  
     :: (Point2,Float) 
     -> (Point2,Point2) 

src/Dodge/Room/Procedural.hs

@@ -26,25 +26,18 @@ import Dodge.LevelGen
 import Dodge.LevelGen.Data
 import Dodge.LightSources.Fitting
 import Dodge.Creature
---import Dodge.Default
 import Geometry
 import Geometry.Vector3D
 import Picture
 import Data.Tile
 
---import Data.List
---import Data.Function (on)
---import qualified Data.Tuple.Extra as Tup
---import qualified Data.Map.Strict as M
 import qualified Data.IntMap.Strict as IM
 import Control.Lens
 import Control.Monad
 import Control.Monad.State
 import System.Random
-{-
-A simple rectangular room with a light in the center.
-Creates links and pathfinding graph.
- -}
+{- A simple rectangular room with a light in the center.
+Creates links and pathfinding graph.  -}
 roomRect
     :: Float    -- ^ Width
     -> Float    -- ^ Height
@@ -73,9 +66,7 @@ roomRect x y xn yn = defaultRoom
     slnks = zip (translateS (V2 20 0) $ gridPoints xd (xn+1)  0  1     )  (repeat     pi ) 
     lnks = nlnks ++ elnks ++ wlnks ++ slnks
     pth  = linksAndPath lnks $ translateS (V2 20 20) (makeGrid xd xn yd yn)
-{-
-Creates a rectangular room, automatically creates links and pathfinding graph at a sensible size.
--}
+{- Creates a rectangular room, automatically creates links and pathfinding graph at a sensible size.  -}
 roomRectAutoLinks :: Float -> Float -> Room
 roomRectAutoLinks x y = roomRect x y ((ceiling x - 40) `div` 60) ((ceiling y - 40) `div` 60)
 
@@ -129,23 +120,12 @@ fourthWall w = do
             ]
         ]
     pure $ defaultRoom
-        { _rmPolys  = [ map toV2 [(0,0),(w,w),(-w,w)] ]
+        { _rmPolys  = [ [V2 0 0,V2 w w,V2 (-w) w] ]
         , _rmLinks  = [(V2 0 w, 0)]
         , _rmPath   = [(V2 0 w,V2 0 0),(V2 0 0,V2 0 w)]
         , _rmPS     = b
         , _rmBound  = [[V2 0 0,V2 w w,V2 (-w) w]]
         }
---fourthCorner :: Float -> Room
---fourthCorner w = Room
---    { _rmPolys  = [ [(0,0),(w,w),(0,2*w),(-w,w)] ]
---    , _rmLinks  = 
---        [((w/2,3*w/2), negate $ pi/4)
---        ,((negate $ w/2,3*w/2), pi/4)
---        ]
---    , _rmPath   = [((0,w),(0,0)),((0,0),(0,w))]
---    , _rmPS     = [sPS (0,w) 0 putLamp]
---    , _rmBound  = [[(w,w),(0,2*w),(-w,w)]]
---    }
 
 fourthCornerWall :: RandomGen g => Float -> State g Room
 fourthCornerWall w = do
@@ -246,7 +226,7 @@ centerVaultRoom w h d = do
             ]
             ++ map (\a -> mountedLightV (rotateV a $ V2 0  d) (rotate3z a $ V3 0 (d+30) 70))
                 [0,0.5*pi,pi,1.5*pi]
-            ++ concat (map (\r -> map (shiftPSBy (V2 0 0,r)) $ theDoor) 
+            ++ concat (map (\r -> map (shiftPlacement (V2 0 0,r)) $ theDoor) 
                         [0,pi/2,pi,3*pi/2])
         , _rmBound  = [rectNSWE h (-h) (-w) w]
         }