#!/usr/bin/perl

$fn = $ARGV[0];

$ShowWhat = $ARGV[1];
if ($ShowWhat eq ""){ $ShowWhat = "mp"; }

if (! $fn){
  print "enter input position file name: ";
  $fn = <STDIN>;
  chomp $fn;
  $interactive = 1;
}

if (! -e $fn){
  die "file $fn not found\n";
}

($c,$t,$s,@p) = readBoard($fn);

@steps = getSteps($t, $s, @p);
$totSteps = $#steps + 1;
#print "number of steps is $totSteps\n";

undef %Pos;
$PosCount = 0;
$PosMul = 0;

saveInitialPos($t, $s, @p);
genMoves($t, $s, @p);

print "$totSteps choices for initial step\n";
print "$PosMul total move combinations\n";
print "$PosCount unique moves\n";
if ($PosMul > 0){
  $fr = int(10000*$PosCount/$PosMul)/100;
  print "$fr% are unique\n";
}

$ans = "y";
if ($interactive){
  $ShowWhat = "";
  print "\n";
  print "should I list the unique moves (y or n)?  ";
  $ans = <STDIN>;
  chomp $ans;
  if ($ans =~ m/^y/i){ $ShowWhat .= "m"; }
  print "\n";
  print "should I list the unique positions (y or n)?  ";
  $ans = <STDIN>;
  chomp $ans;
  if ($ans =~ m/^y/i){ $ShowWhat .= "p"; }
}
if ($ShowWhat ne ""){
  print "\n";
  showMoves();
}
if ($interactive){
  print "\n";
  print "$totSteps choices for initial step\n";
  print "$PosMul total move combinations\n";
  print "$PosCount unique moves\n";
  if ($PosMul > 0){
    $fr = int(10000*$PosCount/$PosMul)/100;
    print "$fr% are unique\n";
  }
}

exit;

sub saveInitialPos{
  local($t,$s,@p) = @_;

# take back any steps that have already been taken and save
#   that board position, but don't count it.
  if ($s){
    addPosition($s, @p);
  }
  @p = takeBackSteps($s, @p);
  addPosition(" ", @p);
  $PosMul -= 1;
  $PosCount -= 1;
}

sub genMoves{
  local($t, $s, @p) = @_;
  local(@steps, $step, @np, $ns, $push);

#print "**** in genMoves\n";
  @steps = getSteps($t, $s, @p);
  foreach $step (@steps){
    ($step, $push) = ($step =~ m/([^\-]*)(\-)?$/);
    @np = takeSteps($step, @p);
    $ns = "$s $step";
    $ns =~ s/^ +//;
    if ($push ne "-"){
      addPosition($ns, @np);
    }
    genMoves($t, $ns, @np);
  }
#print "**** out genMoves\n";
}

sub addPosition{
  local($s, @p) = @_;
  local($p, $os, $fr);

  $PosMul += 1;
  $p = join('', @p);
  $os = $Pos{$p};
  if (($os eq "") || (length($s) < length($os))){
    $Pos{$p} = $s;
    if ($os eq ""){ $PosCount += 1; }
  }
  if ($PosMul%1000 == 0){ 
    $fr = int(10000*$PosCount/$PosMul)/100;
    if ($interactive){
      if ($PosMul==1000){
        print "Unique Toal %\n";
      }
      print "$PosCount $PosMul  $fr\n"; 
    }
  }
}

sub showMoves{
  local($k, $v, $fr);
  local($moves, $pos);

  $moves = ($ShowWhat =~ m/m/i)?1:0;
  $pos = ($ShowWhat =~ m/p/i)?1:0;
  while(($k, $v)=each(%Pos)){
    if ($v =~ m/\w/){
      if ($moves){ print "$v\n"; }
      if ($pos){ print "[$k]\n"; }
    }
  }
}


# Note that steps which start a push are marked with a
#   dash (-) at the end; to indicate that the needs to 
#   be completed.
sub getSteps{
  local($t,$s,@p) = @_;
  local(@s,$ptype,$pcol,$fi,$ni,@a,$a,$type,$col,@np,$ti,@steps);
  local($i,$xd,$pulled,$ls,$stepsLeft,$lastStep,$pstr);
  local($pulledto);

#print "** in getSteps\n";

  @s = split(/ /, $s);
  $stepsLeft = 4;
  $lastStep = "";
  foreach(@s){ 
    if ($_ !~ m/x$/){ 
      $lastStep = $_;
      $stepsLeft -= 1; 
    }
  }
#print "steps Left is $stepsLeft; last step is $lastStep\n";
  if ($stepsLeft <= 0){ return; }
  ($ptype,$pcol, $fi, $ni) = stepInfo($lastStep);
  $ls = lastStepType($t, @s); # 0=?? 1=push -1=pull
#print "last steps Type is $ls\n";
  if (($ptype ne " ") && ($pcol ne $t) && (1) && ($ls != -1)){
#print "must complete push ptype=$ptype pcol=$pcol pto=$ni ls=$ls\n";
#   we have already started a push, so only our pieces
#     which can complete the push can move
    @a = getAdj($fi);
    foreach $a (@a){
      if ($p[$a] eq " "){ next; }
      ($type,$col) = pieceInfo($p[$a]);
      if ($col eq $t){
        if (isStronger($type, $ptype)){
          if (! isFrozen($a, @p)){
            push(@steps, makeStep($a, $fi, @p));
          }
        }
      }
    }
  }
  else{
#print "regular move\n";
# if the rabbit has reached the last row or if no rabbits
#   remaining then more steps cannot be taken.
# we should not enforce this since the applet allows more
#   steps to be taken after a win.  Also we can pull
#   opponents rabbit in the last row and push it back out
#   before the turn is over.

#    for($i=0;$i<8;$i++){
#      if ($p[$i] eq 'R'){ return @steps; }
#    }
#    for($i=56;$i<64;$i++){
#      if ($p[$i] eq 'r'){ return @steps; }
#    }
#    $pstr = join('', @p);
#    if ($pstr !~ m/[rR]/){ return @steps; }

#   go through all the pieces on the board
    for($i=0;$i<$#p+1;$i++){
      if ($p[$i] eq " "){ next; }
      ($type, $col) = pieceInfo($p[$i]);
      if ($col eq $t){
#       our unfrozen pieces can take steps
        if (! isFrozen($i, @p)){
          $xd = ($t eq "w")?"s":"n";
          if (pieceVal($type) != 1){ $xd = ""; }
          @a = getAdj($i, $xd);
          foreach $a (@a){
            if ($p[$a] eq " "){
              push(@steps, makeStep($i, $a, @p));
            }
          }
        }
      }
      else{
#       this is opponents pieces 
#       see if it can be pulled
#print "check pull for $p[$i] \n";
        $pulled = 0;
        $pulledto = -1;
        if (($pcol eq $t) && ($ls == 0) && isStronger($ptype, $type)){
          @a = getAdj($i);
          foreach $a (@a){
            if ($a == $fi){
              push(@steps, makeStep($i, $fi, @p));
              $pulled = 1;
              $pulledto = $fi;
              last;
            }
          }
#          if ($pulled){ next; }
        }
#       see if it can be pushed
#print "check push for $p[$i] \n";
        if (($stepsLeft >= 2) && isPushable($i, @p)){
          @a = getAdj($i);
          foreach $a (@a){
            if ($p[$a] eq " "){
              if ($a != $pulledto){ # add push only if it cant be pulled here
#if ($type eq 'r'){ print "added push from $i to $a\n"; }
                push(@steps, makeStep($i, $a, @p) . "-"); # use - to mark as a push
              }
            }
          }
        }
      }
    }
  }
#print "** out getSteps\n";
  return @steps;
}

sub isPushable{
  local($i, @p) = @_;
  local($ptype,$pcol,$type,$col,@a,$a);

  ($ptype, $pcol) = pieceInfo($p[$i]);
  @a = getAdj($i);
  foreach $a (@a){
    if ($p[$a] eq " "){ next; }
    ($type, $col) = pieceInfo($p[$a]);
    if (($col ne $pcol) && isStronger($type, $ptype)){
      if (! isFrozen($a, @p)){
        return 1;
      }
    }
  }
  return 0;
}

sub takeSteps{
  local($s, @p) = @_;
  local($type, $col, $fi, $ni, @s);
  
  @s = split(/ /,$s);
  foreach $s (@s){
    ($type,$col, $fi, $ni) = stepInfo($s);
    if ($type eq " "){ next; }
    if ($fi<0){
      $p[$ni] = $type;
    }
    elsif ($ni<0){
      $p[$fi] = " ";
    }
    else{
      $p[$ni] = $p[$fi];
      $p[$fi] = " ";
    }
  }
  return @p;
}

sub takeBackSteps{
  local($s, @p) = @_;
  local($type, $col, $fi, $ni, @s);
  
  @s = split(/ /,$s);
  @s = reverse(@s);
  foreach $s (@s){
    ($type,$col, $fi, $ni) = stepInfo($s);
    if ($type eq " "){ next; }
    if ($ni<0){
      $p[$fi] = $type;
    }
    elsif ($fi<0){
      $p[$ni] = " ";
    }
    else{
      $p[$fi] = $p[$ni];
      $p[$ni] = " ";
    }
  }
  return @p;
}

sub checkTraps{
  local(@p) = @_;
  local(@ts, $ts, @a, $a, $trapped, $type, $col, $atype, $acol, $x, $y);

  @ts = (2*8+2, 5*8+5, 2*8+5, 5*8+2);
  foreach $ts (@ts){
    if ($p[$ts] eq " "){ next; }
    ($type,$col) = pieceInfo($p[$ts]);
    @a = getAdj($ts);
    $trapped = 1;
    foreach $a (@a){
      if ($p[$a] eq " "){ next; }
      ($atype,$acol) = pieceInfo($p[$a]);
      if ($acol eq $col){ $trapped = 0; last; }
    }
    if ($trapped){ return $ts; }
  }
}
  

sub makeStep{
  local($i, $ni, @p) = @_;
  local($z, $x, $y, $nx, $ny, $s, $ti, @np);

  if ($i != -1){
    $y = int($i/8);
    $x = $i%8;
  }
  if ($ni != -1){
    $ny = int($ni/8);
    $nx = $ni%8;
  }
  if ($x == -1){
    $nx =~ tr/01234567/abcdefgh/;
    $ny = 8 - $ny;
    return "$p[$i]$nx$ny";
  }
  if ($ni == -1){
    $x =~ tr/01234567/abcdefgh/;
    $y = 8 - $y;
    return "$p[$i]$x${y}x";
  }
  if ($x == $nx){
    if ($ny < $y){ $z = "n"; }
    if ($ny > $y){ $z = "s"; }
  }
  if ($y == $ny){
    if ($nx < $x){ $z = "w"; }
    if ($nx > $x){ $z = "e"; }
  }
  $x =~ tr/01234567/abcdefgh/;
  $y = 8 - $y;
  $s = "$p[$i]$x$y$z";
  @np = takeSteps($s, @p);
  $ti = checkTraps(@np);
  if ($ti){ $s = "$s " . makeStep($ti, -1, @np); }
  return $s;
}

sub isFrozen{
  local($i, @p) = @_;
  local(@a, $a, $x, $y, $type, $col, $atype, $acol, $frozen);

  if ($p[$i] eq " "){ return 0; }
  ($type,$col) = pieceInfo($p[$i]);
  @a = getAdj($i);
  $frozen = 0;
  foreach $a (@a){
    if ($p[$a] eq " "){ next; }
    ($atype,$acol) = pieceInfo($p[$a]);
    if ($acol eq $col){ return 0; }
    if (isStronger($atype, $type)){ $frozen = 1; }
  }
  return $frozen;
}

sub getAdj{
  local($i, $x) = @_;
  local(@a);

  if ($i>7){ if ($x ne "n"){ push(@a, $i-8); }}
  if ($i<56){ if ($x ne "s"){ push(@a, $i+8); }}
  if ($i%8 != 7){ push(@a, $i+1); }
  if ($i%8 != 0){ push(@a, $i-1); }
  return @a;
}

sub pieceInfo{
  local($t) = @_;

  if ($t eq ""){ $t = " "; }
  $c = ($t =~ m/[a-z]/)?"b":"w";
  if ($t eq " "){ $c = " "; }
#  $t = lc($t);
  return ($t, $c);
}

sub lastStepType{
  local($t, @s) = @_;
  local(@a, $i);
  local($type, $col, $x, $y, $nx, $ny);
  local($ptype, $pcol, $px, $pnx);

# Get rid of step that show trapping; not needed here
  @s = grep(/[^x]$/, @s);

# 0=???? 1=push -1=pull
  if ($#s < 0){ return 0; }
  for($i=0;$i<$#s+1;$i++){
    if ($i == 0){ $a[0] = 0; next; }
    ($type,$col, $x, $nx) = stepInfo($s[$i]);
#print "========= info of $s[$i] is $type, $col, $x, $nx\n";
    if (($x<0) || ($nx<0)){ $a[$i] = $a[$i-1]; next; }
    if ($a[$i-1] != 0){ $a[$i] = 0; next; }
    ($ptype, $pcol, $px, $pnx) = stepInfo($s[$i-1]);
    if ($col ne $t){ # enemy is being moved
      $a[$i] = 0;
      if (($pcol eq $t) && ($px == $nx) && isStronger($ptype,$type)){
        $a[$i] = -1;
      }
    }
    else{
      $a[$i] = 0;
      if ($pcol ne $t){ $a[$i] = 1; }
    }
  }
#print " ==== a @a\n";
#print " returning $a[$#s]\n";
  return ($a[$#s]);
}

# return 1 if a is stronger than b
sub isStronger{
  local($a, $b) = @_;
  $a = pieceVal($a);
  $b = pieceVal($b);
  return ($a>$b);
}

sub pieceVal{
  local($p) = @_;

  $p = lc($p);
  $p =~ tr/emhdcr/654321/;
  return $p;
}

sub stepInfo{
  local($s) = @_;
  local($t, $c, $x, $y, $z, $i, $ni);

  ($t,$x,$y,$z) = split(//,$s);
  ($t, $c) = pieceInfo($t);
  $x =~ tr/abcdefgh/01234567/;
  $y = 8 - $y;
  $i = 8*$y + $x;
  $ni = $i;
  if ($z eq "n"){ $ni -= 8; }
  if ($z eq "s"){ $ni += 8; }
  if ($z eq "w"){ $ni -= 1; }
  if ($z eq "e"){ $ni += 1; }
  if ($z eq ""){ $i = -1; } # placement of piece
  if ($z eq "x"){ $ni = -1; } # removal of piece
  return ($t, $c, $i, $ni);
}



sub readBoard{
  local($fn) = @_;
  local(*FH, @f, $f);

  open(FH, "<$fn");
  @f = <FH>;
  close FH;

  $f = join('', @f);
  return parsePos($f);
}

sub parsePos{
  local($p) = @_;
  local($a, $b, @b, $t, $s);
  local($c, $t2);

  $p =~ s/\r//gs;
  $p =~ s/\n+/\n/gs;
  $p =~ s/^[ \t\n]//s;

  ($a,$b) = ($p =~ m/^([^\+]*)(\+[\w\W]+)/);
print "$a\n";
print " $b\n";

  $a =~ s/\n/ /g;
  ($t, $c, $t2, $s) = ($a =~ m/^ *(w|b)? *(\d+)?(w|b)? *(.*)/);

#print "$t $c $t2 [$s]\n";
  if ($t2){ $t = $t2; }

#print "turn = $t\n";
#  $s =~ s/^\d+(w|b) *//;
  $s =~ s/ +/ /g;
  $s =~ s/^ //;
  $s =~ s/ $//;
#print "steps = $s\n";

  $b =~ s/\n//gs;
#  $b =~ s/^\d//gm;
  ($b) = ($b =~ m/\|(.+)/);
  $b =~ s/ \+\-.*//;
  $b =~ s/ (.)/$1/g;
  $b =~ s/\d//g;
  $b =~ s/\|//g;
  $b =~ s/[xX]/ /g;

#print "b = '$b'\n";
  @b = split(//, $b);
  return ($c, $t, $s, @b);
  
}

sub writeBoard{
  local($fn, $c, $t, $s, @b) = @_;
  local(*FH, $b, $i, $row);
  
  open(FH, ">$fn");
  print FH "$c$t $s\n";
  print FH " +-----------------+\n";
  for($i=0;$i<64;$i++){
    if ($i%8 == 0){ 
      $row = 8 - $i/8;
      print FH "$row|";
    }
    print FH " $b[$i]";
    if ($i%8 == 7){
      print FH " |\n";
    }
  }
  print FH " +-----------------+\n";
  print FH "   a b c d e f g h\n";
  close FH;
}


