(**************************************************************************)
(*                                                                        *)
(*  Copyright (C) Jean-Christophe Filliatre                               *)
(*                                                                        *)
(*  This software is free software; you can redistribute it and/or        *)
(*  modify it under the terms of the GNU General Public                   *)
(*  License version 3.                                                    *)
(*                                                                        *)
(*  This software is distributed in the hope that it will be useful,      *)
(*  but WITHOUT ANY WARRANTY; without even the implied warranty of        *)
(*  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.                  *)
(*                                                                        *)
(**************************************************************************)

(**************************************************************************)
(*           Nombre de solutions pour les pentacubes planaires            *)
(*           Cas d'une grille rectangulaire d'aire 60                     *)
(**************************************************************************)

open Printf

(**************************************************************************
   
    Une grille est codée sur 2 entiers 30 bits, selon le schéma suivant

    ^ j=0..h-1
    |              ...  28 29
    | ...
    |   ... 28 29 0 1 2 ...
    | w ...
    | 0 1 2 ...           w-1
    -------------------------> i=0..w-1

 **************************************************************************)

type grille = int * int

type position = grille

(* paramètres *)

let usage () =
  prerr_endline "usage: penta_rect [-q] w h";
  prerr_endline "  with w * h = 60";
  exit 1

let affichage,w,h =
  let n = Array.length Sys.argv in
  let arg i = int_of_string Sys.argv.(i) in
  if n = 3 then true, arg 1, arg 2
  else if n = 4 && Sys.argv.(1) = "-q" then false, arg 2, arg 3
  else usage ()

let w_1 = w - 1
let h_1 = h - 1

let () = if w * h != 60 then usage ()

(* globaux *)

let pos = Array.create_matrix 12 336 (0,0)
let pos_ok = Array.create_matrix 12 336 (0,0)
let nb_pos = Array.create 12 0
let nb_pos_ok = Array.create 12 0

(* grille -> array et array -> grille *)

let array_vers_grille a =
  let t0 = ref 0 in
  let t1 = ref 0 in
  for j = h_1 downto 0 do
    for i = w_1 downto 0 do
      let ofs = w * j + i in
      let t = if ofs < 30 then t0 else t1 in
      t := (!t lsl 1) lor a.(i).(j)
    done
  done;
  !t0, !t1

let grille_vers_array (g0,g1) =
  let t0 = ref g0 in
  let t1 = ref g1 in
  let a = Array.create_matrix w h 0 in
  for j = 0 to h_1 do
    for i = 0 to w_1 do
      let ofs = w * j + i in
      let t = if ofs < 30 then t0 else t1 in
      a.(i).(j) <- !t land 1;
      t := !t lsr 1
    done;
  done;
  a


(* affichage *)

let affiche_grille g =
  let a = grille_vers_array g in
  for j = h_1 downto 0 do
    for i = 0 to w_1 do
      print_string (if a.(i).(j) = 1 then "# " else ". ")
    done;
    print_newline ()
  done;
  print_newline ()

let affiche_solution s m =
  let a = Array.create_matrix w h ' ' in
  for p = 0 to m-1 do
    let g = grille_vers_array pos_ok.(p).(s.(p)) in
    for i = 0 to w-1 do for j = 0 to h-1 do
      if g.(i).(j) = 1 then a.(i).(j) <- Char.chr (65+p)
    done done
  done;
  for j = h-1 downto 0 do for i = 0 to w-1 do
    print_char a.(i).(j); print_char ' '
  done; print_newline() done;
  print_newline ()


(* enregister les positions d'une piece particuliere *)

let reverse_8_bits n =
  let rec rev i dpi n rn =
    if i = 8 then 
      rn 
    else
      rev (succ i) (dpi / 2) (n / 2) (if n land 1 = 1 then rn lor dpi else rn)
  in
  rev 0 128 n 0

let enregistre (p,x1,x2,x3,x4,x5,wp,hp) =
  (* pose un mot de 8 bits n à l'emplacement (i,j) dans la grille g *)
  let blit n i j ((g0,g1) as g) =
    let n = reverse_8_bits n in
    if j >= h then 
      g 
    else
      let ofs = w * j + i in
      if ofs < 22 then 
	(g0 lor (n lsl ofs), g1)
      else if ofs >= 30 then 
	(g0, g1 lor (n lsl (ofs - 30)))
      else 
	(* chevauchement *) 
	(g0 lor ((n lsl ofs) land 0x3fffffff), 
	 g1 lor (n lsr (30 - ofs)))
  in
  for j = 0 to h - hp do
    for i = 0 to w - wp do
      let g = blit x1 i j (0,0) in
      let g = blit x2 i (j+1) g in
      let g = blit x3 i (j+2) g in
      let g = blit x4 i (j+3) g in
      let g = blit x5 i (j+4) g in
      pos.(p).(nb_pos.(p)) <- g;
      nb_pos.(p) <- nb_pos.(p) + 1
    done
  done


(* elimination des positions de pieces impossibles :
   on verifie que toutes les zones connexes ont une aire multiple de 5 *)

let check a c =
  let rec check_rec s = function
    | [] -> 
	s mod 5 = 0
    | (i,j) :: rem ->
	let s,rem = if i<w_1 && a.(i+1).(j) = 0 then begin 
	  a.(i+1).(j) <- 1; s+1,(i+1,j)::rem end else s,rem in
	let s,rem = if j<h_1 & a.(i).(j+1) = 0 then begin 
	  a.(i).(j+1) <- 1; s+1,(i,j+1)::rem end else s,rem in
	let s,rem = if i>0 & a.(i-1).(j) = 0 then begin
	  a.(i-1).(j) <- 1; s+1,(i-1,j)::rem end else s,rem in
	let s,rem = if j>0 & a.(i).(j-1) = 0 then begin
	  a.(i).(j-1) <- 1; s+1,(i,j-1)::rem end else s,rem in
	check_rec s rem
  in 
  check_rec 1 [c]

let verif g =
  let a = grille_vers_array g in
  try
    for i = 0 to w_1 do
      for j = 0 to h_1 do
      	if a.(i).(j) = 0 then begin
	  a.(i).(j) <- 1;
          if not (check a (i,j)) then raise Exit
	end
      done
    done; 
    true
  with Exit -> false

let glor (g0,g1) (p0,p1) = (g0 lor p0, g1 lor p1)
let gland (g0,g1) (p0,p1) = (g0 land p0, g1 land p1)

let positions_ok ini =
  for p = 0 to 11 do
    nb_pos_ok.(p) <- 0;
    for j = 0 to nb_pos.(p)-1 do
      let g = glor pos.(p).(j) ini in
      if verif g then begin
	pos_ok.(p).(nb_pos_ok.(p)) <- pos.(p).(j);
	nb_pos_ok.(p) <- nb_pos_ok.(p) + 1
      end else
	printf "."
    done
  done;
  print_newline();
  for p = 0 to 11 do
    printf "nb pos ok penta %2d : %4d \n" p nb_pos_ok.(p)
  done; 
  print_newline ()

(* initialisation *)

let initialisation ini =

  for i = 0 to 11 do nb_pos.(i) <- 0 done;

  (* penta 0 = ##### *)
  enregistre(0,128,128,128,128,128,1,5);
  enregistre(0,248,0,0,0,0,5,1);

  (* penta 1 = ### 
               # # *)
  enregistre(1,192,128,192,0,0,2,3);
  enregistre(1,224,160,0,0,0,3,2);
  enregistre(1,192,64,192,0,0,2,3);
  enregistre(1,160,224,0,0,0,3,2);

  (* penta 2 =  #
               ###
                #  *)
  enregistre(2,64,224,64,0,0,3,3);

  (* penta 3 = ###
                ## *)
  enregistre(3,128,192,192,0,0,2,3);
  enregistre(3,224,192,0,0,0,3,2);
  enregistre(3,192,192,64,0,0,2,3);
  enregistre(3,96,224,0,0,0,3,2);
  enregistre(3,64,192,192,0,0,2,3);
  enregistre(3,192,224,0,0,0,3,2);
  enregistre(3,192,192,128,0,0,2,3);
  enregistre(3,224,96,0,0,0,3,2);

  (* penta 4  =   # 
                ### 
                #   *)
  enregistre(4,96,64,192,0,0,3,3);
  enregistre(4,128,224,32,0,0,3,3);
  enregistre(4,192,64,96,0,0,3,3);
  enregistre(4,32,224,128,0,0,3,3);

  (* penta 5 = #
               #
               ### *)
  enregistre(5,224,32,32,0,0,3,3);
(*** symétries : on n'en prend qu'un sur les 4
  enregistre(5,32,32,224,0,0,6,6);
  enregistre(5,128,128,224,0,0,6,6);
  enregistre(5,224,128,128,0,0,6,6);
***)  

  (* penta 6 =  # 
               ## 
                #
                # *)
  enregistre(6,64,240,0,0,0,4,2);
  enregistre(6,128,192,128,128,0,2,4);
  enregistre(6,240,32,0,0,0,4,2);
  enregistre(6,64,64,192,64,0,2,4);
  enregistre(6,240,64,0,0,0,4,2);
  enregistre(6,64,192,64,64,0,2,4);
  enregistre(6,32,240,0,0,0,4,2);
  enregistre(6,128,128,192,128,0,2,4);

  (* penta 7 = #
               ### 
               #   *)
  enregistre(7,224,64,64,0,0,3,3);
  enregistre(7,32,224,32,0,0,3,3);
  enregistre(7,64,64,224,0,0,3,3);
  enregistre(7,128,224,128,0,0,3,3);

  (* penta 8 =  ## 
               ## 
                #  *)
  enregistre(8,64,224,128,0,0,3,3);
  enregistre(8,192,96,64,0,0,3,3);
  enregistre(8,32,224,64,0,0,3,3);
  enregistre(8,64,192,96,0,0,3,3);
  enregistre(8,128,224,64,0,0,3,3);
  enregistre(8,96,192,64,0,0,3,3);
  enregistre(8,64,224,32,0,0,3,3);
  enregistre(8,64,96,192,0,0,3,3);

  (* penta 9 = ####
                  # *)
  enregistre(9,128,128,128,192,0,2,4);
  enregistre(9,240,128,0,0,0,4,2);
  enregistre(9,192,64,64,64,0,2,4);
  enregistre(9,16,240,0,0,0,4,2);
  enregistre(9,64,64,64,192,0,2,4);
  enregistre(9,128,240,0,0,0,4,2);
  enregistre(9,192,128,128,128,0,2,4);
  enregistre(9,240,16,0,0,0,4,2);

  (* penta 10 = #
                #
               ##
               #  *)
  enregistre(10,48,224,0,0,0,4,2);
  enregistre(10,128,128,192,64,0,2,4);
  enregistre(10,112,192,0,0,0,4,2);
  enregistre(10,128,192,64,64,0,2,4);
  enregistre(10,192,112,0,0,0,4,2);
  enregistre(10,64,192,128,128,0,2,4);
  enregistre(10,224,48,0,0,0,4,2);
  enregistre(10,64,64,192,128,0,2,4);

  (* penta 11 = #
                ##
                 ## *)
  enregistre(11,192,96,32,0,0,3,3);
  enregistre(11,32,96,192,0,0,3,3);
  enregistre(11,128,192,96,0,0,3,3);
  enregistre(11,96,192,128,0,0,3,3);

  for i = 0 to 11 do
    printf "nb pos. penta %2d : %4d \n" i nb_pos.(i)
  done;

  positions_ok ini

(* la procedure de recherche : un bon vieux backtracking *)

let nb_sol = ref 0
let cur_pos = Array.create 12 0

let rec essayer k ((g0,g1) as pos) =
  if k < 11 & not (verif pos) then 
    ()
  else if k = 12 then begin
    incr nb_sol;
    if affichage then affiche_solution cur_pos 12
  end else
    for i = 0 to nb_pos_ok.(k)-1 do
      let (p0,p1) = pos_ok.(k).(i) in
      if ((g0 land p0) lor (g1 land p1)) = 0 then begin
	let g = (g0 lor p0, g1 lor p1) in
        cur_pos.(k) <- i;
	essayer (k+1) g
      end
    done

(* main *)

let main () =
  let pos_ini = (0,0) in

  printf "\n";
  affiche_grille pos_ini;

  printf "\n\nInitialisation :\n";
  initialisation pos_ini;

  (* printf "Appuyez sur une touche..."; flush stdout;
  let _ = read_line () in *)
  nb_sol := 0;
  essayer 0 pos_ini;

  printf "\nNb de solutions : %d\n" !nb_sol

let _ = Printexc.print main ()