1 files changed, 72 insertions, 0 deletions
diff --git a/src/Xanthous/Game/Lenses.hs b/src/Xanthous/Game/Lenses.hs
new file mode 100644
index 000000000000..91ff5c137d1a
--- /dev/null
+++ b/src/Xanthous/Game/Lenses.hs
@@ -0,0 +1,72 @@
+{-# LANGUAGE RecordWildCards #-}
+--------------------------------------------------------------------------------
+module Xanthous.Game.Lenses
+  ( positionedCharacter
+  , character
+  , characterPosition
+  , updateCharacterVision
+  , getInitialState
+  ) where
+--------------------------------------------------------------------------------
+import           Xanthous.Prelude
+--------------------------------------------------------------------------------
+import           System.Random
+--------------------------------------------------------------------------------
+import           Xanthous.Game.State
+import           Xanthous.Data
+import qualified Xanthous.Data.EntityMap as EntityMap
+import           Xanthous.Data.EntityMap.Graphics (visiblePositions)
+import           Xanthous.Entities.Character (Character, mkCharacter)
+--------------------------------------------------------------------------------
+
+getInitialState :: IO GameState
+getInitialState = do
+  _randomGen <- getStdGen
+  let char = mkCharacter
+      (_characterEntityID, _entities)
+        = EntityMap.insertAtReturningID
+          (Position 0 0)
+          (SomeEntity char)
+          mempty
+      _messageHistory = NoMessageHistory
+      _revealedPositions = mempty
+      _promptState = NoPrompt
+  pure 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
+
+characterPosition :: Lens' GameState Position
+characterPosition = positionedCharacter . position
+
+visionRadius :: Word
+visionRadius = 12 -- TODO make this dynamic
+
+-- | Update the revealed entities at the character's position based on their vision
+updateCharacterVision :: GameState -> GameState
+updateCharacterVision game =
+  let charPos = game ^. characterPosition
+      visible = visiblePositions charPos visionRadius $ game ^. entities
+  in game & revealedPositions <>~ visible