From 8b32092c8fbac55b959b09db348aa367c14de66f Mon Sep 17 00:00:00 2001 From: Nikolas Burk Date: Mon, 23 Nov 2015 18:00:00 -0500 Subject: [PATCH] two players can now play each other, however only the best case scenario is implemented, need more failure and exception handling --- TTTCLI.hs | 12 +----- TTTClient.hs | 40 +++++++++++++++++--- TTTServer.hs | 105 ++++++++++++++++++++++++++++++++++++++++++++------- TicTacToe.hs | 1 + test.hs | 7 ++++ 5 files changed, 136 insertions(+), 29 deletions(-) create mode 100644 test.hs diff --git a/TTTCLI.hs b/TTTCLI.hs index 2aa2ac2..a1d2156 100644 --- a/TTTCLI.hs +++ b/TTTCLI.hs @@ -23,14 +23,6 @@ nextRound b = do let p = currentPlayer b putStrLn $ show b - -- get choice from input - --putStr "Column: " - --col <- getLine - --let colNum = read col - --putStr "Row: " - --row <- getLine - --let rowNum = read row - -- get choice from input col <- getInput "Input column: " row <- getInput "Input row: " @@ -41,8 +33,8 @@ nextRound b = do putStrLn msg nextRound b Right b' -> nextRound b' - - + + getInput :: String -> IO Int getInput msg = do putStr msg diff --git a/TTTClient.hs b/TTTClient.hs index 34ad1fd..e40413d 100644 --- a/TTTClient.hs +++ b/TTTClient.hs @@ -4,23 +4,51 @@ import System.IO import TTTServer import TicTacToe -openConnection :: HostName -> String -> IO Player -openConnection hostname port = do + +playGame :: HostName -> String -> IO () +playGame hostname port = do + p <- getPlayerFromConnection hostname port + playersTurn p + return () + + +playersTurn :: Player -> IO () +playersTurn p = do + m1 <- hGetLine $ handle p + putStrLn $ "did reveive msg from server: " ++ m1 + col <- getLine + hPutStrLn (handle p) col + m2 <- hGetLine $ handle p + putStrLn $ "did reveive msg from server: " ++ m2 + row <- getLine + hPutStrLn (handle p) row + playersTurn p + return () + +getPlayerFromConnection :: HostName -> String -> IO Player +getPlayerFromConnection hostname port = do + + -- | create the server's address using the input parameters addrinfos <- getAddrInfo Nothing (Just hostname) (Just port) let serveraddr = head addrinfos + putStrLn $ "did create server address: " ++ show serveraddr + + -- | create a TCP socket for the incoming data sock <- socket (addrFamily serveraddr) Stream defaultProtocol + -- | configure socket setSocketOption sock KeepAlive 1 + -- | connect to server connect sock (addrAddress serveraddr) + -- | turn socket into handle h <- socketToHandle sock ReadWriteMode - hSetBuffering h LineBuffering - messages <- hGetContents h - putStrLn messages - + info <- hGetLine h + putStrLn $ "initial info: " ++ info + return $ Player h Cross diff --git a/TTTServer.hs b/TTTServer.hs index d2e7f6f..9b6d163 100644 --- a/TTTServer.hs +++ b/TTTServer.hs @@ -5,6 +5,7 @@ import Network.BSD import Data.List import System.IO import Control.Concurrent +import Text.Read import TicTacToe data Player = Player { handle :: Handle, @@ -12,21 +13,35 @@ data Player = Player { handle :: Handle, data Game = Game { player1 :: Player, player2 :: Player, - boardOrMsg :: BoardOrMsg } + board :: Board } + +data MsgType = REQ_INPUT | INFO deriving (Eq, Show) +data Message = Message { msgType :: MsgType, + msg :: String } + +instance Show Message where + show m = show (msgType m) ++ ": " ++ msg m + type HandlerFunc = SockAddr -> String -> IO () serveTTT :: String -> HandlerFunc -> IO () -serveTTT port handlerfunc = do +serveTTT port handlerfunc = do + + -- create the server's address addrinfos <- getAddrInfo (Just (defaultHints {addrFlags = [AI_PASSIVE]})) Nothing (Just port) let serveraddr = head addrinfos + -- create a TCP socket sock <- socket (addrFamily serveraddr) Stream defaultProtocol - bind sock (addrAddress serveraddr) + putStrLn $ "did creater server address: " ++ show serveraddr + -- bind the socket to the address and start listening + bind sock (addrAddress serveraddr) listen sock 4 + -- request processing loop processRequest sock [] where @@ -42,31 +57,82 @@ serveTTT port handlerfunc = do handlePlayer :: Socket -> [Handle] -> IO [Handle] handlePlayer playersock handles = do h <- socketToHandle playersock ReadWriteMode + hSetBuffering h LineBuffering let newHandles = handles ++ [h] if let l = length newHandles in even l && l > 0 then do initiateNewGame $ toTuple $ lastN 2 newHandles - return $ take ((length newHandles) - 2) newHandles + return $ take (length newHandles - 2) newHandles else return newHandles -- | initiate a new game initiateNewGame :: (Handle, Handle) -> IO () initiateNewGame (h1, h2) = do - let player1 = Player h1 Cross - let player2 = Player h2 Circle - let game = Game player1 player2 (Right initialBoard) - sendMessage "Let the game begin" player1 - sendMessage "Let the game begin" player2 + let p1 = Player h1 Cross + let p2 = Player h2 Circle + let game = Game p1 p2 initialBoard + sendMessage (Message INFO "You're playing 'X'") p1 + sendMessage (Message INFO "You're playing 'O'") p2 + manageRound game return () + manageRound :: Game -> IO () + manageRound game = do + case checkWinnerPure $ board game of + Nothing -> print $ board game + Just p -> do + putStrLn $ "Player " ++ show p ++ " won the game" + handleGameOver game + return () + + let p = case currentPlayer $ board game of + Cross -> player1 game + Circle -> player2 game + --let boardInfo = "Board:\n" ++ show (board game) + --sendMessage (Message INFO boardInfo) p + (col, row) <- getPlayerChoice p + case mkChoice (col, row, marker p) $ board game of + Left msg -> do + putStrLn msg + sendMessage (Message INFO msg) p + manageRound game + Right b -> do + let newGame = updateBoard b game + manageRound newGame + return () + + getPlayerChoice :: Player -> IO (Int, Int) + getPlayerChoice p = do + col <- getPlayerInput p "column" + putStrLn $ "did receive col: " ++ show col + row <- getPlayerInput p "row" + putStrLn $ "did receive row: " ++ show row + return (col, row) + + getPlayerInput :: Player -> String -> IO Int + getPlayerInput p s = do + sendMessage (Message REQ_INPUT $ "Input " ++ s ++ ": ") p + inp <- hGetLine (handle p) + case readMaybe inp of + Nothing -> getPlayerInput p s + Just n -> return n + + handleGameOver :: Game -> IO () + handleGameOver game = do + hClose (handle $ player1 game) + hClose (handle $ player2 game) + return () -- | Helpers -sendMessage :: String -> Player -> IO () -sendMessage msg p = do - hPutStrLn (handle p) msg - hFlush (handle p) +updateBoard :: Board -> Game -> Game +updateBoard b g = Game (player1 g) (player2 g) b + +sendMessage :: Message -> Player -> IO () +sendMessage m p = do + hPrint (handle p) m + putStrLn $ "did send message to client: " ++ show m toTuple :: [a] -> (a, a) toTuple (x:y:xs) = (x, y) @@ -79,3 +145,16 @@ zipLeftover (x:xs) (y:ys) = zipLeftover xs ys lastN :: Int -> [a] -> [a] lastN n xs = zipLeftover (drop n xs) xs + +isPrefix :: String -> String -> Bool +isPrefix [] _ = True +isPrefix _ [] = False +isPrefix (p:ps) (x:xs) + | p == x = isPrefix ps xs + | otherwise = False + +stringToMsg :: String -> Message +stringToMsg s + | isPrefix "INFO" s = Message INFO (drop 5 s) + | isPrefix "REQ_INPUT" s = Message REQ_INPUT (drop 10 s) + diff --git a/TicTacToe.hs b/TicTacToe.hs index d271330..72e7f6d 100644 --- a/TicTacToe.hs +++ b/TicTacToe.hs @@ -37,6 +37,7 @@ initialBoard = let initialRows = replicate 3 (RowCons Empty Empty Empty) in case boardFromRows initialRows of (Right b) -> b + boardFromRows :: [Row] -> BoardOrMsg boardFromRows rows | length rows /= 3 = Left ("Not the right number of rows: " ++ show (length rows)) diff --git a/test.hs b/test.hs new file mode 100644 index 0000000..bd59c32 --- /dev/null +++ b/test.hs @@ -0,0 +1,7 @@ + + +main = do + putStr "Input: " + x <- getLine + putStrLn $ "Input was: " ++ x + return ()