Beefy Boxes and Bandwidth Generously Provided by pair Networks
laziness, impatience, and hubris

Re: Perl Tk canvases / abuse...

by kcott (Bishop)
on May 12, 2021 at 10:42 UTC ( #11132463=note: print w/replies, xml ) Need Help??

in reply to Perl Tk canvases / abuse...

G'day Montain_Gman,

Welcome to the Monastery.

I ran your code unaltered and, like ++choroba noted, was not able to reproduce your problem (i.e. no hangs, crashes, or other problems like that).

I'm running Perl 5.32.0 and Tk 804.035. I have a reasonably high-end rig with a fairly powerful GPU (RTX 2080 Ti). This could easily affect the outcome. What do you have?

The $size variable starts at 410. I increased this, via the Entry box, to 600, then 1000, then 2000. With each increase, rendering was progressively slower (at 2000, the rendering seemed to take some minutes). However, at no point did I experience any hangs or exception messages.

In a current Tk project, I have a canvas with around 2000x1000 pixels. It contains a very large number of elements, which include lines, arcs, rectangles, polygons, as well as Photo and Bitmap images. This renders in about one second: substantially different from what I'm seeing with your code.

"... idletasks ... but I'm not sure exactly what is going on."

There are two methods for updating the display: idletasks() and update(). Both are described in Tk::Widget. You've got the correct one (idletasks()) here but you're only interested in updating the canvas. Change




Calling this intermittently in a for loop is correct; however, you also need to do so after the loop:

for ... (...) { ... if (...) { $canvas->idletasks(); } } $canvas->idletasks();

Unless the if is TRUE on the last iteration, you'll end up with a strip that isn't updated. This fixes that.

You can also play around with the if condition to get an optimal value based on the range of numbers you're expecting.

"... more than say 400x400 pixels worth of stuff on a canvas, it tends to bog down ..."

There are a lot of places where you're repeating operations needlessly. Consider:

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

The calculations involving $i are repeated on every iteration of the inner loop; however, the results only change in the outer loop. $a and $b are special variables, so you should avoid using them; but, you don't need either of them, nor do you need $c. You could have written:

for my $i (0..$size-1){ my $i_col = $i%0xFF; my $i_mod20_9 = $i%20>9; for my $j (0..$size-1){ $USE[$i][$j] = $i_mod20_9^($j%20>9) ? sprintf("#%02X0000",$i_col) : sprintf("#00%02X00",$j%0xFF); } }

Having done that, you may notice that both of those sprintf calls can only result in 256 different values each. With your small, default $size of 410, the inner loop is entered 168,100 times; that number grows exponentially as $size is increased. If you precalculated all 512 possible sprintf values, you could reduce the code further to something like:

for my $i (0..$size-1){ my $i_col = $i%0xFF; my $i_mod20_9 = $i%20>9; for my $j (0..$size-1){ $USE[$i][$j] = $i_mod20_9^($j%20>9) ? $reds[$i_col] : $greens +[$j%0xFF]; } }

You could go a step further by caching @USE. If $size doesn't change, nor will @USE: don't run through those hundreds of thousands (or potentially millions) of iterations when you already have the result. You could use something along these lines:

if (exists $use_cols{$size}) { @USE = @{$use_cols{$size}}; } else { for ... { ... $USE[$i][$j] = ...; } $use_cols{$size} = [@USE]; }

If you look down the code to the next nested for loops, you'll see something similar: you're calculating $i*$ps and $i*$ps+$ps on every iteration of the inner loop when the value only changes in the outer loop. Also, the assignment to $c is pointless: you could write "-fill=>$USE[$i][$j],-outline=>$USE[$i][$j]" and have no need of the extra $c variable.

I'll leave it there as I think I've written more than enough. Look through all of your code for further opportunities for improvement.

— Ken

Replies are listed 'Best First'.
Re^2: Perl Tk canvases / abuse...
by Montain_Gman (Initiate) on May 12, 2021 at 11:49 UTC
    Ok many thanks; I see a few of these things here that could definitely help. To you; and the other responder; in general this was just a test script to do something on the canvas to get the issue to happen. So for the real thing, i'm generally processing some kind of data input to figure out what the pixels are. (say a video input, some telemetry data, etc) So that side of the problem doesn't bother me; nor does the overall speed of the render. I am running on a beast of a work machine (precision 7820 tower); but it does not have much in the way of graphics support. So that could definitely be part of the problem; but I have seen this issue before on my home machine with at an least decent graphics card. I have also done stuff drawing tons of lines and good results with a canvas; but probably not nearly as many as 400x400 items going to the canvas at once. I am running in windows and my company also has a ton of spyware / antivirus stuff that kills all productivity, which could be at play. I will also try the other responders single call to the canvas (if that's possible in my case); I need to study what he was suggesting more. (I am not really interested in drawing a checker board; I'd generally be drawing something real) But I assume there's probably a way to stack up all my pixels into a single call and only have 1 tag/object in the same kind of way he did. BTW: i am running strawberry perl on windows: This is perl 5, version 30, subversion 0 (v5.30.0) built for MSWin32-x64-multi-thread Thanks; I will try to get back to post my results in next day or so.
Re^2: Perl Tk canvases / abuse...
by Montain_Gman (Initiate) on May 14, 2021 at 00:21 UTC
    So between your response; and the other response; I have gotten a huge amount of improvement; but I still get the hang / crash eventually. I actually think the main thing helping; is using the single tag for all the entries, and not keeping track of them. That uses way way less memory. I suspect the difference in using $canvas vs $mw for the idle tasks; may not matter in the end; as doing it either way clearly helps. My real script now runs almost at an acceptable level at least. I am about to go on vacation for about a week, but when I get back I'm planning on retrying this on active state perl to see if i see the same thing or not. Thanks.

Log In?

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

How do I use this? | Other CB clients
Other Users?
Others browsing the Monastery: (7)
As of 2021-08-05 15:21 GMT
Find Nodes?
    Voting Booth?
    My primary motivation for participating at PerlMonks is: (Choices in context)

    Results (44 votes). Check out past polls.