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:
parent
2fd3e4c9ad
commit
adb3b74c0c
9 changed files with 155 additions and 39 deletions
|
|
@ -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
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue