Add doors and an open command

Add a Door entity and an Open command, which necessitated supporting the
direction prompt. Currently nothing actually puts doors on the map,
which puts a slight damper on actually testing this out.

4 files changed, 56 insertions, 4 deletions

diff --git a/src/Xanthous/Entities/Arbitrary.hs b/src/Xanthous/Entities/Arbitrary.hs
index 480282cff6a2..2d1890f787a3 100644
--- a/src/Xanthous/Entities/Arbitrary.hs
+++ b/src/Xanthous/Entities/Arbitrary.hs
@@ -9,11 +9,16 @@ import qualified Test.QuickCheck.Gen as Gen
 --------------------------------------------------------------------------------
 import           Xanthous.Entities (SomeEntity(..))
 import           Xanthous.Entities.Character
+import           Xanthous.Entities.Item
+import           Xanthous.Entities.Creature
 import           Xanthous.Entities.Environment
 --------------------------------------------------------------------------------
 
 instance Arbitrary SomeEntity where
   arbitrary = Gen.oneof
     [ SomeEntity <$> arbitrary @Character
-    , pure $ SomeEntity Wall
+    , SomeEntity <$> arbitrary @Item
+    , SomeEntity <$> arbitrary @Creature
+    , SomeEntity <$> arbitrary @Wall
+    , SomeEntity <$> arbitrary @Door
     ]
diff --git a/src/Xanthous/Entities/Creature.hs b/src/Xanthous/Entities/Creature.hs
index 024859473f21..b59cceab4045 100644
--- a/src/Xanthous/Entities/Creature.hs
+++ b/src/Xanthous/Entities/Creature.hs
@@ -12,6 +12,7 @@ module Xanthous.Entities.Creature
 import Xanthous.Prelude
 --------------------------------------------------------------------------------
 import Data.Word
+import Test.QuickCheck.Arbitrary.Generic
 --------------------------------------------------------------------------------
 import Xanthous.Entities.RawTypes hiding (Creature)
 import Xanthous.Entities (Draw(..), Entity(..), DrawRawChar(..))
@@ -25,6 +26,9 @@ data Creature = Creature
   deriving Draw via DrawRawChar "_creatureType" Creature
 makeLenses ''Creature
 
+instance Arbitrary Creature where
+  arbitrary = genericArbitrary
+
 instance Entity Creature where
   blocksVision _ = False
 
diff --git a/src/Xanthous/Entities/Environment.hs b/src/Xanthous/Entities/Environment.hs
index 90fa05315a57..d9275266b0f4 100644
--- a/src/Xanthous/Entities/Environment.hs
+++ b/src/Xanthous/Entities/Environment.hs
@@ -1,13 +1,19 @@
+{-# LANGUAGE TemplateHaskell #-}
 module Xanthous.Entities.Environment
   ( Wall(..)
+  , Door(..)
+  , open
+  , locked
   ) where
 --------------------------------------------------------------------------------
 import Xanthous.Prelude
 import Test.QuickCheck
+import Test.QuickCheck.Arbitrary.Generic
 import Brick (str)
 import Brick.Widgets.Border.Style (unicode)
+import Brick.Types (Edges(..))
 --------------------------------------------------------------------------------
-import Xanthous.Entities (Draw(..), entityIs, Entity(..))
+import Xanthous.Entities (Draw(..), entityIs, Entity(..), SomeEntity)
 import Xanthous.Entities.Draw.Util
 import Xanthous.Data
 --------------------------------------------------------------------------------
@@ -22,8 +28,40 @@ instance Entity Wall where
 instance Arbitrary Wall where
   arbitrary = pure Wall
 
+wallEdges :: (MonoFoldable mono, Element mono ~ SomeEntity)
+          => Neighbors mono -> Edges Bool
+wallEdges neighs = any (entityIs @Wall) <$> edges neighs
+
 instance Draw Wall where
   drawWithNeighbors neighs _wall =
-    str . pure . borderFromEdges unicode $ wallEdges
+    str . pure . borderFromEdges unicode $ wallEdges neighs
+
+data Door = Door
+  { _open   :: Bool
+  , _locked :: Bool
+  }
+  deriving stock (Show, Eq, Ord, Generic)
+  deriving anyclass (NFData, CoArbitrary, Function)
+makeLenses ''Door
+
+instance Arbitrary Door where
+  arbitrary = genericArbitrary
+
+instance Draw Door where
+  drawWithNeighbors neighs door
+    | door ^. open
+    = str . pure $ case wallEdges neighs of
+        Edges True  False  False False -> vertDoor
+        Edges False True   False False -> vertDoor
+        Edges True  True   False False -> vertDoor
+        Edges False False  True  False -> horizDoor
+        Edges False False  False True  -> horizDoor
+        Edges False False  True  True  -> horizDoor
+        _                              -> '+'
+    | otherwise    = str "\\"
     where
-      wallEdges = any (entityIs @Wall) <$> edges neighs
+      horizDoor = '␣'
+      vertDoor = '['
+
+instance Entity Door where
+  blocksVision = not . view open
diff --git a/src/Xanthous/Entities/RawTypes.hs b/src/Xanthous/Entities/RawTypes.hs
index 1546d85e4562..94f650545325 100644
--- a/src/Xanthous/Entities/RawTypes.hs
+++ b/src/Xanthous/Entities/RawTypes.hs
@@ -36,7 +36,12 @@ data CreatureType = CreatureType
        via WithOptions '[ FieldLabelModifier '[Drop 1] ]
                        CreatureType
 makeFieldsNoPrefix ''CreatureType
+
+instance Arbitrary CreatureType where
+  arbitrary = genericArbitrary
+
 --------------------------------------------------------------------------------
+
 data ItemType = ItemType
   { _name :: Text
   , _description :: Text