diff options
Diffstat (limited to 'src/Xanthous/Game')
-rw-r--r-- | src/Xanthous/Game/Arbitrary.hs | 1 | ||||
-rw-r--r-- | src/Xanthous/Game/Draw.hs | 44 | ||||
-rw-r--r-- | src/Xanthous/Game/Lenses.hs | 1 | ||||
-rw-r--r-- | src/Xanthous/Game/State.hs | 19 |
4 files changed, 43 insertions, 22 deletions
diff --git a/src/Xanthous/Game/Arbitrary.hs b/src/Xanthous/Game/Arbitrary.hs index 090eba634d4b..f4c83e005146 100644 --- a/src/Xanthous/Game/Arbitrary.hs +++ b/src/Xanthous/Game/Arbitrary.hs @@ -26,6 +26,7 @@ instance Arbitrary GameState where _revealedPositions <- fmap setFromList . sublistOf $ EntityMap.positions _entities _randomGen <- mkStdGen <$> arbitrary let _promptState = NoPrompt -- TODO + _activePanel <- arbitrary _debugState <- arbitrary pure $ GameState {..} diff --git a/src/Xanthous/Game/Draw.hs b/src/Xanthous/Game/Draw.hs index ab0e31f8a04a..7947c6efe917 100644 --- a/src/Xanthous/Game/Draw.hs +++ b/src/Xanthous/Game/Draw.hs @@ -27,7 +27,7 @@ import Xanthous.Game , debugState, allRevealed ) import Xanthous.Game.Prompt -import Xanthous.Resource (Name) +import Xanthous.Resource (Name, Panel(..)) import qualified Xanthous.Resource as Resource import Xanthous.Orphans () -------------------------------------------------------------------------------- @@ -41,23 +41,23 @@ cursorPosition game = showCursor Resource.Character (game ^. characterPosition . loc) drawMessages :: MessageHistory -> Widget Name -drawMessages = txt . (<> " ") . unwords . oextract +drawMessages = txtWrap . (<> " ") . unwords . oextract drawPromptState :: GamePromptState m -> Widget Name drawPromptState NoPrompt = emptyWidget drawPromptState (WaitingPrompt msg (Prompt _ pt ps pri _)) = case (pt, ps, pri) of (SStringPrompt, StringPromptState edit, _) -> - txt msg <+> renderEditor (txt . fold) True edit - (SDirectionPrompt, DirectionPromptState, _) -> txt msg - (SContinue, _, _) -> txt msg + txtWrap msg <+> renderEditor (txtWrap . fold) True edit + (SDirectionPrompt, DirectionPromptState, _) -> txtWrap msg + (SContinue, _, _) -> txtWrap msg (SMenu, _, menuItems) -> - txt msg + txtWrap msg <=> foldl' (<=>) emptyWidget (map drawMenuItem $ itoList menuItems) - _ -> txt msg + _ -> txtWrap msg where drawMenuItem (chr, MenuOption m _) = - str ("[" <> pure chr <> "] ") <+> txt m + str ("[" <> pure chr <> "] ") <+> txtWrap m drawEntities :: (Position -> Bool) @@ -95,11 +95,32 @@ drawMap game -- character can't see them (game ^. entities) +bullet :: Char +bullet = '•' + +drawPanel :: GameState -> Panel -> Widget Name +drawPanel game panel + = border + . hLimit 35 + . viewport (Resource.Panel panel) Vertical + $ case panel of + InventoryPanel -> + let items = game ^. character . inventory + in if null items + then txtWrap "Your inventory is empty right now." + else + txtWrap "You are currently carrying the following items:" + <=> txt " " + <=> foldl' (<=>) emptyWidget + (map + (txtWrap . ((bullet <| " ") <>) . description) + items) + drawCharacterInfo :: Character -> Widget Name drawCharacterInfo ch = txt " " <+> charName <+> charHitpoints where charName | Just n <- ch ^. characterName - = txt n <+> txt " " + = txt $ n <> " " | otherwise = emptyWidget charHitpoints @@ -114,5 +135,8 @@ drawGame game NoPrompt -> drawMessages (game ^. messageHistory) _ -> emptyWidget <=> drawPromptState (game ^. promptState) - <=> border (drawMap game) + <=> + (maybe emptyWidget (drawPanel game) (game ^. activePanel) + <+> border (drawMap game) + ) <=> drawCharacterInfo (game ^. character) diff --git a/src/Xanthous/Game/Lenses.hs b/src/Xanthous/Game/Lenses.hs index 13f4b89314f7..1f72e08b7b25 100644 --- a/src/Xanthous/Game/Lenses.hs +++ b/src/Xanthous/Game/Lenses.hs @@ -46,6 +46,7 @@ initialStateFromSeed seed = _messageHistory = mempty _revealedPositions = mempty _promptState = NoPrompt + _activePanel = Nothing _debugState = DebugState { _allRevealed = False } diff --git a/src/Xanthous/Game/State.hs b/src/Xanthous/Game/State.hs index 5ddb7de7e9b8..3b401d366d10 100644 --- a/src/Xanthous/Game/State.hs +++ b/src/Xanthous/Game/State.hs @@ -10,6 +10,7 @@ module Xanthous.Game.State , revealedPositions , messageHistory , randomGen + , activePanel , promptState , characterEntityID , GamePromptState(..) @@ -383,6 +384,7 @@ instance -------------------------------------------------------------------------------- + data DebugState = DebugState { _allRevealed :: !Bool } @@ -402,8 +404,12 @@ data GameState = GameState , _characterEntityID :: !EntityID , _messageHistory :: !MessageHistory , _randomGen :: !StdGen + + -- | The active panel displayed in the UI, if any + , _activePanel :: !(Maybe Panel) + , _promptState :: !(GamePromptState AppM) - , _debugState :: DebugState + , _debugState :: !DebugState } deriving stock (Show, Generic) deriving anyclass (NFData) @@ -437,14 +443,3 @@ instance (MonadIO m) => MonadIO (AppT m) where -------------------------------------------------------------------------------- makeLenses ''DebugState - --------------------------------------------------------------------------------- - --- saveGame :: GameState -> LByteString --- saveGame = Zlib.compress . JSON.encode - --- loadGame :: LByteString -> Maybe GameState --- loadGame = JSON.decode . Zlib.decompress - --- saved :: Prism' LByteString GameState --- saved = prism' saveGame loadGame |