138 lines
5.3 KiB
Haskell
138 lines
5.3 KiB
Haskell
module Skat.Matches (
|
|
singleVsBots, pvp, singleWithBidding, Match(..), Unfinished(..), continue,
|
|
Table(..)
|
|
) where
|
|
|
|
import Control.Monad.State
|
|
import Control.Monad.Reader
|
|
import System.Random (mkStdGen)
|
|
|
|
import Skat
|
|
import Skat.Operations
|
|
import Skat.Player as P
|
|
import Skat.Pile
|
|
import Skat.Card
|
|
import Skat.Preperation
|
|
import Skat.Bidding
|
|
|
|
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]
|
|
, matchSingle :: Hand }
|
|
deriving Show
|
|
|
|
data Unfinished = UnfinishedGame { unfinishedGame :: SkatEnv
|
|
, unfinishedPrep :: PrepEnv
|
|
, unfinishedTricks :: [Trick] }
|
|
| UnfinishedPrep { unfinishedPrep :: PrepEnv }
|
|
deriving Show
|
|
|
|
continue :: Communicator c => Unfinished -> c -> c -> c -> IO Table
|
|
continue (UnfinishedGame skatEnv prepEnv tricks) comm1 comm2 comm3 = do
|
|
let ps = players skatEnv
|
|
ps' = Players
|
|
(PL $ OnlineEnv (P.team $ player ps Hand1) (P.hand $ player ps Hand1) comm1)
|
|
(PL $ OnlineEnv (P.team $ player ps Hand2) (P.hand $ player ps Hand2) comm2)
|
|
(PL $ OnlineEnv (P.team $ player ps Hand3) (P.hand $ player ps Hand3) comm3)
|
|
bs = bidders prepEnv
|
|
bs' = Bidders
|
|
(BD $ PrepOnline (Skat.Preperation.hand $ bidder bs Hand1) comm1 [])
|
|
(BD $ PrepOnline (Skat.Preperation.hand $ bidder bs Hand2) comm2 [])
|
|
(BD $ PrepOnline (Skat.Preperation.hand $ bidder bs Hand3) comm3 [])
|
|
skatEnv' = skatEnv { players = ps' }
|
|
prepEnv' = prepEnv { bidders = bs' }
|
|
runGame prepEnv' skatEnv'
|
|
|
|
match :: PrepEnv -> IO Table
|
|
match prepEnv = do
|
|
(maySkatEnv, prepEnv') <- runStateT runPreperation prepEnv
|
|
case maySkatEnv of
|
|
Just skatEnv -> runGame prepEnv' skatEnv
|
|
Nothing -> do
|
|
putStrLn "no one wanted to play"
|
|
return $ Pass $ Skat.Preperation.piles prepEnv'
|
|
|
|
runGame :: PrepEnv -> SkatEnv -> IO Table
|
|
runGame prepEnv skatEnv = do
|
|
(isFinished, finalEnv, tricks) <- (flip runSkat) skatEnv $ do
|
|
-- send current table cards to clients
|
|
-- only relevant if this is a continued game
|
|
-- otherwise table is empty
|
|
table <- getp tableCards
|
|
ps <- playersToList <$> gets players
|
|
mapM_ (\card -> mapM_ (\p -> onCardPlayed p card) ps) (reverse table)
|
|
-- run game
|
|
turn
|
|
-- return if game has finished
|
|
gameOver
|
|
if isFinished then do
|
|
let res = getResults
|
|
(skatGame skatEnv)
|
|
(Skat.Preperation.current prepEnv)
|
|
(skatSinglePlayer skatEnv)
|
|
(Skat.Preperation.piles prepEnv)
|
|
(Skat.piles finalEnv)
|
|
publishGameResults res (bidders prepEnv)
|
|
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 $ Unfinished $ UnfinishedGame finalEnv prepEnv tricks
|
|
|
|
-- | predefined card distribution for testing purposes
|
|
cardDistr :: Piles
|
|
cardDistr = emptyPiles hand1 hand2 hand3 skt
|
|
where hand3 = [Card Ace Spades, Card Jack Diamonds, Card Jack Clubs, Card King Spades,
|
|
Card Nine Spades, Card Ace Diamonds, Card Queen Diamonds, Card Ten Clubs,
|
|
Card Eight Clubs, Card King Clubs]
|
|
hand1 = [Card Jack Spades, Card Jack Hearts, Card Ten Spades, Card Ace Hearts, Card Ten Hearts,
|
|
Card Nine Hearts, Card Seven Clubs, Card Ace Clubs, Card King Diamonds,
|
|
Card Ten Diamonds]
|
|
hand2 = [Card Eight Spades, Card Queen Spades, Card Seven Spades, Card Seven Diamonds,
|
|
Card Seven Hearts, Card Eight Hearts, Card Queen Hearts, Card King Hearts,
|
|
Card Nine Diamonds, Card Eight Diamonds]
|
|
skt = [Card Nine Clubs, Card Queen Clubs]
|
|
|
|
singleVsBots :: Communicator c => c -> IO ()
|
|
singleVsBots comm = do
|
|
cards <- shuffleCards
|
|
let ps = Players
|
|
(PL $ OnlineEnv Team Hand1 comm)
|
|
(PL $ Stupid Team Hand2)
|
|
(PL $ mkAIEnv Single Hand3 10)
|
|
env = SkatEnv (distribute cards) Nothing (Colour Spades Einfach) ps Hand1 Hand3
|
|
void $ evalSkat turn env
|
|
|
|
singleWithBidding :: Communicator c => c -> IO ()
|
|
singleWithBidding comm = do
|
|
cards <- shuffleCards
|
|
let ps = distribute cards
|
|
h1 = map toCard $ handCards Hand1 ps
|
|
bs = Bidders
|
|
(BD $ PrepOnline Hand1 comm h1)
|
|
(BD $ NoBidder Hand2)
|
|
(BD $ NoBidder Hand3)
|
|
env = makePrep ps bs
|
|
void $ match env
|
|
|
|
pvp :: Communicator c => c -> c -> c -> IO Table
|
|
pvp comm1 comm2 comm3 = do
|
|
cards <- shuffleCards
|
|
let ps = distribute cards
|
|
h1 = map toCard $ handCards Hand1 ps
|
|
h2 = map toCard $ handCards Hand2 ps
|
|
h3 = map toCard $ handCards Hand3 ps
|
|
bs = Bidders
|
|
(BD $ PrepOnline Hand1 comm1 $ h1)
|
|
(BD $ PrepOnline Hand2 comm2 $ h2)
|
|
(BD $ PrepOnline Hand3 comm3 $ h3)
|
|
env = makePrep ps bs
|
|
match env
|