Add a close command

Add a close command, to close doors, that works basically the same as
the open command.

4 files changed, 33 insertions, 2 deletions

diff --git a/src/Xanthous/App.hs b/src/Xanthous/App.hs
index 1c2fbf86f3b8..0d4f973d7120 100644
--- a/src/Xanthous/App.hs
+++ b/src/Xanthous/App.hs
@@ -52,7 +52,7 @@ import qualified Xanthous.Entities.Item as Item
 import           Xanthous.Entities.Creature (Creature)
 import qualified Xanthous.Entities.Creature as Creature
 import           Xanthous.Entities.Environment
-                 (Door, open, locked, GroundMessage(..), Staircase(..))
+                 (Door, open, closed, locked, GroundMessage(..), Staircase(..))
 import           Xanthous.Entities.RawTypes
                  ( edible, eatMessage, hitpointsHealed
                  , attackMessage
@@ -182,6 +182,7 @@ handleCommand Open = do
       doors <- uses entities $ entitiesAtPositionWithType @Door pos
       if | null doors -> say_ ["open", "nothingToOpen"]
          | any (view $ _2 . locked) doors -> say_ ["open", "locked"]
+         | all (view $ _2 . open) doors   -> say_ ["open", "alreadyOpen"]
          | otherwise -> do
              for_ doors $ \(eid, _) ->
                entities . ix eid . positioned . _SomeEntity . open .= True
@@ -190,6 +191,21 @@ handleCommand Open = do
   stepGame -- TODO
   continue
 
+handleCommand Close = do
+  prompt_ @'DirectionPrompt ["close", "prompt"] Cancellable
+    $ \(DirectionResult dir) -> do
+      pos <- move dir <$> use characterPosition
+      doors <- uses entities $ entitiesAtPositionWithType @Door pos
+      if | null doors -> say_ ["close", "nothingToClose"]
+         | all (view $ _2 . closed) doors -> say_ ["close", "alreadyClosed"]
+         | otherwise -> do
+             for_ doors $ \(eid, _) ->
+               entities . ix eid . positioned . _SomeEntity . closed .= True
+             say_ ["close", "success"]
+      pure ()
+  stepGame -- TODO
+  continue
+
 handleCommand Look = do
   prompt_ @'PointOnMap ["look", "prompt"] Cancellable
     $ \(PointOnMapResult pos) ->
diff --git a/src/Xanthous/Command.hs b/src/Xanthous/Command.hs
index 7db694575e49..e12feaebd0bc 100644
--- a/src/Xanthous/Command.hs
+++ b/src/Xanthous/Command.hs
@@ -16,6 +16,7 @@ data Command
   | PickUp
   | Drop
   | Open
+  | Close
   | Wait
   | Eat
   | Look
@@ -37,6 +38,7 @@ commandFromKey (KChar 'p') [MCtrl] = Just PreviousMessage
 commandFromKey (KChar ',') [] = Just PickUp
 commandFromKey (KChar 'd') [] = Just Drop
 commandFromKey (KChar 'o') [] = Just Open
+commandFromKey (KChar 'c') [] = Just Close
 commandFromKey (KChar ';') [] = Just Look
 commandFromKey (KChar 'e') [] = Just Eat
 commandFromKey (KChar 'S') [] = Just Save
diff --git a/src/Xanthous/Entities/Environment.hs b/src/Xanthous/Entities/Environment.hs
index 993714c844c5..430ce1b7a99e 100644
--- a/src/Xanthous/Entities/Environment.hs
+++ b/src/Xanthous/Entities/Environment.hs
@@ -7,6 +7,7 @@ module Xanthous.Entities.Environment
     -- * Doors
   , Door(..)
   , open
+  , closed
   , locked
   , unlockedDoor
 
@@ -99,6 +100,9 @@ instance Entity Door where
   entityCollision door | door ^. open = Nothing
                        | otherwise = Just Stop
 
+closed :: Lens' Door Bool
+closed = open . involuted not
+
 -- | A closed, unlocked door
 unlockedDoor :: Door
 unlockedDoor = Door
diff --git a/src/Xanthous/messages.yaml b/src/Xanthous/messages.yaml
index 23cc102f5ef5..4efcc8dbc324 100644
--- a/src/Xanthous/messages.yaml
+++ b/src/Xanthous/messages.yaml
@@ -35,7 +35,16 @@ open:
   prompt: Direction to open (hjklybnu.)?
   success: "You open the door."
   locked: "That door is locked"
-  nothingToOpen: "There's nothing to open there"
+  nothingToOpen: "There's nothing to open there."
+  alreadyOpen: "That door is already open."
+
+close:
+  prompt: Direction to close (hjklybnu.)?
+  success:
+    - You close the door.
+    - You shut the door.
+  nothingToClose: "There's nothing to close there."
+  alreadyClosed: "That door is already closed."
 
 look:
   prompt: Select a position on the map to describe (use Enter to confirm)