#!/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;
[download]