aboutsummaryrefslogtreecommitdiff
path: root/Perl/demos/Tk/demos/zinc_lib/usedamage.pl
blob: 30e6e4bc70b481678b49c8c3ad20700e202f3003 (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
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;
}