Convert generated levels to walls

Add support for converting generated levels to walls, and merge one into
the entity map at the beginning of the game.

There's nothing here that guarantees the character ends up *inside* the
level though (they almost always don't) so that'll have to be slotted
into the level generation process.

6 files changed, 81 insertions, 39 deletions

diff --git a/src/Xanthous/Entities/Arbitrary.hs b/src/Xanthous/Entities/Arbitrary.hs
new file mode 100644
index 000000000000..9153722d9b12
--- /dev/null
+++ b/src/Xanthous/Entities/Arbitrary.hs
@@ -0,0 +1,19 @@
+{-# OPTIONS_GHC -fno-warn-orphans #-}
+--------------------------------------------------------------------------------
+module Xanthous.Entities.Arbitrary () where
+--------------------------------------------------------------------------------
+import           Xanthous.Prelude
+--------------------------------------------------------------------------------
+import           Test.QuickCheck
+import qualified Test.QuickCheck.Gen as Gen
+--------------------------------------------------------------------------------
+import           Xanthous.Entities (SomeEntity(..))
+import           Xanthous.Entities.Character
+import           Xanthous.Entities.Environment
+--------------------------------------------------------------------------------
+
+instance Arbitrary SomeEntity where
+  arbitrary = Gen.oneof
+    [ pure $ SomeEntity Character
+    , pure $ SomeEntity Wall
+    ]
diff --git a/src/Xanthous/Entities/Character.hs b/src/Xanthous/Entities/Character.hs
index 5cf397e82232..faa9964a3833 100644
--- a/src/Xanthous/Entities/Character.hs
+++ b/src/Xanthous/Entities/Character.hs
@@ -2,14 +2,14 @@ module Xanthous.Entities.Character
   ( Character(..)
   , mkCharacter
   ) where
-
+--------------------------------------------------------------------------------
 import Xanthous.Prelude
 import Test.QuickCheck
-
+--------------------------------------------------------------------------------
 import Xanthous.Entities
+--------------------------------------------------------------------------------
 
-data Character where
-  Character :: Character
+data Character = Character
   deriving stock (Show, Eq, Ord, Generic)
   deriving anyclass (CoArbitrary, Function)
   deriving Draw via (DrawCharacter "@" Character)
diff --git a/src/Xanthous/Entities/Draw/Util.hs b/src/Xanthous/Entities/Draw/Util.hs
new file mode 100644
index 000000000000..aa6c5fa4fc47
--- /dev/null
+++ b/src/Xanthous/Entities/Draw/Util.hs
@@ -0,0 +1,31 @@
+module Xanthous.Entities.Draw.Util where
+--------------------------------------------------------------------------------
+import Xanthous.Prelude
+--------------------------------------------------------------------------------
+import Brick.Widgets.Border.Style
+import Brick.Types (Edges(..))
+--------------------------------------------------------------------------------
+
+borderFromEdges :: BorderStyle -> Edges Bool -> Char
+borderFromEdges bstyle edges = ($ bstyle) $ case edges of
+  Edges False False  False False -> const '☐'
+
+  Edges True  False  False False -> bsVertical
+  Edges False True   False False -> bsVertical
+  Edges False False  True  False -> bsHorizontal
+  Edges False False  False True  -> bsHorizontal
+
+  Edges True  True   False False -> bsVertical
+  Edges True  False  True  False -> bsCornerBR
+  Edges True  False  False True  -> bsCornerBL
+
+  Edges False True   True  False -> bsCornerTR
+  Edges False True   False True  -> bsCornerTL
+  Edges False False  True  True  -> bsHorizontal
+
+  Edges False True   True  True  -> bsIntersectT
+  Edges True  False  True  True  -> bsIntersectB
+  Edges True  True   False True  -> bsIntersectL
+  Edges True  True   True  False -> bsIntersectR
+
+  Edges True  True   True  True  -> bsIntersectFull
diff --git a/src/Xanthous/Entities/Environment.hs b/src/Xanthous/Entities/Environment.hs
new file mode 100644
index 000000000000..f5301f94adf2
--- /dev/null
+++ b/src/Xanthous/Entities/Environment.hs
@@ -0,0 +1,26 @@
+module Xanthous.Entities.Environment
+  ( Wall(..)
+  ) where
+--------------------------------------------------------------------------------
+import Xanthous.Prelude
+import Test.QuickCheck
+import Brick (str)
+import Brick.Widgets.Border.Style (unicode)
+--------------------------------------------------------------------------------
+import Xanthous.Entities (Draw(..), entityIs)
+import Xanthous.Entities.Draw.Util
+import Xanthous.Data
+--------------------------------------------------------------------------------
+
+data Wall = Wall
+  deriving stock (Show, Eq, Ord, Generic, Enum)
+  deriving anyclass (CoArbitrary, Function)
+
+instance Arbitrary Wall where
+  arbitrary = pure Wall
+
+instance Draw Wall where
+  drawWithNeighbors neighs _wall =
+    str . pure . borderFromEdges unicode $ wallEdges
+    where
+      wallEdges = any (entityIs @Wall) <$> edges neighs
diff --git a/src/Xanthous/Entities/RawTypes.hs b/src/Xanthous/Entities/RawTypes.hs
index e82cb0c890c7..88087a5dab61 100644
--- a/src/Xanthous/Entities/RawTypes.hs
+++ b/src/Xanthous/Entities/RawTypes.hs
@@ -20,7 +20,7 @@ import Data.Aeson.Generic.DerivingVia
 import Data.Aeson (FromJSON)
 import Data.Word
 
-import Xanthous.Data
+import Xanthous.Entities (EntityChar)
 
 data CreatureType = CreatureType
   { _name :: Text
diff --git a/src/Xanthous/Entities/SomeEntity.hs b/src/Xanthous/Entities/SomeEntity.hs
deleted file mode 100644
index 029247de9b7f..000000000000
--- a/src/Xanthous/Entities/SomeEntity.hs
+++ /dev/null
@@ -1,34 +0,0 @@
-{-# LANGUAGE GADTs #-}
-module Xanthous.Entities.SomeEntity
-  ( SomeEntity(..)
-  , downcastEntity
-  ) where
-
-import Xanthous.Prelude
-import Test.QuickCheck (Arbitrary(..))
-import qualified Test.QuickCheck.Gen as Gen
-
-import Xanthous.Entities (Draw(..), Entity)
-import Data.Typeable
-import Xanthous.Entities.Character
-
-data SomeEntity where
-  SomeEntity :: forall a. (Entity a, Typeable a) => a -> SomeEntity
-
-instance Show SomeEntity where
-  show (SomeEntity x) = "SomeEntity (" <> show x <> ")"
-
-instance Eq SomeEntity where
-  (SomeEntity (a :: ea)) == (SomeEntity (b :: eb)) = case eqT @ea @eb of
-    Just Refl -> a == b
-    _ -> False
-
-instance Arbitrary SomeEntity where
-  arbitrary = Gen.oneof
-    [pure $ SomeEntity Character]
-
-instance Draw SomeEntity where
-  draw (SomeEntity ent) = draw ent
-
-downcastEntity :: (Entity a, Typeable a) => SomeEntity -> Maybe a
-downcastEntity (SomeEntity e) = cast e