diff options
Diffstat (limited to 'src/Xanthous/Game.hs')
-rw-r--r-- | src/Xanthous/Game.hs | 68 |
1 files changed, 52 insertions, 16 deletions
diff --git a/src/Xanthous/Game.hs b/src/Xanthous/Game.hs index f30f7534392f..39066c23b622 100644 --- a/src/Xanthous/Game.hs +++ b/src/Xanthous/Game.hs @@ -3,46 +3,82 @@ module Xanthous.Game ( GameState(..) , entities + , messageHistory + , randomGen + , getInitialState , positionedCharacter , character , characterPosition + + , MessageHistory(..) + , pushMessage ) where -import Xanthous.Prelude -import Test.QuickCheck.Arbitrary +import Data.List.NonEmpty ( NonEmpty((:|))) +import qualified Data.List.NonEmpty as NonEmpty +import System.Random +import Test.QuickCheck +import Test.QuickCheck.Arbitrary.Generic +import Xanthous.Prelude -import Xanthous.Data.EntityMap (EntityMap, EntityID) +import Xanthous.Data.EntityMap (EntityMap, EntityID) import qualified Xanthous.Data.EntityMap as EntityMap -import Xanthous.Data (Positioned, Position(..), positioned, position) -import Xanthous.Entities.SomeEntity -import Xanthous.Entities.Character +import Xanthous.Data (Positioned, Position(..), positioned, position) +import Xanthous.Entities.SomeEntity +import Xanthous.Entities.Character +import Xanthous.Orphans () + +data MessageHistory + = NoMessageHistory + | MessageHistory (NonEmpty Text) Bool + deriving stock (Show, Eq, Generic) + deriving anyclass (NFData, CoArbitrary, Function) + +instance Arbitrary MessageHistory where + arbitrary = genericArbitrary + +pushMessage :: Text -> MessageHistory -> MessageHistory +pushMessage msg NoMessageHistory = MessageHistory (msg :| []) True +pushMessage msg (MessageHistory msgs _) = MessageHistory (NonEmpty.cons msg msgs) True data GameState = GameState { _entities :: EntityMap SomeEntity , _characterEntityID :: EntityID + , _messageHistory :: MessageHistory + , _randomGen :: StdGen } - deriving stock (Show, Eq) + deriving stock (Show) makeLenses ''GameState +instance Eq GameState where + (GameState es₁ ceid₁ mh₁ _) == (GameState es₂ ceid₂ mh₂ _) + = es₁ == es₂ + && ceid₁ == ceid₂ + && mh₁ == mh₂ + instance Arbitrary GameState where arbitrary = do - ents <- arbitrary - char <- arbitrary - pure $ getInitialState - & entities .~ ents - & positionedCharacter .~ char - -getInitialState :: GameState -getInitialState = + char <- arbitrary @Character + charPos <- arbitrary + _messageHistory <- arbitrary + (_characterEntityID, _entities) <- arbitrary <&> + EntityMap.insertAtReturningID charPos (SomeEntity char) + _randomGen <- mkStdGen <$> arbitrary + pure $ GameState {..} + +getInitialState :: IO GameState +getInitialState = do + _randomGen <- getStdGen let char = mkCharacter (_characterEntityID, _entities) = EntityMap.insertAtReturningID (Position 0 0) (SomeEntity char) mempty - in GameState {..} + _messageHistory = NoMessageHistory + pure GameState {..} positionedCharacter :: Lens' GameState (Positioned Character) positionedCharacter = lens getPositionedCharacter setPositionedCharacter |