diff options
author | Griffin Smith <root@gws.fyi> | 2019-09-28T17·20-0400 |
---|---|---|
committer | Griffin Smith <root@gws.fyi> | 2019-09-28T19·03-0400 |
commit | 1a0f618a829ec356e29176c77ea90a8a5a0157b4 (patch) | |
tree | 90d255974b482f6d59dd26a503d28e7adb090188 /src/Xanthous/Game/Lenses.hs | |
parent | 915264acae35e71f79c6193d022baa2455d880d3 (diff) |
Implement the start of creature AI
Add a Brain class, which determines for an entity the set of moves it makes every step of the game, and begin to implement that for gormlaks. The idea here is that every step of the game, a gormlak will move towards the furthest-away wall it can see.
Diffstat (limited to 'src/Xanthous/Game/Lenses.hs')
-rw-r--r-- | src/Xanthous/Game/Lenses.hs | 72 |
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 |