Compare commits
4
Commits
195fd7ec34
...
master
| Author | SHA1 | Date | |
|---|---|---|---|
|
|
0984a188db | ||
|
|
444e50cdb1 | ||
|
|
3306e349d3 | ||
|
|
c6f43b2c96 |
@@ -48,13 +48,18 @@ initServer :: Net.PortNumber -> Buffering -> OnReceive -> IO ServerEnv
|
|||||||
initServer port buffermode handler = do
|
initServer port buffermode handler = do
|
||||||
sock <- Net.socket Net.AF_INET Net.Stream 0
|
sock <- Net.socket Net.AF_INET Net.Stream 0
|
||||||
Net.setSocketOption sock Net.ReuseAddr 1
|
Net.setSocketOption sock Net.ReuseAddr 1
|
||||||
Net.bind sock (Net.SockAddrInet port Net.iNADDR_ANY)
|
addr <- Net.addrAddress <$> resolve
|
||||||
|
Net.bind sock addr
|
||||||
Net.listen sock 5
|
Net.listen sock 5
|
||||||
chan <- newChan
|
chan <- newChan
|
||||||
forkIO $ forever $ do
|
forkIO $ forever $ do
|
||||||
msg <- readChan chan -- clearing the main channel
|
msg <- readChan chan -- clearing the main channel
|
||||||
return ()
|
return ()
|
||||||
return (ServerEnv buffermode sock chan handler)
|
return (ServerEnv buffermode sock chan handler)
|
||||||
|
where resolve = do
|
||||||
|
let hints = Net.defaultHints { Net.addrSocketType = Net.Stream }
|
||||||
|
addrs <- Net.getAddrInfo (Just hints) (Just "127.0.0.1") (Just $ show port)
|
||||||
|
return $ head addrs
|
||||||
|
|
||||||
close :: ServerEnv -> IO ()
|
close :: ServerEnv -> IO ()
|
||||||
close = Net.close . socket
|
close = Net.close . socket
|
||||||
|
|||||||
@@ -29,7 +29,7 @@ newtype NoBidder = NoBidder Hand
|
|||||||
-- | no bidding from that player
|
-- | no bidding from that player
|
||||||
instance Bidder NoBidder where
|
instance Bidder NoBidder where
|
||||||
hand (NoBidder h) = h
|
hand (NoBidder h) = h
|
||||||
askBid _ _ bid = return $ Just 120
|
askBid _ _ bid = return Nothing
|
||||||
askResponse _ _ bid = if bid < 24 then return True else return False
|
askResponse _ _ bid = if bid < 24 then return True else return False
|
||||||
askGame _ _ = return $ Grand Hand
|
askGame _ _ = return $ Grand Hand
|
||||||
askHand _ _ = return True
|
askHand _ _ = return True
|
||||||
|
|||||||
+23
-2
@@ -1,11 +1,11 @@
|
|||||||
module Skat.Matches (
|
module Skat.Matches (
|
||||||
singleVsBots, pvp, singleWithBidding, Match(..), Unfinished(..), continue,
|
singleVsBots, pvp, singleWithBidding, Match(..), Unfinished(..), continue,
|
||||||
Table(..)
|
Table(..), twoWithBidding, H(..), randomPositions
|
||||||
) where
|
) where
|
||||||
|
|
||||||
import Control.Monad.State
|
import Control.Monad.State
|
||||||
import Control.Monad.Reader
|
import Control.Monad.Reader
|
||||||
import System.Random (mkStdGen)
|
import System.Random (mkStdGen, newStdGen)
|
||||||
|
|
||||||
import Skat
|
import Skat
|
||||||
import Skat.Operations
|
import Skat.Operations
|
||||||
@@ -14,6 +14,7 @@ import Skat.Pile
|
|||||||
import Skat.Card
|
import Skat.Card
|
||||||
import Skat.Preperation
|
import Skat.Preperation
|
||||||
import Skat.Bidding
|
import Skat.Bidding
|
||||||
|
import Skat.Utils (shuffle)
|
||||||
|
|
||||||
import Skat.AI.Rulebased
|
import Skat.AI.Rulebased
|
||||||
import Skat.AI.Online
|
import Skat.AI.Online
|
||||||
@@ -122,6 +123,26 @@ singleWithBidding comm = do
|
|||||||
env = makePrep ps bs
|
env = makePrep ps bs
|
||||||
void $ match env
|
void $ match env
|
||||||
|
|
||||||
|
--- helper object for twoWithBidding
|
||||||
|
data H = P1 | P2 | AI
|
||||||
|
|
||||||
|
randomPositions :: IO [H]
|
||||||
|
randomPositions = do
|
||||||
|
gen <- newStdGen
|
||||||
|
return $ shuffle gen [P1, P2, AI]
|
||||||
|
|
||||||
|
twoWithBidding :: Communicator c => [H] -> c -> c -> IO ()
|
||||||
|
twoWithBidding positions comm1 comm2 = do
|
||||||
|
cards <- shuffleCards
|
||||||
|
let bds = zipWith mkBidder [Hand1, Hand2, Hand3] positions
|
||||||
|
ps = distribute cards
|
||||||
|
mkBidder hand P1 = BD $ PrepOnline hand comm1 (map toCard $ handCards hand ps)
|
||||||
|
mkBidder hand P2 = BD $ PrepOnline hand comm2 (map toCard $ handCards hand ps)
|
||||||
|
mkBidder hand AI = BD $ NoBidder hand
|
||||||
|
bs = Bidders (bds !! 0) (bds !! 1) (bds !! 2)
|
||||||
|
env = makePrep ps bs
|
||||||
|
void $ match env
|
||||||
|
|
||||||
pvp :: Communicator c => c -> c -> c -> IO Table
|
pvp :: Communicator c => c -> c -> c -> IO Table
|
||||||
pvp comm1 comm2 comm3 = do
|
pvp comm1 comm2 comm3 = do
|
||||||
cards <- shuffleCards
|
cards <- shuffleCards
|
||||||
|
|||||||
+1
-1
@@ -17,7 +17,7 @@
|
|||||||
#
|
#
|
||||||
# resolver: ./custom-snapshot.yaml
|
# resolver: ./custom-snapshot.yaml
|
||||||
# resolver: https://example.com/snapshots/2018-01-01.yaml
|
# resolver: https://example.com/snapshots/2018-01-01.yaml
|
||||||
resolver: lts-14.3
|
resolver: lts-18.18
|
||||||
|
|
||||||
# User packages to be built.
|
# User packages to be built.
|
||||||
# Various formats can be used as shown in the example below.
|
# Various formats can be used as shown in the example below.
|
||||||
|
|||||||
Reference in New Issue
Block a user