{-# 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