D�but de l'�criture de scripts de d�mo en perl.

1 files changed, 128 insertions, 95 deletions

diff --git a/sandbox/Controls.pm b/sandbox/Controls.pm
index b432129..55f6b6a 100644
--- a/sandbox/Controls.pm
+++ b/sandbox/Controls.pm
@@ -1,186 +1,219 @@
 
-package controls;
+package Controls;
 
-$cur_x = 0;
-$cur_y = 0;
-$cur_angle = 0;
-$corner_x = 0;
-$corner_y = 0;
 $top = 1;
 
 sub new {
-    $tlbbox = $zinc->add('group', $top,
-			 -sensitive => 0, -visible => 0,
-			 -tags 'currentbbox');
-    $zinc->add('rectangle', $tlbbox, [-3, -3, +3, +3]);
-    $trbbox = $zinc->add('group', $top,
-			 -sensitive => 0, -visible => 0,
-			 -tags => 'currentbbox');
-    $zinc->add('rectangle', $trbbox, [-3, -3, +3, +3]);
-    $blbbox = $zinc->add('group', $top,
-			 -sensitive => 0, -visible => 0,
-			 -tags => 'currentbbox');
-    $zinc->add('rectangle', $blbbox, [-3, -3, +3, +3]);
-    $brbbox = $zinc->add('group', $top,
-			 -sensitive => 0, -visible => 0,
-			 -tags 'currentbbox');
-    $zinc->add('rectangle', $brbbox, [-3, -3, +3, +3]);
+    my $proto = shift;
+    my $type = ref($proto) || $proto;
+    my ($zinc) = @_;
+    my $self = {};
+
+    $self{'zinc'} = $zinc;
+    $self{'cur_x'} = 0;
+    $self{'cur_y'} = 0;
+    $self{'cur_angle'} = 0;
+    $self{'corner_x'} = 0;
+    $self{'corner_y'} = 0;
+    
+    $self{'tlbbox'} = $zinc->add('group', $top,
+				 -sensitive => 0, -visible => 0,
+				 -tags => 'currentbbox');
+    $zinc->add('rectangle', $self{'tlbbox'}, [-3, -3, +3, +3]);
+    $self{'trbbox'} = $zinc->add('group', $top,
+				 -sensitive => 0, -visible => 0,
+				 -tags => 'currentbbox');
+    $zinc->add('rectangle', $self{'trbbox'}, [-3, -3, +3, +3]);
+    $self{'blbbox'} = $zinc->add('group', $top,
+				 -sensitive => 0, -visible => 0,
+				 -tags => 'currentbbox');
+    $zinc->add('rectangle', $self{'blbbox'}, [-3, -3, +3, +3]);
+    $self{'brbbox'} = $zinc->add('group', $top,
+				 -sensitive => 0, -visible => 0,
+				 -tags => 'currentbbox');
+    $zinc->add('rectangle', $self{'brbbox'}, [-3, -3, +3, +3]);
     $zinc->add('rectangle', $top, [0, 0, 1, 1],
 	       -linecolor => 'red', -tags => 'lasso',
 	       -visible => 0, -sensitive => 0);
+
+    $zinc->Tk::bind('<Shift-ButtonPress-1>', [\&start_lasso, $self]);
+    $zinc->Tk::bind('<Shift-ButtonRelease-1>', [\&fin_lasso, $self]);
+
+    $zinc->Tk::bind('<ButtonPress-2>', sub { my $ev = $zinc->XEvent();
+					     my @closest = $zinc->find('closest',
+								      $ev->x, $ev->y);
+					     print "at point=$closest[0]\n" });
     
-    $zinc->bind('<ButtonPress-1>', \&start_lasso);
-    $zinc->bind('<ButtonRelease-1>', \&fin_lasso);
-    $zinc->bind('<ButtonPress-2>', sub { my @closest = $zinc->find('closest',
-								   $zinc->XEvent->x,
-								   $zinc->XEvent->y);
-					 print "at point=$closest[0]\n" });
-    
-    $zinc->bind('<ButtonPress-3>', [\&press, \&motion]);
-    $zinc->bind('<ButtonRelease-3>', \&release);
+    $zinc->Tk::bind('<ButtonPress-3>', [\&press, $self, \&motion]);
+    $zinc->Tk::bind('<ButtonRelease-3>', [\&release, $self]);
     
-    $zinc->bind('<Shift-ButtonPress-3>', [\&press, \&zoom]);
-    $zinc->bind('<Shift-ButtonRelease-3>', \&release);
+    $zinc->Tk::bind('<Shift-ButtonPress-3>', [\&press, $self, \&zoom]);
+    $zinc->Tk::bind('<Shift-ButtonRelease-3>', [\&release, $self]);
     
-    $zinc->bind('<Control-ButtonPress-3>', [\&press, \&rotate]);
-    $zinc->bind('<Control-ButtonRelease-3>', \&release);
+    $zinc->Tk::bind('<Control-ButtonPress-3>', [\&press, $self, \&rotate]);
+    $zinc->Tk::bind('<Control-ButtonRelease-3>', [\&release, $self]);
     
-    $zinc->bind('current', '<Enter>', \&showbox);
-    $zinc->bind('current', '<Leave>', \&hidebox);
+    $zinc->Tk::bind('current', '<Enter>', [\&showbox, $self]);
+    $zinc->Tk::bind('current', '<Leave>', [\&hidebox, $self]);
+
+    bless ($self, $type);
+    return $self;
 }
 
 #
 # Controls for the window transform.
 #
 sub press {
-    my ($action) = @_;
-    my $lx = $zinc->XEvent->x;
-    my $ly = $zinc->XEvent->y;
-
-    $cur_x $lx;
-    $cur_y $ly;
-    $cur_angle = atan2($y, $x);
-    $zinc->bind('<Motion>', $action);
+    my ($zinc, $self, $action) = @_;
+    my $ev = $zinc->XEvent();
+    my $lx = $ev->x;
+    my $ly = $ev->y;
+
+    $self->{'cur_x'} = $lx;
+    $self->{'cur_y'} = $ly;
+    $self->{'cur_angle'} = atan2($ly, $lx);
+    $zinc->Tk::bind('<Motion>', [$action, $self]);
 }
 
 sub motion {
-    my $lx = $zinc->XEvent->x;
-    my $ly = $zinc->XEvent->y;
+    my ($zinc, $self) = @_;
+    my $ev = $zinc->XEvent();
+    my $lx = $ev->x;
+    my $ly = $ev->y;
     my @it;
     my @res;
     
-    @it = $zinc->find('withtag' 'controls');
+    @it = $zinc->find('withtag', 'controls');
     if (scalar(@it) == 0) {
 	return;
     }
-    @res = $zinc->transform($it[0], [$lx, $ly, $cur_x, $cur_y]);
+    @res = $zinc->transform($it[0], [$lx, $ly, $self->{'cur_x'}, $self->{'cur_y'}]);
     $zinc->translate('controls', $res[0] - $res[2], $res[1] - $res[3]);
-    $cur_x = $lx;
-    $cur_y = $ly;
+    $self->{'cur_x'} = $lx;
+    $self->{'cur_y'} = $ly;
 }
 
 sub zoom {
-    my $lx = $zinc->XEvent->x;
-    my $ly = $zinc->XEvent->y;
+    my ($zinc, $self) = @_;
+    my $ev = $zinc->XEvent();
+    my $lx = $ev->x;
+    my $ly = $ev->y;
     my $maxx;
     my $maxy;
     my $sx;
     my $sy;
     
-    if ($lx > $cur_x) {
+    if ($lx > $self->{'cur_x'}) {
 	$maxx = $lx;
     } else {
-	$maxx = $cur_x
+	$maxx = $self->{'cur_x'};
     }
-    if ($ly > $cur_y) {
+    if ($ly > $self->{'cur_y'}) {
 	$maxy = $ly
     } else {
-	$maxy = $cur_y
+	$maxy = $self->{'cur_y'};
     }
-    $sx = 1.0 + ($lx - $cur_x)/$maxx;
-    $sy = 1.0 + ($ly - $cur_y)/$maxy;
-    $cur_x = $lx;
-    $cur_y = $ly;
+    $sx = 1.0 + ($lx - $self->{'cur_x'})/$maxx;
+    $sy = 1.0 + ($ly - $self->{'cur_y'})/$maxy;
+    $self->{'cur_x'} = $lx;
+    $self->{'cur_y'} = $ly;
     $zinc->scale('controls', $sx, $sy);
+#   $main::scale *= $sx;
+#   main::update_transform($zinc);
 }
 
 sub rotate {
-    my $lx = $zinc->XEvent->x;
-    my $ly = $zinc->XEvent->y;
+    my ($zinc, $self) = @_;
+    my $ev = $zinc->XEvent();
+    my $lx = $ev->x;
+    my $ly = $ev->y;
     my $langle;
     
     $langle = atan2($ly, $lx);
-    $zinc->rotate('controls', -($langle - $cur_angle));
-    $cur_angle = $langle;
+    $zinc->rotate('controls', -($langle - $self->{'cur_angle'}));
+    $self->{'cur_angle'} = $langle;
 }
 
 sub release {
-    $zinc->bind('<Motion>', '');
+    my ($zinc, $self) = @_;
+    $zinc->Tk::bind('<Motion>', '');
 }
 
 sub start_lasso {
-    my $lx = $zinc->XEvent->x;
-    my $ly = $zinc->XEvent->y;
+    my ($zinc, $self) = @_;
+    my $ev = $zinc->XEvent();
+    my $lx = $ev->x;
+    my $ly = $ev->y;
     my @coords;
     
-    $cur_x = $lx;
-    $cur_y = $ly;
-    $corner_x = $lx;
-    $corner_y = $ly;
-    @coords = $zinc->transform($top, [$x, $y]);
+    $self->{'cur_x'} = $lx;
+    $self->{'cur_y'} = $ly;
+    $self->{'corner_x'} = $lx;
+    $self->{'corner_y'} = $ly;
+    @coords = $zinc->transform($top, [$lx, $ly]);
     $zinc->coords('lasso', [$coords[0], $coords[1], $coords[0], $coords[1]]);
-    $zinc->itemconfigure('lasso' -visible => 1);
+    $zinc->itemconfigure('lasso', -visible => 1);
     $zinc->raise('lasso');
-    $zinc->bind('<Motion>', \&lasso);
+    $zinc->Tk::bind('<Motion>', [\&lasso, $self]);
 }
 
 sub lasso {
-    my $lx = $zinc->XEvent->x;
-    my $ly = $zinc->XEvent->y;
+    my ($zinc, $self) = @_;
+    my $ev = $zinc->XEvent();
+    my $lx = $ev->x;
+    my $ly = $ev->y;
     my @coords;
     
-    $corner_x = $lx;
-    $corner_y = $ly;
-    @coords = $zinc->transform($top [$cur_x, $cur_y, $lx, $ly]);
-    $zinc->coords('lasso', [$coords[0], $$coords[1], $coords[2], $coords[3]]);
+    $self->{'corner_x'} = $lx;
+    $self->{'corner_y'} = $ly;
+    @coords = $zinc->transform($top, [$self->{'cur_x'}, $self->{'cur_y'}, $lx, $ly]);
+    $zinc->coords('lasso', [$coords[0], $coords[1], $coords[2], $coords[3]]);
 }
 
 sub fin_lasso {
-    my $enclosed = join(', ',
-			$zinc->find('enclosed', $cur_x, $cur_y, $corner_x, $corner_y));
-    my $overlapping = join(', ',
-			   $zinc->find('overlapping', $cur_x, $cur_y, $corner_x, $corner_y));
+    my ($zinc, $self) = @_;
+    my $enclosed;
+    my $overlapping;
     
-    $zinc->bind('<Motion>', '');
+    $zinc->Tk::bind('<Motion>', '');
     $zinc->itemconfigure('lasso', -visible => 0);
-    print "enclosed=$enclosed, overlapping=$overlapping\n"
+    $enclosed = join(', ', $zinc->find('enclosed',
+				       $self->{'cur_x'}, $self->{'cur_y'},
+				       $self->{'corner_x'}, $self->{'corner_y'}));
+    $overlapping = join(', ', $zinc->find('overlapping',
+					  $self->{'cur_x'}, $self->{'cur_y'},
+					  $self->{'corner_x'}, $self->{'corner_y'}));
+    print "enclosed=$enclosed, overlapping=$overlapping\n";
 }
 
 sub showbox {
+    my ($zinc, $self) = @_;
     my @coords;
     my @it;
     
-    if (! $zinc->hastag('current' 'currentbbox')) {
+    if (! $zinc->hastag('current', 'currentbbox')) {
 	@it = $zinc->find('withtag', 'current');
 	if (scalar(@it) == 0) {
 	    return;
 	}
 	@coords = $zinc->transform($top, $zinc->bbox('current'));
 
-	$zinc->coords($tlbbox, [$coords[0], $coords[1]]);
-	$zinc->coords($trbbox, [$coords[2], $coords[1]]);
-	$zinc->coords($brbbox, [$coords[2], $coords[3]]);
-	$zinc->coords($blbbox, [$coords[0], $coords[3]]);
+	$zinc->coords($self->{'tlbbox'}, [$coords[0], $coords[1]]);
+	$zinc->coords($self->{'trbbox'}, [$coords[2], $coords[1]]);
+	$zinc->coords($self->{'brbbox'}, [$coords[2], $coords[3]]);
+	$zinc->coords($self->{'blbbox'}, [$coords[0], $coords[3]]);
 	$zinc->itemconfigure('currentbbox', -visible => 1);
     }
 }
 
 sub hidebox {
-    my $lx = $zinc->XEvent->x;
-    my $ly = $zinc->XEvent->y;
+    my ($zinc, $self) = @_;
+    my $ev = $zinc->XEvent();
+    my $lx = $ev->x;
+    my $ly = $ev->y;
     my @next;
     
-    @next = $zinc->find('closest' $lx, $ly);
+    @next = $zinc->find('closest', $lx, $ly);
     if ((scalar(@next) == 0) ||
 	! $zinc->hastag($next[0], 'currentbbox') ||
 	$zinc->hastag('current', 'currentbbox')) {