upgrade matches api
This commit is contained in:
+1
-1
@@ -1,5 +1,5 @@
|
|||||||
name: skat
|
name: skat
|
||||||
version: 0.1.0.7
|
version: 0.1.0.8
|
||||||
github: "githubuser/skat"
|
github: "githubuser/skat"
|
||||||
license: BSD3
|
license: BSD3
|
||||||
author: "flavis"
|
author: "flavis"
|
||||||
|
|||||||
+2
-2
@@ -4,10 +4,10 @@ cabal-version: 1.12
|
|||||||
--
|
--
|
||||||
-- see: https://github.com/sol/hpack
|
-- see: https://github.com/sol/hpack
|
||||||
--
|
--
|
||||||
-- hash: f2e3dd604c5fb3558a0a89d7551927574fb21db0892d1c2d70d401dd30807071
|
-- hash: a2e08e04140990ba90e6d7b70c6bc70b99d073ba723efa9d5e35708995da45e1
|
||||||
|
|
||||||
name: skat
|
name: skat
|
||||||
version: 0.1.0.7
|
version: 0.1.0.8
|
||||||
description: Please see the README on Gitea at <https://git.flavigny.de/christian/skat>
|
description: Please see the README on Gitea at <https://git.flavigny.de/christian/skat>
|
||||||
homepage: https://github.com/githubuser/skat#readme
|
homepage: https://github.com/githubuser/skat#readme
|
||||||
bug-reports: https://github.com/githubuser/skat/issues
|
bug-reports: https://github.com/githubuser/skat/issues
|
||||||
|
|||||||
+16
-9
@@ -1,5 +1,6 @@
|
|||||||
module Skat.Matches (
|
module Skat.Matches (
|
||||||
singleVsBots, pvp, singleWithBidding, Match(..), Unfinished(..), continue
|
singleVsBots, pvp, singleWithBidding, Match(..), Unfinished(..), continue,
|
||||||
|
Table(..)
|
||||||
) where
|
) where
|
||||||
|
|
||||||
import Control.Monad.State
|
import Control.Monad.State
|
||||||
@@ -18,6 +19,11 @@ import Skat.AI.Rulebased
|
|||||||
import Skat.AI.Online
|
import Skat.AI.Online
|
||||||
import Skat.AI.Stupid
|
import Skat.AI.Stupid
|
||||||
|
|
||||||
|
data Table = Unfinished Unfinished
|
||||||
|
| Finished Match
|
||||||
|
| Pass { tablePiles :: Piles }
|
||||||
|
deriving Show
|
||||||
|
|
||||||
data Match = Match { matchPiles :: Piles
|
data Match = Match { matchPiles :: Piles
|
||||||
, matchResult :: Result
|
, matchResult :: Result
|
||||||
, matchTricks :: [Trick]
|
, matchTricks :: [Trick]
|
||||||
@@ -30,7 +36,7 @@ data Unfinished = UnfinishedGame { unfinishedGame :: SkatEnv
|
|||||||
| UnfinishedPrep { unfinishedPrep :: PrepEnv }
|
| UnfinishedPrep { unfinishedPrep :: PrepEnv }
|
||||||
deriving Show
|
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
|
continue (UnfinishedGame skatEnv prepEnv tricks) comm1 comm2 comm3 = do
|
||||||
let ps = players skatEnv
|
let ps = players skatEnv
|
||||||
ps' = Players
|
ps' = Players
|
||||||
@@ -46,14 +52,16 @@ continue (UnfinishedGame skatEnv prepEnv tricks) comm1 comm2 comm3 = do
|
|||||||
prepEnv' = prepEnv { bidders = bs' }
|
prepEnv' = prepEnv { bidders = bs' }
|
||||||
runGame prepEnv' skatEnv'
|
runGame prepEnv' skatEnv'
|
||||||
|
|
||||||
match :: PrepEnv -> IO (Either Unfinished (Maybe Match))
|
match :: PrepEnv -> IO Table
|
||||||
match prepEnv = do
|
match prepEnv = do
|
||||||
(maySkatEnv, prepEnv') <- runStateT runPreperation prepEnv
|
(maySkatEnv, prepEnv') <- runStateT runPreperation prepEnv
|
||||||
case maySkatEnv of
|
case maySkatEnv of
|
||||||
Just skatEnv -> runGame prepEnv' skatEnv
|
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
|
runGame prepEnv skatEnv = do
|
||||||
(isFinished, finalEnv, tricks) <- (flip runSkat) skatEnv $ do
|
(isFinished, finalEnv, tricks) <- (flip runSkat) skatEnv $ do
|
||||||
-- send current table cards to clients
|
-- send current table cards to clients
|
||||||
@@ -74,10 +82,9 @@ runGame prepEnv skatEnv = do
|
|||||||
(Skat.Preperation.piles prepEnv)
|
(Skat.Preperation.piles prepEnv)
|
||||||
(Skat.piles finalEnv)
|
(Skat.piles finalEnv)
|
||||||
publishGameResults res (bidders prepEnv)
|
publishGameResults res (bidders prepEnv)
|
||||||
return $ Right $ Just $
|
return $ Finished $ Match (Skat.Preperation.piles prepEnv) res tricks (skatSinglePlayer skatEnv)
|
||||||
Match (Skat.Preperation.piles prepEnv) res tricks (skatSinglePlayer skatEnv)
|
|
||||||
else do -- if not finished an error has occured, thus returning unfinished game state
|
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
|
-- | predefined card distribution for testing purposes
|
||||||
cardDistr :: Piles
|
cardDistr :: Piles
|
||||||
@@ -115,7 +122,7 @@ singleWithBidding comm = do
|
|||||||
env = makePrep ps bs
|
env = makePrep ps bs
|
||||||
void $ match env
|
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
|
pvp comm1 comm2 comm3 = do
|
||||||
cards <- shuffleCards
|
cards <- shuffleCards
|
||||||
let ps = distribute cards
|
let ps = distribute cards
|
||||||
|
|||||||
Reference in New Issue
Block a user