about summary refs log tree commit diff
path: root/src/Xanthous/Game/State.hs
diff options
context:
space:
mode:
authorGriffin Smith <root@gws.fyi>2020-01-05T04·48-0500
committerGriffin Smith <root@gws.fyi>2020-01-05T04·48-0500
commit6b0bab0e85266ce66836c4584f8cc83b307a3af5 (patch)
treecfb4dbe4c370c3f20277336e6be75171c572137a /src/Xanthous/Game/State.hs
parente669b54f0c9be84dd1e4704ccae4b8169f7458a5 (diff)
Add support for multiple levels
Add a data structure, based on the zipper comonad, which provides
support for multiple levels, each of which is its own entity map. The
current level is provided by coreturn, which the `entities` lens has
been updated to use. Nothing currently supports going up or down levels
yet - that's coming next.
Diffstat (limited to 'src/Xanthous/Game/State.hs')
-rw-r--r--src/Xanthous/Game/State.hs12
1 files changed, 8 insertions, 4 deletions
diff --git a/src/Xanthous/Game/State.hs b/src/Xanthous/Game/State.hs
index 171f381e6b74..7587618c968b 100644
--- a/src/Xanthous/Game/State.hs
+++ b/src/Xanthous/Game/State.hs
@@ -58,7 +58,7 @@ module Xanthous.Game.State
   , allRevealed
   ) where
 --------------------------------------------------------------------------------
-import           Xanthous.Prelude
+import           Xanthous.Prelude hiding (levels)
 --------------------------------------------------------------------------------
 import           Data.List.NonEmpty ( NonEmpty((:|)))
 import qualified Data.List.NonEmpty as NonEmpty
@@ -80,6 +80,7 @@ import qualified Graphics.Vty.Image as Vty
 --------------------------------------------------------------------------------
 import           Xanthous.Util (KnownBool(..))
 import           Xanthous.Data
+import           Xanthous.Data.Levels
 import           Xanthous.Data.EntityMap (EntityMap, EntityID)
 import           Xanthous.Data.EntityChar
 import           Xanthous.Data.VectorBag
@@ -359,8 +360,8 @@ instance Draw SomeEntity where
   drawPriority (SomeEntity ent) = drawPriority ent
 
 instance Brain SomeEntity where
-  step ticks (Positioned pos (SomeEntity ent)) =
-    fmap SomeEntity <$> step ticks (Positioned pos ent)
+  step ticks (Positioned p (SomeEntity ent)) =
+    fmap SomeEntity <$> step ticks (Positioned p ent)
 
 downcastEntity :: forall (a :: Type). (Typeable a) => SomeEntity -> Maybe a
 downcastEntity (SomeEntity e) = cast e
@@ -413,7 +414,7 @@ instance Arbitrary DebugState where
   arbitrary = genericArbitrary
 
 data GameState = GameState
-  { _entities          :: !(EntityMap SomeEntity)
+  { _levels            :: !(Levels (EntityMap SomeEntity))
   , _revealedPositions :: !(Set Position)
   , _characterEntityID :: !EntityID
   , _messageHistory    :: !MessageHistory
@@ -433,6 +434,9 @@ data GameState = GameState
            GameState
 makeLenses ''GameState
 
+entities :: Lens' GameState (EntityMap SomeEntity)
+entities = levels . current
+
 instance Eq GameState where
   (==) = (==) `on` \gs ->
     ( gs ^. entities