let borde t a =
  let n = Array.length t in
  let t1=Array.create (n+2*a) (Array.create (n+2*a) 0) in
    for i=0 to n+2*a-1 do
      t1.(i)<-(Array.create (n+2*a) 0);
    done;
    for i=0 to n-1 do
      for j=0 to n-1 do
	t1.(a+i).(a+j)<-t.(i).(j);
      done;
    done;
    t1

    
let table0=
  ref
    (let a=32 in
       [|
	 [|0;0;0;0;0;0;a;0;a;0;a;0;a;0;0;0;0;0;0;0|];
	 [|0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0|];
	 [|0;0;0;0;0;0;a;0;0;0;0;0;a;0;0;0;0;0;0;0|];
	 [|0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0|];
	 [|0;0;0;0;0;0;a;0;0;0;0;0;a;0;0;0;0;0;0;0|];
	 [|0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0|];
	 [|a;0;a;0;a;0;a;0;0;0;0;0;a;0;a;0;a;0;a;0|];
	 [|0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0|];
	 [|a;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;a;0|];
	 [|0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0|];
	 [|a;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;a;0|];
	 [|0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0|];
	 [|a;0;a;0;a;0;a;0;0;0;0;0;a;0;a;0;a;0;a;0|];
	 [|0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0|];
	 [|0;0;0;0;0;0;a;0;0;0;0;0;a;0;0;0;0;0;0;0|];
	 [|0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0|];
	 [|0;0;0;0;0;0;a;0;0;0;0;0;a;0;0;0;0;0;0;0|];
	 [|0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0|];
	 [|0;0;0;0;0;0;a;0;a;0;a;0;a;0;0;0;0;0;0;0|];
	 [|0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0|]
       |]);;

table0:=borde (!table0) 8;;
  
let copie_table t=
  let t1 = Array.copy t in
    for i=0 to (Array.length t)-1 do
      t1.(i)<-Array.copy t.(i);
    done;
    t1

let trou t x = t.(2*(fst x)).(2*(snd x))

let trou2 t x = t.(fst x).(snd x)

let remplit t x a = t.(2*(fst x)).(2*(snd x))<-a

let remplit2 t x a = t.(fst x).(snd x)<-a

let correct t x = 
  let i = fst x and j=snd x and n=Array.length t in
   0<=i && (2*i)<n && 0<= j && (2*j)<n

let libre t x = (correct t x)  && (trou t x)=0 

let bille t x = (correct t x) && (trou t x) > 0

(* les lignes auquelles appartient une bille
on code les 4 directions (sens trigo) en base 2
une bille sans ligne est codee 1,
avec une ligne verticale: 1+8=9
etc
*)

let puis2 d =
  match d with
    |0->2
    |1->4
    |2->8
    |3->16

(* les 4 directions des lignes partant d'un point *)
let dirx d =
  match d with
    |0->1
    |1->1
    |2->0
    |3->(-1)
let diry d =
  match d with
    |0->0
    |1->1
    |2->1
    |3->1

(* teste si x est a l'interieur d'une ligne de direction d *)
let sur_ligne t x d =
  ((trou t x) land (puis2 d))<>0

(* trace la ligne sur les cotes de x *)
let met_ligne_cotes t x d =
  let (i,j)=x in
  let x1=(2*i+(dirx d),2*j+(diry d)) in
  let x2=(2*i-(dirx d),2*j-(diry d)) in
  let a1 = trou2 t x1 in
  let a2 = trou2 t x2 in
    remplit2 t x1 (a1 lor (puis2 d));
    remplit2 t x2 (a2 lor (puis2 d))
    

(* met x dans l'interieur  d'une ligne de direction d *)
let met_ligne t x d =
  let a = trou t x in
    remplit t x (a lor (puis2 d));
    met_ligne_cotes t x d
      

(* trace une ligne passant par x dans la direction d,
   x etant en position k sur la ligne *)
let trace_ligne t x d k=
  let (i,j)=x in
  let di=dirx d and dj=diry d in
    for r=1 to 3 do
      met_ligne t (i+(r-k)*di,j+(r-k)*dj) d;
    done;
    if (trou t x)=0 then remplit t x 1

(* teste si en x on cree une ligne dans la direction d,
   x etant en position k sur la ligne 
   et en x il n'y a pas forcement de bille *)
let peut_tracer_ligne t x d k=
  let (i,j)=x in
  let di=dirx d and dj=diry d in
  let res = ref true in
    for r=0 to 4 do
      let y= (i+(r-k)*di,j+(r-k)*dj) in
	if r<>k then res:=(!res)&&(bille t y);
	res:= (!res) && (not (sur_ligne t y d));
    done;
    !res

let prt t =
  let s=ref "" in
  let n= Array.length t in
  for j=n-1 downto 0 do
    for i=0 to n-1 do
      let a = trou2 t (i,j) in
      let b =
	if (i mod 2)=0 && (j mod 2)=0
	then match a with
	  |0 -> ". "
	  |_-> if a>=32 then "# " else "o "
	else match a with
	  |2 -> "- "
	  |8 -> "| "
	  |4 -> "/ "
	  |16 ->"\ "
	  |20-> "X "
	  |_ -> "  "
      in s:=(!s)^b;
    done;
      s:=(!s)^"\n";
  done;
    !s

let prtable ()=
  print_string ((prt !table0)^"\n")

let print_table t=
  print_string ((prt t)^"\n")

(* rend les lignes qu'on peut tracer avec x:
   liste de (direction,position) *)
let lignes_point t x =
  let res=ref [] in
    for d=0 to 3 do
      let lk=ref[] in
	for k=0 to 4 do
	  if peut_tracer_ligne t x d k
	  then lk:=k::(!lk);
	done;
	(*if (List.length !lk)>1
	then (print_string ((string_of_int d)^":");
	      List.iter (fun k->print_string ((string_of_int k)^" ")) !lk;
	      print_string "\n";
	      flush(stdout));*)
	if (!lk)<>[] then res:=(d,!lk)::(!res);
    done;
    !res

(* rend la liste des points libres ou on peut tracer une ligne,
   avec leurs lignes *)
let points_possibles t =
  let res = ref [] in
  let n=(Array.length t)/2 in
    for i=0 to n-1 do
      for j=0 to n-1 do
	let r = (lignes_point t (i,j)) in
	  if r<>[]
	  then res:=((i,j),r)::(!res);
      done;
    done;
    !res

(*********************** 60 lignes *)
let choix t l =
  let l = Sort.list
	    (fun (_,l1) (_,l2)->
	       let l1=List.flatten (List.map snd l1) in
	       let l2=List.flatten (List.map snd l2) in
		 (List.length l1)>(List.length l2))
	    l in
    List.hd l

let choix_ligne l =
  let l = Sort.list
	    (fun k1 k2->(abs (k1-2))>(abs (k2-2)))
	    l in
    List.hd l
      

let joue ()=
  let m=ref 0 in
  let np=ref 0 in
    try (while true do
	   let (x,l) = (choix !table0 (points_possibles !table0)) in
	     if (List.length l)>1 then (print_string "*\n";flush(stdout));
	     List.iter
	       (fun (d,lk)->
		  if (List.mem 0 lk)&&(List.mem 4 lk)
		  then (print_string "-----------0 4\n";flush(stdout);
			trace_ligne !table0 x d 0;
			m:=(!m)+1;
			trace_ligne !table0 x d 4;
			m:=(!m)+1)
		  else
		    let k = choix_ligne lk in
		      trace_ligne !table0 x d k;
		      m:=(!m)+1
	       ) l;
	     np:=(!np)+1;
	 done)
    with _ -> 
      prtable();
      print_string ((string_of_int !m)^" lignes\n");
      print_string ((string_of_int !np)^" points ajoutes\n")

(************** 60 lignes *)
	
(* nombre de lignes possibles si on joue la *)
let lignes_si_joue t x ld=
  let t1 = copie_table t in
    let m=ref 0 in
      List.iter
      (fun (d,lk)->
	 if (List.mem 0 lk)&&(List.mem 4 lk)
	 then (trace_ligne t1 x d 0;
	       m:=(!m)+1;
	       trace_ligne t1 x d 4;
	       m:=(!m)+1)
	 else
	   let k = choix_ligne lk in
	     trace_ligne t1 x d k;
	     m:=(!m)+1
      ) ld;
    let lp = points_possibles t1 in
      (!m)+(List.length lp)
(*
      List.fold_left (+) !m
	(List.map (fun (x,l)-> List.length l) lp)
*)
	
let choix2 t lp =
  let m = ref 0 in
  let x0 = ref (1,1) in
  let ld0= ref [] in
    List.iter
      (fun (x,ld)->
	 let n = lignes_si_joue t x ld in
	       if n>(!m)
	       then (m:=n;x0:=x;ld0:=ld)
      ) lp;
    (!x0,!ld0,!m)

let joue2 ()=
  let m=ref 0 in
  let np=ref 0 in
    try (while true do
	   let (x,l,nl) = (choix2 !table0 (points_possibles !table0)) in
	     if l=[] then failwith "fini";
	     List.iter
	       (fun (d,lk)->
		  if (List.mem 0 lk)&&(List.mem 4 lk)
		  then (trace_ligne !table0 x d 0;
			m:=(!m)+1;
			trace_ligne !table0 x d 4;
			m:=(!m)+1)
		  else
		    let k = choix_ligne lk in
		      trace_ligne !table0 x d k;
		      m:=(!m)+1
	       ) l;
	     np:=(!np)+1;
	     prtable();
	     print_string ((string_of_int nl)^" lignes prevues\n");
	     print_string ((string_of_int !m)^" lignes\n");
	     print_string ((string_of_int !np)^" points ajoutes\n")
	 done)
    with _ -> 
      prtable();
      print_string ((string_of_int !m)^" lignes\n");
      print_string ((string_of_int !np)^" points ajoutes\n")
	

(* avec back-track *)

let max_lignes=ref 0;;
let rec list_rem x l=
  match l with
      [] -> []
    |y::l -> if y=x then l else y::(list_rem x l)
let rec souk l =
  if l=[] then [] else
    let x= List.nth l (Random.int (List.length l)) in
      x::(souk (list_rem x l))
  
let rec joue3_rec t m0 np =
  let lp= points_possibles t in
  let lp = Sort.list
	     (fun (_,l1) (_,l2)->
		let l1=List.flatten (List.map snd l1) in
		let l2=List.flatten (List.map snd l2) in
		  (List.length l1)>(List.length l2))
	     lp in
(*  let lp = souk lp in *)
  if lp=[]
  then (if m0>(!max_lignes)
	then (print_string "\n";
	      print_table t;
	      print_string ((string_of_int m0)^" lignes\n");
	      print_string ((string_of_int np)^" points ajoutes\n");
	      flush(stdout);
	      max_lignes:=m0)
	(* else (print_string (".");flush(stdout))*)
       )
  else
    let n=List.length lp in
    if true
    then
      List.iter
	(fun (x,ld)->
	   let t1=copie_table t in
	   let m=ref m0 in
	     List.iter
	       (fun (d,lk)->
		  if (List.mem 0 lk)&&(List.mem 4 lk)
		  then (print_string "-----------0 4\n";flush(stdout);
			trace_ligne t1 x d 0;
			m:=(!m)+1;
			trace_ligne t1 x d 4;
			m:=(!m)+1)
		  else
		    let k = choix_ligne lk in
		      trace_ligne t1 x d k;
		      m:=(!m)+1
	       ) ld;
	     joue3_rec t1 !m (np+1)
	) lp
	
let joue3 ()=
  max_lignes:=0;
  joue3_rec !table0 0 0;;

joue3();;

(* a compiler et executer:
ocamlopt morpion.ml -o joue
 ./joue.exe
*)