diff options
author | Jasper Van der Jeugt | 2020-07-30 22:07:37 +0200 |
---|---|---|
committer | Jasper Van der Jeugt | 2020-07-30 22:07:37 +0200 |
commit | c92c0f65c733c9aba5c56313a4bc313a299e1230 (patch) | |
tree | c5bb44d969ac2b91e664e1235b00278cdece11d7 /server | |
parent | ab1267a757bcc997f05cc9babe2d1fb9bb681ce4 (diff) |
Some logic
Diffstat (limited to 'server')
-rw-r--r-- | server/lib/Cafp/Game.hs | 22 | ||||
-rw-r--r-- | server/lib/Cafp/Main/GenerateElmTypes.hs | 1 | ||||
-rw-r--r-- | server/lib/Cafp/Messages.hs | 8 |
3 files changed, 26 insertions, 5 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]] } diff --git a/server/lib/Cafp/Main/GenerateElmTypes.hs b/server/lib/Cafp/Main/GenerateElmTypes.hs index 7900b1c..677bc5c 100644 --- a/server/lib/Cafp/Main/GenerateElmTypes.hs +++ b/server/lib/Cafp/Main/GenerateElmTypes.hs @@ -13,6 +13,7 @@ main = putStrLn $ makeElmModule "Messages" [ DefineElm (Proxy :: Proxy BlackCard) , DefineElm (Proxy :: Proxy WhiteCard) , DefineElm (Proxy :: Proxy Cards) + , DefineElm (Proxy :: Proxy TableView) , DefineElm (Proxy :: Proxy GameView) , DefineElm (Proxy :: Proxy ServerMessage) , DefineElm (Proxy :: Proxy ClientMessage) diff --git a/server/lib/Cafp/Messages.hs b/server/lib/Cafp/Messages.hs index 219efb4..de0ae26 100644 --- a/server/lib/Cafp/Messages.hs +++ b/server/lib/Cafp/Messages.hs @@ -3,6 +3,7 @@ module Cafp.Messages ( BlackCard (..) , WhiteCard (..) , Cards (..) + , TableView (..) , GameView (..) , ServerMessage (..) , ClientMessage (..) @@ -20,10 +21,14 @@ data Cards = Cards , cardsWhite :: [Text] } deriving (Show) +data TableView + = Proposing BlackCard (Maybe WhiteCard) + deriving (Show) + data GameView = GameView { gameViewOpponents :: [Text] , gameViewMyName :: Text - , gameViewBlackCard :: Maybe BlackCard + , gameViewTable :: TableView , gameViewHand :: [WhiteCard] } deriving (Show) @@ -41,6 +46,7 @@ data ClientMessage deriveBoth defaultOptions ''BlackCard deriveBoth defaultOptions ''WhiteCard deriveBoth (defaultOptionsDropLower 5) ''Cards +deriveBoth defaultOptions ''TableView deriveBoth (defaultOptionsDropLower 8) ''GameView deriveBoth defaultOptions ''ServerMessage deriveBoth defaultOptions ''ClientMessage |