flavis 5 лет назад
Родитель
Сommit
195fd7ec34
3 измененных файлов: 19 добавлений и 11 удалений
  1. +1
    -1
      package.yaml
  2. +2
    -1
      skat.cabal
  3. +16
    -9
      src/Skat/Matches.hs

+ 1
- 1
package.yaml Просмотреть файл

@@ -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
- 1
skat.cabal Просмотреть файл

@@ -4,10 +4,10 @@ cabal-version: 1.12
-- --
-- see: https://github.com/sol/hpack -- see: https://github.com/sol/hpack
-- --
-- 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
src/Skat/Matches.hs Просмотреть файл

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


Загрузка…
Отмена
Сохранить