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:
parent
6678ac986c
commit
58fce2ec19
17 changed files with 454 additions and 52 deletions
|
|
@ -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
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue