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

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

So I have found using perl canvases to debug problems; and visualize things in my field can be quite easy and fast to do. Anyway what I've found is that if I do more than say 400x400 pixels worth of stuff on a canvas, it tends to bog down; and basically it will hang.

If i stay at say 200x200; the canvas behaves fast and I just don't get this problem. I have found (maybe superstitiously); that using idletasks to break things up helps, but I'm not sure exactly what is going on. I suspect without it, I am flooding some queue inside TK. There also seems to be a relationship with the hang and the amount of memory I am using.

Anyway I can't post my 'real' script, as it's tied to real work. Essentially i need to simulate a legacy graphics system, and I'm using perl/tk to test things out before we do the real work on the target. My real resolution I need to hit is just over 400x400; but if i operate it that way, I can generally only get 1-2 images displayed before it will hang. (200x200; runs nice) So i created this little script to just see if i could get the same thing to happen to post here, and it generally has the same issue. If you run this, you can then use the mouse (press and hold, move, and release) to draw lines. Hitting go will redraw the back ground. If you do those things 2-3 times; especially if you make the resolution a bit higher; it is locking up for me.

Can anyone enlighten me on what can be done to avoid this, or what is happening under the hood? Is there an easier way to just do straight pixel level screen outputs? (image magic ? I tried getting that to work but had issues on my work machine...) So would rather just stick with TK because it is very lightweight to support. (easy to install / support; anyone with perl 5.8 already has it too...)

Thanks.

ONE last thing; in reviewing this; I found I am not clearing TAGS array. So that will keep eating more memory. But even if you do @TAGS =(); if you run the script enough; you'll still see the same thing happening. So that seems to be a clue; that it's a memory thing...

use Tk; my @TAGS; my $canvas_width = 600; my $canvas_height = 600; my $mw = new MainWindow; my $top = $mw->Frame()->pack(-side=>'top'); $canvas=$top->Canvas( -width=>$canvas_width, -height=>$canvas_height, )->pack(-side=>'left'); my $size = 410; my $entry = $top->Entry(-textvariable=>\$size)->pack(-side=>'top'); my $button = $top->Button(-text=>"go",-command=>\&go)->pack( -side=>'top'); $mw->Tk::bind('<MouseWheel>', [\&wheel,Ev('D')]); $canvas->Tk::bind( "<Button>", [\&button_press,Ev('x'),Ev('y')]); $canvas->Tk::bind( "<ButtonRelease>", [\&button_release,Ev('x'),Ev('y')]); $canvas->Tk::bind( "<Motion>", [\&motion,Ev('x'),Ev('y')]); $mw->Tk::bind('<KeyPress>', [\&key,Ev('k')]); my $start_x; my $start_y; my $start_draw = 0; $mw->after(100,\&go); MainLoop(); #################################################################### sub button_press{ my ($dontknow,$x1,$y1) = @_; $start_draw = 1; $start_x = $x1; $start_y = $y1; } #################################################################### sub button_release{ my ($dontknow,$x1,$y1) = @_; if($start_draw){ $start_draw = 0; $canvas->createLine($start_x,$start_y,$x1,$y1, -width=>2,-fill=>'white'); } } #################################################################### sub motion{ my ($dontknow,$x1,$y1) = @_; } #################################################################### sub key{ my ($na,$key) = @_; print "$key\n"; } #################################################################### sub wheel{ my ($dontknow,$clicks) = @_; } #################################################################### sub erase{ for my $i (0..$#TAGS){ $canvas->delete($TAGS[$i]); if($i%($size*5)==0){ $mw->idletasks(); } } } #################################################################### sub go{ my @USE; &erase(); for my $i (0..$size-1){ for my $j (0..$size-1){ my $a = ($i%20) > 9; my $b = ($j%20) > 9; my $c; if($a^$b){ $c = sprintf("#%02X0000",$i%0xFF); } else { $c = sprintf("#00%02X00",$j%0xFF); } $USE[$i][$j]=$c; } } my $ps = $canvas_width/$size; for my $i (0..$#USE){ for my $j (0..$#{$USE[$i]}){ my $c = $USE[$i][$j]; my $tag = $canvas->createRectangle( $i*$ps,$j*$ps, $i*$ps+$ps,$j*$ps+$ps, -fill=>$c,-outline=>$c); push(@TAGS,$tag); } if($i%5==0){ $mw->idletasks(); } } $center_x = $canvas_width/2; $center_y = $canvas_height/2; $x_tag1 = $canvas->createLine( $center_x-10, $center_y-10, $center_x+10, $center_y+10, -width=>2,-fill=>'red'); $x_tag2 = $canvas->createLine( $center_x-10, $center_y+10, $center_x+10, $center_y-10, -width=>2,-fill=>'red'); # $mw->after(3000,\&go); }