Beefy Boxes and Bandwidth Generously Provided by pair Networks
We don't bite newbies here... much
 
PerlMonks  

comment on

( #3333=superdoc: print w/replies, xml ) Need Help??

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

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":



  • Are you posting in the right place? Check out Where do I post X? to know for sure.
  • Posts may use any of the Perl Monks Approved HTML tags. Currently these include the following:
    <code> <a> <b> <big> <blockquote> <br /> <dd> <dl> <dt> <em> <font> <h1> <h2> <h3> <h4> <h5> <h6> <hr /> <i> <li> <nbsp> <ol> <p> <small> <strike> <strong> <sub> <sup> <table> <td> <th> <tr> <tt> <u> <ul>
  • Snippets of code should be wrapped in <code> tags not <pre> tags. In fact, <pre> tags should generally be avoided. If they must be used, extreme care should be taken to ensure that their contents do not have long lines (<70 chars), in order to prevent horizontal scrolling (and possible janitor intervention).
  • Want more info? How to link or or How to display code and escape characters are good places to start.
Log In?
Username:
Password:

What's my password?
Create A New User
Domain Nodelet?
Chatterbox?
and the web crawler heard nothing...

How do I use this? | Other CB clients
Other Users?
Others making s'mores by the fire in the courtyard of the Monastery: (4)
As of 2021-07-30 13:15 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    No recent polls found

    Notices?