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
import Skat.AI.Minmax (playCLI)

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 env
            -- if pts > 60 then return 1 else return 0
            return pts
        else runAI

env :: SkatEnv
env = SkatEnv piles Nothing Spades playersExamp Hand1
    where piles = distribute allCards 

envStupid :: SkatEnv
envStupid = SkatEnv piles Nothing Spades pls2 Hand1
    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 Single Hand3)

shuffledEnv :: IO SkatEnv
shuffledEnv = do
    cards <- shuffleCards
    return $ SkatEnv (distribute cards) Nothing Spades playersExamp Hand1

shuffledEnv2 :: IO SkatEnv
shuffledEnv2 = do
    cards <- shuffleCards
    return $ SkatEnv (distribute cards) Nothing Spades pls2 Hand1

env2 :: SkatEnv
env2 = SkatEnv piles Nothing Spades playersExamp Hand1
    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) [] []

env3 :: SkatEnv
env3 = SkatEnv piles Nothing Diamonds pls2 Hand3
    where hand1 = [ Card Jack Diamonds, Card Jack Clubs, Card Nine Spades, Card King Spades
                  , Card Seven Diamonds, Card Nine Diamonds, Card Seven Clubs, Card Eight Clubs
                  , Card Ten Clubs, Card Eight Hearts ]
          hand2 = [ Card Seven Spades, Card Eight Spades, Card Seven Hearts, Card Nine Hearts
                  , Card Ace Hearts, Card King Diamonds, Card Ace Diamonds, Card Nine Clubs
                  , Card King Clubs, Card Ace Clubs ]
          hand3 = [ Card Jack Hearts, Card Jack Spades, Card Ten Spades, Card Ace Spades, Card Eight Diamonds
                  , Card Queen Diamonds, Card Ten Diamonds, Card Ten Hearts, Card Queen Hearts, Card King Hearts ]
          skat = [ Card Queen Clubs, Card Queen Spades]
          h1 = map (putAt Hand1) hand1
          h2 = map (putAt Hand2) hand2
          h3 = map (putAt Hand3) hand3
          skt = map (putAt SkatP) skat
          piles = Piles (h1 ++ h2 ++ h3) [] skt

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

playSkat :: IO ()
playSkat = do
    void $ (flip runStateT) env3 playCLI