diff options
Diffstat (limited to 'src/Xanthous/Game')
-rw-r--r-- | src/Xanthous/Game/Arbitrary.hs | 18 | ||||
-rw-r--r-- | src/Xanthous/Game/Lenses.hs | 6 | ||||
-rw-r--r-- | src/Xanthous/Game/State.hs | 12 |
3 files changed, 24 insertions, 12 deletions
diff --git a/src/Xanthous/Game/Arbitrary.hs b/src/Xanthous/Game/Arbitrary.hs index a4e0255ca8c2..3be711099c23 100644 --- a/src/Xanthous/Game/Arbitrary.hs +++ b/src/Xanthous/Game/Arbitrary.hs @@ -5,15 +5,17 @@ -------------------------------------------------------------------------------- module Xanthous.Game.Arbitrary where -------------------------------------------------------------------------------- -import Xanthous.Prelude +import Xanthous.Prelude hiding (levels, foldMap) -------------------------------------------------------------------------------- import Test.QuickCheck import System.Random +import Data.Foldable (foldMap) -------------------------------------------------------------------------------- -import Xanthous.Game.State +import Xanthous.Data.Levels +import qualified Xanthous.Data.EntityMap as EntityMap import Xanthous.Entities.Entities () import Xanthous.Entities.Character -import qualified Xanthous.Data.EntityMap as EntityMap +import Xanthous.Game.State -------------------------------------------------------------------------------- instance Arbitrary GameState where @@ -21,9 +23,13 @@ instance Arbitrary GameState where chr <- arbitrary @Character charPos <- arbitrary _messageHistory <- arbitrary - (_characterEntityID, _entities) <- arbitrary <&> - EntityMap.insertAtReturningID charPos (SomeEntity chr) - _revealedPositions <- fmap setFromList . sublistOf $ EntityMap.positions _entities + levels <- arbitrary + let (_characterEntityID, currentLevel) = + EntityMap.insertAtReturningID charPos (SomeEntity chr) + $ extract levels + _levels = levels & current .~ currentLevel + _revealedPositions <- fmap setFromList . sublistOf + $ foldMap EntityMap.positions levels _randomGen <- mkStdGen <$> arbitrary let _promptState = NoPrompt -- TODO _activePanel <- arbitrary diff --git a/src/Xanthous/Game/Lenses.hs b/src/Xanthous/Game/Lenses.hs index f7f4648dd5ed..010fcb7022b5 100644 --- a/src/Xanthous/Game/Lenses.hs +++ b/src/Xanthous/Game/Lenses.hs @@ -25,6 +25,7 @@ import Control.Monad.Random (getRandom) -------------------------------------------------------------------------------- import Xanthous.Game.State import Xanthous.Data +import Xanthous.Data.Levels import qualified Xanthous.Data.EntityMap as EntityMap import Xanthous.Data.EntityMap.Graphics (visiblePositions) import Xanthous.Entities.Character (Character, mkCharacter) @@ -38,11 +39,12 @@ initialStateFromSeed :: Int -> GameState initialStateFromSeed seed = let _randomGen = mkStdGen seed chr = mkCharacter - (_characterEntityID, _entities) + (_characterEntityID, level) = EntityMap.insertAtReturningID (Position 0 0) (SomeEntity chr) mempty + _levels = oneLevel level _messageHistory = mempty _revealedPositions = mempty _promptState = NoPrompt @@ -108,4 +110,4 @@ entitiesCollision entitiesCollision = join . maximumMay . fmap entityCollision collisionAt :: MonadState GameState m => Position -> m (Maybe Collision) -collisionAt pos = uses (entities . EntityMap.atPosition pos) entitiesCollision +collisionAt p = uses (entities . EntityMap.atPosition p) entitiesCollision diff --git a/src/Xanthous/Game/State.hs b/src/Xanthous/Game/State.hs index 171f381e6b74..7587618c968b 100644 --- a/src/Xanthous/Game/State.hs +++ b/src/Xanthous/Game/State.hs @@ -58,7 +58,7 @@ module Xanthous.Game.State , allRevealed ) where -------------------------------------------------------------------------------- -import Xanthous.Prelude +import Xanthous.Prelude hiding (levels) -------------------------------------------------------------------------------- import Data.List.NonEmpty ( NonEmpty((:|))) import qualified Data.List.NonEmpty as NonEmpty @@ -80,6 +80,7 @@ import qualified Graphics.Vty.Image as Vty -------------------------------------------------------------------------------- import Xanthous.Util (KnownBool(..)) import Xanthous.Data +import Xanthous.Data.Levels import Xanthous.Data.EntityMap (EntityMap, EntityID) import Xanthous.Data.EntityChar import Xanthous.Data.VectorBag @@ -359,8 +360,8 @@ instance Draw SomeEntity where drawPriority (SomeEntity ent) = drawPriority ent instance Brain SomeEntity where - step ticks (Positioned pos (SomeEntity ent)) = - fmap SomeEntity <$> step ticks (Positioned pos ent) + step ticks (Positioned p (SomeEntity ent)) = + fmap SomeEntity <$> step ticks (Positioned p ent) downcastEntity :: forall (a :: Type). (Typeable a) => SomeEntity -> Maybe a downcastEntity (SomeEntity e) = cast e @@ -413,7 +414,7 @@ instance Arbitrary DebugState where arbitrary = genericArbitrary data GameState = GameState - { _entities :: !(EntityMap SomeEntity) + { _levels :: !(Levels (EntityMap SomeEntity)) , _revealedPositions :: !(Set Position) , _characterEntityID :: !EntityID , _messageHistory :: !MessageHistory @@ -433,6 +434,9 @@ data GameState = GameState GameState makeLenses ''GameState +entities :: Lens' GameState (EntityMap SomeEntity) +entities = levels . current + instance Eq GameState where (==) = (==) `on` \gs -> ( gs ^. entities |