Binding Events In Perl TK

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

Oh Wise Perl Monks, I come again seeking some wisdom: I am learning Tk and am having a problem. Here is the situation: I have a hash, and am generating radio buttons, labels, and entry widgets based upon the size of the hash. My goal is to have the entry widget corresponding to the radio button turn black when the radio button is clicked. Here are some code snippets, and I will place the full code after the readmore tag:
Here I am generating the radio buttons:

    for (0..$numChem)  #numChem is the size of the array
    {
        my $solvCheck = $frame4->Radiobutton(
        -variable => \$isSolv,    #isSolve is the varible that will ho
+ld the index of the solvent
        -value => "$_"             
        );
        $solvCheck ->bind("all","<Button-1>" => \&colorme);   #when bu
+tton-1 is pushed, execute &colorme
        $solvCheck -> pack();
    }
[download]

Here is the code that sets the color of the entry widgets:

    for (0..$numChem){
        ${$wtPercent}[$_] = 0;
        $wtpercentcolor{$_} = "white";   #initialized hash to original
+ly set all colors to white
    };
    for (0..$numChem){${$vol}[$_] = 0};
    for (0..$numChem)
    {
        $wtPercentbox[$_] = $frame10->Entry(
        -textvariable => \${$wtPercent}[$_],
        -width => 5,
        -background => $wtpercentcolor{$_}  #set background color
        );
        $wtPercentbox[$_] -> pack(-pady => 4);
    }
[download]

Here is the code that changes the color in the %wtpercentcolor hash:

sub colorme
{
    my $index = our $isSolv;
    our %wtpercentcolor;
    our $wtpercentcolor;
    our $numChem;
    for (0..$numChem){
        $wtpercentcolor{$_} = "white";
    };    
    $wtpercentcolor{$index} = "black";
    #$wtpercentcolor = "black"
};
[download]

Here is the full code:

#!/usr/bin/env perl -w

require Tk;
use Tk;
use Tk::Font;
use English;

use strict;
use warnings;

our %density = (
                DI => "1",
                HF => "1.16",
                NH4OH => "0.9",
                H202 => "1.11",
                HCl => "1.18",
                H2SO4 => "1.84",
                Citric => "1",
                NH4F => "1.01",
                TMAH => "1",
                Nitric => "1.415",
                Acetic => "1.05",
                Phosphoric => "1.7",
                IPA  => "0.79"
            );

our %concentration =(
                DI => "1",
                HF => "0.49",
                NH4OH => "0.29",
                H202 => "0.3",
                HCl => "0.37",
                H2SO4 => ".98",
                Citric => "0.5",
                NH4F => "0.4",
                TMAH => "0.25",
                Nitric => "0.7",
                Acetic => "0.8",
                Phosphoric => "0.85",
                IPA => "1.0"
                );


my $mw = MainWindow->new;

$mw -> title("BathCalc Selection");
$mw -> geometry("+400+400");

#Setting frames in main window.
my $menuframe = $mw -> Frame(
        -relief => "groove",
        -borderwidth => 2
        )->pack(
        -side => "top",
        -fill => "x",
        );
my $topframe = $mw -> Frame()->pack(
        -side => "top",
        -fill => "x",
        -padx => 10,
        -pady => 5
        );
my $midframe = $mw -> Frame()->pack(
        -side => "top",
        -fill => "x",
        -padx => 10,
        );
my $botframe = $mw -> Frame()->pack(
        -side => "top",
        -fill => "x",
        -padx => 10,
        -pady => 5
        );
#command to make a file menubutton
my $file_mw = $menuframe -> Menubutton (
        -text => "File",
        -activeforeground => "grey"
        ) -> pack (-side => 'left');
        
$file_mw -> command(
        -label => "Exit",
        -command => sub{$mw -> destroy}
        );        
        
        
#setting up selections as to where to go next
my $rb;
my $r1=$midframe->Radiobutton(
    -text=>"Calculate Amount of Material to Pour a Bath", 
    -value=>"1", 
    -variable=>\$rb
    ) -> pack(side => 'top', -anchor => 'w');
my $r2=$midframe->Radiobutton(
    -text=>"Convert Chemical Ratio to Mass Percent", 
    -value=>"2", 
    -variable=>\$rb
    ) -> pack(side => 'top', -anchor => 'w');
my $r3=$midframe->Radiobutton(
    -text=>"Display Assumptions", 
    -value=>"3", 
    -variable=>\$rb
    ) -> pack(side => 'top', -anchor => 'w');
    
my $text1 = $topframe->Label (
    -text => "Selection:",
    -font => '{times new roman} 14'
    ) -> pack(side => 'top', -anchor => 'w');

my $actionButton = $botframe -> Button(
    -text => "Go",
    -command => \&CHOOSE
    ) -> pack(-side => 'left', padx => '50', pady => '20');

my $exitButton = $botframe -> Button(
    -text => "Quit",
    -command => sub{exit}
    ) -> pack(-side => 'right', padx => '50', pady => '20');

MainLoop ();

sub CHOOSE
{
    if ($rb == 1)
    {
        &MAKE_BATH;
    } 
          
    elsif ($rb == 2)
    {
        &RATIO;
    }
                    
    elsif ($rb == 3)
    {  
    &ASSUME;
    }
}

sub MAKE_BATH   #This subroutine will generate a new window that will 
+require user input to calculate volumes
                #required to pour up a bath of known size and concentr
+ation.  The default concentration and 
                #density will be displayed and allow users to change i
+f they need to do so.
{
    my $mb = MainWindow -> new;
    $mb -> title("Bath Pour Up");
    $mb -> geometry("+200+200");

#this frame is going to be the menu bar.
    my $frame1 = $mb -> Frame(
        -relief => "groove",
        -borderwidth => 3
        )->pack(
        -side => "top",
        -fill => "x"
        );

    #The next section sets up all of the frames I will need, many, man
+y frames...        
    my $file_mb = $frame1 -> Menubutton (
        -text => "File",
        -activeforeground => "grey"
        ) -> pack (-side => 'left');
        
    $file_mb -> command(
        -label => "Exit",
        -command => sub{$mb -> destroy}
        );
    my $midhold = $mb -> Frame()->pack(
        -side => "top",
        -fill => "x",
        -padx => 3
        );                
    my $frame2 = $midhold -> Frame()->pack(
        -side => "left",
        -anchor => "n"
        );    
    my $frame3 = $midhold -> Frame()->pack(
        -side => "left",
        -anchor => "n"
        );
    my $frame4 = $frame2 -> Frame()->pack(
        -side => "left",
        -anchor => "n"
        );
    my $frame5 = $frame2 -> Frame()->pack(
        -side => "left",
        -anchor => "n"
        );
    my $frame6 = $frame3 -> Frame()->pack(
        -side => "left",
        -anchor => "n"
        );
    my $frame7 = $frame3 -> Frame()->pack(
        -side => "left",
        -anchor => "n"
        );
    my $frame8 = $frame6 -> Frame()->pack(
        -side => "left",
        -anchor => "n"
        );
    my $frame9 = $frame6 -> Frame()->pack(
        -side => "left",
        -anchor => "n"
        );
    my $frame10 = $frame7 -> Frame()->pack(
        -side => "left",
        -anchor => "n"
        );
    my $frame11 = $frame7 -> Frame()->pack(
        -side => "left",
        -anchor => "n"
        );
    my $calcVolframe = $mb -> Frame(
    -borderwidth => 3
    )->pack(
        -side => "top", 
        -fill => 'x', 
        );
        
    my $frame12 = $mb -> Frame(
    -relief => "raised", 
    -borderwidth => 3
    )->pack(
        -side => "bottom", 
        -fill => 'x', 
        );
    my $headingOne = $frame5 ->Label(
        -relief => "raised",
        -text => "Chemical Name"
        ) -> pack();
    my $headingTwo = $frame9 ->Label(
        -relief => "raised",
        -text => "Concentration (%)"
        ) -> pack();    
    my $headingThree = $frame8 ->Label(
        -text => "Density (g/mL)",
        -relief => "raised"
        ) -> pack();        
    my $headingFour = $frame10 ->Label(
        -text => "Wt %",
        -relief => "raised",
        -width => 5
        ) -> pack();
    my $headingFive = $frame11 ->Label(
        -text => "Calculated Volume (L)",
        -relief => "raised"
        ) -> pack();    
    my $headingSix = $frame4 ->Label(
        -text => "Solvent",
        -relief => "raised"
        ) -> pack();
    my $headingSeven = $frame12 ->Label(
        -text => "Status:"
        ) -> pack(-side => 'left');

    our $statustext = "Testing";
    my $status =$frame12 -> Entry(
        -textvariable => \$statustext,
        -foreground => 'red',
        -width => 50
        ) -> pack(-side => "left");

    our $totalvolume;
    my $voltext = $calcVolframe -> Entry(
        -textvariable => \$totalvolume,
        -width => 5
        ) -> pack(
            -side => 'right',
            -padx => 36);
        
    my $volLbl = $calcVolframe ->Label(
        -text => "Bath Volume (L):"
        ) -> pack(-side=>'right');
###########################################################
#Calculate Button Below
###########################################################
    our @vol;
    our $vol = \@vol;    
    my $calcButton = $calcVolframe -> Button(
        -text => "Calculate",
        -command => \&VOLCALC
        ) -> pack(-side => 'left', padx => '50', pady => '10');
###########################################################
#Calculate Button Above
###########################################################
                
    foreach (sort keys(%density))
    {
        my $keytext = $frame5->Label (
        -height => 1,
        -width => 10,
        -text => "$_",
        -justify => 'center',
        -pady => 5
        );
        $keytext -> pack();
    }

    
    our $isSolv;
    my @chemname =  (keys(%density));    #need to know how many radio 
+buttons to make, so counting chemicals
    our $numChem = $#chemname;
    our %wtpercentcolor;
    our $wtpercentcolor = \%wtpercentcolor;
    my @wtPercentbox;
    
    for (0..$numChem)  #numChem is the size of the array
    {
        my $solvCheck = $frame4->Radiobutton(
        -variable => \$isSolv,    #isSolve is the varible that will ho
+ld the index of the solvent
        -value => "$_"             
        );
        $solvCheck ->bind("all","<Button-1>" => \&colorme);   #when bu
+tton-1 is pushed, execute &colorme
        $solvCheck -> pack();
    }    

    foreach (sort keys(%density))
    {
        my $denbox = $frame8->Entry(
            -textvariable => \$density{$_},
            -width => 5,
            -justify => "center",
            -background => "grey"
        );
        $denbox -> pack(-pady => 4);
    }

    foreach (sort keys(%concentration))
    {
        my $conbox = $frame9->Entry(
            -textvariable => \$concentration{$_},
            -width => 5,
            -justify => "center",
            -background => "grey"
        );
        $conbox -> pack(-pady => 4);
    };
    
    our @wtPercent;
    our $wtPercent = \@wtPercent;

    
    for (0..$numChem){
        ${$wtPercent}[$_] = 0;
        $wtpercentcolor{$_} = "white";   #initialized hash to original
+ly set all colors to white
    };
    for (0..$numChem){${$vol}[$_] = 0};
    for (0..$numChem)
    {
        $wtPercentbox[$_] = $frame10->Entry(
        -textvariable => \${$wtPercent}[$_],
        -width => 5,
        -background => $wtpercentcolor{$_}  #set background color
        );
        $wtPercentbox[$_] -> pack(-pady => 4);
    }


    for (0..$numChem)
    {
        my $volBox = $frame11->Entry(
        -textvariable => \${$vol}[$_],
        -width => 5,
        -background => "grey"
        );
        $volBox -> pack(-pady => 4);
    }    
}
    

sub VOLCALC
{
    our $isSolv;
    if (defined($isSolv)){
        my @chemname =  (sort keys(our %density));    
        my $solventname = $chemname[$isSolv];        
        our $statustext = $solventname;
    }else{
        our $statustext = "You need to select a solvent"
    };

}
sub sum
{
    #this subroutine sums the numbers passed to it.  Returns a single 
+value.
    my $sum = 0;
    foreach my $line (@_)
    {
        $sum += $line;
    }
    return $sum;
}

sub colorme
{
    my $index = our $isSolv;
    our %wtpercentcolor;
    our $wtpercentcolor;
    our $numChem;
    for (0..$numChem){
        $wtpercentcolor{$_} = "white";
    };    
    $wtpercentcolor{$index} = "black";
    #$wtpercentcolor = "black"
};
[download]

Any help would be greatly appeciated!

Comment on Binding Events In Perl TK Select or Download Code

Replies are listed 'Best First'.
Re: Binding Events In Perl TK by mawe (Hermit) on Aug 27, 2004 at 13:54 UTC
Hi! First of all: for the second MainWindow use grid instead of pack, so you don't need all those frames. I wrote a small script, where you can see how I would do what you want (I hope it is what you want :-)): use Tk; my $top = new MainWindow(); my %density = ( DI => "1", HF => "1.16", NH4OH => "0.9", H202 => "1.11", HCl => "1.18", H2SO4 => "1.84", Citric => "1", NH4F => "1.01", TMAH => "1", Nitric => "1.415", Acetic => "1.05", Phosphoric => "1.7", IPA => "0.79" ); my $i = 0; for my $x (keys %density) { $top->Radiobutton( -value=>$i, -command=>[\&colorme, $i])->grid(-row=>$i,-column=>0); $top->Label(-text=>$x)->grid(-row=>$i,-column=>1); $entry[$i] = $top->Entry(-bg=>'white')->grid(-row=>$i,-column=>2); $entry[$i]->insert('end',$density{$x}); $i++; } MainLoop(); sub colorme { my $i = shift; map{$_->configure(-bg=>'white')}@entry; $entry[$i]->configure(-bg=>'black'); } [download] Hope this helps. mawe	[reply] [d/l]
Re: Binding Events In Perl TK by zentara (Cardinal) on Aug 27, 2004 at 17:56 UTC
I don't quite understand why you would want to turn the Entry associated with the radiobutton black. This would obscure the text. Are you trying to disable it after it has been selected once? For that matter, I don't see an Entry associated with the radiobuttons in your code.(Or else I'm not running your code right). I see Labels next to radiobuttions. To do what you want, without writing the code for you, is to use the -command option for radiobutton which, which will call a subroutine when the radiobutton is selected. In that sub, you can configure the -background of your entries. Something like: `my $rb1 = $mw->Radiobutton(-text => "Button One", -value => 'button1', -variable => \$rb, -command => [ \&blacken, '$entry1'])->pack +; my $rb2 = $mw->Radiobutton(-text => "Button Two", -value => 'button2', -variable => \$rb, -command => [ \&blacken, '$entry2'])->pack +; sub blacken { my $entry = shift; $entry->configure(-backround => 'black'); #maybe you want #$entry->configure(-state => 'disabled') }` [download] Of course you can get fancy in your blacken sub, and test for the state of the radiobutton, and unblacken if it is blackened already. But I'm clueless as to why you want to do this? If you could be more specific, as to what your desired intent is, we can help more. I'm not really a human, but I play one on earth. flash japh	[reply] [d/l]
Re^2: Binding Events In Perl TK by qumsieh (Scribe) on Aug 27, 2004 at 22:30 UTC
`-command => [ \&blacken, '$entry1']` That of course won't work since you pass the string literal '$entry1' which you attempt to use as a Tk::Entry object in the `blacken()` sub. You need to remove the quotes.	[reply] [d/l] [select]