upgrade matches api
This commit is contained in:
+16
-9
@@ -1,5 +1,6 @@
|
||||
module Skat.Matches (
|
||||
singleVsBots, pvp, singleWithBidding, Match(..), Unfinished(..), continue
|
||||
singleVsBots, pvp, singleWithBidding, Match(..), Unfinished(..), continue,
|
||||
Table(..)
|
||||
) where
|
||||
|
||||
import Control.Monad.State
|
||||
@@ -18,6 +19,11 @@ import Skat.AI.Rulebased
|
||||
import Skat.AI.Online
|
||||
import Skat.AI.Stupid
|
||||
|
||||
data Table = Unfinished Unfinished
|
||||
| Finished Match
|
||||
| Pass { tablePiles :: Piles }
|
||||
deriving Show
|
||||
|
||||
data Match = Match { matchPiles :: Piles
|
||||
, matchResult :: Result
|
||||
, matchTricks :: [Trick]
|
||||
@@ -30,7 +36,7 @@ data Unfinished = UnfinishedGame { unfinishedGame :: SkatEnv
|
||||
| UnfinishedPrep { unfinishedPrep :: PrepEnv }
|
||||
deriving Show
|
||||
|
||||
continue :: Communicator c => Unfinished -> c -> c -> c -> IO (Either Unfinished (Maybe Match))
|
||||
continue :: Communicator c => Unfinished -> c -> c -> c -> IO Table
|
||||
continue (UnfinishedGame skatEnv prepEnv tricks) comm1 comm2 comm3 = do
|
||||
let ps = players skatEnv
|
||||
ps' = Players
|
||||
@@ -46,14 +52,16 @@ continue (UnfinishedGame skatEnv prepEnv tricks) comm1 comm2 comm3 = do
|
||||
prepEnv' = prepEnv { bidders = bs' }
|
||||
runGame prepEnv' skatEnv'
|
||||
|
||||
match :: PrepEnv -> IO (Either Unfinished (Maybe Match))
|
||||
match :: PrepEnv -> IO Table
|
||||
match prepEnv = do
|
||||
(maySkatEnv, prepEnv') <- runStateT runPreperation prepEnv
|
||||
case maySkatEnv of
|
||||
Just skatEnv -> runGame prepEnv' skatEnv
|
||||
Nothing -> putStrLn "no one wanted to play" >> return (Right Nothing)
|
||||
Nothing -> do
|
||||
putStrLn "no one wanted to play"
|
||||
return $ Pass $ Skat.Preperation.piles prepEnv'
|
||||
|
||||
runGame :: PrepEnv -> SkatEnv -> IO (Either Unfinished (Maybe Match))
|
||||
runGame :: PrepEnv -> SkatEnv -> IO Table
|
||||
runGame prepEnv skatEnv = do
|
||||
(isFinished, finalEnv, tricks) <- (flip runSkat) skatEnv $ do
|
||||
-- send current table cards to clients
|
||||
@@ -74,10 +82,9 @@ runGame prepEnv skatEnv = do
|
||||
(Skat.Preperation.piles prepEnv)
|
||||
(Skat.piles finalEnv)
|
||||
publishGameResults res (bidders prepEnv)
|
||||
return $ Right $ Just $
|
||||
Match (Skat.Preperation.piles prepEnv) res tricks (skatSinglePlayer skatEnv)
|
||||
return $ Finished $ Match (Skat.Preperation.piles prepEnv) res tricks (skatSinglePlayer skatEnv)
|
||||
else do -- if not finished an error has occured, thus returning unfinished game state
|
||||
return $ Left $ UnfinishedGame finalEnv prepEnv tricks
|
||||
return $ Unfinished $ UnfinishedGame finalEnv prepEnv tricks
|
||||
|
||||
-- | predefined card distribution for testing purposes
|
||||
cardDistr :: Piles
|
||||
@@ -115,7 +122,7 @@ singleWithBidding comm = do
|
||||
env = makePrep ps bs
|
||||
void $ match env
|
||||
|
||||
pvp :: Communicator c => c -> c -> c -> IO (Either Unfinished (Maybe Match))
|
||||
pvp :: Communicator c => c -> c -> c -> IO Table
|
||||
pvp comm1 comm2 comm3 = do
|
||||
cards <- shuffleCards
|
||||
let ps = distribute cards
|
||||
|
||||
Reference in New Issue
Block a user