##Five in Perl/TK
##By Chen
$VERSION=0.02;
use strict;
use Tk;

my @links=(
## 0 5 10 15 20
## 1 6 11 16 21
## 2 7 12 17 22
## 3 8 13 18 23
## 4 9 14 19 24
[0,1,5],
[1,0,2,6],
[2,1,3,7],
[3,2,4,8],
[4,3,9],
[5,0,6,10],
[6,1,5,7,11],
[7,2,6,8,12],
[8,3,7,9,13],
[9,4,8,14],
[10,5,11,15],
[11,6,10,12,16],
[12,7,11,13,17],
[13,8,12,14,18],
[14,9,13,19],
[15,10,16,20],
[16,11,15,17,21],
[17,12,16,18,22],
[18,13,17,19,23],
[19,14,18,24],
[20,15,21],
[21,16,20,22],
[22,17,21,23],
[23,18,22,24],
[24,19,23],

);


my @beginlib=(
## 0 5 10 15 20
## 1 6 11 16 21
## 2 7 12 17 22
## 3 8 13 18 23
## 4 9 14 19 24
[12],
[7,12,11,17,13],
[7,11,13,17],
[0,2,4,10,12,14,20,22,24],

[11,12,13],
[6,8,16,18],

);



my @gcolor;

sub init_color
{
    my @colors;
    ##my $i;
    my $v;
    
    #if(@_ == 0){
        for(0.. 24)
        {
        #$colors[$_]= ($_ % 2 ) ? 'red':'black';
            $colors[$_]='black';
        }
    #}
    if(@_ != 0)
    {
        $v=shift;
        foreach (@{$beginlib[$v]})
        {
            $colors[$_]='red';
        }
        
        
    }
     @colors;
}
print @gcolor;

@gcolor=init_color();


my $top=MainWindow->new();

my $menu_bar=$top->Frame()->pack('-side'=>'top','-fill'=>'x');

my $menu_new=$menu_bar->Menubutton('-text'=>'New')->pack('-side'=>'lef
+t','-padx' =>0);

#my $i=0;

for(0.. $#beginlib){
   $menu_new->command('-label'=>'No.'.($_ + 1),-command=> [\&onNew,$_]
+);
   #$menu_new->command('-label'=>'第2种');
   #$menu_new->command('-label'=>'第3种');
  }
  
  $menu_new->command('-label'=>'Random',-command=>\&onRandom);
   
my $menu_about=$menu_bar->Menubutton('-text'=>'Help')->pack('-side'=>'
+left');
    $menu_about->command('-label'=>'Rule',-command=>\&content);
    $menu_about->command('-label'=>'About Five',-command=>\&about);





my $c=$top->Canvas(-width,250,-height,250,
                                -relief,'sunken',
                                -borderwidth,5,
                                #-fill,'green',
                                #-outline,'black',
                                )->pack();

my @grids;
gen();
MainLoop();


sub onGrid
{
    #print @_;
    my $cc=shift;
    my $id=shift;
    print $id,"\n";
    #print $c->type('current');
    #print $cc->itemconfigure('current','-fill'=>'red');
    #print $cc->itemcget('current','-fill');
    turn ( @{$links[$id]} );
    
    #turn($id-1);
    gen();
    check();
    

    #turn ($grids[$id-1]);
    #print $id.':'.$cc;
    #search($cc);
}

sub search
{
    my $cc=shift;
    for(0 ..24)
    {
        #print  $grids[$_]->itemcget('current','-fill').':';
        print  $cc ;#eq $grids[$_];
        print @grids,"\n";
    }
    
    
}





#sub turn
#{
#    my $cc=shift;
#    if ($cc->itemcget('current','-fill') eq 'red')
#    {
    #    $cc->itemconfigure('current','-fill'=>'black');
    #    }
    #    else
    #    {
    #        $cc->itemconfigure('current','-fill'=>'red');
    #        }
    
    
#}

sub turn
{
    my $id;
    foreach (@_)
    {
        $id=$_;
        if($gcolor[$id] eq 'red')    
        {
            $gcolor[$id]='black';
        }
        else
        {
            $gcolor[$id]='red';
        }
    }
    
}





sub grid
{
    my $v=shift;
    my ($i,$j);
    $i=int $v/5;
    $j=$v%5;
    
    my @re;
    push @re,50 *$i;
    push @re,50 *$j;
    push @re,50 *$i+50;
    push @re,50 *$j+50;
    @re;
    
}

sub gen
{
    $c->delete('all');
    for(0..24)
    {
     $grids[$_]=$c->create('rectangle',grid($_),'-fill'=> $gcolor[$_],
                                                                      
+              '-width'=>2,
                                                                      
+              #'-relief'=>'raised',
                                                                      
+              '-outline'=>'green',
                                                                      
+              '-tags' =>'items'.$_);
    


    $c->bind('items'.$_,'<1>'=>[\&onGrid,$_]);
    }

    
}

my $top2;
sub check()
{
    my $i;
    for($i=0;$i<25;$i++)
    {
        last if ($gcolor[$i] eq 'black');    
            
    }
    
    if($i>24)
    {
        #$top2=MainWindow->new();
        #$top->title('胜利了！');
        $top->Dialog('-text'=>'Win! Congrats!')->Show();
        
    }
    #return 1 if ($i >= 24);
    #return 0;
    
}


sub about
{
    #print 'about';
    $top->Dialog('-text'=>'Five 0.02 ,by Aubell,2004-12-13')->Show();
}

sub content
{
    my $dlg=$top->Dialog();
    $dlg->configure('-text'=>"Goal:Make all the grids red.");
    $dlg->Show();
}

sub onNew
{
    #print shift;
    @gcolor=init_color(shift);
    gen();
    
    
}

sub onRandom
{
    @gcolor=init_color();
    #gen();
     my $cnt=int rand(25);
     for(0 .. $cnt)
     {
          $gcolor[int rand (25)]='red';
         }
         gen();
    
    
}

[download]

In reply to Fivee by aubell

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, details, 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, summary, 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.