skat/app/Main.hs

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