From 58fce2ec1976b957c7e24a282964c62f7ddf7b02 Mon Sep 17 00:00:00 2001
From: Griffin Smith <root@gws.fyi>
Date: Sun, 15 Sep 2019 13:00:28 -0400
Subject: Progressively reveal the map to the player

As the character walks around the map, progressively reveal the entities
on the map to them, using an algorithm based on well known
circle-rasterizing and line-rasterizing algorithms to calculate lines of
sight that are potentially obscured by walls.
---
 src/Xanthous/Game.hs | 35 ++++++++++++++++++++++++++++++-----
 1 file changed, 30 insertions(+), 5 deletions(-)

(limited to 'src/Xanthous/Game.hs')

diff --git a/src/Xanthous/Game.hs b/src/Xanthous/Game.hs
index 6a4689610689..ed65217e627b 100644
--- a/src/Xanthous/Game.hs
+++ b/src/Xanthous/Game.hs
@@ -1,10 +1,11 @@
-{-# LANGUAGE MultiWayIf #-}
+{-# LANGUAGE MultiWayIf      #-}
 {-# LANGUAGE TemplateHaskell #-}
 {-# LANGUAGE RecordWildCards #-}
 --------------------------------------------------------------------------------
 module Xanthous.Game
   ( GameState(..)
   , entities
+  , revealedEntities
   , messageHistory
   , randomGen
 
@@ -13,6 +14,7 @@ module Xanthous.Game
   , positionedCharacter
   , character
   , characterPosition
+  , updateCharacterVision
 
   , MessageHistory(..)
   , pushMessage
@@ -33,8 +35,10 @@ import           Test.QuickCheck
 import           Test.QuickCheck.Arbitrary.Generic
 import           Control.Monad.State.Class
 --------------------------------------------------------------------------------
+import           Xanthous.Util (appendVia)
 import           Xanthous.Data.EntityMap (EntityMap, EntityID)
 import qualified Xanthous.Data.EntityMap as EntityMap
+import           Xanthous.Data.EntityMap.Graphics
 import           Xanthous.Data (Positioned, Position(..), positioned, position)
 import           Xanthous.Entities (SomeEntity(..), downcastEntity, entityIs)
 import           Xanthous.Entities.Character
@@ -68,6 +72,8 @@ hideMessage (MessageHistory msgs _) = MessageHistory msgs False
 
 data GameState = GameState
   { _entities          :: EntityMap SomeEntity
+    -- | A subset of the overall set of entities
+  , _revealedEntities  :: EntityMap SomeEntity
   , _characterEntityID :: EntityID
   , _messageHistory    :: MessageHistory
   , _randomGen         :: StdGen
@@ -76,10 +82,12 @@ data GameState = GameState
 makeLenses ''GameState
 
 instance Eq GameState where
-  (GameState es₁ ceid₁ mh₁ _) == (GameState es₂ ceid₂ mh₂ _)
-    = es₁ == es₂
-    && ceid₁ == ceid₂
-    && mh₁ == mh₂
+  (==) = (==) `on` \gs ->
+    ( gs ^. entities
+    , gs ^. revealedEntities
+    , gs ^. characterEntityID
+    , gs ^. messageHistory
+    )
 
 instance Arbitrary GameState where
   arbitrary = do
@@ -88,6 +96,11 @@ instance Arbitrary GameState where
     _messageHistory <- arbitrary
     (_characterEntityID, _entities) <- arbitrary <&>
       EntityMap.insertAtReturningID charPos (SomeEntity char)
+    revealedPositions <- sublistOf $ EntityMap.positions _entities
+    let _revealedEntities = mempty &~ do
+          for_ revealedPositions $ \pos -> do
+            let ents = _entities ^. EntityMap.atPosition pos
+            EntityMap.atPosition pos <>= ents
     _randomGen <- mkStdGen <$> arbitrary
     pure $ GameState {..}
 
@@ -101,6 +114,7 @@ getInitialState = do
           (SomeEntity char)
           mempty
       _messageHistory = NoMessageHistory
+      _revealedEntities = _entities
   pure GameState {..}
 
 positionedCharacter :: Lens' GameState (Positioned Character)
@@ -130,6 +144,17 @@ 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 = visibleEntities charPos visionRadius $ game ^. entities
+  in game & revealedEntities %~ appendVia EntityMap.Deduplicate visible
+
+
 --------------------------------------------------------------------------------
 
 data Collision
-- 
cgit 1.4.1