#!/usr/bin/perl

# This is just a modified version of the move count program.
#   This returns a leagle move for the given input position.

# This program does not even look at the move list file,
#   but it is provided as the second argument


$fn = $ARGV[0];

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);

# for the setup just select from some common setups
if ($c == 1){
  if ($t eq 'w'){
    @setup = (
'Ee2 Md2 Ca1 Dc2 Hb2 Hg2 Ch1 Df2 Rb1 Rc1 Rd1 Re1 Rf1 Rg1 Ra2 Rh2',
'Ee2 Md2 Da1 Hb2 Dh1 Hg2 Cf1 Cc1 Rb1 Rd1 Re1 Rg1 Ra2 Rc2 Rf2 Rh2',
'Ee2 Md2 Hh2 Dg2 Db1 Ca2 He1 Cf1 Ra1 Rc1 Rd1 Rg1 Rh1 Rb2 Rc2 Rf2',
'Ee2 Md2 Ha2 Hh2 Db2 Dg2 Cc2 Cf2 Ra1 Rb1 Rc1 Rd1 Re1 Rf1 Rg1 Rh1',
    '');
  }
  else{
    @setup = (
'ee7 md7 ha7 hh7 db7 dg7 cf8 cc8 rc7 rf7 ra8 rb8 rd8 re8 rg8 rh8',
'ha7 hh7 dg7 me7 ed7 cc8 cf8 da8 rb7 rc7 rf7 rb8 rd8 re8 rg8 rh8',
'ee7 md7 ha7 hh7 db7 dg7 cf8 cc8 rc7 rf7 ra8 rb8 rd8 re8 rg8 rh8',
'me7 ed7 ha7 hh7 db7 dg7 cc8 cf8 rc7 rf7 ra8 rb8 rd8 re8 rg8 rh8',
    '');
  }
  print $setup[rand($#setup)] . "\n";
  exit;
}

# for all other moves generate about 10 random leagle moves
#   evaluate them and just select the best one

$N = 400;

for($i=0;$i<$N;$i++){
  $move = genRandMove($t, @p);
  $score = evalMove($t, $move, @p);
  if (($bscore eq "") || ($score > $bscore)){
#print "$score > $bscore  - $move  replaces $bmove\n";
    $bmove = $move; $bscore = $score;
  }
}

print "$bmove\n";

exit;

sub evalMove{
  local($t, $m, @p) = @_;
  local(@np, $sq, $i, $r);
  local($Rg, $Cg, $Pg, $Sg);
  local($Rs, $Cs, $Ps, $Ss);

  @np = takeSteps($rs, @p);
  $i = 0;
  foreach $sq (@np){
    if ($sq eq 'R'){
      $r = int($i/8);
      $r = 8 - $r;
      $r = $r*$r*$r;
      $Rg += $r;
      $Cg += 1;
    }
    if ($sq eq 'r'){
      $r = int($i/8);
      $r = $r + 1;
      $r = $r*$r*$r;
      $Rs += $r;
      $Cs += 1;
    }
    if ($sq eq 'R'){ $Pg += 1; }
    if ($sq eq 'C'){ $Pg += 2; }
    if ($sq eq 'D'){ $Pg += 3; }
    if ($sq eq 'H'){ $Pg += 4; }
    if ($sq eq 'M'){ $Pg += 5; }
    if ($sq eq 'E'){ $Pg += 6; }
    if ($sq eq 'r'){ $Ps += 1; }
    if ($sq eq 'c'){ $Ps += 2; }
    if ($sq eq 'd'){ $Ps += 3; }
    if ($sq eq 'h'){ $Ps += 4; }
    if ($sq eq 'm'){ $Ps += 5; }
    if ($sq eq 'e'){ $Ps += 6; }
    $i++;
  }
  $Sg = $Rg + ($Cg+1)*$Pg;
  $Ss = $Rs + ($Cs+1)*$Ps;
#print "gold: $Sg  vs  silver: $Ss\n";
  if ($t eq 'w'){ return($Sg - $Ss); }
  if ($t eq 'b'){ return($Ss - $Sg); }
}

sub genRandMove{
  local($t, @p) = @_;
  local($s, $sc, @steps, $push);

  $push = "-";
  for($sc=0;$sc<4;$sc++){
    @steps = getSteps($t, $s, @p);
    if ($push eq ''){
      @steps = (@steps, '');
    }
    $rs = $steps[rand($#steps+1)];
    if ($rs ne ''){ 
      ($rs, $push) = ($rs =~ m/([^\-]*)(\-)?$/);
      $s .= " $rs"; 
      $s =~ s/^ +//;
      @p = takeSteps($rs, @p);
    }
  }
  return $s;
}



exit;


@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){
  print "\n";
  print "should I list the unique moves (y or n)?  ";
  $ans = <STDIN>;
  chomp $ans;
}
if ($ans =~ m/^y/i){
  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);

  @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);
  }
}

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);

  while(($k, $v)=each(%Pos)){
    if ($v =~ m/\w/){
      print "$v\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";
        if (($pcol eq $t) && ($ls == 0) && isStronger($ptype, $type)){
          $pulled = 0;
          $pulledto = -1;
          @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);

# 0=???? 1=push -1=pull
  if ($#s < 0){ return 0; }
  for($i=0;$i<$#s+1;$i++){
    if ($i == 0){ $a[0] = 0; next; }
    if ($a[$i-1] != 0){ $a[$i] = 0; next; }
    ($type,$col, $x, $nx) = stepInfo($s[$i]);
    if (($x<0) || ($nx<0)){ $a[$i] = $a[$i-1]; 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; }
    }
  }
  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;
}


