in reply to Re: PerlTK: update radiobutton content on code execution
in thread PerlTK: update radiobutton content on code execution

Hi zentara,

thank you for your help. I will try to explain my problem.


start script.
Program-> chose AA
CrashMode-> chose 12 
>
Now the Button Load should display only AA_121 and AA_122.
Currently all Elements of the Array  @Load are displayed.


Thanks
Cem

[download]
Cleaned code 
#!/usr/bin/perl
use warnings;
use strict;
use Tk;

my @VehicleProgram = ( 'AA',     'BB' );
my @CrashMode      = ( '12',     '13' );
my @Load           = ( 'AA_121', 'AA_13', 'BB_12', 'CC_12', 'AA_122' )
+;
my @LoadArrayRef = @Load;

my $Program   = 'undef';
my $CrashMode = 'undef';
my $Load      = 'undef';
my $Error     = 'no';
my $font2 = '-adobe-courier-medium-r-normal--16-100-100-100-m-90-iso88
+59-2';
my $sw4;
my $comment;

my $mw = MainWindow->new;

my $toplevel = $mw->toplevel;

my $menubar = $toplevel->Menu( -type => 'menubar' )->pack;


my $w1 = $menubar->cascade( -label => 'Program',    -tearoff => 0 );
my $w2 = $menubar->cascade( -label => 'Crash Mode', -tearoff => 0 );
my $w6 = $menubar->cascade( -label => 'Load',       -tearoff => 0 );



my $sw3 = $mw->Frame(
   -relief => 'ridge',
   -bd     => 2,
   -height => '40'
 )->pack(
   -side   => 'top',
   -anchor => 'w',
   -expand => 0,
   -fill   => 'both'
 );





foreach my $i ( @VehicleProgram ) {
   $w1->radiobutton(
      -label    => "$i",
      -command  => \&set_bg,
      -variable => \$Program,
      -font     => "$font2",
      -value    => "$i"
   );
}
foreach my $i ( @CrashMode ) {
   $w2->radiobutton(
      -label    => "$i",
      -command  => \&set_bg,
      -variable => \$CrashMode,
      -font     => "$font2",
      -value    => "$i"
   );
}


foreach my $i ( @LoadArrayRef ) {
   $w6->radiobutton(
      -label    => "$i",
      -command  => \&set_bg,
      -variable => \$Load,
      -font     => "$font2",
      -value    => "$i"
   );
}

MainLoop;

sub set_bg {
   $sw4->destroy if Exists( $sw4 );
   $sw4 = $mw->Frame(
      -relief => 'ridge',
      -bd     => 2,
      -height => '40'
    )->pack(
      -side   => 'top',
      -anchor => 'w',
      -expand => 0,
      -fill   => 'both'
    );
 
   $sw4->Label(
      -text => "$Program",
      -font => "$font2"
   )->pack( -side => 'left', -anchor => 'w' );
 
   $sw4->Label(
      -text => "$CrashMode",
      -font => "$font2"
   )->pack( -side => 'left', -anchor => 'w' );
 

 
   $sw4->Label(
      -textvariable => \$Load,
      -font => "$font2"
   )->pack( -side => 'left', -anchor => 'w' );

   @LoadArrayRef = @Load;
   UpdateLoadArray();
}

sub UpdateLoadArray {
   my ( @new );
   
   print "@LoadArrayRef\n\n";
   
   foreach ( @LoadArrayRef ) {
      if ( $_ !~ /$Program/ )   { next }
      if ( $_ !~ /$CrashMode/ ) { next }
      print "$_\n";
      push( @new, $_ );
   }
   @LoadArrayRef = @new;
   print "-----\n";
   print "new-> @new\n";

   print "Program:$Program CrashMode:$CrashMode\n";

   # update label thru textvariable
   $Load = join ' ', @new;



   foreach ( @LoadArrayRef ) { print "$_\n" }

   print "-----\n";
}

sub CreateRun {
}

[download]

Replies are listed 'Best First'.
Re^3: PerlTK: update radiobutton content on code execution
by zentara (Cardinal) on Feb 27, 2009 at 19:17 UTC
    Well you have a problem with your putting undef in quotes, like = 'undef'. You could switch to total textvariables in the label, and set them to '' instead of undef. That way, they will display as "no width' in the label, unless they have a value.
    Read more... (6 kB)
    I'm not really a human, but I play one on earth My Petition to the Great Cosmic Conciousness
[reply]
[d/l]
      Hi, but the content of the Load button is always same. it is 
      AA_121
AA_13
BB_12
CC_12
AA_122

      [download]
      This is not changing depending on the Values of $Program and $CrashMode I am not talking about the output on the shell. My problem is the TK window. Thanks Cem
[reply]
[d/l]
        Hi,
        in order to close the loop here is the solution.
        You need to destroy and rebuilt the button.

        Cheers
        Cem 
        #!/usr/bin/perl -w
use strict;
use Tk;
my @VehicleProgram=('AA','BB');
my @CrashMode=('12','13');
my @Load=('AA_121','AA_13','BB_12','CC_12','AA_122');
my @LoadArrayRef=@Load;
my $sw4;
my $sw1;
my $menub2;

my $Program   = 'undef';
my $CrashMode = 'undef';
my $Drive     = 'undef';
my $Side      = 'undef';
my $dummy     = 'undef';
my $Load      = 'undef';
my $Error     ='no';


my $mw = MainWindow->new;

#my $toplevel = $mw->toplevel;

my $MFrame1 = $mw->Frame()->pack(-side=>'top');
my $MFrame2 = $mw->Frame()->pack(-side=>'bottom');

my $Frame1 = $MFrame1->Frame()->pack(-side=>'left');
my $Frame2 = $MFrame1->Frame()->pack(-side=>'left');
my $Frame3 = $MFrame1->Button(-text => 'Exit',
                         -borderwidth=>'0',
                         -command => sub{exit})->pack(-side=>'right');
my $Frame4 = $MFrame2->Frame()->pack(-side=>'bottom',
                                -fill => 'both',
                                -expand=> '1');

my $menubar = $Frame1->Menu(-type => 'menubar',
                            -relief=>'groove',
                            -borderwidth=>'0')->pack;

my $w1 = $menubar->cascade(-label => 'Program',-tearoff => 0);
my $w2 = $menubar->cascade(-label => 'Crash Mode',-tearoff => 0);

$sw1 = $Frame2->Frame()->pack();

my $menub = $sw1 ->Menubutton(-text   =>  "Load",
                               -relief=>'groove',
                               -borderwidth=>'0')->pack();




foreach my $i (@VehicleProgram) {
    $w1->radiobutton (-label => "$i",
                      -command => \&set_bg,
                      -variable => \$Program,
                      -value => "$i")
} 
foreach my $i (@CrashMode) {
    $w2->radiobutton (-label => "$i",
                      -command => \&set_bg,
                      -variable => \$CrashMode,
                      -value => "$i")
} 
 

MainLoop;

sub set_bg {
    $sw1->destroy if Exists($sw1);
    $sw4->destroy if Exists($sw4);
    $sw4 = $Frame4->Frame(-relief => 'ridge', -bd => 2,-height=>'40')-
+>pack();
    $sw4->Label(-text   =>  "$Program",)
                      ->pack(-side => 'left',-anchor => 'w');
    $sw4->Label(-text   =>  "$CrashMode",
                     )->pack(-side => 'left',-anchor => 'w');
    $sw4->Label(-text   =>  "$Drive",)
                      ->pack(-side => 'left',-anchor => 'w');
    $sw4->Label(-text   =>  "$Side",)
                      ->pack(-side => 'left',-anchor => 'w');
    $sw4->Label(-text   =>  "$dummy",)
                      ->pack(-side => 'left',-anchor => 'w');
    $sw4->Label(-text   =>  "$Load",)
                      ->pack(-side => 'left',-anchor => 'w');
    @LoadArrayRef=@Load;
UpdateLoadArray ();

  $sw1 = $Frame2->Frame()->pack();

my $menub = $sw1->Menubutton(-text   =>  "Load")->pack();

        foreach my $i (@LoadArrayRef) {
          $menub->radiobutton(
                       -label => "$i",
                       -command => \&set_bg,
                       -variable => \$Load,
                       -value => "$i"
                      );
    }
}

sub UpdateLoadArray {  
   my (@new);
   foreach (@LoadArrayRef) {
       if ($_ !~ /$Program/) {next}
       if ($_ !~ /$CrashMode/) {next}
#       print "$_\n";
       push (@new,$_);
   }
   @LoadArrayRef=@new;
#      print "-----\n";
#      print "Program:$Program CrashMode:$CrashMode\n";
#      foreach (@LoadArrayRef) {print "$_\n"}
#      print "-----\n";
}

sub CreateRun {  
}

        [download]
[reply]
[d/l]

In Section Seekers of Perl Wisdom