Place doors on the level

Pick a random subset of cells on the level that have a wall on two
opposite sides and are clear on the other two sides, and place closed,
unlocked doors on those cells.

1 files changed, 19 insertions, 1 deletions

diff --git a/src/Xanthous/Generators.hs b/src/Xanthous/Generators.hs
index 592bf73c0007..8c0372ed538c 100644
--- a/src/Xanthous/Generators.hs
+++ b/src/Xanthous/Generators.hs
@@ -13,9 +13,11 @@ module Xanthous.Generators
   , levelWalls
   , levelItems
   , levelCreatures
+  , levelDoors
   , levelCharacterPosition
   , levelTutorialMessage
   , generateLevel
+  , levelToEntityMap
   ) where
 --------------------------------------------------------------------------------
 import           Xanthous.Prelude hiding (Level)
@@ -34,6 +36,7 @@ import qualified Xanthous.Data.EntityMap as EntityMap
 import           Xanthous.Entities.Environment
 import           Xanthous.Entities.Item (Item)
 import           Xanthous.Entities.Creature (Creature)
+import           Xanthous.Game.State (SomeEntity(..))
 --------------------------------------------------------------------------------
 
 data Generator
@@ -109,6 +112,7 @@ cellsToWalls cells = foldl' maybeInsertWall mempty . assocs $ cells
 
 data Level = Level
   { _levelWalls             :: !(EntityMap Wall)
+  , _levelDoors             :: !(EntityMap Door)
   , _levelItems             :: !(EntityMap Item)
   , _levelCreatures         :: !(EntityMap Creature)
   , _levelTutorialMessage   :: !(EntityMap GroundMessage)
@@ -116,13 +120,27 @@ data Level = Level
   }
 makeLenses ''Level
 
-generateLevel :: MonadRandom m => SGenerator gen -> Params gen -> Dimensions -> m Level
+generateLevel
+  :: MonadRandom m
+  => SGenerator gen
+  -> Params gen
+  -> Dimensions
+  -> m Level
 generateLevel gen ps dims = do
   rand <- mkStdGen <$> getRandom
   let cells = generate gen ps dims rand
       _levelWalls = cellsToWalls cells
   _levelItems <- randomItems cells
   _levelCreatures <- randomCreatures cells
+  _levelDoors <- randomDoors cells
   _levelCharacterPosition <- chooseCharacterPosition cells
   _levelTutorialMessage <- tutorialMessage cells _levelCharacterPosition
   pure Level {..}
+
+levelToEntityMap :: Level -> EntityMap SomeEntity
+levelToEntityMap level
+  = (SomeEntity <$> level ^. levelWalls)
+  <> (SomeEntity <$> level ^. levelDoors)
+  <> (SomeEntity <$> level ^. levelItems)
+  <> (SomeEntity <$> level ^. levelCreatures)
+  <> (SomeEntity <$> level ^. levelTutorialMessage)