fork download 
  1. module Main (main) where
  2.  
  3. type Game = String
  4.  
  5. newGame :: Game
  6. newGame = "........."
  7.  
  8. printGame :: Game -> IO ()
  9. printGame game = do
  10.     putStrLn "  012"
  11.     putStrLn ("0 " ++ (take 3 game))
  12.     putStrLn ("1 " ++ (take 3 (drop 3 game)))
  13.     putStrLn ("2 " ++ (take 3 (drop 6 game)))
  14.  
  15. isEmpty :: Int -> Int -> Game -> Bool
  16. isEmpty x y game =
  17.     if 0 <= x && x < 3 && 0 <= y && y < 3 then
  18.         let p = y * 3 + x in
  19.         (game!!p) == '.'
  20.     else
  21.         False
  22.  
  23. getPlayerInputs :: Game -> IO (Int, Int)
  24. getPlayerInputs game = do
  25.     putStrLn "x y ?"
  26.     line <- getLine
  27.     let inputs = words line
  28.     let x = read (inputs!!0)
  29.     let y = read (inputs!!1)
  30.     if isEmpty x y game then
  31.         return (x, y)
  32.     else
  33.         getPlayerInputs game -- 再帰ループ
  34.  
  35. getComputerInputs :: Game -> IO (Int, Int)
  36. getComputerInputs game = do
  37.     let (inputs:_) = [ (x, y) | x <- [0, 1, 2], y <- [0, 1, 2], isEmpty x y game]
  38.     return inputs
  39.  
  40. putByPlayer :: Int -> Int -> Game -> Game
  41. putByPlayer x y game =
  42.     let p = y * 3 + x in
  43.     let front = take p game in
  44.     let back = drop (p + 1) game in
  45.     front ++ "o" ++ back
  46.  
  47. putByComputer :: Int -> Int -> Game -> Game
  48. putByComputer x y game =
  49.     let p = y * 3 + x in
  50.     let front = take p game in
  51.     let back = drop (p + 1) game in
  52.     front ++ "x" ++ back
  53.  
  54. isPlayerWinner :: Game -> Bool
  55. isPlayerWinner game =
  56.     case game of 
  57.     ('o':'o':'o': _ : _ : _ : _ : _ : _ :_) -> True
  58.     ( _ : _ : _ :'o':'o':'o': _ : _ : _ :_) -> True
  59.     ( _ : _ : _ : _ : _ : _ :'o':'o':'o':_) -> True
  60.     ('o': _ : _ :'o': _ : _ :'o': _ : _ :_) -> True
  61.     ( _ :'o': _ : _ :'o': _ : _ :'o': _ :_) -> True
  62.     ( _ : _ :'o': _ : _ :'o': _ : _ :'o':_) -> True
  63.     ('o': _ : _ : _ :'o': _ : _ : _ :'o':_) -> True
  64.     ( _ : _ :'o': _ :'o': _ :'o': _ : _ :_) -> True
  65.     _ -> False
  66.  
  67. isComputerWinner :: Game -> Bool
  68. isComputerWinner game =
  69.     case game of 
  70.     ('x':'x':'x': _ : _ : _ : _ : _ : _ :_) -> True
  71.     ( _ : _ : _ :'x':'x':'x': _ : _ : _ :_) -> True
  72.     ( _ : _ : _ : _ : _ : _ :'x':'x':'x':_) -> True
  73.     ('x': _ : _ :'x': _ : _ :'x': _ : _ :_) -> True
  74.     ( _ :'x': _ : _ :'x': _ : _ :'x': _ :_) -> True
  75.     ( _ : _ :'x': _ : _ :'x': _ : _ :'x':_) -> True
  76.     ('x': _ : _ : _ :'x': _ : _ : _ :'x':_) -> True
  77.     ( _ : _ :'x': _ :'x': _ :'x': _ : _ :_) -> True
  78.     _ -> False
  79.  
  80. isDrawn :: Game -> Bool
  81. isDrawn game = all (/='.') game
  82.  
  83. playTurn :: String -- name
  84.          -> (Game -> IO (Int, Int)) -- get~Inputs
  85.          -> (Int -> Int -> Game -> Game) -- putBy~
  86.          -> (Game -> Bool) -- is~Winner
  87.          -> Game
  88.          -> IO (Game, Bool)
  89. playTurn name getInputs putBy isWinner game1 = do
  90.     putStrLn (name ++ "'s turn")
  91.     (x, y) <- getInputs game1
  92.     putStrLn ("put (" ++ (show x) ++ ", " ++ (show y) ++ ")")
  93.     let game2 = putBy x y game1
  94.     printGame game2
  95.     if isWinner game2 then do
  96.         putStrLn (name ++ " won")
  97.         return (game2, True)
  98.     else if isDrawn game2 then do
  99.         putStrLn "Game was drawn"
  100.         return (game2, True)
  101.     else do
  102.         return (game2, False)
  103.  
  104. playPlayersTurn :: Game -> IO (Game, Bool)
  105. playPlayersTurn game = do
  106.     playTurn "Player"
  107.              getPlayerInputs
  108.              putByPlayer
  109.              isPlayerWinner
  110.              game
  111.  
  112. playComputersTurn :: Game -> IO (Game, Bool)
  113. playComputersTurn game = do
  114.     playTurn "Computer"
  115.              getComputerInputs
  116.              putByComputer
  117.              isComputerWinner
  118.              game
  119.  
  120. playGame :: (Game -> IO (Game, Bool)) -- current playTurn
  121.          -> (Game -> IO (Game, Bool)) -- next PlayTurn
  122.          -> Game
  123.          -> IO ()
  124. playGame current next game1 = do
  125.     (game2, endgame) <- current game1
  126.     if endgame then do
  127.         return ()
  128.     else do
  129.         playGame next current game2 -- 交換して再帰ループ
  130.  
  131. main :: IO ()
  132. main = do
  133.     let game = newGame
  134.     printGame game
  135.     playGame playPlayersTurn
  136.              playComputersTurn
  137.              game
  138.  
Success #stdin #stdout 0s 8388607KB
comments (?)
stdin 
1 1
0 1
2 1
stdout 
  012
0 ...
1 ...
2 ...
Player's turn
x y ?
put (1, 1)
  012
0 ...
1 .o.
2 ...
Computer's turn
put (0, 0)
  012
0 x..
1 .o.
2 ...
Player's turn
x y ?
put (0, 1)
  012
0 x..
1 oo.
2 ...
Computer's turn
put (0, 2)
  012
0 x..
1 oo.
2 x..
Player's turn
x y ?
put (2, 1)
  012
0 x..
1 ooo
2 x..
Player won
https://ideone.com/HHEWZv
language:
Haskell (ghc 8.4.4)
created:
6 years ago
visibility:
public

Share or Embed source code

Discover > Sphere Engine API

The brand new service which powers Ideone!

Discover > IDE Widget

Widget for compiling and running the source code in a web browser!