Beefy Boxes and Bandwidth Generously Provided by pair Networks
We don't bite newbies here... much
 
PerlMonks  

Re: Mastermind Game in Perl/Tk

by Tux (Abbot)
on Jan 23, 2007 at 16:18 UTC ( #596119=note: print w/replies, xml ) Need Help??


in reply to Mastermind Game in Perl/Tk

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

Replies are listed 'Best First'.
Re^2: Mastermind Game in Perl/Tk
by Anonymous Monk on Jan 23, 2007 at 21:00 UTC
    couldn't read file "ok.xpm": No such file or directory at G:/perl/site/lib/Tk/Image.pm line 22.
      ok.xpm
      nok.xpm
      But they are really, really simple (really):
      > cat ok.xpm /* XPM */ static char * ProLogo [] = { /* width height ncolors cpp [x_hot y_hot] */ "6 5 2 1 0 0", /* colors */ " c Gray85", "# c Black", /* pixels */ " ", " ## ", " #### ", " ## ", " "}; > cat nok.xpm /* XPM */ static char * ProLogo [] = { /* width height ncolors cpp [x_hot y_hot] */ "6 5 2 1 0 0", /* colors */ " c Gray85", "o c White", /* pixels */ " ", " oo ", " oooo ", " oo ", " "};

      Enjoy, Have FUN! H.Merijn

Log In?
Username:
Password:

What's my password?
Create A New User
Node Status?
node history
Node Type: note [id://596119]
help
Chatterbox?
and the web crawler heard nothing...

How do I use this? | Other CB clients
Other Users?
Others romping around the Monastery: (5)
As of 2020-10-27 13:26 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?
    My favourite web site is:












    Results (256 votes). Check out past polls.

    Notices?