Question

Napisać w Haskellu aplikację służącą do rozegrania pojedynczej partii w kółko i krzyżyk przez dwóch użytkowników komputera. Aplikacja ma pytać o ruchy, kontrolować ich poprawność, wyświetlać planszę po każdym ruchy, a w końcu ogłaszać wynik partii.

Answer 1

-- W ogólności program jest prosty. Rekurencyjnie należy wykonywać kroki, które

-- opisałeś w zadaniu. Plus trochę walidacji danych (tu isDigit z Data.Char) oraz

-- wypisywanie (tu wygodnie sprawdzają się instancje Show).

-- Może rozwiązanie jest nieco mało idiomatyczne, ale powinno być proste w zrozumieniu

 

import Data.Char

 

data Field = O | X | U Integer deriving Eq
instance Show Field where
  show O = "O"
  show X = "X"
  show (U i) = show i

 

data Row = Row Field Field Field

rowEdge = " "
fieldSep = " | "
instance Show Row where
  show (Row f1 f2 f3) = rowEdge ++ show f1 ++ fieldSep ++ show f2 ++ fieldSep ++ show f3 ++ rowEdge

 

data Board = Board Row Row Row
rowSep = "\n---+---+---\n"
instance Show Board where
  show (Board r1 r2 r3) = show r1 ++ rowSep ++ show r2 ++ rowSep ++ show r3

startBoard = Board (Row (U 1) (U 2) (U 3)) (Row (U 4) (U 5) (U 6)) (Row (U 7) (U 8) (U 9))

 

data Player = Circle | Cross

fieldFor Circle = O

fieldFor Cross = X

other Circle = Cross
other Cross = Circle

 

displayBoard = putStrLn . show

parseMove [d] board
  | isDigit d = return $ digitToInt d
  | otherwise = parseMove "inval" board
parseMove _ board = do
  putStrLn "Provided input is not a digit"
  getMove board

getMove board = do

  () <- putStrLn "Please enter field: "
  input <- getLine
  () <- putStrLn ""
  parseMove input board

 

withMove 1 f1 (Board (Row (U 1) f2 f3) r2 r3) = Just $ Board (Row f1 f2 f3) r2 r3
withMove 2 f2 (Board (Row f1 (U 2) f3) r2 r3) = Just $ Board (Row f1 f2 f3) r2 r3
withMove 3 f3 (Board (Row f1 f2 (U 3)) r2 r3) = Just $ Board (Row f1 f2 f3) r2 r3
withMove 4 f4 (Board r1 (Row (U 4) f5 f6) r3) = Just $ Board r1 (Row f4 f5 f6) r3
withMove 5 f5 (Board r1 (Row f4 (U 5) f6) r3) = Just $ Board r1 (Row f4 f5 f6) r3
withMove 6 f6 (Board r1 (Row f4 f5 (U 6)) r3) = Just $ Board r1 (Row f4 f5 f6) r3
withMove 7 f7 (Board r1 r2 (Row (U 7) f8 f9)) = Just $ Board r1 r2 (Row f7 f8 f9)
withMove 8 f8 (Board r1 r2 (Row f7 (U 8) f9)) = Just $ Board r1 r2 (Row f7 f8 f9)
withMove 9 f9 (Board r1 r2 (Row f7 f8 (U 9))) = Just $ Board r1 r2 (Row f7 f8 f9)
withMove _ _ _ = Nothing

putMove board player move = case withMove move (fieldFor player) board of
  Just board -> return board
  Nothing -> getMove board >>= putMove board player

 

orElse (Just x) _ = Just x
orElse _ (Just x) = Just x
orElse _ _ = Nothing
sameIn [X, X, X] = Just X
sameIn [O, O, O] = Just O
sameIn _ = Nothing

finished (Board (Row f1 f2 f3) (Row f4 f5 f6) (Row f7 f8 f9)) =

  (sameIn [f1, f2, f3] `orElse` sameIn [f4, f5, f6] `orElse` sameIn [f7, f8, f9]
    `orElse` sameIn [f1, f4, f7] `orElse` sameIn [f2, f5, f8] `orElse` sameIn [f3, f6, f9]
    `orElse` sameIn [f1, f5, f9] `orElse` sameIn [f3, f5, f7])

 

unfilled (U _) = True
unfilled _ = False
anyFieldLeft (Board (Row f1 f2 f3) (Row f4 f5 f6) (Row f7 f8 f9)) =
  any unfilled [f1, f2, f3, f4, f5, f6, f7, f8, f9]

 

printStats board field = do

  finalBoard board
  putStrLn $ "Player " ++ (show $ field) ++ " won!"

 

finalBoard board = do
  putStrLn "Finished!"
  putStrLn $ show board

 

continueWith board player = case finished board of
  Just field -> printStats board field
  Nothing -> if anyFieldLeft board then nextRound board $ other player else finalBoard board

 

nextRound board player = do
  () <- displayBoard board
  move <- getMove board
  newBoard <- putMove board player move
  continueWith newBoard player

 

main = nextRound startBoard Cross