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.Bidding

import Skat.AI.Stupid
import Skat.AI.Online
import Skat.AI.Rulebased
import Skat.AI.Minmax (playCLI)

main :: IO ()
main = testMinmax 10

testMinmax :: Int -> IO ()
testMinmax n = do
    let acs = repeat playSkat
    sequence_ (take n acs)

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 $ TrumpColour Spades) cs
    if length trs >= 5 && any ((==32) . getID) cs
        then do
            pts <- fst <$> evalSkat turn env
            -- if pts > 60 then return 1 else return 0
            return pts
        else runAI

env :: SkatEnv
env = SkatEnv piles Nothing (Colour Spades Einfach) playersExamp Hand1 Hand3
    where piles = distribute allCards 

envStupid :: SkatEnv
envStupid = SkatEnv piles Nothing (Colour Spades Einfach) pls2 Hand1 Hand3
    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 (Colour Spades Einfach) playersExamp Hand1 Hand3

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

env2 :: SkatEnv
env2 = SkatEnv piles Nothing (Colour Hearts Einfach) playersExamp Hand2 Hand3
    where hand1 = [Card Eight Hearts, Card Queen Hearts, Card Ace Clubs, Card Queen Diamonds]
          hand2 = [Card Seven Hearts, Card King Hearts, Card Ten Hearts, Card Queen Spades]
          hand3 = [Card Seven Spades, Card King Spades, Card Ace Spades, Card Queen Clubs]
          piles = emptyPiles hand1 hand2 hand3 []

env3 :: SkatEnv
env3 = SkatEnv piles Nothing (Colour Diamonds Einfach) pls2 Hand3 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]
          piles = emptyPiles hand1 hand2 hand3 skat

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 = void $ (flip runSkat) env3 playCLI