Add a close command

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

1 files changed, 17 insertions, 1 deletions

diff --git a/src/Xanthous/App.hs b/src/Xanthous/App.hs
index 1c2fbf86f3..0d4f973d71 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) ->