From 58bdd812d7889f425d3902a41dd48a0546d1aa32 Mon Sep 17 00:00:00 2001
From: lemort
Date: Tue, 15 Jan 2008 12:45:37 +0000
Subject: Ajout d'une demo pour la propriete usedamage dans le but d'illustrer
 les apports de l'optimisation

---
 Perl/demos/Tk/demos/zinc_lib/usedamage.pl | 114 ++++++++++++++++++++++++++++++
 1 file changed, 114 insertions(+)
 create mode 100644 Perl/demos/Tk/demos/zinc_lib/usedamage.pl

(limited to 'Perl/demos/Tk')

diff --git a/Perl/demos/Tk/demos/zinc_lib/usedamage.pl b/Perl/demos/Tk/demos/zinc_lib/usedamage.pl
new file mode 100644
index 0000000..30e6e4b
--- /dev/null
+++ b/Perl/demos/Tk/demos/zinc_lib/usedamage.pl
@@ -0,0 +1,114 @@
+#!/usr/bin/perl -w
+#
+# Use damage test
+#
+# $Id$
+# this simple test has been developped by A.Lemort lemort@intuilab.com
+
+
+use vars qw( $VERSION );
+($VERSION) = sprintf("%d.%02d", q$Revision$ =~ /(\d+)\.(\d+)/);
+
+use Tk;
+use Tk::Zinc;
+use strict;
+
+
+#
+# Mainwindow
+#
+my $mw = new MainWindow();
+
+
+#
+# Text zone
+#
+my $text = $mw->Scrolled(qw/Text -relief sunken -borderwidth 2 -setgrid true -height 8 -scrollbars e/);
+$text->pack(-expand => 1, -fill => 'both');
+
+$text->insert('0.0',
+              'This toy-app illustrates how the -usedamage property can increase TkZinc performance.
+The Following operations are possible:
+   Press "0" to desactivate OpenGL optimization
+   Press "1" to activate OpenGL optimization (same result as the old GL_DAMAGE compilation flag). These optimizations work well with Nvidia cards but it creates a stange trail effect with other cards (black trails)
+   Press "2" to activate OpenGL optimization. These optimizations are a bit slower but they have a much better compatibility'
+	      );
+
+#
+# Zinc
+#
+my $zinc = $mw->Zinc(
+		     -render => 1,
+		     -usedamage => 0,
+		     -relief => 'flat',
+		     -borderwidth => 0,
+		     -highlightthickness => 0,
+		     -width => 700,
+		     -height => 700,
+		     )->pack(
+			     -expand => 1,
+			     -fill => 'both',
+			     );
+
+
+# Add a lot of rectangles
+my $N = 10000;
+foreach my $i (0...$N) {
+    $zinc->add('rectangle', 1, [50 + rand()*500, 50 + rand()*500, 50 + rand()*500, 50 + rand()*500], -filled => 1, -fillcolor => 'blue');
+}
+
+# Add a label
+my $label = $zinc->add('text', 1, -position => [5, 10], -text => 'usedamage=0: Without OpenGL optimization');
+
+# Add a moveable circle
+my $circle = $zinc->add('arc', 1, [0,0,50,50], -filled => 1, -fillcolor => 'red', -linewidth => 2);
+$zinc->translate($circle, 50, 50);
+
+# Add bindings to move our circle
+my ($X, $Y);
+$zinc->bind($circle, '<ButtonPress-1>',[\&press, Ev('x'), Ev('y')]);
+$zinc->bind($circle, '<B1-Motion>', [\&motion, Ev('x'), Ev('y')]);
+
+
+# Add bindings to change the value of usedamage
+$mw->bind('<KeyPress-0>', sub {
+    # No optimization
+    $zinc->configure(-usedamage => 0);
+    $zinc->itemconfigure($label, -text => 'usedamage=0: Without OpenGL optimization');
+});
+$mw->bind('<KeyPress-1>', sub {
+    # OpenGL optimization (best with Nvidia
+    $zinc->configure(-usedamage => 1);
+    $zinc->itemconfigure($label, -text => 'usedamage=1: With OpenGL optimization (better performance but works only with Nvidia cards)');
+});
+$mw->bind('<KeyPress-2>', sub {
+    # OpenGL optimization (best with Nvidia
+    $zinc->configure(-usedamage => 2);
+    $zinc->itemconfigure($label, -text => 'usedamage=2: With OpenGL optimization (a bit slower but much better compatibility)');
+});
+
+
+# Mainloop
+MainLoop;
+
+
+
+#
+# Press
+# 
+sub press {
+    my ($zinc, $x, $y) = @_;
+    $X = $x;
+    $Y = $y;
+}
+
+
+#
+# Motion
+#
+sub motion {
+    my ($zinc, $x, $y) = @_;
+    $zinc->translate($circle, $x - $X, $y - $Y);
+    $X = $x;
+    $Y = $y;
+}
-- 
cgit v1.1