Beefy Boxes and Bandwidth Generously Provided by pair Networks
Syntactic Confectionery Delight
 
PerlMonks  

comment on

( #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;

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":



  • 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 exploiting the Monastery: (5)
    As of 2020-10-21 07:50 GMT
    Sections?
    Information?
    Find Nodes?
    Leftovers?
      Voting Booth?
      My favourite web site is:












      Results (212 votes). Check out past polls.

      Notices?