neilwatson has asked for the wisdom of the Perl Monks concerning the following question:

Thanks to those who helped me with my last Tk question. Now once again I ask for help. I'm having trouble getting my widgets to change colour:
#!/usr/bin/perl use warnings; use strict; use Tk; #flashcards for multiplication tables #Neil H watson #Tue Jul 15 20:24:47 EDT 2003 #upper time table limit my $scale; my $table; my ($score, $guess, $num1, $num2, $question, $answer); my ($correct, $count, $percent, $rightwrong); my $colour = 'purple'; #define main window my $mw = MainWindow->new; #create a large readable font my $font = $mw->fontCreate('font', -family => 'courier', -size => 28, -weight => 'bold'); $mw->title("Times Tables"); #return key prints question without #calculation the first score $mw->bind("<KP_Enter>", \&question); #scale to select upper limit (up to 12) $mw->Scale(-from => 1, -to => 12, -variable => \$scale)->pack(-side => 'left'); #guess widget $mw->Entry(-width => 3, -takefocus => 1, -font => $font, -textvariable => \$guess)->pack(-side => 'right'); #question widget $mw->Label(-textvariable => \$question, -font => $font)->pack(-side => 'right'); #right/wrong widget $mw->Label(-textvariable => \$rightwrong, -foreground => $colour)->pack(-side=> 'bottom'); #score widget $mw->Label(-textvariable => \$score)->pack(-side => 'bottom'); MainLoop; #checking sub check { if ($answer == $guess) { #count correct answers $correct++; $rightwrong = 'Correct!'; $colour = 'green'; }else{ $rightwrong = 'Wrong!'; $colour = 'red'; } #count questions $count++; #calculate score $percent = int($correct/$count*100); $score = "$correct correct out of $count\n($percent%)"; #clear guess $guess =""; question(); } sub question { #generate question and answer $table = $scale; $num1 = int(rand($table)+1); $num2 = int(rand(12)+1); $answer = $num1*$num2; $question = "$num1 x $num2 = "; #return checks answer and prints #new question. This prevents #the first loop from calculating #a score $mw->bind("<KP_Enter>", \&check); }

After each question, whether right or wrong, the colour of the right/wrong widget never changes. Why?

Neil Watson
watson-wilson.ca

Replies are listed 'Best First'.
Re: More Perl/Tk help.
by fergal (Chaplain) on Jul 27, 2003 at 19:35 UTC

    You need to tell the widget that the colour has changed. When you do $colour = 'red'; you are changing the value of the $colour variable but the widget doesn't know you have changed anything, it's not like -textvariable where any changes you make show up immediately. The -textvariable stuff does some funky magic so that it catches any updates you make to the variable. Very few other Tk parameters work like that as there is a memory and possibly performance cost associated with it.

    You need to change

    $mw->Label(-textvariable => \$rightwrong, -foreground => $colour)->pack(-side=> 'bottom');
    to
    my $RWWidget = $mw->Label(-textvariable => \$rightwrong, -foreground => $colour)->pack(-side=> 'bottom');
    and then add something like
    $RWWidget->configure(foreground => $colour);
    into your check() subroutine.
Re: More Perl/Tk help.
by Aristotle (Chancellor) on Jul 27, 2003 at 19:25 UTC
    Because you passed $colour by value, as opposed to $rightwrong, which was passed by reference. In the former case the method gets a copy of the state the variable had at invocation time. Obviously then you can change the variable all you like - it won't change the copy. To do what you wanted, you need to reconfigure the widget.
    # ... my $rw = $mw->Label(-textvariable => \$rightwrong, -foreground => $colour)->pack(-side=> 'bottom'); # ... if ($answer == $guess) { #count correct answers $correct++; $rightwrong = 'Correct!'; $rw->configure(-foreground => 'green'); }else{ $rightwrong = 'Wrong!'; $rw->configure(-foreground => 'red'); } # ...
    (If I am allowed a personal comment, I really hate Tk's way of using pass-by-reference to keep track of changes. It leads to spaghetti code real quick like.)

    Makeshifts last the longest.

Re: More Perl/Tk help.
by neilwatson (Priest) on Jul 27, 2003 at 20:25 UTC