Beefy Boxes and Bandwidth Generously Provided by pair Networks
Pathologically Eclectic Rubbish Lister
 
PerlMonks  

Re: Tk::Table clear creates unwanted boxes

by Athanasius (Archbishop)
on Aug 05, 2014 at 15:42 UTC ( [id://1096304]=note: print w/replies, xml ) Need Help??


in reply to Tk::Table clear creates unwanted boxes

Hello toolic,

Yes, I can reproduce this exactly. And from playing around with it, I found the following, which seems to work correctly:

#! perl use strict; use warnings; use Tk; use Tk::Table; my $mw = MainWindow->new(); my $upper = $mw ->Frame()->pack(-side => 'top'); my $but1 = $upper->Frame()->pack(); my $lower = $mw ->Frame()->pack(-side => 'bottom'); my $table = $lower->Table(-rows => 3, -columns => 5)->pack; upd_table(); $but1->Button ( -text => 'update', -command => sub { upd_table() }, )->pack(); MainLoop(); exit; sub upd_table { $table->clear() if $table; for my $row (0 .. 2) { for my $col (0 .. 4) { my $x = int rand 10; my $cell = $table->Entry(-width => 4, -text => $x); $table->put($row, $col, $cell); } } }

That is, I just moved the line

$table = $lower->Table(-rows => 3, -columns => 5)->pack;

from the subroutine to the main code. No idea why this works, though. :-O

Hope that helps,

Athanasius <°(((><contra mundum Iustus alius egestas vitae, eros Piratica,

Replies are listed 'Best First'.
Re^2: Tk::Table clear creates unwanted boxes
by choroba (Cardinal) on Aug 05, 2014 at 16:23 UTC
    No idea why this works, though
    Because the OP creates a new table every time, but the old one is not deleted (as it is referenced by its parent widget, probably), only cleared.
    لսႽ† ᥲᥒ⚪⟊Ⴙᘓᖇ Ꮅᘓᖇ⎱ Ⴙᥲ𝇋ƙᘓᖇ
      choroba, I had tried using delete on the table as well, but that was not working for me. I can not figure out where to use it in my code. If you could demonstrate (especially on my more realistic code), that would be greatly appreciated.
Re^2: Tk::Table clear creates unwanted boxes
by toolic (Bishop) on Aug 05, 2014 at 16:25 UTC
    ++

    As Mr. Spock would say... fascinating. Much appreciated, Athanasius. Your modification works for me as well, even on an older version of Tk. That solves the problem for my original post.

    The real reason I have the sub is that I also need the number of rows to vary each time I click the button. So, the OP was reduced too much. Thanks to your recommendation, my more realistic code below works also. I happen to know up front that the maximum number of rows is a constant (32):

    use warnings; use strict; use Tk; use Tk::Table; my $mw = MainWindow->new(); my $upper = $mw->Frame()->pack(-side => 'top'); my $but1 = $upper->Frame()->pack(); my $lower = $mw->Frame()->pack(-side => 'bottom'); my $table = $lower->Table(-rows => 32, -columns => 5)->pack; upd_table(); $but1->Button( -text => 'update', -command => sub { upd_table() }, )->pack(); MainLoop(); exit; sub upd_table { $table->clear() if $table; my $r = 3 + int rand 3; foreach my $row ( 0 .. $r-1 ) { foreach my $col ( 0 .. 4 ) { my $x = int rand 10; my $cell = $table->Entry( -width => 4, -text => $x ); $table->put( $row, $col, $cell ); } } }

    It would be helpful if another Monk could explain this behavior and suggest a better method.

      suggest a better method.

      If it was me, I would put the varying number grid on a Tk::Canvas, and just use tags to control which table is currently showing. It is a very good way to do it.

      As to your method of recreating multiple tables, the following is probably somewhat along the way to do it. You have a packing problem, because the window will want to resize with each table. Maybe you can work that out.

      #!/usr/bin/perl use warnings; use strict; use Tk; use Tk::Table; my $mw = MainWindow->new(); my $upper = $mw->Frame()->pack(-side => 'top'); my $but1 = $upper->Frame()->pack(); my $lower = $mw->Frame()->pack(-side => 'bottom'); my $table = $lower->Table()->pack; my $new_row = int rand 4; my $new_col = int rand 5; upd_table($new_row,$new_col); $but1->Button( -text => 'update', -command => sub { $new_row = int rand 4; $new_col = int rand 5; upd_table( $new_row,$new_col) }, )->pack(); MainLoop(); exit; sub upd_table { $table->packForget(); my ($rowin,$colin) = @_; $table = $lower->Table(-rows => $rowin, -columns => $colin)->pack; foreach my $row ( 0 .. $rowin-1 ) { foreach my $col ( 0 .. $colin ) { my $x = int rand 10; my $cell = $table->Entry( -width => 4, -text => $x ); $table->put( $row, $col, $cell ); } } }
      as far as making a Canvas do it, look at this.
      #!/usr/bin/perl use warnings; use strict; use Tk; #by thundergnat on comp.lang.perl.tk my $top = MainWindow->new; my $canvas = $top->Canvas->pack(-expand => 1, -fill => 'both'); my (@dots, @lines); my ($gridx, $gridy) = (5, 6); for my $y(0 .. $gridx-1){ for my $x(0 .. $gridy-1){ $dots[$x][$y] = $canvas->createOval( 25 + $x * 55, 25 + $y * 55, 35 + $x * 55, 35 + $y * 55, -fill => 'red' ); } } current($dots[0][0]); $top->bind('<Up>' => sub{ my ($point, $x, $y) = get_coords('active'); return if ($point < $gridy); draw($dots[$x][$y], $dots[$x][$y-1]); } ); $top->bind('<Down>' => sub{ my ($point, $x, $y) = get_coords('active'); return if ($point > $gridy * ($gridx - 1)); draw($dots[$x][$y], $dots[$x][$y+1]); } ); $top->bind('<Left>' => sub{ my ($point, $x, $y) = get_coords('active'); return if ($point % $gridy == 1); draw($dots[$x][$y], $dots[$x-1][$y]); } ); $top->bind('<Right>' => sub{ my ($point, $x, $y) = get_coords('active'); return unless ($point % $gridy); draw($dots[$x][$y], $dots[$x+1][$y]); } ); $top->bind('<1>' => sub{ my (undef, $x1, $y1) = get_coords('active'); my (undef, $x2, $y2) = get_coords('current'); return unless defined $x2; draw($dots[$x1][$y1], $dots[$x2][$y2]); } ); $top->bind('<BackSpace>' => sub{ return unless @lines; my ($line, $start) = @{$lines[-1]}; $canvas->delete($line); current($start); pop @lines; } ); MainLoop; sub get_coords{ my $tag = shift; my $item = $canvas->find(withtag => $tag); return unless $item; return $item->[0], ($item->[0] - 1) % $gridy, int (($item->[0] - 1) / +$gridy); } sub current{ $canvas->itemconfigure('active', -fill => 'red'); $canvas->itemconfigure($_[0], -fill => 'yellow'); $canvas->dtag('active', 'active'); $canvas->addtag('active', 'withtag', $_[0]); } sub draw{ my ($start, $end) = @_; my @start_coords = $canvas->bbox($start); my @end_coords = $canvas->bbox($end); return unless @end_coords; my @line_coords = ( ($start_coords[0] + $start_coords[2]) / 2, ($start_coords[1] + $start_coords[3]) / 2, ($end_coords[0] + $end_coords[2]) / 2, ($end_coords[1] + $end_coords[3]) / 2 ); my $line = $canvas->createLine(@line_coords, -arrow => 'last'); push @lines, [$line, $start]; current($end); } __END__

      I'm not really a human, but I play one on earth.
      Old Perl Programmer Haiku ................... flash japh
        Thank you for the code examples. I'll give them a try.

Log In?
Username:
Password:

What's my password?
Create A New User
Domain Nodelet?
Node Status?
node history
Node Type: note [id://1096304]
help
Chatterbox?
and the web crawler heard nothing...

How do I use this?Last hourOther CB clients
Other Users?
Others rifling through the Monastery: (4)
As of 2024-04-24 20:51 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    No recent polls found