Add entities, and allow walking around

Add support for entities via a port of the EntityMap type, and implement
command support starting at basic hjkl.

1 files changed, 64 insertions, 3 deletions

diff --git a/src/Xanthous/Game.hs b/src/Xanthous/Game.hs
index c88509819cbb..3ca00afbbda1 100644
--- a/src/Xanthous/Game.hs
+++ b/src/Xanthous/Game.hs
@@ -1,12 +1,73 @@
+{-# LANGUAGE TemplateHaskell #-}
+{-# LANGUAGE RecordWildCards #-}
 module Xanthous.Game
   ( GameState(..)
+  , entities
   , getInitialState
+
+  , positionedCharacter
+  , character
+  , characterPosition
   ) where
 
 import Xanthous.Prelude
+import Test.QuickCheck.Arbitrary
+
+import Xanthous.Data.EntityMap (EntityMap, EntityID)
+import qualified Xanthous.Data.EntityMap as EntityMap
+import Xanthous.Data (Positioned, Position(..), positioned, position)
+import Xanthous.Entities
+import Xanthous.Entities.SomeEntity
+import Xanthous.Entities.Character
 
 data GameState = GameState
-  { }
+  { _entities          :: EntityMap SomeEntity
+  , _characterEntityID :: EntityID
+  }
+  deriving stock (Show, Eq)
+makeLenses ''GameState
+
+instance Arbitrary GameState where
+  arbitrary = do
+    ents <- arbitrary
+    char <- arbitrary
+    pure $ getInitialState
+      & entities .~ ents
+      & positionedCharacter .~ char
+
+getInitialState :: GameState
+getInitialState =
+  let char = mkCharacter
+      (_characterEntityID, _entities)
+        = EntityMap.insertAtReturningID
+          (Position 0 0)
+          (SomeEntity char)
+          mempty
+  in GameState {..}
+
+positionedCharacter :: Lens' GameState (Positioned Character)
+positionedCharacter = lens getPositionedCharacter setPositionedCharacter
+  where
+    setPositionedCharacter :: GameState -> Positioned Character -> GameState
+    setPositionedCharacter game char
+      = game
+      &  entities . at (game ^. characterEntityID)
+      ?~ fmap SomeEntity char
+
+    getPositionedCharacter :: GameState -> Positioned Character
+    getPositionedCharacter game
+      = over positioned
+        ( fromMaybe (error "Invariant error: Character was not a character!")
+        . downcastEntity
+        )
+      . fromMaybe (error "Invariant error: Character not found!")
+      $ EntityMap.lookupWithPosition
+        (game ^. characterEntityID)
+        (game ^. entities)
+
+
+character :: Lens' GameState Character
+character = positionedCharacter . positioned
 
-getInitialState :: IO GameState
-getInitialState = pure GameState
+characterPosition :: Lens' GameState Position
+characterPosition = positionedCharacter . position