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.
This commit is contained in:
Griffin Smith 2019-09-15 13:00:28 -04:00
parent 6678ac986c
commit 58fce2ec19
17 changed files with 454 additions and 52 deletions

View file

@ -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