about summary refs log tree commit diff
path: root/src/Xanthous/Game.hs
diff options
context:
space:
mode:
authorGriffin Smith <root@gws.fyi>2019-08-31T17·17-0400
committerGriffin Smith <root@gws.fyi>2019-08-31T17·18-0400
commit4ef19aa35a6d63a8d9f7b6a7a11ac82c2a525783 (patch)
tree00a0109cca42bbdda93fa117142d381501c1bf00 /src/Xanthous/Game.hs
parent6eba471e2426e7e4e7d5c935e3ce973e13fd6b24 (diff)
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.
Diffstat (limited to 'src/Xanthous/Game.hs')
-rw-r--r--src/Xanthous/Game.hs67
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