From c92c0f65c733c9aba5c56313a4bc313a299e1230 Mon Sep 17 00:00:00 2001
From: Jasper Van der Jeugt
Date: Thu, 30 Jul 2020 22:07:37 +0200
Subject: Some logic

---
 server/lib/Cafp/Game.hs | 22 ++++++++++++++++++----
 1 file changed, 18 insertions(+), 4 deletions(-)

(limited to 'server/lib/Cafp/Game.hs')

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]]
         }
-- 
cgit v1.2.3