diff options
Diffstat (limited to 'server/lib/Cafp/Game.hs')
| -rw-r--r-- | server/lib/Cafp/Game.hs | 22 |
1 files changed, 18 insertions, 4 deletions
diff --git a/server/lib/Cafp/Game.hs b/server/lib/Cafp/Game.hs index 740eac5..3a67ef6 100644 --- a/server/lib/Cafp/Game.hs +++ b/server/lib/Cafp/Game.hs @@ -27,16 +27,26 @@ import qualified Data.Text as T type PlayerId = Int +data Table + = TableProposing BlackCard (HMS.HashMap PlayerId WhiteCard) + deriving (Show) + data Game = Game { _gameCards :: !Cards - , _gamePlayers :: !(HMS.HashMap Int Text) + , _gamePlayers :: !(HMS.HashMap PlayerId Text) + , _gameTable :: !Table , _gameNextPlayerId :: !Int } deriving (Show) makeLenses ''Game newGame :: Cards -> Game -newGame cards = Game cards HMS.empty 1 +newGame cards = Game + { _gameCards = cards + , _gamePlayers = HMS.empty + , _gameTable = TableProposing (BlackCard 0) HMS.empty + , _gameNextPlayerId = 1 + } joinGame :: Game -> (PlayerId, Game) joinGame game = @@ -57,10 +67,14 @@ processClientMessage pid msg game = case msg of gameViewForPlayer :: PlayerId -> Game -> GameView gameViewForPlayer self game = let opponents = map snd . HMS.toList . HMS.delete self $ game ^. gamePlayers - name = fromMaybe "" $ game ^. gamePlayers . at self in + name = fromMaybe "" $ game ^. gamePlayers . at self + + table = case game ^. gameTable of + TableProposing black proposals -> + Proposing black (HMS.lookup self proposals) in GameView { gameViewOpponents = opponents , gameViewMyName = name - , gameViewBlackCard = Just $ BlackCard 0 + , gameViewTable = table , gameViewHand = [WhiteCard x | x <- [0 .. 9]] } |