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