Quantcast
Channel: OCaml - Topics tagged dune
Viewing all articles
Browse latest Browse all 521

TicTacToe Game GUI with Bogue

$
0
0

can someone help me to create Tictatoe game using graphical interface ?!
i already have the code for the game but not gui just in the terminal .

type piece = Cross | Circle

let piece_opposite = function
  | Cross -> Circle
  | Circle -> Cross

let add_color color s = "\027[3" ^ color ^ "m" ^ s ^ "\027[39m"

let piece_option_to_string = function
  | Some Cross -> add_color "1" " X "
  | Some Circle -> add_color "6" " O "
  | None -> " "

type board = piece option array array

let board_at board i j = board.(i).(j)

let board_init _ =
  Array.init 3 (fun _ -> Array.make 3 None)

let board_copy b =
  let res = board_init () in
  let n, p = 3, 3 in
  for i = 0 to n - 1 do
    for j = 0 to p - 1 do
      res.(i).(j) <- b.(i).(j)
    done
  done ;
  res

let board_place board piece i j =
  let board' = board_copy board in
  let () = board'.(i).(j) <- Some piece in
  board'

let board_transpose b =
  let res = board_init () in
  let n, p = 3, 3 in
  for i = 0 to n - 1 do
    for j = 0 to p - 1 do
      res.(j).(i) <- b.(i).(j)
    done
  done ;
  res

  let board_print b =
    let print_separator () =
      print_endline "+-------+-------+-------+";
    in
  
    let print_row r =
      print_string "|";
      Array.iter (fun piece ->
        match piece with
        | Some p -> print_string ("  " ^ piece_option_to_string (Some p) ^ "  |")
        | None -> print_string "       |"
      ) r;
      print_endline "";
    in
  
    print_separator ();
    Array.iter print_row b;
    print_separator ()
  
  

let has_won piece board =
  let winning_line = Array.for_all (fun x -> x = Some piece) in
  let is_main_diagonal_winning = Array.for_all (fun x -> x = Some piece) [|board.(0).(0); board.(1).(1); board.(2).(2)|] in
  let is_other_diagonal_winning = Array.for_all (fun x -> x = Some piece) [|board.(0).(2); board.(1).(1); board.(2).(0)|] in
  Array.exists winning_line board
  || Array.exists winning_line (board_transpose board)
  || is_main_diagonal_winning
  || is_other_diagonal_winning

let has_lost piece board =
  has_won (piece_opposite piece) board

let winning_board_cross = [|
  [|Some Cross; None; None|];
  [|Some Cross; Some Circle; None|];
  [|Some Cross; Some Circle; None|];
|]

let winning_board_circle = [|
  [|Some Cross; None; Some Circle|];
  [|Some Cross; Some Circle; None|];
  [|Some Circle; Some Circle; None|];
|]

let empty_board = board_init ()

let () = assert (has_won Cross winning_board_cross)
let () = assert (has_won Circle winning_board_circle)
let () = assert (has_lost Circle winning_board_cross)
let () = assert (has_lost Cross winning_board_circle)
let () = assert (not (has_lost Cross empty_board) && not (has_lost Circle empty_board))
let () = assert (not (has_won Cross empty_board) && not (has_won Circle empty_board))

let possible_moves board =
  let all_moves = List.init 3 (fun i -> List.init 3 (fun j -> (i, j))) |> List.flatten in
  List.filter (fun p -> board_at board (fst p) (snd p) |> Option.is_none) all_moves

let is_game_over board =
  has_won Cross board
  || has_won Circle board
  || Array.for_all (Array.for_all Option.is_some) board

let eval player board =
  if has_won player board then
    1
  else if has_lost player board then
    -1
  else
    0

type 'a tree =
  | Node of 'a * 'a tree list
  | Leaf

let tree_to_list tree =
  let rec aux = function
    | Leaf ->
        []
    | Node (n, children) ->
        n :: List.fold_left List.append [] (List.map aux children)
  in
  aux tree

let make_moves_tree max_depth board player =

  let rec aux depth board player =
    let moves = possible_moves board in
    match moves, depth with
    | [], _ -> Node (board, [Leaf])
    | _, 0 -> Node (board, [Leaf])
    | _l, d ->
        if is_game_over board then
          Node (board, [Leaf])
        else
          Node (board,
                List.map
                  (fun m -> aux (d - 1) (board_place board player (fst m) (snd m)) (piece_opposite player))
                  moves)
  in
  aux max_depth board player

let list_max l = List.fold_left max min_int l

let list_min l = List.fold_left min max_int l

let evaluate_board max_depth board player =

  let tree = make_moves_tree max_depth board player in

  let rec aux d tree = match tree with
    | Node (b, [Leaf]) -> eval player b
    | Node (_, l) ->
        if d mod 2 = 0 then list_max (List.map (aux (d + 1)) l)
        else list_min (List.map (aux (d + 1)) l)
    | Leaf -> failwith "Should not happen"
  in aux 0 tree

let find_best_move max_depth board player =
  let moves = possible_moves board in
  let possible_boards = List.map (fun m -> board_place board player (fst m) (snd m)) moves in
  let scores = List.map (fun b -> evaluate_board max_depth b (piece_opposite player)) possible_boards in
  let moves_and_scores = List.combine moves scores in
  let best_move_and_score = List.sort (fun x y -> compare (snd x) (snd y)) moves_and_scores
                            |> List.hd in
  fst best_move_and_score

let almost_winning_board = [|
  [|Some Cross; None; None|];
  [|Some Cross; None; None|];
  [|None; Some Circle; Some Circle|];
|]

let () = assert (find_best_move 2 almost_winning_board Circle = (2, 0))
let () = assert (find_best_move 2 almost_winning_board Cross = (2, 0))

let max_depth = 9

let rec play board player =
  board_print board;
  if is_game_over board then begin
    print_endline "Game over!";
    if has_won Cross board then
      print_endline "You won!"
    else if has_won Circle board then
      print_endline "Computer won!"
    else
      print_endline "Draw!"
  end
  else
    match player with
    | Cross ->
        print_endline "\nEnter move...";
        let command = read_int () in
        let i, j = command / 3, command mod 3 in
        let board' = board_place board Cross i j in
        play board' Circle
    | Circle ->
        let i, j = find_best_move max_depth board Circle in
        let board' = board_place board Circle i j in
        play board' Cross

let () = play empty_board Cross

4 posts - 2 participants

Read full topic


Viewing all articles
Browse latest Browse all 521

Trending Articles