about summary refs log tree commit diff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--src/Xanthous/App.hs11
-rw-r--r--src/Xanthous/Command.hs2
-rw-r--r--src/Xanthous/Game/Arbitrary.hs1
-rw-r--r--src/Xanthous/Game/Draw.hs44
-rw-r--r--src/Xanthous/Game/Lenses.hs1
-rw-r--r--src/Xanthous/Game/State.hs19
-rw-r--r--src/Xanthous/Resource.hs35
-rw-r--r--src/Xanthous/messages.yaml5
8 files changed, 79 insertions, 39 deletions
diff --git a/src/Xanthous/App.hs b/src/Xanthous/App.hs
index df76eadc3bbc..9d606bbef344 100644
--- a/src/Xanthous/App.hs
+++ b/src/Xanthous/App.hs
@@ -34,7 +34,7 @@ import           Xanthous.Game.State
 import           Xanthous.Game.Draw (drawGame)
 import           Xanthous.Game.Prompt
 import           Xanthous.Monad
-import           Xanthous.Resource (Name)
+import           Xanthous.Resource (Name, Panel(..))
 import qualified Xanthous.Messages as Messages
 import           Xanthous.Util.Inflection (toSentence)
 --------------------------------------------------------------------------------
@@ -231,6 +231,8 @@ handleCommand Read = do
             in readAndContinue msgs
   continue
 
+handleCommand Inventory = showPanel InventoryPanel >> continue
+
 handleCommand Save = do
   -- TODO default save locations / config file?
   prompt_ @'StringPrompt ["save", "location"] Cancellable
@@ -439,4 +441,9 @@ entityMenu_ = mkMenuItems @[_] . map entityMenuItem
 -- entityMenu :: Entity entity => [entity] -> Map Char (MenuOption entity)
 -- entityMenu = map (map runIdentity) . entityMenu_ . fmap Identity
 
---------------------------------------------------------------------------------
+showPanel :: Panel -> AppM ()
+showPanel panel = do
+  activePanel ?= panel
+  prompt_ @'Continue ["generic", "continue"] Uncancellable
+    . const
+    $ activePanel .= Nothing
diff --git a/src/Xanthous/Command.hs b/src/Xanthous/Command.hs
index 61fb11b22e77..a14a4d071307 100644
--- a/src/Xanthous/Command.hs
+++ b/src/Xanthous/Command.hs
@@ -20,6 +20,7 @@ data Command
   | Look
   | Save
   | Read
+  | Inventory
 
     -- | TODO replace with `:` commands
   | ToggleRevealAll
@@ -35,6 +36,7 @@ commandFromKey (KChar ';') [] = Just Look
 commandFromKey (KChar 'e') [] = Just Eat
 commandFromKey (KChar 'S') [] = Just Save
 commandFromKey (KChar 'r') [] = Just Read
+commandFromKey (KChar 'i') [] = Just Inventory
 
 commandFromKey (KChar 'r') [MMeta] = Just ToggleRevealAll
 
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
diff --git a/src/Xanthous/Resource.hs b/src/Xanthous/Resource.hs
index 5350e7646e38..cc2fc97a1464 100644
--- a/src/Xanthous/Resource.hs
+++ b/src/Xanthous/Resource.hs
@@ -1,24 +1,31 @@
 --------------------------------------------------------------------------------
 module Xanthous.Resource
-  ( Name(..)
+  ( Panel(..)
+  , Name(..)
   ) where
 --------------------------------------------------------------------------------
 import Xanthous.Prelude
 --------------------------------------------------------------------------------
 import Test.QuickCheck
-import Test.QuickCheck.Arbitrary.Generic
+import Data.Aeson (ToJSON, FromJSON)
+--------------------------------------------------------------------------------
+import Xanthous.Util.QuickCheck
 --------------------------------------------------------------------------------
 
-data Name = MapViewport
-            -- ^ The main viewport where we display the game content
-          | Character
-            -- ^ The character
-          | MessageBox
-            -- ^ The box where we display messages to the user
-          | Prompt
-            -- ^ The game's prompt
-  deriving stock (Show, Eq, Ord, Generic)
-  deriving anyclass (NFData, CoArbitrary, Function)
+-- | Enum for "panels" displayed in the game's UI.
+data Panel
+  = InventoryPanel -- ^ A panel displaying the character's inventory
+  deriving stock (Show, Eq, Ord, Generic, Enum, Bounded)
+  deriving anyclass (NFData, CoArbitrary, Function, ToJSON, FromJSON)
+  deriving Arbitrary via GenericArbitrary Panel
 
-instance Arbitrary Name where
-  arbitrary = genericArbitrary
+
+data Name
+  = MapViewport -- ^ The main viewport where we display the game content
+  | Character   -- ^ The character
+  | MessageBox  -- ^ The box where we display messages to the user
+  | Prompt      -- ^ The game's prompt
+  | Panel Panel -- ^ A panel in the game
+  deriving stock (Show, Eq, Ord, Generic)
+  deriving anyclass (NFData, CoArbitrary, Function, ToJSON, FromJSON)
+  deriving Arbitrary via GenericArbitrary Name
diff --git a/src/Xanthous/messages.yaml b/src/Xanthous/messages.yaml
index 1c5692ddfec0..40a37cf59b1a 100644
--- a/src/Xanthous/messages.yaml
+++ b/src/Xanthous/messages.yaml
@@ -5,6 +5,9 @@ dead:
   - You perish...
   - You have perished...
 
+generic:
+  continue: Press enter to continue...
+
 save:
   location:
     "Enter filename to save to: "
@@ -61,4 +64,4 @@ read:
   result: "\"{{message}}\""
 
 tutorial:
-  message1: The caves are dark and full of nightmarish creatures - and you are likely to perish without food. Seek out sustenance, and pick it up with ,
+  message1: The caves are dark and full of nightmarish creatures - and you are likely to perish without food. Seek out sustenance! You can pick items up with ,.
generated by cgit-pink 1.4.1 (git 2.44.2) at 2024-11-04T11·29+0000