#!perl -w

use strict;
use warnings;

use Win32::GuiTest qw(:ALL);
$Win32::GuiTest::debug = 0;

sub Pause
{ my $msg = shift;
  $msg = "<Enter> to continue..." if ! $msg;
  print $msg;
  <STDIN>;
}

use constant
{ MINESWEEPER_TITLE => 'Minesweeper',
  MINESWEEPER_EXE   => 'winmine.exe',
};

my @windows = FindWindowLike(undef, '^' . MINESWEEPER_TITLE . '$');
die @windows . " windows found. Too many.\n" if (@windows > 1);
my $window = $windows[0];

if (not $window) {
  print 'Could not find ', MINESWEEPER_TITLE, ' -- starting ', MINESWEEPER_EXE, '... ' ;
  system('start ' . MINESWEEPER_EXE) == 0
    or die "Can't start " . MINESWEEPER_EXE . ": $!\n";
  print "OK.\n";
  $window = WaitWindow('^' . MINESWEEPER_TITLE . '$', 2)
    or die 'Still no ' . MINESWEEPER_TITLE . ". Out!\n";
}

use constant
{ CELLW => 16,
  CELLH => 16,
  OFFSX => 13,
  OFFSY => 55,
  PADX  => 1,  # These two will change bitmaps!
  PADY  => 1,  #
  IMIN  => 1,
  JMIN  => 1,
  IMAX  => 30,
  JMAX  => 16,
  MINES => 99,
};

sub MouseClickCell($$$;$)
{ my ($window, $i, $j, $click) = @_;
  MouseClickClient($window, CELLW * ($i - IMIN + 0.5) + OFFSX, CELLH * ($j - JMIN + 0.5) + OFFSY, $click);
}

sub MouseClickClient($$$;$)
{ my ($window, $x, $y, $click) = @_;
  $click = "{LeftClick}" unless defined $click;
  MouseMoveAbsPix(ClientToScreen($window, $x, $y));
  if ($click)
  { #my $wasactive = GetForegroundWindow();
    SetForegroundWindow($window);
    #SetFocus($window);
    SendMouse($click);
    #SetForegroundWindow($wasactive);
  }
}

sub ReadCell($$$)
{ my ($window, $i, $j) = @_;
  my $cf = ReadClient($window, 
    CELLW * ($i - IMIN) + OFFSX + PADX, CELLH * ($j - JMIN) + OFFSY + PADY, 
    CELLW * ($i - IMIN + 1) + OFFSX - PADX - 1, CELLH * ($j - JMIN + 1) + OFFSY - PADY - 1);
  print("Unknown Cell Face in ($i, $j)\n") unless defined $cf;
  return $cf;
}

# The following face definitions depend on PAD bits, color depth and (maybe) resolution.
# This is for 32-bit color, 1280x1024 resolution and 1 PAD bit all around (i.e. 13x13 bitmaps):
my %CELLFACE =
( 14005 => '+',  # Flag[ged mine]
  32134 => '.',  # Unknown, Unopened
  18310 => '?',  # Question mark
  32170 => '0',  # 0 neighboring mines -- empty cell
  19330 => '1',  # 1
   3050 => '2',  # ...
  12268 => '3',
   7082 => '4',
    810 => '5',
   9130 => '6',
   6826 => '7',
  17578 => '8',
  54686 => '-',  # Mine, unflagged (Game over!)
  26117 => '*',  # Blown mine, mistake -- you've stepped on it (Game over!)
  55037 => 'X',  # False mine, mistake -- no mine there (Game over!)
);

sub ReadClient($$$$$)
{ my ($window, @rect) = @_;
  my $ds = new Win32::GuiTest::DibSect;
  #my $wasactive = GetForegroundWindow();
  SetForegroundWindow($window);
  #SetFocus($window);
  $ds -> CopyClient($window, \@rect) or die "Can't CopyClient()\n";
  #SetForegroundWindow($wasactive);
  my $fname = "$window\_$rect[0]x$rect[1].bmp";
  $ds -> SaveAs($fname);# or die "Can't SaveAs(\"$fname\"): $!\n";
  $ds -> Destroy or die "Can't Destroy()\n";
  open(FILE, $fname) or die "Can't open $fname: $!\n";
  binmode(FILE);
  my $bitmap=<FILE>;
  close(FILE);
  my $cs = unpack('%C*', $bitmap);
  my $cf = $CELLFACE{$cs};
  if (defined $cf) { unlink($fname) or die "Can't unlink($fname): $!\n"; }
  else             { print("Unknown Cell Face: \$cs = $cs, bitmap saved in $fname\n"); }
  return $cf;
}  

sub ReadField(\@\%;$)
{ my ($r_field, $r_count) = @_;
  for (values(%CELLFACE)) { $$r_count{$_} = 0 }
  for my $j (JMIN..JMAX)
  { $$r_field[$j] = [];
    for my $i (IMIN..IMAX)
    { my $cf = ReadCell($window, $i, $j);
      $$r_field[$j][$i] = defined($cf) ? $cf : ' ';
      if ($$r_field[$j][$i] eq '?' && $_[2])  # erase question marks:
      { MouseClickCell($window, $i, $j, '{RightClick}');
        $$r_field[$j][$i] = '.';
      }
      $$r_count{$cf}++;
    }
  }
  #for (JMIN..JMAX) { print(@{$$r_field[$_]}[IMIN..IMAX], "\n") }
  #Pause 'ReadField() done... <Enter> to continue';
}

my (@field, %count, %interesting, $mines_remaining, $cells_remaining, $percent_solved);

sub min($$) { $_[0] < $_[1] ? $_[0] : $_[1] }
sub max($$) { $_[0] > $_[1] ? $_[0] : $_[1] }

sub neighbors($$;$)
{ my ($i, $j, $mask) = @_;
  my @neighbors;
  for my $ni (max($i-1, IMIN) .. min($i+1, IMAX))
  { for my $nj (max($j-1, JMIN) .. min($j+1, JMAX))
    { next if ($ni == $i && $nj == $j);  # don't count self
      push(@neighbors, "$ni,$nj") unless $mask && $field[$nj][$ni] !~ /$mask/;
    }
  }
  return @neighbors;
}

sub add_if_interesting($$)  # Note that '.'s fenced in by '+'s are not "interesting" and will be missed
{ my ($i, $j) = @_;
  if ($field[$j][$i] =~ /[0-8]/)
  { if (my @neig_unkno = neighbors($i, $j, '[.?]'))
    { my @neig_mines = neighbors($i, $j, '\+');
      $interesting{"$i,$j"} = {cell_value => $field[$j][$i] - '0',
                               neig_unkno => \@neig_unkno,
                               neig_mines => \@neig_mines};
    }
  }
}

sub PrintField() { for (JMIN..JMAX) { print(@{$field[$_]}[IMIN..IMAX], "\n") } }

sub AnalyzeField(;$)
{
  PrintField if @_;

  if ($count{'-'} || $count{'*'} || $count{'X'})
  { print "I think we are DEAD!\n";
    return -1;
  }

  $mines_remaining = MINES - $count{'+'};# - $count{'-'} - $count{'*'};  # last two => matter no more...
  $cells_remaining = $count{'.'} + $count{'?'};

  if (! $cells_remaining)
  { die "WEIRD... 0 cells + $mines_remaining mines remaining... I give up\n" if ($mines_remaining);
    print "I think we've WON!!!\n";
    return 1;
  }

  $percent_solved = (1 - $cells_remaining / (IMAX - IMIN + 1) / (JMAX - JMIN + 1)) * 100;
  printf "%.0f%% solved. Background Probability is (%s/%s) = (1/%.2f) = %.2f\n",
    $percent_solved, $mines_remaining, $cells_remaining,
    $cells_remaining/$mines_remaining, $mines_remaining/$cells_remaining
    if @_;
  return 0;
}

sub ij2i_j($) { split(/,\s*/, $_[0]) }

sub FlagMine(@)
{
  print "Flagging  @_\n" if @_;
  for my $ij (@_)
  { my ($i, $j) = ij2i_j($ij);
    die "Attempted to flag a '$field[$j][$i]' at [$i,$j] as a mine!\n" if $field[$j][$i] !~ /[.?]/;

    MouseClickCell($window, $i, $j, '{RightClick}' x ($field[$j][$i] eq '.' ? 1 : 2));

    $count{$field[$j][$i]}--;

    #$field[$j][$i] = '+';
    my $cf = ReadCell($window, $i, $j);
    $field[$j][$i] = defined($cf) ? $cf : ' ';  # expected to be '+'

    $count{$field[$j][$i]}++;

    for my $nij (neighbors($i, $j, '[0-8]'))
    { delete($interesting{$nij});
      my ($ni, $nj) = ij2i_j($nij);
      add_if_interesting($ni, $nj);
    }
  }
  return @_;  # [count?] flagged cells
}

sub Reveal(@)
{
  print "Revealing @_\n" if @_;
  for my $ij (@_)
  { my ($i, $j) = ij2i_j($ij);
    die "Attempted to reveal a '$field[$j][$i]' at [$i,$j]\n" if $field[$j][$i] !~ /[.?]/;

    MouseClickCell($window, $i, $j, '{LeftClick}');

    $count{$field[$j][$i]}--;

    my $cf = ReadCell($window, $i, $j);
    $field[$j][$i] = defined($cf) ? $cf : ' ';

    $count{$field[$j][$i]}++;

    for my $nij ($ij, neighbors($i, $j, '[0-8]'))
    { delete($interesting{$nij});
      my ($ni, $nj) = ij2i_j($nij);
      add_if_interesting($ni, $nj);
    }
  }
  return @_;
}

sub MarkQuestion(@)
{
  print "P-marking @_\n";
  for my $ij (@_)
  { my ($i, $j) = ij2i_j($ij);
    next if $field[$j][$i] eq '?';
    die "Attempted to P-mark a '$field[$j][$i]' at [$i,$j]\n" if $field[$j][$i] ne '.';

    MouseClickCell($window, $i, $j, '{RightClick}{RightClick}');

    $count{$field[$j][$i]}--;

    my $cf = ReadCell($window, $i, $j);
    $field[$j][$i] = defined($cf) ? $cf : ' ';

    $count{$field[$j][$i]}++;
  }
  return 0;  # since we did not really change anything.
}

my @N_FACT = (1, 1, 2, 6, 24, 120, 720, 5040, 40320);
sub nr_combinations($$) { $N_FACT[$_[0]] / $N_FACT[$_[1]] / $N_FACT[$_[0] - $_[1]] }

sub cell2ncombs($)
{ my $r_cell = $interesting{$_[0]};
  my $n = @{$$r_cell{neig_unkno}};
  my $r = $$r_cell{cell_value} - @{$$r_cell{neig_mines}};
  nr_combinations($n, $r);
}

sub by_combinations { cell2ncombs($a) <=> cell2ncombs($b) }

sub move_algo_3(;@)
{ # this algorithm suggests cells to reveal based on probabilities:
  my ($pmin, $cmin) = $mines_remaining/$cells_remaining;  # b/g probability, undef
  for my $ij (@_ ? @_ : keys(%interesting))
  { my %cell = %{$interesting{$ij}};
    my $p = ($cell{cell_value} - @{$cell{neig_mines}}) / @{$cell{neig_unkno}};  # no 0div for %interesting
    ($pmin, $cmin) = ($p, \%cell) if $p < $pmin;
  }
  return ($cmin ? MarkQuestion(@{$cmin->{neig_unkno}}) : 0);
}

sub combos_n_r
{ my ($n, $r) = @_;
  return [] if $n == 0;
  my @combos;
  push @combos, map { push @$_, 0; $_ } combos_n_r($n-1, $r) unless $r == $n;
  push @combos, map { push @$_, 1; $_ } combos_n_r($n-1, $r-1) unless $r == 0;
  @combos;
}
#for (combos_n_r(8,4)) {print @$_, "\n"};

sub move_algo_2(;@)
{ # this algorithm flags/reveals cells around given cell from looking at all possible combinations:
  my (@toFlag, @toReveal);

  for my $ij (sort by_combinations (@_ ? @_ : keys(%interesting)))
  {
    my $r_cell = $interesting{$ij};
    my $n = @{$$r_cell{neig_unkno}};
    my $r = min($$r_cell{cell_value} - @{$$r_cell{neig_mines}}, $mines_remaining);
    my @all_combos = combos_n_r($n, $r);

    print "$ij : ", map((@$_, ' '), @all_combos), "\n";

    if (scalar(@all_combos) == 1)  # shortcut if only one combo possible for $ij cell:
    { for my $k (0..@{$all_combos[0]} - 1)
      { if ($all_combos[0][$k]) { push @toFlag,   $$r_cell{neig_unkno}[$k] }
        else                    { push @toReveal, $$r_cell{neig_unkno}[$k] }
      }
      return FlagMine(@toFlag) + Reveal(@toReveal);
    }

    my %sub_interesting;
    for my $ij_u (@{$$r_cell{neig_unkno}})  # for every unknown around my cell:
    { my ($i, $j) = ij2i_j($ij_u);
      for (neighbors($i, $j, '[0-8]')) { $sub_interesting{$_} = $interesting{$_} }
    }
    delete $sub_interesting{$ij};  # my cell itself is always satisfied and thus is not sub_interesting.
    next unless %sub_interesting;  # shortcut: abandon the cell if there are no neighboring cells with info

    print 's.int: ', map("$sub_interesting{$_}{cell_value}\@$_ ", keys(%sub_interesting)), "\n";

    my @valid_combos;

    COMBO:
    for my $combo (@all_combos)  # for each combo
    {
      for my $k (0..$n-1)  # for each unknown cell
      { my ($i, $j) = ij2i_j($$r_cell{neig_unkno}[$k]);
        $field[$j][$i] = ($combo->[$k] ? '+' : ' ');  # assign current combo
      }
      for my $ij_u (keys(%sub_interesting))
      { my ($i, $j) = ij2i_j($ij_u);
        my $m_needed = $field[$j][$i] - '0' - neighbors($i, $j, '\+');
        next COMBO if $m_needed < 0 || $m_needed > neighbors($i, $j, '[.?]');  # invalid
      }
      push @valid_combos, $combo;  # valid
    }

    for my $ij_u (@{$$r_cell{neig_unkno}})  # restore all unknowns:
    { my ($i, $j) = ij2i_j($ij_u);
      $field[$j][$i] = '.';
    }

    next if scalar(@valid_combos) == scalar(@all_combos);  # shortcut: all valid, no decision for this $ij

    print "valid: ", map((@$_, ' '), @valid_combos), "\n";  # could use shortcut if only one valid combo,

    U_CELL:
    for my $k (0..$n-1)  # for each unknown cell
    { my ($sum, $prd) = (0, 1);
      for my $combo (@valid_combos)  # for each VALID combo
      { $sum += $combo->[$k];
        $prd *= $combo->[$k];
        next U_CELL if $prd == 0 && $sum != 0;
      }
      if ($sum == 0) { push @toReveal, $$r_cell{neig_unkno}[$k] }  # "well"
      else           { push @toFlag,   $$r_cell{neig_unkno}[$k] }  # "column"
    }

    return FlagMine(@toFlag) + Reveal(@toReveal) if @toReveal || @toFlag;

  }  # for $ij in keys %interesting
  return 0;
}

READIT: while()
{
  ReadField(@field, %count, 'un_questionmark');

  %interesting = ();
  for my $j (JMIN..JMAX) { for my $i (IMIN..IMAX) { add_if_interesting($i, $j) } }

  while ()
  {
    last READIT if AnalyzeField;
    # Work is done here: (Note ORDER is important!)
    last unless move_algo_2() || move_algo_3();  # ...
  }

  AnalyzeField('verbose');
  Pause "Don't know what to do next. You try, then hit <ENTER> to continue...";
}

Pause "<Enter> to exit...";

SetForegroundWindow($window);
SendKeys("%{F4}");  # Alt-F4 to exit

my ($user, $system, $cuser, $csystem) = times();
print '($user, $system, $cuser, $csystem) = ' . "($user, $system, $cuser, $csystem)\n";
print "Bye, world!\n";
