aboutsummaryrefslogtreecommitdiff
path: root/Perl/demos
diff options
context:
space:
mode:
Diffstat (limited to 'Perl/demos')
-rw-r--r--Perl/demos/Tk/demos/zinc_lib/usedamage.pl93
1 files changed, 88 insertions, 5 deletions
diff --git a/Perl/demos/Tk/demos/zinc_lib/usedamage.pl b/Perl/demos/Tk/demos/zinc_lib/usedamage.pl
index 1a90020..b7f1005 100644
--- a/Perl/demos/Tk/demos/zinc_lib/usedamage.pl
+++ b/Perl/demos/Tk/demos/zinc_lib/usedamage.pl
@@ -9,16 +9,18 @@
use vars qw( $VERSION );
($VERSION) = sprintf("%d.%02d", q$Revision$ =~ /(\d+)\.(\d+)/);
+use strict;
use Tk;
use Tk::Zinc;
-use strict;
+use Tk::LabFrame;
+use Time::HiRes;
#
# Mainwindow
#
my $mw = new MainWindow();
-
+$mw->title("10.000 rectangles and a drag-n-droppable circle");
#
# Text zone
@@ -44,16 +46,18 @@ my $zinc = $mw->Zinc(
-borderwidth => 0,
-highlightthickness => 0,
-width => 700,
- -height => 700,
+ -height => 600,
)->pack(
-expand => 1,
-fill => 'both',
);
+# Seed our random generator
+srand(1234567890);
# Add a lot of rectangles
-my $N = 10000;
-foreach my $i (0...$N) {
+my $Nrect = 10000;
+foreach my $i (0...$Nrect) {
$zinc->add('rectangle', 1, [50 + rand()*500, 50 + rand()*500, 50 + rand()*500, 50 + rand()*500], -filled => 1, -fillcolor => 'blue');
}
@@ -88,6 +92,46 @@ $mw->bind('<KeyPress-2>', sub {
});
+#
+# Commands
+#
+
+# Benchmark data
+my $N = 50;
+my $delta = 550/$N;
+
+my $commandFrame = $mw->Frame()->pack(-expand => 1, -fill => 'both');
+my $commandFrameTitle = $commandFrame->LabFrame(
+ -label => 'Automatic benchmark: trasnlate our circle from top-left to bottom-right ('.$N.' steps)',
+ )->pack(
+ -side => 'bottom',
+ -fill => 'both',
+ -expand => 1,
+ );
+
+foreach my $i (0...2) {
+ my $value = $i;
+
+ # Label: display result
+ my $label = $commandFrameTitle->Label(
+ -text => 'Press button to start benchmark',
+ )->grid(
+ -row => $i,
+ -column => 1,
+ );
+
+ my $button = $commandFrameTitle->Button(
+ -text => 'Test usedamage='.$value,
+ -command => sub {
+ benchmarkUsedamage($label, $value);
+ },
+ )->grid(
+ -row => $i,
+ -column => 0,
+ );
+}
+
+
# Mainloop
MainLoop;
@@ -112,3 +156,42 @@ sub motion {
$X = $x;
$Y = $y;
}
+
+
+#
+# Benchmark usedamage
+#
+sub benchmarkUsedamage {
+ my ($label, $usedamage) = @_;
+
+ # Get usedamage value
+ my $previousValue = $zinc->cget(-usedamage);
+
+ # Force redisplay
+ $zinc->tset($circle, 1, 0, 0, 1, 0, 0);
+ $zinc->itemconfigure($circle, -sensitive => 0);
+ $zinc->configure(-usedamage => $usedamage);
+ $zinc->update();
+
+ # Get current time
+ my ($s0, $micros0) = Time::HiRes::gettimeofday();
+
+ # Move our circle
+ foreach my $i (1...$N) {
+ $zinc->translate($circle, $delta, $delta);
+ $zinc->update();
+ }
+
+ # Get current time
+ my ($s, $micros) = Time::HiRes::gettimeofday();
+
+ # Calculate delta time in ms
+ my $time = ($s - $s0)*1000 + ($micros - $micros0)/1000;
+
+ # Display time
+ $label->configure(-text => $time.' ms');
+
+ # Restore usedamage
+ $zinc->configure(-usedamage => $previousValue);
+ $zinc->itemconfigure($circle, -sensitive => 1);
+} \ No newline at end of file