TicTacToe Game GUI with Bogue

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

2 Likes

you might be interested by this tutorial

https://sanette.github.io/bogue-tutorials/bogue-tutorials/widgets.html

especially this section

2 Likes

i have issue in line 9 , type square :

open Bogue

module W = Widget
module L = Layout

type player = X | O | Empty


type square = { 
  mutable state: player;
  box: W.Box;
}

let make_square () =
  let style = Style.empty in
  let box = W.box ~w:50 ~h:50 ~style () in
  { state = Empty; box }

let get_player_char = function
  | X -> "X"
  | O -> "O"
  | Empty -> " "

let check_winner board =
  let winning_combinations = [
    [0; 1; 2]; [3; 4; 5]; [6; 7; 8]; (* Rows *)
    [0; 3; 6]; [1; 4; 7]; [2; 5; 8]; (* Columns *)
    [0; 4; 8]; [2; 4; 6]              (* Diagonals *)
  ] in
  let check_combination [a; b; c] =
    match board.(a).state, board.(b).state, board.(c).state with
    | X, X, X -> Some X
    | O, O, O -> Some O
    | _ -> None
  in
  List.fold_left (fun acc comb ->
      match acc with
      | Some _ -> acc
      | None -> check_combination comb) None winning_combinations

let make_board () =
  Array.init 9 (fun _ -> make_square ())

let make_layout board =
  let dark = Style.(of_bg (opaque_bg Draw.(find_color "saddlebrown"))) in
  let light = Style.(of_bg (opaque_bg Draw.(find_color "bisque"))) in
  let make_row i =
    Array.init 3 (fun j ->
        let index = i * 3 + j in
        let square = board.(index) in
        let background =
          if (i + j) mod 2 = 0 then L.style_bg light else L.style_bg dark
        in
        L.resident ~background square.box)
  in
  Array.init 3 (fun i ->
      L.flat ~margins:0 (Array.to_list (make_row i)))
  |> Array.to_list
  |> L.tower ~margins:0

let next_player current_player =
  match current_player with
  | X -> O
  | O -> X
  | Empty -> failwith "Invalid player"

let add_move square player =
  if square.state = Empty then (
    square.state <- player;
    W.Box.set_text square.box (get_player_char player);
    true
  ) else false

let is_board_full board =
  Array.for_all (fun square -> square.state <> Empty) board

let rec game_loop board current_player =
  if check_winner board <> None then (
    let winner = match check_winner board with
      | Some X -> "X"
      | Some O -> "O"
      | _ -> "Nobody"
    in
    print_endline ("Congratulations! Player " ^ winner ^ " wins!")
  )
  else if is_board_full board then (
    print_endline "It's a draw!"
  )
  else (
    print_endline ("Player " ^ (get_player_char current_player) ^ "'s turn.");
    print_endline "Enter the index of the square to place your mark (0-8):";
    let index = read_int () in
    if index >= 0 && index < 9 then (
      let square = board.(index) in
      if add_move square current_player then (
        let next = next_player current_player in
        game_loop board next
      ) else (
        print_endline "Invalid move! Try again.";
        game_loop board current_player
      )
    ) else (
      print_endline "Invalid input! Try again.";
      game_loop board current_player
    )
  )

let () =
  let board = make_board () in
  let layout = make_layout board in
  Bogue.run (Bogue.of_layout layout);
  game_loop board X

W.Box is not a type, you should use W.t for generic widgets