|
|
|
@@ -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 |
|
|
|
|