Source file board.ml

open Knights_tour

module PointMap = Map.Make(Point)

type square =
  | Occupied of Polyomino.t 
  | Vacant
  | Blocked

type t = {
  size: Point.t;
  squares: Polyomino.t option PointMap.t; (* map of squares on the board excluding blocked squares *)
}

let size {size;_} = size

let get {squares;_} pt =
  match PointMap.find_opt pt squares with 
  | None -> Blocked
  | Some (Some p) -> Occupied p
  | Some None -> Vacant

let vacant {squares;_} =
  let vacancies = ref PointSet.empty in
  squares |> PointMap.iter (fun pt square ->
    if Option.is_none square then
      vacancies := PointSet.add pt !vacancies
  );
  !vacancies
  
let of_string img =
  let vacancies = PointSet.of_string img |> PointSet.normalize_translation in
  {
    size = Point.{
      x = PointSet.max_x vacancies + 1;
      y = PointSet.max_y vacancies + 1;
    };
    squares = PointSet.fold (fun vacant board -> PointMap.add vacant None board) vacancies PointMap.empty
  }

let classic = of_string "
  ########
  ########
  ########
  ###..###
  ###..###
  ########
  ########
  ########"

let%expect_test "Board of_string |> vacant" =
  let open Printf in
  let board = classic in
  printf "min x: %d y: %d\n" (PointSet.min_x (vacant board)) (PointSet.min_y (vacant board));
  printf "max x: %d y: %d\n" (PointSet.max_x (vacant board)) (PointSet.max_y (vacant board));
  printf "size = (%d, %d)\n" (size board).x (size board).y;
  printf "\n";
  printf "%s" (PointSet.to_string (vacant board));
  [%expect{|
    min x: 0 y: 0
    max x: 7 y: 7
    size = (8, 8)

    ########
    ########
    ########
    ###..###
    ###..###
    ########
    ########
    ######## |}]

let put board points poly =
  PointSet.fold (fun pt board ->
    match PointMap.find pt board with 
    | None -> PointMap.add pt (Some poly) board
    | _ -> failwith "Invalid placement. Polyomino should only be placed on vacant squares"
  ) points board.squares
  |> (fun squares -> {board with squares})  

let to_string board =
  let square_to_char = (function
  | Vacant -> '.'
  | Occupied p -> Polyomino.name p
  | Blocked -> '#'
  ) in

  let size = board.size in
  let image = Buffer.create ((size.x+1)*(size.y+1)) in
  for y = 0 to size.y-1 do
    for x = 0 to size.x-1 do
      Buffer.add_char image (square_to_char (get board {x;y}))
    done;
    Buffer.add_char image '\n'
  done;
  Buffer.contents image

let%expect_test "Place a polyomino" =
  let polyos = Polyomino.of_order 5 in
  let board = classic in
  polyos |> List.iteri (fun i poly ->
    Printf.printf "%d:\n" (i+1);
    let board = put board (Polyomino.points poly) poly in
    Printf.printf "%s\n" (to_string board)
  )
  ; [%expect{|
    1:
    AAAAA...
    ........
    ........
    ...##...
    ...##...
    ........
    ........
    ........

    2:
    BBBB....
    B.......
    ........
    ...##...
    ...##...
    ........
    ........
    ........

    3:
    CCCC....
    .C......
    ........
    ...##...
    ...##...
    ........
    ........
    ........

    4:
    DDD.....
    DD......
    ........
    ...##...
    ...##...
    ........
    ........
    ........

    5:
    EEE.....
    E.E.....
    ........
    ...##...
    ...##...
    ........
    ........
    ........

    6:
    FFF.....
    F.......
    F.......
    ...##...
    ...##...
    ........
    ........
    ........

    7:
    GGG.....
    .G......
    .G......
    ...##...
    ...##...
    ........
    ........
    ........

    8:
    HHH.....
    ..HH....
    ........
    ...##...
    ...##...
    ........
    ........
    ........

    9:
    II......
    .II.....
    .I......
    ...##...
    ...##...
    ........
    ........
    ........

    10:
    JJ......
    .JJ.....
    ..J.....
    ...##...
    ...##...
    ........
    ........
    ........

    11:
    KK......
    .K......
    .KK.....
    ...##...
    ...##...
    ........
    ........
    ........

    12:
    .L......
    LLL.....
    .L......
    ...##...
    ...##...
    ........
    ........
    ........ |}]

let draw_size = 32

module CharMap = Map.Make(Char)
let color_table : Graphics.color CharMap.t = 
  let ct = ref CharMap.empty in
  for i = 1 to 14 do
    let ch = (Char.code 'A') + i - 1 |> Char.chr in
    let r = i mod 2 in
    let i = i / 2 in
    let g = i mod 2 in
    let i = i / 2 in
    let b = i mod 2 in
    let i = i / 2 in
    let dark = (i mod 2) * 100 + 100 in
    ct := CharMap.add ch (Graphics.rgb (200-dark*r) (200-dark*g) (200-dark*b)) !ct
  done;
  !ct

let%expect_test "color table" =
  color_table |> CharMap.iter (fun k v ->
    Printf.printf "'%c' -> %d\n" k v
  )
  ; [%expect{|
    'A' -> 6605000
    'B' -> 13133000
    'C' -> 6579400
    'D' -> 13158500
    'E' -> 6604900
    'F' -> 13132900
    'G' -> 6579300
    'H' -> 13158600
    'I' -> 51400
    'J' -> 13107400
    'K' -> 200
    'L' -> 13158400
    'M' -> 51200
    'N' -> 13107200 |}]

let color_of = function 
| Vacant -> Graphics.white
| Blocked -> Graphics.black
| Occupied p -> CharMap.find (Polyomino.name p) color_table
let draw (board:t) = 
  Graphics.set_font "12x24";
  Graphics.clear_graph ();
  let sz = size board in
  for y = 0 to sz.y-1 do
    for x = 0 to sz.x-1 do
      Graphics.set_color (get board {x;y} |> color_of);
      Graphics.fill_rect (x*draw_size) (y*draw_size) draw_size draw_size
    done
  done