haskell/naval_battle.hs

   1 import Random
   2 import Array
   3 import System.IO
   4 type Board = Array Int (Array Int Int)
   5
   6 board_size = (20, 20)
   7 board_empty = 1
   8 board_itens = [(4, 2, board_empty + 1), (3, 3, board_empty + 2), (1, 5, board_empty + 3), (5, 1, board_empty + 4)]
   9
  10 create_board :: Int -> Int -> Int -> Board
  11 create_board m n v = listArray (1, m) [listArray (1, n) [v | i <- [1..n]] | i <- [1..m]]
  12
  13 main = do
  14         g <- getStdGen
  15         hSetBuffering stdout NoBuffering
  16         game_loop (populate_board (create_board (fst board_size) (snd board_size) board_empty) board_itens g) (create_board (fst board_size) (snd board_size) 0)
  17
  18 board_to_string board = " " ++ unwords [s ++ "\n" | s <- [unwords [(show $ board!i!j) ++ " "  | j <- range $ bounds(board!i)] | i <- range (bounds(board))]]
  19
  20 game_loop :: Board -> Board -> IO()
  21 game_loop board user_board = do
  22         print "GameBoard:\n"
  23         putStr $ board_to_string board
  24         print "UserBoard:\n"
  25         putStr $ board_to_string user_board
  26         print "x:"
  27         x <- readLn
  28         if x == 0
  29                 then return ()
  30                 else do
  31                         print "y:"
  32                         y <- readLn
  33                         print "z:"
  34                         game_loop board (set x y user_board (board!x!y))
  35                         return ()
  36
  37 set :: Int -> Int -> Board -> Int -> Board
  38 set x y board v = board // [(x, board!x // [(y, v)])]
  39
  40 populate_board board [] _ = board
  41 populate_board board (x : rest) g =
  42         let (nboard, ng) = populate_board_item board x g
  43         in populate_board nboard rest ng
  44
  45 populate_board_item board (0, _, _) g  = (board, g)
  46 populate_board_item board (count, size, id) g =
  47         let (nboard, ng) = populate_board_item_size board size id g
  48             (rboard, rg) = populate_board_item nboard ((count - 1), size, id) ng
  49         in (rboard, rg)
  50
  51 populate_board_item_size board size id g =
  52         let (direction, ng) = randomR(0, 1) g
  53             (rboard, rg) = populate_board_item_size_direction board size direction id ng
  54         in (rboard, rg)
  55
  56 populate_board_item_size_direction board size direction id g
  57                 | valid_fill board i j direction size = (fill_board board i j direction size id, g2)
  58                 | True                          = (populate_board_item_size_direction board size direction id g2)
  59                 where
  60                         (i, g1) = randomR(1, (fst board_size) - direction * size) g
  61                         (j, g2) = randomR(1, (snd board_size) - (1 - direction) * size) g1
  62
  63 fill_board :: Board -> Int -> Int -> Int -> Int -> Int -> Board
  64 fill_board board i j direction 0 id = board
  65 fill_board board i j direction size id = fill_board (set i j board (id)) (i + direction) (j + 1 - direction) direction (size - 1) id
  66
  67 valid_fill :: Board -> Int -> Int -> Int -> Int -> Bool
  68 valid_fill board i j direction 0 = True
  69 valid_fill board i j direction size = (board!i!j) == board_empty && (valid_fill board (i + direction) (j + 1 - direction) direction (size - 1))
  70