Here's a simple, dynamic (change number of colors and -places) I wrote back in February 2004 for my kids:
#!/pro/bin/perl
use strict;
use warnings;
sub usage ()
{
print STDERR "usage: mastermind.pl [ -p places ] [ -c colors ]\n";
exit 0;
} # usage
use Getopt::Long qw( :config nopermute bundling );
my $ncolor = 7;
my $nplace = 5;
my $nguess = 14;
GetOptions (
"p|places=i" => \$nplace,
"c|colors=i" => \$ncolor,
"g|guess=i" => \$nguess,
) or usage ();
my @color = qw(
black red green blue yellow cyan magenta
darkred orange darkgreen gray50 darkblue
white wheat purple gold );
unless ($^O ne "win32") {
my $pid = fork;
$pid < 0 and die "Unable to run in the background, cannot fork: $!
+\n";
$pid and exit 0;
}
use Tk;
my $mw = MainWindow->new;
$mw->configure (
-bg => "Gray85",
-fg => "Black");
$mw->optionAdd ('*background' => "Gray85");
$mw->optionAdd ('*foreground' => "Black");
$mw->optionAdd ('*activeBackground' => "Gray85");
$mw->optionAdd ('*activeForeground' => "Black");
my $gw = $mw->Frame (-relief => "ridge")->pack (qw( -side top -fill bo
+th -expand 1 -anchor w));
my $cw = $mw->Frame (-relief => "ridge")->pack (qw( -side top -fill bo
+th -expand 1));
my $bw = $mw->Frame (-relief => "ridge")->pack (qw( -side top -fill bo
+th -expand 1));
my $grid = $gw->Frame ()->grid (-sticky => "nesw");
$grid->gridRowconfigure (0, -weight => 1); # allow expansion in bot
+h ...
$grid->gridColumnconfigure (0, -weight => 1); # ... X and Y dimensions
sub opnw ()
{
exec $^X, "mastermind.pl", "-p$nplace", "-c$ncolor", "-g$nguess";
} # opnw
my (@g, @c); # Grid of widgets and colors
my $cc; # Current color
my $row; # Rows guessed
my @X; # The great unknown
my @ok = (
$mw->Pixmap (-file => "ok.xpm"),
$mw->Pixmap (-file => "nok.xpm"),
);
sub solve ($$)
{
my ($f, $r, @y) = @_;
my @x = @X;
foreach my $x (0 .. ($nplace - 1)) {
($y[$x] = $c[$r][$x]) == $x[$x] or next;
$y[$x] = $x[$x] = -2;
$f->Button (
-height => 7,
-width => 8,
-borderwidth => 0,
-highlightthickness => 0,
-image => $ok[0],
-background => "Gray85")->pack (-side => "left");
}
foreach my $x (0 .. ($nplace - 1)) {
$x[$x] >= 0 or next;
foreach my $y (0 .. ($nplace - 1)) {
$x == $y and next;
$y[$y] >= 0 or next;
$x[$x] == $y[$y] or next;
$x[$x] = $y[$y] = -2;
$f->Button (
-height => 7,
-width => 8,
-borderwidth => 0,
-highlightthickness => 0,
-image => $ok[1],
-background => "Gray85")->pack (-side => "left
+");
}
}
$row = $r;
} # solve
sub init ()
{
($cc, $row) = (0, 0);
foreach my $c (0 .. ($nplace - 1)) {
$X[$c] = int rand ($ncolor);
}
foreach my $r (0 .. ($nguess - 1)) {
foreach my $c (0 .. ($nplace - 1)) {
$g[$r][$c] = $grid->Button (
-relief => "ridge",
-background => "gray85",
-command => sub {
$r < $row and return;
$g[$r][$c]->configure (-background => $color[($c[$
+r][$c] = $cc)]);
},
)->grid (-column => $c, -row => $r, -sticky => "news")
+;
}
my $f = $g[$r][$nplace] = $grid->Frame ()->grid (-column => $n
+place, -row => $r, -sticky => "ew");
my $b;
$b = $f->Button (
-text => "!",
-command => sub {
foreach my $x (0 .. ($nplace - 1)) {
defined $c[$r][$x] && $c[$r][$x] >= 0 or return;
}
solve ($f, $r);
$b->packForget;
},
)->pack (qw( -side left -expand 1 -fill both));
}
$cw->Button (
-text => "<",
-command => sub {
$ncolor > 2 or return;
$ncolor--;
opnw ();
})->pack (qw( -side left -expand 0 -fill y ));
foreach my $c (0 .. ($ncolor - 1)) {
$cw->Button (
-relief => "ridge",
-background => $color[$c],
-command => sub { $cc = $c },
)->pack (qw( -side left -expand 1 -fill both ));
}
$cw->Button (
-text => ">",
-command => sub {
$ncolor >= 16 and return;
$ncolor++;
opnw ();
})->pack (qw( -side left -expand 0 -fill y ));
$bw->Button (
-text => "[",
-command => sub {
$nplace > 2 or return;
$nplace--;
opnw ();
})->pack (qw( -side left -expand 0 -fill y ));
$bw->Button (-text => "Stop", -command => \&exit)->pack (qw( -s
+ide left -expand 1 -fill both ));
$bw->Button (
-text => "]",
-command => sub {
$nplace++; # No limit :)
opnw ();
})->pack (qw( -side right -expand 0 -fill y ));
$bw->Button (-text => "Opnieuw", -command => \&opnw)->pack (qw( -s
+ide right -expand 1 -fill both ));
} # init
init ();
MainLoop;
Enjoy, Have FUN! H.Merijn