http://www.perlmonks.org?node_id=674646

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

Hi, I am currently running into a problem while creating a Perl/Tk application. The programme will potentially run for a rather long time and I'd like to have the user having some feedback that something is still happening. So a progress bar and a status line combined in a Toplevel widget seemed to be a good idea, but I often need more than one. Being lazy, I placed the widget creation, update and destroy routines into a module and access it from other modules. The reference to the Toplevel widget is returned and saved in a variable.
When using only one widget, everything is fine.
But when creating two, I am running into problems. Creating the widgets is no problem, but when I update one widget (using its unique reference), both Toplevel widgets are updated at the same time, overwriting the content of the first with the content of the second.
I am a bit confused why this happens and would really appreciate any help or guidance.

Here's the principle structure:

package Basics::progress_bar;
<stuff>
sub progress_bar {
my $tl= $mw->Toplevel();
...<stuff>...
return ($tl);
}

sub update {
my %args = @_;
...<redefine some variables>...
#$args{widget} should contain the unique reference that was returned above.
$args{widget}->update;
}
1;


And here are the widget calls from within another module:
$progress_bar_ref_a = &progress_bar(parameters);
$progress_bar_ref_b = &progress_bar(other parameters);

Updating the widget from within another module:
&update(widget => $progress_bar_ref_b,
additional parameters);

Although specifying the reference for the 2nd instance, both widgets will be updated with the new parameters.

Replies are listed 'Best First'.
Re: Modifying Tk widgets via references
by my_nihilist (Sexton) on Mar 17, 2008 at 21:29 UTC
    I am learning Tk right now and probably can't help you with your main problem, but i was experimenting with something involving multiple top level widgets today and you should know that Tk never lets go of the widget occupied memory after "destroy". i think this is an acknowledged flaw. Today i had a 5mg (resident ram) program double in size after i destroyed/recreated a top level widget ten times! If you have a way to watch this check out it's significance to your situation.

    What works great (i will try to come up with some brief code and maybe references) is to start the different top levels "-state=>'withdrawn'" and then make them appear and disappear with "$TL->state('normal')" and "$TL->state('withdrawn')". this way, you only have to deal with the two actual widgets (presuming you don't want sets of them to appear, eg. two progress bars, three progress bars at once) and the amount of memory consumed will remain stable. That may even solve the problem.
      Thanks for the hint,
      yes, ultimately, I will simply withdraw/show the widgets until that part of the programme is finished. The destroy part was more or less an easy thing to do as a proof of concept.
      If I can't find a better solution, I will probably have to create dedicated widgets for each instance, but that somehow seems to be a very clumsy way of doing it and I was hoping to simplify the code by re-using the widget calls.
Re: Modifying Tk widgets via references
by my_nihilist (Sexton) on Mar 17, 2008 at 21:53 UTC
    well, here's the code i was talking about anyway (it works on linux fedora 7). If you need to believe about the memory thing, just try "Tk destroy memory" in PerlMonks or google.
    #!/usr/bin/perl -w use strict; use Tk; my $MW = new MainWindow(); my $TLi = $MW->Toplevel(); $TLi->state('withdrawn'); my $TLii = $MW->Toplevel(); $TLii->state('withdrawn'); my $Bi = $MW->Button(-text=>"Toplevel 1",-command=>sub{raiselower(1)}) +->pack(); my $Bii = $MW->Button(-text=>"Toplevel 2",-command=>sub{raiselower(2)} +)->pack(); MainLoop; sub raiselower { if (@_ == 1) { my $state = $TLi->state(); if ($state eq "withdrawn") {$TLi->state('normal')} else {$TLi->state('withdrawn')} } elsif (@_ == 2) { my $state = $TLii->state(); if ($state eq "withdrawn") {$TLii->state('normal')} else {$TLii->state('withdrawn')} } }
    Click the buttons alternately over and over!
Re: Modifying Tk widgets via references
by zentara (Archbishop) on Mar 18, 2008 at 13:46 UTC
    Being lazy, I placed the widget creation, update and destroy routines into a module and access it from other modules. The reference to the Toplevel widget is returned and saved in a variable. When using only one widget, everything is fine. But when creating two, I am running into problems. Creating the widgets is no problem, but when I update one widget (using its unique reference), both Toplevel widgets are updated at the same time, overwriting the content of the first with the content of the second.

    Well in addition to what my_nihilist said, about reusing toplevel windows, you can extend that to reuse all widgets. Don't try to create/destroy widgets....at best you will get a memory gain for each cycle. Withdraw or packForget them, reconfigure them, then re-pack them.

    As far as why the 2 toplevels get the same information, you probably have the module setup wrong and you are not returning a blessed object ( usually called $self in the module). Here is the basics of a Tk module/package

    #!/usr/bin/perl use warnings; use strict; use Tk; package ZCanTree; #without Tk::Derived the option -dooda will fail use base qw(Tk::Derived Tk::Canvas); Tk::Widget->Construct('ZCanTree'); sub ClassInit { my ($class, $mw) = @_; #set the $mw as parent $class->SUPER::ClassInit($mw); } # end ClassInit sub Populate { my ( $self, $args ) = @_; #------------------------------------------------------------------- #take care of args which don't belong to the SUPER, see Tk::Derived my $xtra_arg = delete $args->{-dooda}; #delete and read same time if( defined $xtra_arg ) { $self->{'dooda'} = $xtra_arg } #----------------------------------------------------------------- $self->SUPER::Populate($args); $self->{'can'} = $self->Canvas( )->pack(-expand=>1,-fill=>'both'); $self->Advertise( Canvas => $self->{'can'} ); print "2\n"; } sub get_dooda{ my $self = shift; return $self->{'dooda'}; } 1; package main; use Tk; my $mw = MainWindow->new; $mw->geometry("400x400"); my $canf = $mw->ZCanTree( -bg => 'black', -dooda => 42, )->pack(-fill=>'both',-expand=>1); my $button = $mw->Button( -text=>'Dooda', -command=> sub{ print $canf->get_dooda(),"\n" } )->pack(); my $button1 = $mw->Button( -text=>'Exit', -command=> sub{exit} )->pack +(); Tk::MainLoop;

    I'm not really a human, but I play one on earth. Cogito ergo sum a bum