Link up messages to the overall game

Add a "say" function for saying messages within an app monad to the
user, and link everything up to display them and track their history
This commit is contained in:
Griffin Smith 2019-09-01 16:21:45 -04:00
parent 2fd3e4c9ad
commit adb3b74c0c
9 changed files with 155 additions and 39 deletions

View file

@ -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
char <- arbitrary @Character
charPos <- arbitrary
_messageHistory <- arbitrary
(_characterEntityID, _entities) <- arbitrary <&>
EntityMap.insertAtReturningID charPos (SomeEntity char)
_randomGen <- mkStdGen <$> arbitrary
pure $ GameState {..}
getInitialState :: GameState
getInitialState =
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