let debugf = Format.ifprintf Format.std_formatter

let pp_card out ((x, y), n) = Format.fprintf out "((%d, %d), %d)" x y n

let intersects ((x1l, y1b), n1) ((x2l, y2b), n2) =
  let x1r = x1l + n1 in
  let x2r = x2l + n2 in
  let y1t = y1b + n1 in
  let y2t = y2b + n2 in
  let result = x1l < x2r && x1r > x2l && y1t > y2b && y1b < y2t in
  begin
    result
  end

let rec card_fits size idx placed_cards (x, y) =
  if x + idx > size then false
  else if y + idx > size then false
  else
    match placed_cards with
    | [] -> true
    | h :: t ->
        if intersects h ((x, y), idx) then false else card_fits size idx t (x, y)

let rec in_card (x, y) cards =
  match cards with
  | [] -> false
  | ((a, b), n) :: t ->
      if x >= a && x < a + n && y >= b && y < b + n then true
      else in_card (x, y) t

let next_pos size (x, y) cards =
  let rec impl x y =
    if x >= size then impl 0 (y + 1)
    else if in_card (x, y) cards then impl (x + 1) y
    else (x, y)
  in
  impl (x + 1) y

let pp_pos out (x, y) = Format.fprintf out "(@[%d,@ %d@])" x y

let rec find_solutions_impl cards size n idx current_alloc current_pos = begin
	debugf "find_solutions_impl:@ @[<hov>%a@ %d@ %d@ %d@ %a@ %a@]@;@?"
	(Format.pp_print_array Format.pp_print_int) cards
	size n idx
	(Format.pp_print_list pp_card) current_alloc
	pp_pos current_pos;

  if current_pos = (0, size) then current_alloc
  else if idx = 0 then []
  else if cards.(idx) = 0 then
    find_solutions_impl cards size n (idx - 1) current_alloc current_pos
  else if card_fits size idx current_alloc current_pos then begin
    Array.set cards idx (cards.(idx) - 1);
    let new_alloc = (current_pos, idx) :: current_alloc in
    let new_pos = next_pos size current_pos new_alloc in
    let alloc = find_solutions_impl cards size n n new_alloc new_pos in
    Array.set cards idx (cards.(idx) + 1);
    if List.is_empty alloc then
    find_solutions_impl cards size n (idx - 1) current_alloc current_pos
    else alloc
  end
  else find_solutions_impl cards size n (idx - 1) current_alloc current_pos
end

let find_solutions cards size =
  find_solutions_impl cards size
    (Array.length cards - 1)
    (Array.length cards - 1)
    [] (0, 0)

let n = 8
let tri_n = (n + 1) * n / 2

(* Cards is an array initialised so that cards[x] = x for x = [0..9].

   These are the cards we need to fit into the square of length tri_n.
 *)
let cards = Array.init (n + 1) Fun.id
let soln = find_solutions cards tri_n
let () = Format.printf "@[<hov>Base number: %d,@;side length: %d@;" n tri_n
let () = Format.printf "Solution: %a@]@\n" (Format.pp_print_list pp_card) soln