module Main where import Control.Monad.State import Control.Monad.Reader import Control.Concurrent import qualified Network.WebSockets as WS import qualified Data.ByteString.Lazy.Char8 as BS import Skat import Skat.Card import Skat.Operations import Skat.Player import Skat.Pile import Skat.AI.Stupid import Skat.AI.Online import Skat.AI.Rulebased main :: IO () main = testAI 10 testAI :: Int -> IO () testAI n = do let acs = repeat runAI vals <- sequence (take n acs) putStrLn $ "average won points " ++ show (fromIntegral (sum vals) / fromIntegral n) runAI :: IO Int runAI = do env <- shuffledEnv let ps = piles env cs = handCards Hand3 ps trs = filter (isTrump Spades) cs if length trs >= 5 && any ((==32) . getID) cs then do pts <- fst <$> evalStateT (turn Hand1) env -- if pts > 60 then return 1 else return 0 return pts else runAI env :: SkatEnv env = SkatEnv piles Nothing Spades playersExamp where piles = distribute allCards envStupid :: SkatEnv envStupid = SkatEnv piles Nothing Spades pls2 where piles = distribute allCards playersExamp :: Players playersExamp = Players (PL $ Stupid Team Hand1) (PL $ Stupid Team Hand2) (PL $ mkAIEnv Single Hand3 10) pls2 :: Players pls2 = Players (PL $ Stupid Team Hand1) (PL $ Stupid Team Hand2) (PL $ Stupid Team Hand3) shuffledEnv :: IO SkatEnv shuffledEnv = do cards <- shuffleCards return $ SkatEnv (distribute cards) Nothing Spades playersExamp env2 :: SkatEnv env2 = SkatEnv piles Nothing Spades playersExamp where hand1 = [Card Seven Clubs, Card King Clubs, Card Ace Clubs, Card Queen Diamonds] hand2 = [Card Seven Hearts, Card King Hearts, Card Ace Hearts, Card Queen Spades] hand3 = [Card Seven Spades, Card King Spades, Card Ace Spades, Card Queen Clubs] h1 = map (putAt Hand1) hand1 h2 = map (putAt Hand2) hand2 h3 = map (putAt Hand3) hand3 piles = Piles (h1 ++ h2 ++ h3) [] [] runWebSocketServer :: IO () runWebSocketServer = do WS.runServer "localhost" 4243 application application :: WS.PendingConnection -> IO () application pending = do conn <- WS.acceptRequest pending putStrLn "someone connected" forever $ do msg <- WS.receiveData conn putStrLn $ BS.unpack msg