Add debug command to reveal the game

Add a (debug) command to reveal all tiles on the game regardless of the
character's vision, which'll make it easier to debug creature's behavior
while they're not visible.
This commit is contained in:
Griffin Smith 2019-09-28 15:01:21 -04:00
parent 1a0f618a82
commit abea2dcfac
7 changed files with 52 additions and 10 deletions

View file

@ -155,6 +155,13 @@ handleCommand Open = do
handleCommand Wait = stepGame >> continue
handleCommand ToggleRevealAll = do
val <- debugState . allRevealed <%= not
say ["debug", "toggleRevealAll"] $ object [ "revealAll" A..= val ]
continue
--------------------------------------------------------------------------------
handlePromptEvent
:: Text -- ^ Prompt message
-> Prompt AppM

View file

@ -17,6 +17,9 @@ data Command
| Open
| Wait
-- | TODO replace with `:` commands
| ToggleRevealAll
commandFromKey :: Key -> [Modifier] -> Maybe Command
commandFromKey (KChar 'q') [] = Just Quit
commandFromKey (KChar '.') [] = Just Wait
@ -24,6 +27,7 @@ commandFromKey (KChar (directionFromChar -> Just dir)) [] = Just $ Move dir
commandFromKey (KChar 'p') [MCtrl] = Just PreviousMessage
commandFromKey (KChar ',') [] = Just PickUp
commandFromKey (KChar 'o') [] = Just Open
commandFromKey (KChar 'r') [MMeta] = Just ToggleRevealAll
commandFromKey _ _ = Nothing
--------------------------------------------------------------------------------

View file

@ -21,6 +21,11 @@ module Xanthous.Game
-- * App monad
, AppT(..)
-- * Debug State
, DebugState(..)
, debugState
, allRevealed
) where
--------------------------------------------------------------------------------
import Xanthous.Game.State

View file

@ -24,4 +24,5 @@ instance Arbitrary GameState where
_revealedPositions <- fmap setFromList . sublistOf $ EntityMap.positions _entities
_randomGen <- mkStdGen <$> arbitrary
let _promptState = NoPrompt -- TODO
_debugState <- arbitrary
pure $ GameState {..}

View file

@ -23,6 +23,7 @@ import Xanthous.Game
, messageHistory
, GamePromptState(..)
, promptState
, debugState, allRevealed
)
import Xanthous.Game.Prompt
import Xanthous.Resource (Name)
@ -46,14 +47,11 @@ drawPromptState (WaitingPrompt msg (Prompt _ pt ps _)) =
_ -> undefined
drawEntities
:: Set Position
-- ^ Positions the character has seen
-- FIXME: this will break down as soon as creatures can walk around on their
-- own, since we don't want to render things walking around when the
-- character can't see them
:: (Position -> Bool)
-- ^ Can we render a given position?
-> EntityMap SomeEntity -- ^ all entities
-> Widget Name
drawEntities visiblePositions allEnts
drawEntities canRenderPos allEnts
= vBox rows
where
entityPositions = EntityMap.positions allEnts
@ -62,7 +60,7 @@ drawEntities visiblePositions allEnts
rows = mkRow <$> [0..maxY]
mkRow rowY = hBox $ renderEntityAt . flip Position rowY <$> [0..maxX]
renderEntityAt pos
| pos `member` visiblePositions
| canRenderPos pos
= let neighbors = EntityMap.neighbors pos allEnts
in maybe (str " ") (drawWithNeighbors neighbors)
$ allEnts ^? atPosition pos . folded
@ -73,7 +71,12 @@ drawMap game
= viewport Resource.MapViewport Both
. showCursor Resource.Character (game ^. characterPosition . loc)
$ drawEntities
(game ^. revealedPositions)
(\pos ->
(game ^. debugState . allRevealed)
|| (pos `member` (game ^. revealedPositions)))
-- FIXME: this will break down as soon as creatures can walk around on their
-- own, since we don't want to render things walking around when the
-- character can't see them
(game ^. entities)
drawGame :: GameState -> [Widget Name]

View file

@ -32,6 +32,11 @@ module Xanthous.Game.State
, downcastEntity
, _SomeEntity
, entityIs
-- * Debug State
, DebugState(..)
, debugState
, allRevealed
) where
--------------------------------------------------------------------------------
import Xanthous.Prelude
@ -158,10 +163,10 @@ instance Entity SomeEntity where
blocksVision (SomeEntity ent) = blocksVision ent
description (SomeEntity ent) = description ent
downcastEntity :: forall a. (Entity a, Typeable a) => SomeEntity -> Maybe a
downcastEntity :: forall (a :: Type). (Typeable a) => SomeEntity -> Maybe a
downcastEntity (SomeEntity e) = cast e
entityIs :: forall a. (Entity a, Typeable a) => SomeEntity -> Bool
entityIs :: forall (a :: Type). (Typeable a) => SomeEntity -> Bool
entityIs = isJust . downcastEntity @a
_SomeEntity :: forall a. (Entity a, Typeable a) => Prism' SomeEntity a
@ -169,6 +174,15 @@ _SomeEntity = prism' SomeEntity downcastEntity
--------------------------------------------------------------------------------
data DebugState = DebugState
{ _allRevealed :: !Bool
}
deriving stock (Show, Eq, Generic)
deriving anyclass (NFData, CoArbitrary, Function)
instance Arbitrary DebugState where
arbitrary = genericArbitrary
data GameState = GameState
{ _entities :: !(EntityMap SomeEntity)
, _revealedPositions :: !(Set Position)
@ -176,6 +190,7 @@ data GameState = GameState
, _messageHistory :: !MessageHistory
, _randomGen :: !StdGen
, _promptState :: !(GamePromptState AppM)
, _debugState :: DebugState
}
deriving stock (Show)
makeLenses ''GameState
@ -198,3 +213,7 @@ instance (Monad m) => MonadRandom (AppT m) where
getRandom = randomGen %%= random
getRandomRs rng = uses randomGen $ randomRs rng
getRandoms = uses randomGen randoms
--------------------------------------------------------------------------------
makeLenses ''DebugState

View file

@ -24,3 +24,6 @@ combat:
killed:
- You kill the {{creature.creatureType.name}}!
- You've killed the {{creature.creatureType.name}}!
debug:
toggleRevealAll: revealAll now set to {{revealAll}}