I'm writing a perl GUI using Gtk2, it has a scrolled window which contains a number of GTk2::Expander which includes different widgets.
The poroblem is when i have a large number of Expanders (~80,000) the time it takes to perform show_all() is large, and when i open a single expander it takes several seconds. Running the same script with less expanders give a very fast response.
Since my expanders exists in a scrolled window and only part of them would be really visible, is there a way to improve the performance? like showing only the visible expanders and keeping all others as hidden?
I can't use GTK3, I need to use Perl and Gtk2 only.
Example Code:
my $ItemsCount = 10000;
my $ScWin = Gtk2::ScrolledWindow->new(undef, undef);
my $Frame = Gtk2::Frame->new('Items');
my $ItemsBox = Gtk2::Table->new(2, $ItemsCount+1, FALSE);
my $View = Gtk2::Viewport->new();
$ScWin->set_policy('automatic', 'automatic');
$View->add($ItemsBox);
$ScWin->add($View);
for my $i (0 .. $ItemsCount-1) {
my $exp = Gtk2::Expander->new();
$exp ->set_label("Item #$i");
$ItemsBox->attach($exp, 0, 1, $i, $i+1, 'fill', 'fill', 1, 2);
}
$MainBox ->pack_start ($ScWin , TRUE, TRUE, 0);
Related
I'm trying to animate the results of a mathematical process in a 2D canvas with Tk. I've decided to do it with Tk and not SDL because right now i'm working with both Linux and Windows machines and Strawberry Perl doesn't compile proberly in windows, whil Tk is up on both pcs.
What i would like to do with Tk is that:
1)Popping up the canvas while my program is working out the coordinates of the points i would like to draw.
2)Drawing them instantly into the canvas without waiting for the process to reach the end
It's actually a simple animation, where a bunch of points moves around the Canvas while my script updates their coordinates.
Here you have a code snippet i've been writing so far for a single point:
use Tk;
#calcuate the coordinate of a single point
$x=10;
$y=10;
$top = MainWindow->new();
# create a canvas widget
$canvas = $top->Canvas(width => 600, height => 400) -> pack();
# For example, let's create 1 point inside the canvas
$canvas->create ('oval', $x, $y, $x+3, $y+3, -fill=>"black"); # fill color of object
MainLoop;
The problem with the above code is that i would like to add my 'math' script inside it in order to update the $x and $y coordinates above (with some sort of for/while cycle) without shutting down the original canvas, by obtaining a single point moving all around it (atually there are more points i'm supposed to display but that's a minor detail).
FYI, using a simple for cycle embedding the ''Mainloop'' directive doesn't fix the problem.
Thanks in advance guys
Quoting from Mastering Perl/Tk, chapter 15 "Anatomy of the MainLoop":
Option 1: use your own MainLoop implementation
use Tk qw(:eventtypes);
while (Tk::MainWindow->Count) {
# process events - but don't block waiting for them
DoOneEvent(ALL_EVENTS | DONT_WAIT);
# your update implementation goes here
}
Option 2: use a repeat timer event
Later in the chapter it is stated that DoOneEvent() isn't really necessary for most stuff. You could use timer events instead, e.g.
my $update = sub {
# your update implementation goes here
};
# run update every 50ms
$top->repeat(50, $update);
MainLoop;
SOLUTION:
As per Stefan Becker suggested option nr.2, here is what has finally fixed the problem:
use Tk:
$top = MainWindow->new();
# create a canvas widget
$canvas = $top->Canvas(width => 600,
height => 400,
background => 'black') -> pack();
$x=300;
$y=200;
my $update = sub {
$canvas->delete('all'); #unquote this line if you don't want the original point positions to be drawn in the canvas. Viceversa
$x=$x+(-5+rand(10)); #white noise
$y=$y-(-5+rand(10)); #white noise
$canvas->create ('oval', $x , $y , $x+5, $y+5, -fill=>"red");
};
$top->repeat(50, $update);
MainLoop;
I've just added the statement $canvas->delete('all') at the beginning of the updating loop in order to draw just actual points and not the history.
I'm using the perl module PDF::API2::Annotation to add annotations to my pdf files.
There is support to decide where the annot will be created using a rect. Something like this:
$annot->text( $text, -rect => [ 10, 10, 10, 10 ] );
which works fine, but I'm having problem to be accurate on where to put my annotations.
I know the lower left corner of the pdf is (0,0). Let's say i want to put an annotation exactly in the middle of the page, any idea how can i achieve that?
according to this https://www.leadtools.com/help/leadtools/v18/dh/to/leadtools.topics.pdf~pdf.topics.pdfcoordinatesystem.html
a pdf is divided to points, and each point is 1/72 inch. and a pdf size is so the middle should be
(306,396)
But thats not even close to the middle.
You can get the size of the page media box and then calculate the middle from that:
# get the mediabox
my ($llx, $lly, $urx, $ury) = $page->get_mediabox;
# print out the page coordinates
say "page mediabox: " . join ", ", $llx, $lly, $urx, $ury;
# output: 0, 0, 612, 792 for the strangely-shaped page I created
# calculate the midpoints
my $midx = $urx/2;
my $midy = $ury/2;
my $annot = $page->annotation;
# create an annotation 20 pts wide and high around the midpoint of the mediabox
$annot->text($text, -rect=>[$midx-10,$midy-10,$midx+10,$midy+10]);
As well as the media box, you can also get the page crop box, trim box, bleed box, and art box:
for my $box ('mediabox', 'cropbox', 'trimbox', 'artbox', 'bleedbox') {
my $get = "get_$box";
say "$box dimensions: " . join ", ", $page->$get;
}
These are usually all the same unless the document has been set up for professional printing with a bleed area, etc.
Suppose I want to take one picture, move all of its pixels one pixel to the right and one to the left, and save it. I tried this code:
my $image_file = "a.jpg";
my $im = GD::Image->newFromJpeg($image_file);
my ($width, $height) = $im->getBounds();
my $outim = new GD::Image($width, $height);
foreach my $x (1..$width)
{
foreach my $y (1..$height)
{
my $index = $im->getPixel($x-1,$y-1);
my ($r,$g,$b) = $im->rgb($index);
my $color = $outim->colorAllocate($r,$g,$b);
$outim->setPixel($x,$y,$color);
}
}
%printing the picture...
That doesn't do the trick; it draws all pixels, except those in which x=0 or y=0, in one color. Where am I going wrong?
Look in the docs:
Images created by reading JPEG images will always be truecolor. To
force the image to be palette-based, pass a value of 0 in the optional
$truecolor argument.
It's not indexed. Try adding a ,0 to your newFromJpeg call.
From the comments, it seems your next problem is the number of colors to allocate. By default, the indexed image is 8-bit, meaning a maximum number of 256 unique colors (2^8=256). The "simple" workaround is of course to use a truecolor image instead, but that depends on whether you can accept truecolor output.
If not, your next challenge will be to come up with "an optimal" set of 256 colors that will minimize the visible defects in the image itself (see http://en.wikipedia.org/wiki/Color_quantization). That used to be a whole topic in itself that we seldom have to worry about today. If you still have to worry about it, you are probably better off offloading that job to some specialized tool like Imagemagik or similar, rather than try to implement it yourself. Unless you like challenges of course.
Here's a solution using Imager because it's a very nice module and I'm more familiar with it, and it handles image transformations nicely.
use Imager;
my $image_file = "a.jpg";
my $src = Imager->new(file => $image_file) or die Imager->errstr;
my $dest = Imager->new(
xsize => $src->getwidth() + 1,
ysize => $src->getheight() + 1,
channels => $src->getchannels
);
$dest->paste(left => 1, top => 1, src => $src);
$dest->write(file => "b.jpg") or die $dest->errstr;
Try reversing the direction of x and y - not from 1 to max but from max to 1. You are not sliding the colors but copying the same again and again.
I realize that this is an old post, but this is a piece of code that I use GD:Thumb for creating resized images.
sub png {
my ($orig,$n) = (shift,shift);
my ($ox,$oy) = $orig->getBounds();
my $r = $ox>$oy ? $ox / $n : $oy / $n;
my $thumb = GD::Image->newFromPng($ox/$r,$oy/$r,[0]);
$thumb->copyResized($orig,0,0,0,0,$ox/$r,$oy/$r,$ox,$oy);
return $thumb, sprintf("%.0f",$ox/$r), sprintf("%.0f",$oy/$r);
}
I have two panels animating (blinking on/off) fine as heartbeats. However I want them to alternate beating instead of at the same time. So panel1 beats with a 10 count and then panel2 beats with a 10 count. I then want this to loop so it continues the pattern until the user presses the back key to exit the activity. I tried a few things with no luck. Here is the two panels beating together...
Sub beats
PNL1.Initialize("PNL1")
gdpanel1.Initialize("TOP_BOTTOM", Array As Int(Colors.DarkGray, Colors.Red))
gdpanel1.CornerRadius=0
PNL1.Background=gdpanel1
mainPNL.AddView(PNL1,0,0,100%x,50%y)
SetRadialGradientRed(gdpanel1,PNL1.Height/1.5)
a.InitializeAlpha("a",0,1)
a.Duration = 200
a.RepeatCount = 10
a.Start(PNL1)
PNL2.Initialize("PNL1")
gdpanel2.Initialize("TOP_BOTTOM", Array As Int(Colors.DarkGray, Colors.Blue))
gdpanel2.CornerRadius=0
PNL2.Background=gdpanel2
mainPNL.AddView(PNL2,0,50%y,100%x,50%y)
SetRadialGradientBlue(gdpanel2,PNL2.Height/1.5)
b.InitializeAlpha("b",0,1)
b.Duration = 200
b.RepeatCount = 10
b.Start(PNL2)
End Sub
Sub a_AnimationEnd
'
End Sub
Sub b_AnimationEnd
'
End Sub
You should start animation b in Sub a_AnimationEnd and start animation a in Sub b_AnimationEnd.
I am making some plots in Perl using GD::Graph and some of the data is outside the area I would like to display, but instead of being truncated off the chart outside the graphing area, it is being drawn over the title, legend, and axis labels. Does anyone know how to stop this from happening?
If you know what your bounds are, filter the data and don't include those points in the data that you send to GD::Graph.
To clarify: are you declaring the y_max_value height and your data is overflowing that bound? Or is GD::Graph miscalculating the correct upper limit?
If you're setting the value, you need to fix your values to that upper bound. GD::Graph is only doing what you're telling it to do. (Which is more or less what Brian said).
OTOH, I've found that GD::Graph doesn't always cope well with cumulative (stacked) graphs, and tends to overestimate the y_max_value in those circumstances. It can also produce some unattractive values on the Y axis, with floating point numbers at the tick values. Is this what you're really trying to solve?
Having had both these problems, we've found a solution using Tie::RangeHash to create 'tidy' increments that always produce 5 integer tick points.
use Tie::RangeHash ;
my $y_ranges = new Tie::RangeHash Type => Tie::RangeHash::TYPE_NUMBER;
$y_ranges->add(' -500, -101', '-25');
$y_ranges->add(' -100, -26', '-10');
$y_ranges->add(' -25, -1', '-5');
$y_ranges->add(' 0, 25', '5');
$y_ranges->add(' 26, 100', '10');
$y_ranges->add(' 101, 500', '25');
$y_ranges->add(' 501, 1000', '100');
$y_ranges->add(' 1001, 5000', '250');
$y_ranges->add(' 5001, 10000','1000');
$y_ranges->add('10001, 50000','2500');
$y_ranges->add('50001,' ,'5000');
sub set_y_axis {
# This routine over-rides the y_max_value calculation in GD::Graph, which produces double the
# required limit, and therefore a lot of white-space...
return 1 unless #_ ; #no point going any further if no arguments were provided, however result has to be
#non-zero to avoid /0 errors in GD::Graph
my #a = map { $_ || 0 } #_ ; #array may have undefs in it. Set null to zero for calc of max
my ($y_max) = sort { $b <=> $a } #a ; # Get largest total for y-axis
my $y_range = $y_ranges->fetch($y_max);
my $y_axis = ($y_max%$y_range==0) ? $y_max+$y_range : ($y_max - ($y_max%$y_range) + $y_range);
sprintf("%d", $y_axis);
}
sub my_graph {
my #ymax;
# generate data... foreach loop etc
push(#ymax, $this_y_value); # append y-value or cumulative y-value as appropriate
# etc.
my $graph = GD::Graph::lines->new(750, 280);
$graph->set(
y_max_value => set_y_axis(#ymax),
x_labels_vertical => 1,
transparent => 1,
# etc
);
# etc
}
Hope that's useful to you.