Gormlaks attack back

When gormlaks see the character, they step towards them and attack
dealing 1 damage when adjacent. Characters have hitpoints now, displayed
at the bottom of the game screen, and when the game is over they die.

2 files changed, 26 insertions, 2 deletions

diff --git a/src/Xanthous/Game/Draw.hs b/src/Xanthous/Game/Draw.hs
index b3e27f86a693..e1242f2b7a2d 100644
--- a/src/Xanthous/Game/Draw.hs
+++ b/src/Xanthous/Game/Draw.hs
@@ -14,11 +14,13 @@ import           Xanthous.Data (Position(Position), x, y, loc)
 import           Xanthous.Data.EntityMap (EntityMap, atPosition)
 import qualified Xanthous.Data.EntityMap as EntityMap
 import           Xanthous.Entities
+import           Xanthous.Entities.Character
 import           Xanthous.Game
                  ( GameState(..)
                  , entities
                  , revealedPositions
                  , characterPosition
+                 , character
                  , MessageHistory(..)
                  , messageHistory
                  , GamePromptState(..)
@@ -42,8 +44,8 @@ drawPromptState (WaitingPrompt msg (Prompt _ pt ps _)) =
   case (pt, ps) of
     (SStringPrompt, StringPromptState edit) ->
       txt msg <+> renderEditor (txt . fold) True edit
-    (SDirectionPrompt, DirectionPromptState) ->
-      txt msg
+    (SDirectionPrompt, DirectionPromptState) -> txt msg
+    (SContinue, _) -> txt msg
     _ -> undefined
 
 drawEntities
@@ -79,6 +81,17 @@ drawMap game
     -- character can't see them
     (game ^. entities)
 
+drawCharacterInfo :: Character -> Widget Name
+drawCharacterInfo ch = txt " " <+> charName <+> charHitpoints
+  where
+    charName | Just n <- ch ^. characterName
+             = txt n <+> txt " "
+             | otherwise
+             = emptyWidget
+    charHitpoints
+        = txt "Hitpoints: "
+      <+> txt (tshow $ ch ^. characterHitpoints)
+
 drawGame :: GameState -> [Widget Name]
 drawGame game
   = pure
@@ -86,3 +99,4 @@ drawGame game
   $   drawMessages (game ^. messageHistory)
   <=> drawPromptState (game ^. promptState)
   <=> border (drawMap game)
+  <=> drawCharacterInfo (game ^. character)
diff --git a/src/Xanthous/Game/Prompt.hs b/src/Xanthous/Game/Prompt.hs
index f0df1385f79d..cb34793c6d60 100644
--- a/src/Xanthous/Game/Prompt.hs
+++ b/src/Xanthous/Game/Prompt.hs
@@ -31,6 +31,7 @@ data PromptType where
   Menu            :: Type -> PromptType
   DirectionPrompt :: PromptType
   PointOnMap      :: PromptType
+  Continue        :: PromptType
   deriving stock (Generic)
 
 instance Show PromptType where
@@ -39,6 +40,7 @@ instance Show PromptType where
   show (Menu _) = "Menu"
   show DirectionPrompt = "DirectionPrompt"
   show PointOnMap = "PointOnMap"
+  show Continue = "Continue"
 
 data SPromptType :: PromptType -> Type where
   SStringPrompt    ::      SPromptType 'StringPrompt
@@ -46,10 +48,12 @@ data SPromptType :: PromptType -> Type where
   SMenu            :: forall a. SPromptType ('Menu a)
   SDirectionPrompt ::      SPromptType 'DirectionPrompt
   SPointOnMap      ::      SPromptType 'PointOnMap
+  SContinue        ::      SPromptType 'Continue
 
 class SingPromptType pt where singPromptType :: SPromptType pt
 instance SingPromptType 'StringPrompt where singPromptType = SStringPrompt
 instance SingPromptType 'DirectionPrompt where singPromptType = SDirectionPrompt
+instance SingPromptType 'Continue where singPromptType = SContinue
 
 instance Show (SPromptType pt) where
   show SStringPrompt    = "SStringPrompt"
@@ -57,6 +61,7 @@ instance Show (SPromptType pt) where
   show SMenu            = "SMenu"
   show SDirectionPrompt = "SDirectionPrompt"
   show SPointOnMap      = "SPointOnMap"
+  show SContinue        = "SContinue"
 
 data PromptCancellable
   = Cancellable
@@ -73,10 +78,12 @@ data PromptResult (pt :: PromptType) where
   MenuResult       :: forall a. a    -> PromptResult ('Menu a)
   DirectionResult  :: Direction -> PromptResult 'DirectionPrompt
   PointOnMapResult :: Position  -> PromptResult 'PointOnMap
+  ContinueResult   ::             PromptResult 'Continue
 
 data PromptState pt where
   StringPromptState :: Editor Text Name -> PromptState 'StringPrompt
   DirectionPromptState :: PromptState 'DirectionPrompt
+  ContinuePromptState :: PromptState 'Continue
 
 deriving stock instance Show (PromptState pt)
 
@@ -103,6 +110,7 @@ mkPrompt c pt@SStringPrompt cb =
   let ps = StringPromptState $ editorText Resource.Prompt (Just 1) ""
   in Prompt c pt ps cb
 mkPrompt c pt@SDirectionPrompt cb = Prompt c pt DirectionPromptState cb
+mkPrompt c pt@SContinue cb = Prompt c pt ContinuePromptState cb
 mkPrompt _ _ _ = undefined
 
 isCancellable :: Prompt m -> Bool
@@ -116,6 +124,8 @@ submitPrompt (Prompt _ pt ps cb) =
       cb . StringResult . mconcat . getEditContents $ edit
     (SDirectionPrompt, DirectionPromptState) ->
       pure () -- Don't use submit with a direction prompt
+    (SContinue, ContinuePromptState) ->
+      cb ContinueResult -- Don't use submit with a direction prompt
     _ -> undefined
 
 -- data PromptInput :: PromptType -> Type where