diff --git a/src/Dodge/Config/Data.hs b/src/Dodge/Config/Data.hs index a61ce9229..db3262671 100644 --- a/src/Dodge/Config/Data.hs +++ b/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 } diff --git a/src/Dodge/Layout.hs b/src/Dodge/Layout.hs index edf37dd30..e41f53d56 100644 --- a/src/Dodge/Layout.hs +++ b/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 diff --git a/src/Dodge/LevelGen.hs b/src/Dodge/LevelGen.hs index b20c5ca1e..8a4e9b477 100644 --- a/src/Dodge/LevelGen.hs +++ b/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) diff --git a/src/Dodge/Menu.hs b/src/Dodge/Menu.hs index 2f922f2a2..6fb6f5d30 100644 --- a/src/Dodge/Menu.hs +++ b/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 diff --git a/src/Dodge/Render/Picture.hs b/src/Dodge/Render/Picture.hs index a07acdca3..bdb970574 100644 --- a/src/Dodge/Render/Picture.hs +++ b/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 diff --git a/src/Dodge/Room/Link.hs b/src/Dodge/Room/Link.hs index 32156e305..016bbae68 100644 --- a/src/Dodge/Room/Link.hs +++ b/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) diff --git a/src/Dodge/Room/Procedural.hs b/src/Dodge/Room/Procedural.hs index 181d19baf..ac09195b6 100644 --- a/src/Dodge/Room/Procedural.hs +++ b/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] }