(* A board has 38 "lanes" that can possibly have sandwiches (a lane
   needs at least 3 squares to have a sandwich) -- 8 horizontal, 8
   vertical, 11 sw-ne, and 11 se-nw.  Each square has 3 possible
   states; empty, black, or white.  So if L is the length of a lane,
   then a lane has 3^L possible states.  Any lane can be represented
   as a number by treating the square states as base 3 digits.  We
   call this numerical representation of a lane the "index" of the
   lane.

   For any given lane state, there is a set, possibly empty, of moves
   that black can make to create a sandwich in that lane, and likewise
   for white.  In order to speed up move generation, we can compute a
   table for each lane, that has an entry for every possible index for
   that lane.  The entry contains the move lists for black and white
   for that lane state.  Now to find the possible moves from a given
   board, you compute the index for each lane, and then take the union
   of the entries for all the lanes from the precomputed lane tables.
   That gives you all the possible moves.  This can be significanlty
   faster than actually analyzing the board to find all the potential
   sandwiches.

   This module implements some tables and functions to implement the
   above scheme of move generation.
*)


let pow3 = XArray.tabulate 9 (function n -> truncate (3.0 ** (float n)))

let black = 0
and empty = 1
and white = 2

let opponent p = 2 - p
    
let laneLength = [|
  8; 8; 8; 8; 8; 8; 8; 8;		(* the 8 horizontals *)
  8; 8; 8; 8; 8; 8; 8; 8;		(* the 8 verticals *)
  3; 4; 5; 6; 7; 8; 7; 6; 5; 4; 3;	(* the SW-NE diagonals *)
  3; 4; 5; 6; 7; 8; 7; 6; 5; 4; 3 |]	(* the NE-SW diagonals *)

(* takes a lane as an array of {0,1,2} and returns the index *)
let indexOfLane lane =
  Array.fold_left (fun ind p -> ind * 3 + p) 0 lane

(* takes an index value and returns the corresponding lane of length len *)
let laneOfIndex index len =
  XArray.tabulate len (function i -> (index / pow3.(len-i-1)) mod 3)

type moves = { black: int array;
	       white: int array;
	       bfront: int;		(* black frontier pieces *)
	       wfront: int		(* white   "       " *)
	     }

(* return a pair of lists, of black's moves and white's moves respectively,
   with empty lists to represent no move.  The moves are stored as an index into
   the lane *)
let movesOfLane lane =
  let len = Array.length lane in  
  (* returns the index containing op if l begins with the pattern "op+ me",
     else -1.  *)
  let rec sandwich me op ind dir =
    if ind < 0 || ind >= len || lane.(ind) = empty then false
    else begin
      if lane.(ind) = op then sandwich me op (dir ind) dir
      else true
    end
  and countFront who = XArray.fold_lefti
      (fun i n p ->
	if p <> empty then n
	else 
	  n + (if i > 0 && lane.(i-1) = who then 1 else 0)
	    + (if i < len - 1 && lane.(i+1) = who then 1 else 0))
      0 lane in
  
  let bl, wh = XArray.fold_lefti
      (fun i (bl, wh) p ->
      	if p <> empty then (bl, wh)
      	else begin
	  let left =
	    if i < 2 || lane.(i-1) = empty then -1
	    else begin
	      let op = lane.(i-1) in
	      let me = opponent op in
	      if sandwich me op (pred i) pred then me
	      else -1
	    end in
	  
	  let right =
	    if i > (len - 3) || (left <> -1 && lane.(i+1) <> left) then -1
	    else begin
	      let op = lane.(i+1) in
	      let me = opponent op in
	      if sandwich me op (succ i) succ then me
	      else -1
	    end in

	  ((if left = black || right = black then i::bl else bl),
	   (if left = white || right = white then i::wh else wh))
      	end)
      ([], []) lane in
  { black = Array.of_list bl;
    white = Array.of_list wh;
    bfront = countFront black;
    wfront = countFront white
  }

(* translates the moves in lane, move becomes move * m + a
   - : (int list * int list) array -> int -> int -> (int list * int list) array
   *)
      
let translateLane lane m a =
  Array.map
    (function e ->
      { black=Array.map (function mv -> mv * m + a) e.black;
       	white=Array.map (function mv -> mv * m + a) e.white;
	bfront=e.bfront; wfront=e.wfront
      } )
    lane

(* 0-7   - horizontal lanes, left is most significant
   8-15  - vertical lanes, from top, top is most significant
   16-26 - SW-NE diagonals, from left to right, left is most significant
   27-37 - NE-SW diagonals, from right to left, left is most significant
   *)
let legalMovesTable =
  let table = Array.create 38 [||] in
  
  (* do length 8 lanes *)
  (let lane8table = XArray.tabulate pow3.(8)
      (function i -> movesOfLane (laneOfIndex i 8)) in
  (* rows *)
  for row = 0 to 7 do
    table.(row) <- translateLane lane8table 1 (8 * row)
  done;
  (* columns *)
  for col = 0 to 7 do
    table.(col + 8) <- translateLane lane8table 8 col
  done;
  (* sw-ne diagonal *)
  table.(21) <- translateLane lane8table (-7) 56;
  (* nw-se diagonal *)
  table.(32) <- translateLane lane8table 9 0);
  
  (* other lane lengths *)
  for len = 7 downto 3 do
    let lanetable = XArray.tabulate pow3.(len)
	(function i -> movesOfLane (laneOfIndex i len)) in
    (* sw-ne diagonals *)
    table.(16 + (len-3)) <- translateLane lanetable (-7) ((len - 1) * 8);
    table.(16 + (13-len)) <- translateLane lanetable (-7) (56 + (8 - len));

    (* nw-se diagonals *)
    table.(27 + (len-3)) <- translateLane lanetable 9 (8 - len);
    table.(27 + (13-len)) <- translateLane lanetable 9 (8 * (8 - len));
  done;
  table
    
type square = { lanes: int array;
		flipOffsets: int array;
		placeOffsets: int array
	      }

let squareIndexes =
  XArray.tabulate 64
    (function i ->
      let row = i / 8
      and col = i mod 8 in
      let sum = row + col
      and dif = row - col in
      let swne = if sum < 1 || sum >= 13 then -1 else sum - 2
      and nwse = if dif >= 6 || dif <= -6 then -1 else 5 + dif in

      let lanes = [|row;
		    col + 8;
		    if swne >= 0 then swne + 16 else -1;
		    if nwse >= 0 then nwse + 27 else -1 |]
      and placeOffsets = [|pow3.(7 - col); (* rows are first col, MSD *)
			   pow3.(7 - row); (* cols are first row, MSD *)
			   if swne < 0 then -1
			   else if swne < 6 then pow3.(row)
			   else pow3.(7 - col);
			   if nwse < 0 then -1
			   else if nwse < 6 then pow3.(7 - col)
			   else pow3.(7 - row) |] in
      { lanes = lanes;
	placeOffsets = placeOffsets;
	flipOffsets = Array.map (( * ) 2) placeOffsets
      } )
