Beefy Boxes and Bandwidth Generously Provided by pair Networks
No such thing as a small change
 
PerlMonks  

comment on

( #3333=superdoc: print w/replies, xml ) Need Help??
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

In reply to Re: Mastermind Game in Perl/Tk by Tux
in thread Mastermind Game in Perl/Tk by Anonymous Monk

Title:
Use:  <p> text here (a paragraph) </p>
and:  <code> code here </code>
to format your post; it's "PerlMonks-approved HTML":



  • Posts are HTML formatted. Put <p> </p> tags around your paragraphs. Put <code> </code> tags around your code and data!
  • Titles consisting of a single word are discouraged, and in most cases are disallowed outright.
  • Read Where should I post X? if you're not absolutely sure you're posting in the right place.
  • Please read these before you post! —
  • Posts may use any of the Perl Monks Approved HTML tags:
    a, abbr, b, big, blockquote, br, caption, center, col, colgroup, dd, del, div, dl, dt, em, font, h1, h2, h3, h4, h5, h6, hr, i, ins, li, ol, p, pre, readmore, small, span, spoiler, strike, strong, sub, sup, table, tbody, td, tfoot, th, thead, tr, tt, u, ul, wbr
  • You may need to use entities for some characters, as follows. (Exception: Within code tags, you can put the characters literally.)
            For:     Use:
    & &amp;
    < &lt;
    > &gt;
    [ &#91;
    ] &#93;
  • Link using PerlMonks shortcuts! What shortcuts can I use for linking?
  • See Writeup Formatting Tips and other pages linked from there for more info.
  • Log In?
    Username:
    Password:

    What's my password?
    Create A New User
    Chatterbox?
    and the web crawler heard nothing...

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












      Results (256 votes). Check out past polls.

      Notices?