diff --git a/appDodge/Main.hs b/appDodge/Main.hs index 4b0df7a2c..b6507d0fa 100644 --- a/appDodge/Main.hs +++ b/appDodge/Main.hs @@ -90,7 +90,7 @@ doSideEffects u = do u' <- _sideEffects w u endTicks <- SDL.ticks let lastFrameTicks = _frameTimer preData - when (_debug_seconds_frame $ _config u) $ void $ renderFoldable + when (debugOn Show_ms_frame $ _config u) $ void $ renderFoldable (_pictureShaders $ _renderData preData) (setDepth (-1) . translate (-0.5) (-0.8) . scale 0.0005 0.0005 diff --git a/src/Dodge/Config/Data.hs b/src/Dodge/Config/Data.hs index 3d2587373..296cf0836 100644 --- a/src/Dodge/Config/Data.hs +++ b/src/Dodge/Config/Data.hs @@ -3,6 +3,7 @@ {-# LANGUAGE StrictData #-} module Dodge.Config.Data where import Data.Aeson +import qualified Data.Set as S import GHC.Generics import Control.Lens data Configuration = Configuration @@ -18,20 +19,23 @@ data Configuration = Configuration , _windowPosX :: Int , _windowPosY :: Int , _gameplay_rotate_to_wall :: Bool - , _debug_show_sound :: Bool - , _debug_seconds_frame :: Bool - , _debug_noclip :: Bool - , _debug_cr_status :: Bool - , _debug_cr_awareness :: Bool - , _debug_mouse_position :: Bool - , _debug_view_boundaries :: Bool - , _debug_walls :: Bool , _debug_view_clip_bounds :: RoomClipping - , _debug_pathing :: Bool - , _debug_remove_LOS :: Bool - , _debug_cull_more_lights :: Bool + , _debug_booleans :: S.Set DebugBool -- consider using Data.BitSet } deriving (Generic, Show) +data DebugBool + = Show_sound + | Show_ms_frame + | Noclip + | Cr_status + | Cr_awareness + | Mouse_position + | View_boundaries + | Walls_info + | Pathing + | Remove_LOS + | Cull_more_lights + deriving (Generic, Eq,Ord,Bounded, Enum, Show) data ResFactor = FullRes | HalfRes | QuarterRes deriving (Generic, Show, Eq, Ord, Enum, Bounded) instance ToJSON ResFactor where @@ -49,10 +53,13 @@ resFactorNum rf = case rf of QuarterRes -> 4 makeLenses ''Configuration +instance ToJSON DebugBool where + toEncoding = genericToEncoding defaultOptions instance ToJSON Configuration where toEncoding = genericToEncoding defaultOptions +instance FromJSON DebugBool instance FromJSON Configuration defaultConfig :: Configuration @@ -69,16 +76,19 @@ defaultConfig = Configuration , _windowPosX = 0 , _windowPosY = 0 , _gameplay_rotate_to_wall = True - , _debug_show_sound = False - , _debug_seconds_frame = True - , _debug_noclip = False - , _debug_mouse_position = False - , _debug_cr_status = False - , _debug_cr_awareness = False - , _debug_view_boundaries = False + , _debug_booleans = S.singleton Show_ms_frame , _debug_view_clip_bounds = NoRoomClipBoundaries - , _debug_pathing = False - , _debug_walls = False - , _debug_remove_LOS = False - , _debug_cull_more_lights = False +-- , _debug_show_sound = False +-- , _debug_seconds_frame = True +-- , _debug_noclip = False +-- , _debug_mouse_position = False +-- , _debug_cr_status = False +-- , _debug_cr_awareness = False +-- , _debug_view_boundaries = False +-- , _debug_pathing = False +-- , _debug_walls = False +-- , _debug_remove_LOS = False +-- , _debug_cull_more_lights = False } +debugOn :: DebugBool -> Configuration -> Bool +debugOn db = S.member db . _debug_booleans diff --git a/src/Dodge/Creature/Picture.hs b/src/Dodge/Creature/Picture.hs index fa3d1f43b..28094016c 100644 --- a/src/Dodge/Creature/Picture.hs +++ b/src/Dodge/Creature/Picture.hs @@ -79,7 +79,7 @@ basicCrShape cr creatureDisplayText :: Configuration -> World -> Creature -> Picture creatureDisplayText cfig w cr - | not (_debug_cr_awareness cfig) = [] + | not (debugOn Cr_awareness cfig) = [] | otherwise = setLayer DebugLayer . setDepth 20 diff --git a/src/Dodge/Debug/Terminal.hs b/src/Dodge/Debug/Terminal.hs index 816d15c52..13730cc25 100644 --- a/src/Dodge/Debug/Terminal.hs +++ b/src/Dodge/Debug/Terminal.hs @@ -1,5 +1,6 @@ module Dodge.Debug.Terminal where +import MaybeHelp import Dodge.Creature import Dodge.Creature.Damage --import Dodge.Creature.State @@ -19,8 +20,9 @@ import qualified IntMapHelp as IM --import Graphics.Rendering.OpenGL.GL.Shaders (validateProgram) --import Dodge.Data (Universe(Universe)) + applyTerminalString :: String -> Universe -> Universe -applyTerminalString "NOCLIP" = config . debug_noclip %~ not +applyTerminalString "NOCLIP" = config . debug_booleans . at Noclip %~ toggleJust applyTerminalString "LOADME" = (uvWorld . creatures . ix 0 . crInv .~ stackedInventory) . (uvWorld . creatures . ix 0 . crInvCapacity .~ 50) applyTerminalString "LM" = applyTerminalString "LOADME" diff --git a/src/Dodge/Menu.hs b/src/Dodge/Menu.hs index 2ad7c4678..9bc5cce58 100644 --- a/src/Dodge/Menu.hs +++ b/src/Dodge/Menu.hs @@ -3,6 +3,7 @@ module Dodge.Menu , pauseMenu , gameOverMenu ) where +import Dodge.Config.Data import LensHelp import Dodge.Menu.OptionType import Dodge.StartNewGame @@ -79,21 +80,28 @@ debugMenu = slTitleOptions "OPTIONS:GAMEPLAY" debugMenuOptions debugMenuOptions :: [MenuOption] -debugMenuOptions = zipWith ($) - [ makeBoolOption debug_seconds_frame "SHOW SECONDS/FRAME" - , makeBoolOption debug_noclip "NOCLIP" - , makeBoolOption debug_cr_status "SHOW CREATURE STATUS" - , makeBoolOption debug_cr_awareness "SHOW CREATURE AWARENESS" - , makeBoolOption debug_view_boundaries "SHOW VIEW BOUNDARIES" - , makeEnumOption debug_view_clip_bounds "SHOW ROOM CLIP" return - , makeBoolOption debug_pathing "SHOW PATHING" - , makeBoolOption debug_show_sound "SHOW VISUAL SOUNDS" - , makeBoolOption debug_mouse_position "SHOW MOUSE POSITION" - , makeBoolOption debug_walls "SHOW WALL INFO" - , makeBoolOption debug_remove_LOS "REMOVE LOS" - , makeBoolOption debug_cull_more_lights "CULL MORE LIGHTS" - ] - $ map Scancode [4 ..] +debugMenuOptions = zipWith f [minBound..] $ map Scancode [4..] + where + f :: DebugBool -> Scancode -> MenuOption + f bd = Toggle (return . Just . (config . debug_booleans . at bd %~ toggleJust)) + (Right . g bd . (^? config . debug_booleans . ix bd)) + g bd Nothing = (show bd, "FALSE") + g bd _ = (show bd, "TRUE") +-- zipWith ($) +-- [ makeBoolOption debug_seconds_frame "SHOW SECONDS/FRAME" +-- , makeBoolOption debug_noclip "NOCLIP" +-- , makeBoolOption debug_cr_status "SHOW CREATURE STATUS" +-- , makeBoolOption debug_cr_awareness "SHOW CREATURE AWARENESS" +-- , makeBoolOption debug_view_boundaries "SHOW VIEW BOUNDARIES" +-- , makeEnumOption debug_view_clip_bounds "SHOW ROOM CLIP" return +-- , makeBoolOption debug_pathing "SHOW PATHING" +-- , makeBoolOption debug_show_sound "SHOW VISUAL SOUNDS" +-- , makeBoolOption debug_mouse_position "SHOW MOUSE POSITION" +-- , makeBoolOption debug_walls "SHOW WALL INFO" +-- , makeBoolOption debug_remove_LOS "REMOVE LOS" +-- , makeBoolOption debug_cull_more_lights "CULL MORE LIGHTS" +-- ] +-- $ map Scancode [4 ..] gameplayMenu :: ScreenLayer gameplayMenu = slTitleOptions "OPTIONS:GAMEPLAY" diff --git a/src/Dodge/Render.hs b/src/Dodge/Render.hs index f8c0b37de..f2189b6cd 100644 --- a/src/Dodge/Render.hs +++ b/src/Dodge/Render.hs @@ -107,7 +107,7 @@ doDrawing pdata u = do currentProgram $= Just (_shadProg lwShad) uniform (head $ _shadUnis lwShad) $= viewFrom3d bindVertexArrayObject $= Just (_vao $ _shadVAO lwShad) - if not (_debug_remove_LOS cfig) + if not (debugOn Remove_LOS cfig) then glDrawArrays (marshalEPrimitiveMode $ _shadPrim lwShad) 0 diff --git a/src/Dodge/Render/Lights.hs b/src/Dodge/Render/Lights.hs index 7f78f3db4..aed9c0b10 100644 --- a/src/Dodge/Render/Lights.hs +++ b/src/Dodge/Render/Lights.hs @@ -23,5 +23,5 @@ lightsForGloom cfig w = mapMaybe getLS (IM.elems $ _lightSources w) lpos = xyV3 $ _lsPos ls rad = _lsRad ls extraculltest - | _debug_cull_more_lights cfig = True + | debugOn Cull_more_lights cfig = True | otherwise = isNothing (intersectSegPolyFirst lpos (lpos +.+ rad *.* (normalizeV (cpos -.- lpos))) cbox) diff --git a/src/Dodge/Render/ShapePicture.hs b/src/Dodge/Render/ShapePicture.hs index 99c85df78..8cae77a98 100644 --- a/src/Dodge/Render/ShapePicture.hs +++ b/src/Dodge/Render/ShapePicture.hs @@ -93,7 +93,7 @@ mcSPic bt = uncurryV translateSPf (_mcPos bt) soundPics :: Configuration -> World -> Picture soundPics cfig w - | _debug_show_sound cfig = pictures $ M.map (soundPic cfig w) $ _playingSounds w + | debugOn Show_sound cfig = pictures $ M.map (soundPic cfig w) $ _playingSounds w | otherwise = [] soundPic :: Configuration -> World -> Sound -> Picture @@ -111,7 +111,7 @@ soundPic cfig w s = fixedSizePicClampArrow 50 50 thePic p cfig w drawMousePosition :: Configuration -> World -> Picture drawMousePosition cfig w - | not $ _debug_mouse_position cfig = mempty + | not $ debugOn Mouse_position cfig = mempty | otherwise = setLayer FixedCoordLayer . winScale cfig . uncurryV translate p @@ -124,7 +124,7 @@ drawMousePosition cfig w drawWallIDs :: Configuration -> World -> Picture drawWallIDs cfig w - | _debug_walls cfig = setLayer FixedCoordLayer + | debugOn Walls_info cfig = setLayer FixedCoordLayer $ foldMap f (_walls w) | otherwise = mempty where @@ -140,7 +140,7 @@ drawWallIDs cfig w drawPathing :: Configuration -> World -> Picture drawPathing cfig w - | _debug_pathing cfig + | debugOn Pathing cfig = setLayer DebugLayer $ (color green . pictures . map (thickLine 5 . tflat2) $ graphToEdges gr) <> concatMap dispInc (graphToIncidence gr) @@ -170,7 +170,7 @@ crDisplayInfo cfig w cr drawCrInfo :: Configuration -> World -> Picture drawCrInfo cfig w - | _debug_cr_status cfig = setLayer FixedCoordLayer + | debugOn Cr_status cfig = setLayer FixedCoordLayer $ renderInfoListsAt (2*hw - 400) 0 cfig w $ mapMaybe (crDisplayInfo cfig w) $ IM.elems $ _creatures w | otherwise = mempty @@ -179,7 +179,7 @@ drawCrInfo cfig w viewBoundaries :: Configuration -> World -> Picture viewBoundaries cfig w - | _debug_view_boundaries cfig + | debugOn View_boundaries cfig = setLayer DebugLayer $ color green (concatMap (polygonWire . _grBound) grs) <> color yellow (concatMap (\q -> line [p,q]) $ farWallPoints p w) | otherwise = [] diff --git a/src/Dodge/WallCreatureCollisions.hs b/src/Dodge/WallCreatureCollisions.hs index fe52c618a..059e788e1 100644 --- a/src/Dodge/WallCreatureCollisions.hs +++ b/src/Dodge/WallCreatureCollisions.hs @@ -23,7 +23,7 @@ colCrsWalls cfig w = w & creatures %~ fmap (noclipCheck cfig w) noclipCheck :: Configuration -> World -> Creature -> Creature noclipCheck cfig w c - | _debug_noclip cfig && _crID c == 0 = c -- for noclip + | debugOn Noclip cfig && _crID c == 0 = c -- for noclip | otherwise = colCrWall w c -- no noclip check, so no need for a configuration file diff --git a/src/MaybeHelp.hs b/src/MaybeHelp.hs index e07de4c07..aabe087d9 100644 --- a/src/MaybeHelp.hs +++ b/src/MaybeHelp.hs @@ -23,4 +23,8 @@ strictify :: Maybe a -> Maybe' a strictify Nothing = Nothing' strictify (Just x) = Just' x +toggleJust :: Maybe a -> Maybe () +toggleJust Nothing = Just () +toggleJust _ = Nothing + makeLenses ''Maybe'