GeneralTicTacToe (empty) → 0.1.0.0

raw patch · 4 files changed

+164/−0 lines, 4 filesdep +basesetup-changed

Dependencies added: base

Files

• GeneralTicTacToe.cabal +23/−0
• LICENSE +1/−0
• Setup.hs +2/−0
• TicTacToe.hs +138/−0

@@ -0,0 +1,23 @@+name:                GeneralTicTacToe
+version:             0.1.0.0
+synopsis:            A general TicTacToe game implementation.
+
+description:         Tic-tac-toe (also known as Noughts and crosses or Xs and
+                     Os) is a paper-and-pencil game for two players, X and O,
+                     who take turns marking the spaces in a 3×3 grid. The player
+                     who succeeds in placing three of their marks in a
+                     horizontal, vertical, or diagonal row wins the game.  
+
+homepage:            http://afonso.xyz
+license:             MIT
+license-file:        LICENSE
+author:              Afonso Matos
+maintainer:          contact@afonsomatos.com
+category:            Game
+build-type:          Simple
+cabal-version:       >=1.10
+
+executable GeneralTicTacToe
+  main-is: TicTacToe.hs           
+  build-depends:       base >=4.7 && <4.8
+  default-language:    Haskell2010

@@ -0,0 +1,1 @@+Stuff

@@ -0,0 +1,2 @@+import Distribution.Simple
+main = defaultMain

@@ -0,0 +1,138 @@+module Main where
+
+import Data.List (transpose)
+import Data.Foldable (asum)
+import System.IO (hSetBuffering, stdout, BufferMode (NoBuffering))
+
+import Utils (surround, nth, isInt)
+
+data Tile = O | X | Empty deriving Eq
+
+instance Show Tile where
+    show Empty = " "
+    show O     = "O"
+    show X     = "X"
+
+-- ======================
+-- Board Helper Functions
+-- ======================
+type Board = [[ Tile ]]
+
+showBoard :: Board -> String
+showBoard xss = unlines
+             . surround vtx
+             . map (concat . surround mid . map show)
+             $ xss
+
+    where mid = "|"
+          vtx = surround '+' $ replicate (length xss) '-'                   
+
+whoWon :: Board -> Maybe Player
+whoWon xss = asum
+           . map winner
+           $ diag : anti : cols ++ xss
+
+    where cols = transpose xss
+          diag = zipWith (!!) xss           [0..]
+          anti = zipWith (!!) (reverse xss) [0..]
+
+          winner []     = Nothing
+          winner (x:xs) = if all (==x) xs && x /= Empty
+                              then Just (toPlayer x)
+                              else Nothing
+
+getCoords :: Int -> Board -> (Int, Int)
+getCoords n = divMod (n - 1) . length
+
+fillTile :: Board -> Int -> Tile -> Board
+fillTile xss n tile = nth row (nth col (const tile)) xss
+    
+    where (row, col) = getCoords n xss
+
+isOver :: Board -> Bool
+isOver = all (notElem Empty)
+
+-- ========================
+-- Player related functions
+-- ========================
+data Player = Player1 | Player2
+
+instance Show Player where
+    show Player1 = "1st Player"
+    show Player2 = "2nd Player"
+
+toPlayer :: Tile -> Player
+toPlayer X = Player1
+toPlayer _ = Player2
+
+fromPlayer :: Player -> Tile
+fromPlayer Player1 = X
+fromPlayer Player2 = O
+
+changePlayer :: Player -> Player
+changePlayer Player1 = Player2
+changePlayer Player2 = Player1
+
+-- ===========================
+-- Game and UI Logic Functions
+-- ===========================
+data ValidationError = OutOfRange | AlreadyFilled | NotInteger
+
+instance Show ValidationError where
+    show NotInteger    = "Only integers allowed"
+    show OutOfRange    = "Number is not in range"
+    show AlreadyFilled = "That tile is already filled" 
+
+validateNumber :: Board -> String -> Either ValidationError Int
+validateNumber xss x
+    | not $ isInt x              = Left NotInteger
+    | num < 1 || num > tiles     = Left OutOfRange
+    | xss !! row !! col /= Empty = Left AlreadyFilled
+    | otherwise                  = Right num
+
+    where num        = read x
+          tiles      = length (concat xss)
+          (row, col) = getCoords num xss
+
+getNumber :: Board -> IO Int
+getNumber xss = do
+
+    input <- getLine
+
+    case validateNumber xss input of
+
+        Left  err -> putStrLn ("Invalid: " ++ show err) >> getNumber xss
+        Right num -> return num
+
+nextPlay :: Player -> Board -> IO ()
+nextPlay player board = do
+
+    putStrLn $ "Your turn, " ++ show player ++ "!"
+
+    putStr $ "Tile number [1.." ++ show (length . concat $ board) ++ "]: "
+    num <- getNumber board
+
+    let tile = fromPlayer   player
+        next = changePlayer player
+    
+    gameStep next (fillTile board num tile)
+
+gameStep :: Player -> Board -> IO ()
+gameStep player board = do
+
+    putStrLn $ showBoard board
+
+    case whoWon board of
+
+        Just winner -> putStrLn $ show winner ++ " won!"
+
+        Nothing | isOver board -> putStrLn "Game ended in a draw"
+                | otherwise    -> nextPlay player board
+
+startBoard :: Int -> Board
+startBoard x = replicate x (replicate x Empty)
+
+main :: IO ()
+main = do
+    hSetBuffering stdout NoBuffering
+    gameStep Player1 (startBoard 3)