Beefy Boxes and Bandwidth Generously Provided by pair Networks
Your skill will accomplish
what the force of many cannot
 
PerlMonks  

comment on
( [id://3333]=superdoc: print w/replies, xml ) Need Help?? 

use Tk;
my $mw = MainWindow->new;
$code_font = $mw->fontCreate('code', -family => 'verdana', -size => 7)
+;
$code_font2 = $mw->fontCreate('font2', -family => 'verdana', -size => 
+12);
$linea = 1;

###############
# Subroutines #
sub start {
    &reclean;
    if ( $won == 1 ) {$winlabel->destroy;
              $won -= 1;
              $linea->delete($fuoco)};
    $coor = 10;
    $hiduno = int(rand 6) + 1;
    $hiddue = int(rand 6) + 1;
    $hidtre = int(rand 6) + 1;
    $hidquattro = int(rand 6) + 1;
    #print "uno:$hiduno,due:$hiddue,tre:$hidtre,quattro:$hidquattro";
    $nascosto = $mw->Canvas(-background => "black")->place(-relx => 0.
+0, -rely => 0.00, -relwidth => 0.4, -relheight => 0.1);  
    $qm = $nascosto->createText(40,10, -text => "?  ?  ?  ?", -fill =>
+ "white", -font => 'font2');
    $mialabel->configure(-text => "Line 1- choose colors");
    $fuoco = $steps[0]->createText($coor,8, -text=>"?", -fill => "whit
+e"); #x: 10,30,50,70
    $activeline = 1;
    $cerchio = 1;
    $coor = 10;
    }
    
    
sub colora {
    &cercalinea;
    &cercacerchio;
    $linea->delete($fuoco);
    $n = shift;
    $color = $linea->itemconfigure("$circ", -fill=>     "$n");
    #print "\n$coor\n";
    if ( $coor < 70 ) {
    $coor += 20;
    $fuoco = $linea->createText($coor,8, -text=>"?", -fill => "white")
+; #x: 10,30,50,70
    $cerchio += 1;
        }
    else {
        &valuta;
        if ( $activeline < 10 ) {
        $activeline += 1;
    }
    else {
        $loselabel = $mw->Label(-text => "You Lost!\n Press start to p
+lay again", -font => 'code', -background => "black", -foreground => "
+white")
            ->place(-relx => 0.2, -rely => 0.5, -relwidth => 0.6, -rel
+height => 0.3);
            }
        $coor = 10;
        &cercalinea;
        $fuoco = $linea->createText($coor,8, -text=>"?", -fill => "whi
+te"); #x: 10,30,50,70
        $mialabel->configure(-text => "Line $activeline- choose colors
+");
        $cerchio = 1;
        }
    }

sub cercalinea {
    if ($activeline == 1) { $linea =    $steps[0];}
    elsif ($activeline == 2) { $linea = $steps[1];}
    elsif ($activeline == 3) { $linea = $steps[2];}
    elsif ($activeline == 4) { $linea = $steps[3];}
    elsif ($activeline == 5) { $linea = $steps[4];}
    elsif ($activeline == 6) { $linea = $steps[5];}
    elsif ($activeline == 7) { $linea = $steps[6];}
    elsif ($activeline == 8) { $linea = $steps[7];}
    elsif ($activeline == 9) { $linea = $steps[8];}
    elsif ($activeline == 10) { $linea =$steps[9];}
        }

sub cercacerchio {
    if ($cerchio == 1) { $circ =$uno }
    elsif ($cerchio == 2) { $circ =$due }
    elsif ($cerchio == 3) { $circ =$tre }
    elsif ($cerchio == 4) { $circ =$quattro }
        }

sub valuta { 
    $buone = 0;
    $mezze = 0;
    $primo = $linea->itemcget("$uno", -fill);
    $secondo = $linea->itemcget("$due", -fill);
    $terzo = $linea->itemcget("$tre", -fill);
    $quarto = $linea->itemcget("$quattro", -fill);
    #print "primo: $primo\nsecondo: $secondo\nterzo: $terzo\nquarto: $
+quarto\n";
    &trasforma;

$hid[1] = 0;
$hid[2] = 0;
$hid[3] = 0;
$hid[4] = 0;
$mia[1] = 0;
$mia[2] = 0;
$mia[3] = 0;
$mia[4] = 0;

    if    ( $a == $hiduno     ) { $buone +=1 ;$hid[1] = 1 ; $mia[1] = 
+1}
    if    ( $b == $hiddue     ) { $buone +=1 ;$hid[2] = 1 ; $mia[2] = 
+1}
    if    ( $c == $hidtre     ) { $buone +=1 ;$hid[3] = 1 ; $mia[3] = 
+1}
    if    ( $d == $hidquattro ) { $buone +=1 ;$hid[4] = 1 ; $mia[4] = 
+1}
    
    if ( $a == $hiddue && $hid[2] == 0 && $mia[1] == 0 ) { $mezze +=1 
+;$hid[2] = 1 }
        elsif ( $a == $hidtre && $hid[3] == 0 && $mia[1] == 0 ) { $mez
+ze +=1 ;$hid[3] = 1 }
        elsif ( $a == $hidquattro && $hid[4] == 0 && $mia[1] == 0 ) { 
+$mezze +=1 ;$hid[4] = 1 }
        
    if ( $b == $hiduno && $hid[1] == 0 && $mia[2] == 0) { $mezze +=1 ;
+$hid[1] = 1 }
        elsif ( $b == $hidtre && $hid[3] == 0 && $mia[2] == 0) { $mezz
+e +=1 ;$hid[3] = 1 }
        elsif ( $b == $hidquattro && $hid[4] == 0 && $mia[2] == 0) { $
+mezze +=1 ;$hid[4] = 1 }
        
    if ( $c == $hiduno && $hid[1] == 0 && $mia[3] == 0) { $mezze +=1 ;
+$hid[1] = 1 }
        elsif ( $c == $hiddue && $hid[2] == 0 && $mia[3] == 0) { $mezz
+e +=1 ;$hid[2] = 1 }
        elsif ( $c == $hidquattro && $hid[4] == 0 && $mia[3] == 0) { $
+mezze +=1 ;$hid[4] = 1 }
        
    if ( $d == $hiduno && $hid[1] == 0 && $mia[4] == 0) { $mezze +=1 ;
+$hid[1] = 1 }
        elsif ( $d == $hiddue && $hid[2] == 0 && $mia[4] == 0) { $mezz
+e +=1 ;$hid[2] = 1 }
        elsif ( $d == $hidtre && $hid[3] == 0 && $mia[4] == 0) { $mezz
+e +=1 ;$hid[3] = 1 }
    
    #print "buone: $buone\nmezze: $mezze\n";
        if ( $buone == 4 ) {
        $won = 1;
        $winlabel = $mw->Label(-text => "You Won!\n Press start to pla
+y again", -font => 'code', -background => "black", -foreground => "wh
+ite")
            ->place(-relx => 0.2, -rely => 0.3, -relwidth => 0.6, -rel
+height => 0.3);
            }
    &risultato;
    }

sub risultato {
    $keok = 0;
    while ( $buone > 0 ) {
        $keok +=1;
        $colorok = $linea->itemconfigure($ok[$keok], -fill=>     "blac
+k");
        #print "buone: $buone\n";
        #print "okkeok:$ok[$keok]\n";
        $buone -=1;
    }
        while ( $mezze > 0 ) {
        $keok +=1;
        $colorok = $linea->itemconfigure($ok[$keok], -fill=>     "whit
+e");
        #print "buone: $buone\n";
        #print "okkeok:$ok[$keok]\n";
        $mezze -=1;
        }    
}

sub trasforma {
    
    if ( $primo eq "red") { $a=1 }
    elsif ( $primo eq "blue") { $a=2 }
    elsif ( $primo eq "green") { $a=3 }
    elsif ( $primo eq "yellow") { $a=4 }
    elsif ( $primo eq "purple") { $a=5 }
    elsif ( $primo eq "orange") { $a=6 }
    if ( $secondo eq "red") { $b=1 }
    elsif ( $secondo eq "blue") { $b=2 }
    elsif ( $secondo eq "green") { $b=3 }
    elsif ( $secondo eq "yellow") { $b=4 }
    elsif ( $secondo eq "purple") { $b=5 }
    elsif ( $secondo eq "orange") { $b=6 }
    if ( $terzo eq "red") { $c=1 }
    elsif ( $terzo eq "blue") { $c=2 }
    elsif ( $terzo eq "green") { $c=3 }
    elsif ( $terzo eq "yellow") { $c=4 }
    elsif ( $terzo eq "purple") { $c=5 }
    elsif ( $terzo eq "orange") { $c=6 }
    if ( $quarto eq "red") { $d=1 }
    elsif ( $quarto eq "blue") { $d=2 }
    elsif ( $quarto eq "green") { $d=3 }
    elsif ( $quarto eq "yellow") { $d=4 }
    elsif ( $quarto eq "purple") { $d=5 }
    elsif ( $quarto eq "orange") { $d=6 }
    }
    
    
######################
# Disegno le 10 aree #
$steps[0] = $mw->Canvas(-background => gray55)->place(  -relx => 0.4, 
+-rely => 0.8,  -relwidth => 0.6, -relheight => 0.09);
$steps[1] = $mw->Canvas(-background => gray52)->place(-relx => 0.4, -r
+ely => 0.71, -relwidth => 0.6, -relheight => 0.09);
$steps[2] = $mw->Canvas(-background => gray49)->place(  -relx => 0.4, 
+-rely => 0.62, -relwidth => 0.6, -relheight => 0.09);
$steps[3] = $mw->Canvas(-background => gray46)->place( -relx => 0.4, -
+rely => 0.53, -relwidth => 0.6, -relheight => 0.09);
$steps[4] = $mw->Canvas(-background => gray43)->place( -relx => 0.4, -
+rely => 0.44, -relwidth => 0.6, -relheight => 0.09);
$steps[5] = $mw->Canvas(-background => gray40)->place(  -relx => 0.4, 
+-rely => 0.35, -relwidth => 0.6, -relheight => 0.09);
$steps[6] = $mw->Canvas(-background => gray37)->place(-relx => 0.4, -r
+ely => 0.26, -relwidth => 0.6, -relheight => 0.09);
$steps[7] = $mw->Canvas(-background => gray34)->place( -relx => 0.4, -
+rely => 0.17, -relwidth => 0.6, -relheight => 0.09);
$steps[8] = $mw->Canvas(-background => gray31)->place(   -relx => 0.4,
+ -rely => 0.08, -relwidth => 0.6, -relheight => 0.09);
$steps[9] = $mw->Canvas(-background => gray29)->place( -relx => 0.4, -
+rely => 0.00, -relwidth => 0.6, -relheight => 0.09);

############################
# Definizione dei pulsanti #
$exitbtt = $mw->Button(-text => "Exit", -font => 'code', -command => s
+ub { exit })
    ->place(-relx => 0.8, -rely => 0.9, -relwidth => 0.2, -relheight =
+> 0.1);
$startbtt = $mw->Button(-text => "Start", -font => 'code', -command =>
+ sub { start })
    ->place(-relx => 0.0, -rely => 0.9, -relwidth => 0.2, -relheight =
+> 0.1); 
$redbtt = $mw->Button(-background => "red", -activebackground => "toma
+to", -command =>[ \&colora  , "red" ])
    ->place(-relx => 0.0, -rely => 0.8, -relwidth => 0.1, -relheight =
+> 0.1);
$bluebtt = $mw->Button(-background => "blue", -activebackground => "st
+eelblue", -command => [ \&colora  , "blue" ])
    ->place(-relx => 0.0, -rely => 0.7, -relwidth => 0.1, -relheight =
+> 0.1);
$grennbtt = $mw->Button(-background => "green", -activebackground => "
+limegreen", -command => [ \&colora  , "green" ])
    ->place(-relx => 0.0, -rely => 0.6, -relwidth => 0.1, -relheight =
+> 0.1);
$yellowbtt = $mw->Button(-background => "yellow", -activebackground =>
+ "gold1", -command => [ \&colora  , "yellow" ])
    ->place(-relx => 0.0, -rely => 0.5, -relwidth => 0.1, -relheight =
+> 0.1);
$purplebtt = $mw->Button(-background => "purple", -activebackground =>
+ "purple3", -command => [ \&colora  , "purple" ])
    ->place(-relx => 0.0, -rely => 0.4, -relwidth => 0.1, -relheight =
+> 0.1);
$orangebtt = $mw->Button(-background => "orange", -activebackground =>
+ "coral", -command => [ \&colora  , "orange" ])
    ->place(-relx => 0.0, -rely => 0.3, -relwidth => 0.1, -relheight =
+> 0.1);
    
######################
# Definisco la label #    
$mialabel = $mw->Label(-text => "Press Start!", -font => 'code', -back
+ground => "black", -foreground => "white")
    ->place(-relx => 0.2, -rely => 0.9, -relwidth => 0.6, -relheight =
+> 0.1);
    
    

###############################################
# 4 x 10 spazi vuoti da riempire con i colori #
sub clean {
foreach $step (@steps){
$uno = $step->createOval(3,2, 16, 15, -fill=>       "grey");
$due = $step->createOval(23,2, 36, 15, -fill=>      "grey");
$tre = $step->createOval(43,2, 56, 15, -fill=>      "grey");
$quattro = $step->createOval(63,2, 76, 15, -fill=>  "grey"); 
    }
}


sub reclean {
    foreach $step (@steps){
    $step->itemconfigure    ("$uno", -fill=>     "grey");
    $step->itemconfigure    ("$due", -fill=>     "grey");
    $step->itemconfigure    ("$tre", -fill=>     "grey");
    $step->itemconfigure    ("$quattro", -fill=>     "grey");
    $step  ->itemconfigure ($ok[1], -fill=> "grey");
    $step  ->itemconfigure ($ok[2], -fill=> "grey");
    $step  ->itemconfigure ($ok[3], -fill=> "grey");
    $step  ->itemconfigure ($ok[4], -fill=> "grey");
        }
}

    
######################################
# Disegno i quadratini dei risultati #
foreach $step (@steps){
$ok[1] = $step  ->createRectangle(81, 5, 88, 12);
$ok[2] = $step  ->createRectangle(90, 5, 97, 12);
$ok[3] = $step  ->createRectangle(99, 5, 106, 12);
$ok[4] = $step  ->createRectangle(108, 5, 115, 12);
}


&clean;
    if ( $buone == 4 ) {
        $winlabel = $mw->Label(-text => "You Won!\n Press start to pla
+y again", -font => 'code', -background => "black", -foreground => "wh
+ite")
            ->place(-relx => 0.2, -rely => 0.5, -relwidth => 0.6, -rel
+height => 0.3);
            }    


MainLoop;

[download]

In reply to 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":


  • Are you posting in the right place? Check out Where do I post X? to know for sure.
  • Posts may use any of the Perl Monks Approved HTML tags. Currently these include the following:
    <code> <a> <b> <big> <blockquote> <br /> <dd> <dl> <dt> <em> <font> <h1> <h2> <h3> <h4> <h5> <h6> <hr /> <i> <li> <nbsp> <ol> <p> <small> <strike> <strong> <sub> <sup> <table> <td> <th> <tr> <tt> <u> <ul>
  • Snippets of code should be wrapped in <code> tags not <pre> tags. In fact, <pre> tags should generally be avoided. If they must be used, extreme care should be taken to ensure that their contents do not have long lines (<70 chars), in order to prevent horizontal scrolling (and possible janitor intervention).
  • Want more info? How to link or How to display code and escape characters are good places to start.
Log In?
Username:
Password:

What's my password?
Create A New User
Domain Nodelet?

www.com | www.net | www.org
Chatterbox?
and the web crawler heard nothing...

How do I use this? • Last hour • Other CB clients
Other Users?
Others learning in the Monastery: (6)
As of 2024-04-19 13:15 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    No recent polls found