add preconfigured matches and extend online ai
This commit is contained in:
+18
-10
@@ -33,6 +33,7 @@ instance Player OnlineEnv where
|
||||
chooseCard p table _ hand = runReaderT (choose table hand) p >>= \c -> return (c, p)
|
||||
onCardPlayed p c = runReaderT (cardPlayed c) p >> return p
|
||||
onGameResults p res = runReaderT (onResults res) p
|
||||
onGameStart p singlePlayer = runReaderT (onStart singlePlayer) p
|
||||
|
||||
type Online m = ReaderT OnlineEnv m
|
||||
|
||||
@@ -65,23 +66,30 @@ cardPlayed card = query (BS.unpack $ encode $ CardPlayedQuery card)
|
||||
onResults :: MonadIO m => (Int, Int) -> Online m ()
|
||||
onResults (sgl, tm) = query (BS.unpack $ encode $ GameResultsQuery sgl tm)
|
||||
|
||||
data ChooseQuery = ChooseQuery [Card] [CardS Played]
|
||||
data CardPlayedQuery = CardPlayedQuery (CardS Played)
|
||||
data GameResultsQuery = GameResultsQuery Int Int
|
||||
data ChosenResponse = ChosenResponse Card
|
||||
onStart :: MonadPlayer m => Hand -> Online m ()
|
||||
onStart singlePlayer = do
|
||||
trCol <- trumpColour
|
||||
ownHand <- asks getHand
|
||||
query (BS.unpack $ encode $ GameStartQuery trCol ownHand singlePlayer)
|
||||
|
||||
data Query = ChooseQuery [Card] [CardS Played]
|
||||
| CardPlayedQuery (CardS Played)
|
||||
| GameResultsQuery Int Int
|
||||
| GameStartQuery Colour Hand Hand
|
||||
|
||||
instance ToJSON ChooseQuery where
|
||||
data Response = ChosenResponse Card
|
||||
|
||||
instance ToJSON Query where
|
||||
toJSON (ChooseQuery hand table) =
|
||||
object ["query" .= ("choose_card" :: String), "hand" .= hand, "table" .= table]
|
||||
|
||||
instance ToJSON CardPlayedQuery where
|
||||
toJSON (CardPlayedQuery card) =
|
||||
object ["query" .= ("card_played" :: String), "card" .= card]
|
||||
|
||||
instance ToJSON GameResultsQuery where
|
||||
toJSON (GameResultsQuery sgl tm) =
|
||||
object ["query" .= ("results" :: String), "single" .= sgl, "team" .= tm]
|
||||
toJSON (GameStartQuery trumps handNo sglPlayer) =
|
||||
object ["query" .= ("start_game" :: String), "trumps" .= show trumps,
|
||||
"hand" .= toInt handNo, "single" .= toInt sglPlayer]
|
||||
|
||||
instance FromJSON ChosenResponse where
|
||||
instance FromJSON Response where
|
||||
parseJSON = withObject "ChosenResponse" $ \v -> ChosenResponse
|
||||
<$> v .: "card"
|
||||
|
||||
Reference in New Issue
Block a user