From 0abcd8c9581f0017cb2bd59a09e93800ea8f3b1f Mon Sep 17 00:00:00 2001
From: Griffin Smith <root@gws.fyi>
Date: Fri, 29 Nov 2019 15:43:46 -0500
Subject: 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.
---
 src/Xanthous/Game/Draw.hs | 16 +++++++++++++---
 1 file changed, 13 insertions(+), 3 deletions(-)

(limited to 'src/Xanthous/Game/Draw.hs')

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)
-- 
cgit 1.4.1