App-SweeperBot
view release on metacpan or search on metacpan
lib/App/SweeperBot.pm view on Meta::CPAN
package App::SweeperBot;
# minesweeper.pl
#
# Win32::Screenshot, Win32::GuiTest, and Image::Magick are needed for this
# program. Use ActivePerl's PPM to install the first two:
# ppm> install Win32-GuiTest
# ppm> install http://theoryx5.uwinnipeg.ca/ppms/Win32-Screenshot.ppd
#
# The version of Image-Magick used by this code can be found at
# http://www.bribes.org/perl/ppmdir.html . Different ImageMagick
# distributions may result in different signature codes.
#
# 20050726, Matt Sparks (f0rked), http://f0rked.com
=head1 NAME
App::SweeperBot - Play windows minesweeper, automatically!
=head1 SYNOPSIS
C:\Path\To\Distribution> SweeperBot.exe
=head1 DESCRIPTION
This is alpha code, and released for testing and demonstration
purposes only. It is still under active development.
Using this code for playing minesweeper on a production basis is
strongly discouraged.
=head1 METHODS
=cut
use strict;
use warnings;
use Carp;
use NEXT;
use 5.006;
our $VERSION = '0.03';
use Scalar::Util qw(looks_like_number);
use Win32::Process qw(NORMAL_PRIORITY_CLASS);
use constant DEBUG => 0;
use constant VERBOSE => 0;
use constant CHEAT => 1;
use constant UBER_CHEAT => 0;
use constant SMILEY_LENGTH => 26;
# The minimum and maximum top dressings define the range in which
# we'll look for a smiley, which we use to calibrate our board. Different
# windows themes put them in different places.
use constant MINIMUM_TOP_DRESSING => 56;
use constant MAXIMUM_TOP_DRESSING => 75;
my $Smiley_offset = 0;
use constant CHEAT_SAFE => "d0737abfd3abdacfeb15d559e28c2f0b3662a7aa03ac5b7a58afc422110db75a"; # Old 58
# use constant CHEAT_SAFE => "ad95131bc0b799c0b1af477fb14fcf26a6a9f76079e48bf090acb7e8367bfd0e"; # Old 510
use constant CHEAT_UNSAFE => "374708fff7719dd5979ec875d56cd2286f6d3cf7ec317a3b25632aab28ec37bb"; # Old 58
# use constant CHEAT_UNSAFE => "e3820096cb82366b860b8a4e668453a7aaaf423af03bdf289fa308ea03a79332"; # Old 510
# alarm(180); # Nuke process after three minutes, in case of run-aways.
use Win32::Screenshot;
use Win32::GuiTest qw(
FindWindowLike
GetWindowRect
SendMouse
MouseMoveAbsPix
SendKeys
);
# Square width and height.
use constant SQUARE_W => 16;
use constant SQUARE_H => 16;
# Top-left square location (15,104)
use constant SQUARE1X => 15;
use constant MIN_SQUARE1Y => 96;
use constant MAX_SQAURE1Y => 115;
# How far left of the smiley to click to focus on the board.
use constant FOCUS_X_OFFSET => 50;
my $Square1Y;
my %char_for = (
0 => 0,
unpressed => ".",
1 => 1,
2 => 2,
3 => 3,
4 => 4,
lib/App/SweeperBot.pm view on Meta::CPAN
}
=head2 make_move
$sweeperbot->make_move($game_state);
Given a game state, determines the next move(s) that should be made,
and makes them. By default this uses a very simple process:
=over
=item *
If C<UBER_CHEAT> is set, then cheat.
=item *
If we find a square where the number of adjacent mines matches the
number on the square, L</stomp> on it.
=item *
If the number of adjacent unpressed squares matches the number of
unknown adjacent mines, then flag them as mines.
=item *
If all else fails, pick a square at random. If C<CHEAT> is defined,
and we would have picked a square with a mine, then pick another.
=back
If you want to inherit from this class to change the AI, overriding
this method is the place to do it.
=cut
sub make_move {
my ($this, $game_state) = @_;
our ($squares_x, $squares_y);
my $altered_board = 0;
foreach my $y (1..$squares_y) {
SQUARE: foreach my $x (1..$squares_x) {
if (UBER_CHEAT) {
if (cheat_is_square_safe([$x,$y])) {
$this->press($x,$y);
}
else {
$this->flag_mines($game_state,[$x,$y]);
}
$altered_board = 1;
}
# Empty squares are dull.
next SQUARE if ($game_state->[$x][$y] eq 0);
# Unpressed/flag squares don't give us any information.
next SQUARE if (not looks_like_number($game_state->[$x][$y]));
my @adjacent_unpressed = $this->adjacent_unpressed_for($game_state,$x,$y);
# If there are no adjacent unpressed squares, then
# this square is boring.
next SQUARE if not @adjacent_unpressed;
my $adjacent_mines = $this->adjacent_mines_for($game_state,$x,$y);
# If the number of mines is equal to the number
# on this square, then stomp on it.
if ($adjacent_mines == $game_state->[$x][$y]) {
print "Stomping on $x,$y\n" if DEBUG;
$this->stomp($x,$y);
$altered_board = 1;
}
# If the number of mines plus unpressed squares is
# equal to the number on this square, then mark all
# adjacent squares as having mines.
if ($adjacent_mines + @adjacent_unpressed == $game_state->[$x][$y]) {
print "Marking mines next to $x,$y\n" if DEBUG;
$this->flag_mines($game_state,@adjacent_unpressed);
$altered_board = 1;
}
}
}
if (not $altered_board) {
# Drat! Can't find a good move. Pick a square at
# random.
my @unpressed = ();
foreach my $x (1..$squares_x) {
foreach my $y (1..$squares_y) {
push(@unpressed,[$x,$y]) if $game_state->[$x][$y] eq "unpressed";
}
}
my $square = $unpressed[rand @unpressed];
if (CHEAT) {
while (not $this->cheat_is_square_safe($square)) {
$square = $unpressed[rand @unpressed];
}
}
print "Guessing square ",join(",",@$square),"\n" if DEBUG;
$this->press(@$square);
}
return;
}
=head2 capture_game_state
my $game_state = $sweeperbot->capture_game_state;
Walks over the entire board, capturing the value in each location and
lib/App/SweeperBot.pm view on Meta::CPAN
Takes a game state and a list of locations, and returns an array-ref
containing those locations from the list that have been flagged as
a mine.
=cut
sub mines_at {
my ($this, $game_state, @locations) = @_;
my $mines = 0;
foreach my $square (@locations) {
if ($game_state->[ $square->[0] ][ $square->[1] ] eq "flag") {
$mines++;
}
}
return $mines;
}
=head2 unpressed_list
my $unpressed = $this->unpressed-list($game_state, @locations);
Identical to L</mines_at> above, but returns any locations that have
not been pressed (and not flagged as a mine).
=cut
sub unpressed_list {
my ($this, $game_state, @locations) = @_;
my @unpressed = grep { ($game_state->[ $_->[0] ][ $_->[1] ] eq "unpressed") } @locations;
return @unpressed;
}
=head2 enable_cheats
$sweeperbot->enable_cheats;
Sends the magic C<xyzzy> cheat to minesweeper, which allows us to
determine the contents of a square by examining the top-left pixel
of the entire display.
For this cheat to be used in the default AI, the C<CHEAT> constant
must be set to a true value in the C<App::SweeperBot> source.
=cut
sub enable_cheats {
SendKeys("xyzzy{ENTER}+ ");
return;
}
=head2 cheat_is_square_safe
if ($sweeperbot->cheat_is_square_safe($x,$y) {
print "($x,$y) looks safe!\n";
} else {
print "($x,$y) has a mine underneath.\n";
}
If cheats are enabled, returns true if the given square looks
safe to step on, or false if it appears to contain a mine.
Note that especially on fast, multi-core systems, it's possible
for this to move the mouse and capture the required pixel before
minesweeper has had a chance to update it. So if you cheat,
you may sometimes be surprised.
=cut
sub cheat_is_square_safe {
my ($this, $square) = @_;
our($l,$t);
MouseMoveAbsPix(
$l+SQUARE1X+($square->[0]-1)*SQUARE_W+SQUARE_W/2,
$t+$Square1Y+($square->[1]-1)*SQUARE_H+SQUARE_W/2,
);
# Capture our pixel.
my $pixel = CaptureRect(0,0,1,1);
my $signature = $pixel->Get("signature");
print "Square at @$square has sig of $signature\n" if DEBUG;
if ($signature eq CHEAT_SAFE) {
print "This square (@$square) looks safe\n" if DEBUG;
return 1;
} elsif ($signature eq CHEAT_UNSAFE) {
print "This square (@$square) looks dangerous!\n" if DEBUG;
return;
}
die "Square @$square has unknown cheat-signature\n$signature\n";
}
__END__
=head1 BUGS
Plenty. The code is pretty awful right now. Anything that could go
wrong probably will.
Use of this program may cause sweeperbot to take control of our
mouse and keyboard, playing minesweeper endlessly for days on end,
and forcing the user to go and do something productive instead.
All methods that require a game-state to be passed will be modified
in the future to be usable without the game-state. The
C<App::SweeperBot> object itself should be able to retain state.
=head1 AUTHOR
Paul Fenwick E<lt>pjf@cpan.orgE<gt>
=head1 COPYRIGHT AND LICENSE
Copyright (C) 2005-2008 by Paul Fenwick, E<lt>pjf@cpan.orgE<gt>
Based upon original code Copyright (C) 2005 by
Matt Sparks E<lt>root@f0rked.comE<gt>
This application is free software; you can redistribute it and/or
modify it under the same terms as Perl itself, either Perl version 5.6.0
or, at your option, any later version of Perl 5 you may have available.
=cut
( run in 0.497 second using v1.01-cache-2.11-cpan-39bf76dae61 )