about summary refs log tree commit diff
path: root/src/Xanthous/Game/Draw.hs
diff options
context:
space:
mode:
authorGriffin Smith <root@gws.fyi>2019-11-29T20·43-0500
committerGriffin Smith <root@gws.fyi>2019-11-30T02·25-0500
commit0abcd8c9581f0017cb2bd59a09e93800ea8f3b1f (patch)
tree0dab0269ec6c08df6eef8f124aca2f8076c9e040 /src/Xanthous/Game/Draw.hs
parentf37d0f75c0b4a77c8e35192c24c6fdb6f2bc4619 (diff)
Implement a "look" command
Implement the PointOnMap prompt type, which allows the player to move
the cursor around and select a position on the map, and use this prompt
type to implement a "look" command, describing all entities at the
selected position.
Diffstat (limited to 'src/Xanthous/Game/Draw.hs')
-rw-r--r--src/Xanthous/Game/Draw.hs16
1 files changed, 13 insertions, 3 deletions
diff --git a/src/Xanthous/Game/Draw.hs b/src/Xanthous/Game/Draw.hs
index ffbf30cca864..2f7ccf29f795 100644
--- a/src/Xanthous/Game/Draw.hs
+++ b/src/Xanthous/Game/Draw.hs
@@ -32,6 +32,14 @@ import qualified Xanthous.Resource as Resource
 import           Xanthous.Orphans ()
 --------------------------------------------------------------------------------
 
+cursorPosition :: GameState -> Widget Name -> Widget Name
+cursorPosition game
+  | WaitingPrompt _ (Prompt _ SPointOnMap (PointOnMapPromptState pos) _ _)
+    <- game ^. promptState
+  = showCursor Resource.Prompt (pos ^. loc)
+  | otherwise
+  = showCursor Resource.Character (game ^. characterPosition . loc)
+
 drawMessages :: MessageHistory -> Widget Name
 drawMessages = txt . (<> " ") . unwords . oextract
 
@@ -46,7 +54,7 @@ drawPromptState (WaitingPrompt msg (Prompt _ pt ps pri _)) =
     (SMenu, _, menuItems) ->
       txt msg
       <=> foldl' (<=>) emptyWidget (map drawMenuItem $ itoList menuItems)
-    _ -> undefined
+    _ -> txt msg
   where
     drawMenuItem (chr, MenuOption m _) =
       str ("[" <> pure chr <> "] ") <+> txt m
@@ -77,7 +85,7 @@ drawEntities canRenderPos allEnts
 drawMap :: GameState -> Widget Name
 drawMap game
   = viewport Resource.MapViewport Both
-  . showCursor Resource.Character (game ^. characterPosition . loc)
+  . cursorPosition game
   $ drawEntities
     (\pos ->
          (game ^. debugState . allRevealed)
@@ -102,7 +110,9 @@ drawGame :: GameState -> [Widget Name]
 drawGame game
   = pure
   . withBorderStyle unicode
-  $   drawMessages (game ^. messageHistory)
+  $ case game ^. promptState of
+       NoPrompt -> drawMessages (game ^. messageHistory)
+       _ -> emptyWidget
   <=> drawPromptState (game ^. promptState)
   <=> border (drawMap game)
   <=> drawCharacterInfo (game ^. character)