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);  
        
   
}

[download]

In reply to Perl Tk canvases / abuse... by Montain_Gman

Title:
Use:  <p> text here (a paragraph) </p>
and:  <code> code here </code>
to format your post, it's "PerlMonks-approved HTML":


  • Posts are HTML formatted. Put <p> </p> tags around your paragraphs. Put <code> </code> tags around your code and data!
  • Titles consisting of a single word are discouraged, and in most cases are disallowed outright.
  • Read Where should I post X? if you're not absolutely sure you're posting in the right place.
  • Please read these before you post! —
  • Posts may use any of the Perl Monks Approved HTML tags:
    a, abbr, b, big, blockquote, br, caption, center, col, colgroup, dd, del, details, div, dl, dt, em, font, h1, h2, h3, h4, h5, h6, hr, i, ins, li, ol, p, pre, readmore, small, span, spoiler, strike, strong, sub, summary, sup, table, tbody, td, tfoot, th, thead, tr, tt, u, ul, wbr
  • You may need to use entities for some characters, as follows. (Exception: Within code tags, you can put the characters literally.)
            For:     Use:
    & &amp;
    < &lt;
    > &gt;
    [ &#91;
    ] &#93;
  • Link using PerlMonks shortcuts! What shortcuts can I use for linking?
  • See Writeup Formatting Tips and other pages linked from there for more info.