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

2 files changed, 515 insertions, 264 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')) {
diff --git a/sandbox/testzinc.pl b/sandbox/testzinc.pl
index fa031f3..3d0b1c1 100644
--- a/sandbox/testzinc.pl
+++ b/sandbox/testzinc.pl
@@ -1,232 +1,445 @@
 #!/usr/bin/perl -w
 
-# Before `make install' is performed this script should be runnable with
-# `make test'. After `make install' it should work as `perl zinc.t'
 
-######################### We start with some black magic to print on failure.
-
-# Change 1..1 below to 1..last_test_to_print .
-# (It may become useful if the test is moved to ./t subdirectory.)
-
-BEGIN { $| = 1; print "1..1\n"; }
-END {print "not ok 1\n" unless $loaded;}
+use Tk;
 use Tk::Zinc;
-$loaded = 1;
-print "ok 1\n";
 
-######################### End of black magic.
+use Controls;
 
-# Insert your test code below (better if it prints "ok 13"
-# (correspondingly "not ok 13") depending on the success of chunk 13
-# of the test code):
+$map_path = "/usr/share/toccata/maps";
+
+$mw = MainWindow->new();
 
-use Tk;
 
-$map_path = "/usr/share/toccata/maps";
-$image_path = "/usr/share/toccata/images";
-
-$mw = MainWindow->new;
-$logo = $mw->Photo(-file => "$image_path/logo.gif");
-# $canvas = $mw->Canvas;
-# $canvas->pack(-expand => t, -fill => 'both');
-# $text = $canvas->create('text', 30, 20, -width => 45, -text => "hello");
-# @listOfList = $canvas->itemconfigure($text);
-# for (@listOfList) {
-#     ($option, $name, $class, $default, $value) = @$_;
-#     print "$option, $value\n";
-# }
-# MainLoop;
-# exit;
 ###################################################
 # creation zinc
 ###################################################
-
-#$mw->Zinc()->pack;
-#MainLoop; exit;
 $top = 1;
-$zinc = $mw->Zinc(-backcolor => 'skyblue', -relief => 'sunken');
-$zinc->pack(-expand => 't', -fill => 'both');
+$scale = 1.0;
+$center_x = 0.0;
+$center_y = 0.0;
+$zinc_width = 800;
+$zinc_height = 500;
+$delay = 2000;
+$rate = 0.3;
+%tracks = ();
+
+$zinc = $mw->Zinc(-backcolor => 'gray65', -relief => 'sunken');
+$zinc->pack(-expand => 1, -fill => 'both');
+$zinc->configure(-width => $zinc_width, -height => $zinc_height);
+#$radar = $top;
+$radar = $zinc->add('group', $top, -tags => ['controls', 'radar']);
+$zinc->configure(-overlapmanager => $radar);
 
-$zinc->configure(-width => 800, -height => 500);
-$color = $zinc->cget("-backcolor"); print "zinc backcolor=$color\n";
 
 ###################################################
-# creation track
+# creation panneau controle
 ###################################################
-$track = $zinc->add("track", $top, 10);
-#$zinc->itemconfigure($track, -tags => 'toto');
+$rc = $mw->Frame()->pack();
+$rc->Button(-text => 'Up',
+	    -command => sub { $center_y -= 30.0;
+			      update_transform($zinc); })->grid(-row => 0,
+								-column => 2,
+								-sticky, 'ew');
+$rc->Button(-text => 'Down',
+	    -command => sub { $center_y += 30.0;
+			      update_transform($zinc); })->grid(-row => 2,
+								-column => 2,
+								-sticky, 'ew');
+$rc->Button(-text => 'Left',
+	    -command => sub { $center_x += 30.0;
+			      update_transform($zinc); })->grid(-row => 1,
+								-column => 1);
+$rc->Button(-text => 'Right',
+	    -command => sub { $center_x -= 30.0;
+			      update_transform($zinc); })->grid(-row => 1,
+								-column => 3);
+$rc->Button(-text => 'Expand',
+	    -command => sub { $scale *= 1.1;
+			      update_transform($zinc); })->grid(-row => 1,
+								-column => 4);
+$rc->Button(-text => 'Shrink',
+	    -command => sub { $scale *= 0.9;
+			      update_transform($zinc); })->grid(-row => 1,
+								-column => 0);
+$rc->Button(-text => 'Reset',
+	    -command => sub { $scale = 1.0;
+			      $center_x = $center_y = 0.0;
+			      update_transform($zinc); })->grid(-row => 1,
+								-column => 2,
+								-sticky, 'ew');
+$rc->Button(-text => 'Quit',
+	    -command => \&exit)->grid(-row => 3,
+				      -column => 2);
 
-$zinc->itemconfigure($track, -position => [1, 1]); 
-$zinc->itemconfigure($track, -position => [10, 10]); 
-$zinc->itemconfigure($track, -position => [20, 20]); 
-$zinc->itemconfigure($track, -position => [30, 30]); 
-$zinc->itemconfigure($track, -position => [40, 40]); 
-$zinc->itemconfigure($track, -position => [50, 50]); 
-$zinc->itemconfigure($track, -position => [60, 50]); 
-$zinc->itemconfigure($track, -speedvector => [20, 0]); 
-$zinc->itemconfigure($track, -symbolcolor => 'red', -labeldistance => 60);
-$zinc->itemconfigure($track, -markersize => 10, -filledmarker => 1,
-		      -markercolor => "green");
 
-print "zinc itemconfigure :\n\n";
-for $attr ($zinc->itemconfigure($track)) {
-    print "  ( ",join(',', @$attr)," )\n" ;
+###################################################
+# Code de reconfiguration lors d'un
+# redimensionnement.
+###################################################
+$zinc->Tk::bind('<Configure>', [\&resize]);
+
+sub resize {
+    my ($zinc) = @_;
+    my $ev = $zinc->XEvent();
+    my $width = $ev->w;
+    my $height = $ev->h;
+    my $bw = $zinc->cget(-borderwidth);
+    $zinc_width = $width - 2*$bw;
+    $zinc_height = $height - 2*$bw;
+    update_transform($zinc);
 }
-print "\n";
-
-$size = $zinc->itemcget($track, -markersize); print "track markersize=$size\n";
-(@coords) = $zinc->itemcget($track, "-position");
-print "track position=",$coords[0],"+",$coords[1],"\n";
 
+sub update_transform {
+    my ($zinc) = @_;
 
-$zinc->itemconfigure($track, -labelformat => "x40x20+0+0 x40x20+40+0 x150x60+0+0");
+    $zinc->treset($top);
+    $zinc->translate($top, -$center_x, -$center_y);
+    $zinc->scale($top, $scale, $scale);
+    $zinc->scale($top, 1, -1);
+    $zinc->translate($top, $zinc_width/2, $zinc_height/2);
+}
 
-$zinc->itemconfigure($track, 0, -filled => 1 , -backcolor => "red",
- 		      -border => "contour");
-$zinc->itemconfigure($track, 0, -text => "TO");
-$zinc->itemconfigure($track, 1, -filled => 1 , -backcolor => "green",
-		      -border => "contour");
-$zinc->itemconfigure($track, 1, -filled => 1 , -backcolor => "green",
-		      -border => "contour");
-$zinc->itemconfigure($track, 2, -image => $logo , -alignment => "center");
-#$mk = $zinc->itemcget($track, -markercolor);
 
-$zinc->itemconfigure($track, 0, -reliefthickness =>  2, -relief => "sunken",
-		      -bordercolor => "red", -border => "noborder");
+###################################################
+# Creation de pistes.
+###################################################
+sub create_tracks {
+    my $i = 20;
+    my $j;
+    my $track;
+    my $x;
+    my $y;
+    my $w = $zinc_width / $scale;
+    my $h = $zinc_height / $scale;
+    my $d;
+    my $item;
+    
+    for ( ; $i > 0; $i--) {
+	$track = {};
+	$track->{'item'} = $item = $zinc->add('track', $radar, 6);
+	$tracks{$item} = $track;
+	$track->{'x'} = rand($w) - $w/2 + $center_x;
+	$track->{'y'} = rand($h) - $h/2 + $center_y;
+	$d = (rand() > 0.5) ? 1 : -1;
+	$track->{'vx'} =  (8.0 + rand(10.0)) * $d;
+	$d = (rand() > 0.5) ? 1 : -1;
+	$track->{'vy'} =  (8.0 + rand(10.0)) * $d;
+	$zinc->itemconfigure($item,
+			     -position => [$track->{'x'}, $track->{'y'}],
+			     -speedvector => [$track->{'vx'}, $track->{'vy'}],
+			     -speedvectorsensitive => 1,
+			     -labeldistance => 30,
+			     -markersize => 20,
+			     -historycolor => 'gray30',
+			     -filledhistory => 0,
+			     -labelformat => "x71x50+0+0 x50a0^0^0 x25a0^0>1 a0a0>2>1 x25a0>3>1 a0a0^0>2");
+	$zinc->itemconfigure($item, 0,
+			     -filled => 0,
+			     -backcolor => 'gray60',
+#			     -border => "contour",
+			     -sensitive => 1
+			     );
+	$zinc->itemconfigure($item, 1,
+			     -filled => 1,
+			     -backcolor => 'gray55',
+			     -text => "AFR001");
+	$zinc->itemconfigure($item, 2,
+			     -filled => 0,
+			     -backcolor => 'gray65',
+			     -text => "360");
+	$zinc->itemconfigure($item, 3,
+			     -filled => 0,
+			     -backcolor => 'gray65',
+			     -text => "/");
+	$zinc->itemconfigure($item, 4,
+			     -filled => 0,
+			     -backcolor => 'gray65',
+			     -text => "410");
+	$zinc->itemconfigure($item, 5,
+			     -filled => 0,
+			     -backcolor => 'gray65',
+			     -text => "Balise");
+	my $b_on = sub { $zinc->itemconfigure('current', $zinc->currentpart(),
+					      -border => 'contour')};
+	my $b_off = sub { $zinc->itemconfigure('current', $zinc->currentpart(),
+					       -border => 'noborder')};
+	my $tog_b = sub { my $current = $zinc->find('withtag', 'current');
+			  my $curpart = $zinc->currentpart();
+			  if ($curpart =~ '[0-9]+') {
+			      my $on_off = $zinc->itemcget($current, $curpart, -sensitive);
+			      $zinc->itemconfigure($current, $curpart,
+						   -sensitive => !$on_off);
+			  }
+		      };
+	for ($j = 0; $j < 6; $j++) {
+	    $zinc->bind($item.":$j", '<Enter>', $b_on);
+            $zinc->bind($item.":$j", '<Leave>', $b_off);
+            $zinc->bind($item, '<1>', $tog_b);
+            $zinc->bind($item, '<Shift-1>', sub {});
+        }
+	$zinc->bind($item, '<Enter>',
+		    sub {$zinc->itemconfigure('current',
+					      -historycolor => 'red',
+					      -symbolcolor => 'red',
+					      -markercolor => 'red',
+					      -leaderwidth => 2,
+					      -leadercolor => 'red',
+					      -speedvectorwidth => 2,
+					      -speedvectorcolor => 'red')});
+        $zinc->bind($item, '<Leave>',
+                    sub {$zinc->itemconfigure('current',
+					      -historycolor => 'black',
+					      -symbolcolor => 'black',
+					      -markercolor => 'black',
+					      -leaderwidth => 1,
+					      -leadercolor => 'black',
+					      -speedvectorwidth => 1,
+					      -speedvectorcolor => 'black')});
+        $zinc->bind($item.':position', '<1>', [\&create_route]);
+        $zinc->bind($item.':position', '<Shift-1>', sub { });
+        $track->{'route'} = 0;
+    }
+}
 
-$zinc->bind($track.":speedvector", "<Enter>",
-	     sub {$zinc->itemconfigure($track, -speedvectorcolor => 'red')});
-$zinc->bind($track.":speedvector", "<Leave>",
-    sub {$zinc->itemconfigure($track, -speedvectorcolor => 'black')});
-	     
+create_tracks();
 
 ###################################################
 # creation way point
 ###################################################
-print "creating way point\n";
-my $wp = $zinc->add("waypoint", $top, 10);
-$zinc->itemconfigure($wp,
-    -symbolcolor => "green",
-    -position => [0, 80],
-    -labelformat => "x40x20+0+0x40x20+40+0x80x40+0+0"
-    );
-$zinc->itemconfigure($wp, 0 ,-filled => 1 ,-backcolor => "tan",-text => "TO");
-$zinc->itemconfigure($wp, 1 ,-filled => 1 ,-backcolor => "wheat",-text => "TO");
-$zinc->itemconfigure($wp, 2 ,-border => "contour");
-$zinc->bind($wp, "<Enter>", \&borders);
-$zinc->bind($wp, "<Leave>", [ \&borders, "off"]);
+sub create_route {
+    my ($zinc) = @_;
+    my $wp;
+    my $connected;
+    my $x;
+    my $y;
+    my $i = 4;
+    my $track = $tracks{$zinc->find('withtag', 'current')};
+    
+    if ($track->{'route'} == 0) {
+	$x = $track->{'x'} + 8.0 * $track->{'vx'};
+	$y = $track->{'y'} + 8.0 * $track->{'vy'};
+	$connected = $track->{'item'};
+	for ( ; $i > 0; $i--) {
+	    $wp = $zinc->add('waypoint', 'radar', 2,
+			     -position => [$x, $y],
+			     -connecteditem => $connected,
+			     -connectioncolor => 'green',
+			     -symbolcolor => 'green',
+			     -labelformat => 'x20x18+0+0');
+	    $zinc->lower($wp, $connected);
+	    $zinc->bind($wp.':0', '<Enter>',
+			sub {$zinc->itemconfigure('current', 0, -border => 'contour')});
+	    $zinc->bind($wp.':position', '<Enter>',
+			sub {$zinc->itemconfigure('current', -symbolcolor => 'red')});
+	    $zinc->bind($wp.':leader', '<Enter>',
+			sub {$zinc->itemconfigure('current', -leadercolor => 'red')});
+	    $zinc->bind($wp.':connection', '<Enter>',
+			sub {$zinc->itemconfigure('current', -connectioncolor => 'red')});
+	    $zinc->bind($wp.':0', '<Leave>',
+			sub {$zinc->itemconfigure('current', 0, -border => '')});
+	    $zinc->bind($wp.':position', '<Leave>',
+			sub {$zinc->itemconfigure('current', -symbolcolor => 'green')});
+	    $zinc->bind($wp.':leader', '<Leave>',
+			sub {$zinc->itemconfigure('current', -leadercolor => 'black')});
+	    $zinc->bind($wp.':connection', '<Leave>',
+			sub {$zinc->itemconfigure('current', -connectioncolor => 'green')});
+	    $zinc->itemconfigure($wp, 0,
+				 -text => "$i",
+				 -filled => 1,
+                                 -backcolor => 'gray55');
+	    $zinc->bind($wp.':position', '<1>', [\&del_way_point]);
+	    $x += (2.0 + rand(8.0)) * $track->{'vx'};
+	    $y += (2.0 + rand(8.0)) * $track->{'vy'};
+	    $connected = $wp;
+	}
+	$track->{'route'} = $wp;
+    }
+    else {
+	$wp = $track->{'route'};
+	while ($wp != $track->{'item'}) {
+	    $track->{'route'} = $zinc->itemcget($wp, -connecteditem);
+	    $zinc->bind($wp.':position', '<1>', '');
+	    $zinc->bind($wp.':position', '<Enter>', '');
+	    $zinc->bind($wp.':position', '<Leave>', '');
+	    $zinc->bind($wp.':leader', '<Enter>', '');
+            $zinc->bind($wp.':leader', '<Leave>', '');
+            $zinc->bind($wp.':connection', '<Enter>', '');
+            $zinc->bind($wp.':connection', '<Leave>', '');
+            $zinc->bind($wp.':0', '<Enter>', '');
+            $zinc->bind($wp.':0', '<Leave>', '');
+            $zinc->remove($wp);
+	    $wp = $track->{'route'};
+	}
+	$track->{'route'} = 0;
+    }
+}
 
 ###################################################
-# creation 2nd track
+# suppression waypoint intermediaire
 ###################################################
-print "creating second track\n";
-$track2 = $zinc->add("track", $top, 10, -speedvector => [-20, 0], -position => [0, 50]);
-$zinc->itemconfigure($track2, -connecteditem => $track);
+sub find_track {
+    my ($zinc, $wp) = @_;
+    my $connected = $wp;
+    
+    while ($zinc->type($connected) ne 'track') {
+	$connected = $zinc->itemcget($connected, -connecteditem);
+    }
+    return $connected;
+}
+
+sub del_way_point {
+    my ($zinc) = @_;
+    my $wp = $zinc->find('withtag', 'current');
+    my $track = $tracks{find_track($zinc, $wp)};
+    my $next = $zinc->itemcget($wp, -connecteditem);
+    my $prev;
+    my $prevnext;
+
+    $prev = $track->{'route'};
+    if ($prev != $wp) {
+	$prevnext = $zinc->itemcget($prev, -connecteditem);
+	while ($prevnext != $wp) {
+	    $prev = $prevnext;
+	    $prevnext = $zinc->itemcget($prev, -connecteditem);
+	}
+    }
+    $zinc->itemconfigure($prev, -connecteditem => $next);
+    $zinc->bind($wp.':position', '<1>', '');
+    $zinc->remove($wp);
+    if ($wp == $track->{'route'}) {
+	if ($next == $track->{'item'}) {
+	    $track->{'route'} = 0;
+	}
+	else {
+	    $track->{'route'} = $next;
+	}
+    }
+}
+
+sub stick_wp {
+    my ($zinc) = @_;
+    my $ev = $zinc->XEvent();
+
+    if ($just_wiped) {
+	$just_wiped = 0;
+	return;
+    }
+    my ($x, $y) = $zinc->transform('radar', [$ev->x, $ev->y]);
+    my $wp = $zinc->add('waypoint', 'radar', 2,
+			-position => [$x, $y],
+			-connectioncolor => 'red',
+			-symbolcolor => 'red',
+			-labelformat => 'a2a2+0+0');
+    $zinc->itemconfigure($wp, 0,
+			 -text => "$x".'@'."$y",
+			 -color => 'red',
+			 -filled => 1,
+			     -backcolor => 'gray55');
+    $zinc->bind($wp.':position', '<1>', [\&wipe_wp]);
+}
+
+sub wipe_wp {
+    my ($zinc) = @_;
+    $zinc->remove('current');
+    $just_wiped = 1;
+}
+
+$zinc->Tk::bind('<1>', [\&stick_wp]);
+
 
 ###################################################
 # creation macro
 ###################################################
-print "creating macro\n";
-$macro = $zinc->add("tabular", $top, 10,
-    -labelformat => "x40x20+0+0 x40x20+40+0"
-    );
-$zinc->itemconfigure($macro, 0 , -text => "une");
-$zinc->itemconfigure($macro, 1, -text => "macro");
-$zinc->itemconfigure($macro, -connecteditem => $track);
-$zinc->bind($macro.":0", "<Enter>", [ \&borders, "on"]);
-$zinc->bind($macro.":0", "<Leave>", [ \&borders, "off"]);
+#$macro = $zinc->add("tabular", $radar, 10,
+#    -labelformat => "x40x20+0+0 x40x20+40+0"
+#    );
+#$zinc->itemconfigure($macro, 0 , -text => "une");
+#$zinc->itemconfigure($macro, 1, -text => "macro");
+#$zinc->itemconfigure($macro, -connecteditem => $track);
+#$zinc->bind($macro.":0", "<Enter>", [ \&borders, "on"]);
+#$zinc->bind($macro.":0", "<Leave>", [ \&borders, "off"]);
 
 ###################################################
 # creation ministrip
 ###################################################
-print "creating ministrip\n";
-$ministrip = $zinc->add("tabular", $top, 10,
-    -labelformat => "x40x20+0+0 x40x20+40+0",
-    -position => [100, 10]
-    );
-$zinc->itemconfigure($ministrip, 0 , -text => 'ministrip');
+#$ministrip = $zinc->add("tabular", $radar, 10,
+#    -labelformat => "x40x20+0+0 x40x20+40+0",
+#    -position => [100, 10]);
+#$zinc->itemconfigure($ministrip, 0 , -text => 'ministrip');
 
 ###################################################
 # creation map
 ###################################################
-print "creating map\n";
 $mw->videomap("load", "$map_path/videomap_paris-w_90_2", 0, "paris-w");
 $mw->videomap("load", "$map_path/videomap_orly", 17, "orly");
 $mw->videomap("load", "$map_path/hegias_parouest_TE.vid", 0, "paris-ouest");
 
-print "videomap ids : ",
-    join('|', $mw->videomap("ids", "$map_path/videomap_orly")),"\n";
-$map = $zinc->add("map", $top, -color => 'red');
-$zinc->itemconfigure($map,-mapinfo => 'orly');
+$map = $zinc->add("map", $radar,
+		  -color => 'gray80');
+$zinc->itemconfigure($map,
+		     -mapinfo => 'orly');
 
-#$map2 = $zinc->add("map", $top, -color => 'green', -filled => 1, -priority => 0,
-#   -fillpattern => AlphaStipple6);
-#$zinc->itemconfigure($map2, -mapinfo => 'paris-ouest');
+$map2 = $zinc->add("map", $radar,
+		   -color => 'gray60',
+		   -filled => 1,
+		   -priority => 0,
+		   -fillpattern => AlphaStipple6);
+$zinc->itemconfigure($map2,
+		     -mapinfo => 'paris-ouest');
 
-$map3 = $zinc->add("map", $top, -color => 'orange');
-$zinc->itemconfigure($map3,-mapinfo => "paris-w");
+$map3 = $zinc->add("map", $radar,
+		   -color => 'gray50');
+$zinc->itemconfigure($map3,
+		     -mapinfo => "paris-w");
 
 
 ###################################################
-#creation rectangle, arc, curve
-###################################################
-
-$rect = $zinc->add('rectangle', $top, [-50, -50, 50, -80], -linecolor => 'bisque');
-$zinc->bind($rect, '<Enter>', sub { $zinc->itemconfigure($rect, -linecolor => 'red')});
-$zinc->bind($rect, '<Leave>', sub { $zinc->itemconfigure($rect, -linecolor => 'bisque')});
-
-$arc = $zinc->add('arc', $top, [-100, 80, -50, 30], -linecolor => 'bisque',
-    -tags => ["arc"]);
-#$zinc->addtag("fleche",'withtag', $arc);
-#$zinc->addtag("carquois",'withtag', $arc);
-$zinc->add('rectangle', $top, [-101, 81, -49, 29], -linecolor => 'green');
-$zinc->raise($arc);
-$zinc->bind($arc, '<Enter>', sub {$zinc->itemconfigure($arc, -linecolor => 'red')});
-$zinc->bind($arc, '<Leave>', sub {$zinc->itemconfigure($arc, -linecolor => 'bisque')});
-print "arc tags=", join('|',$zinc->gettags($arc)),"\n";
-
-$zinc->itemconfigure($arc, -startangle => 0, -extent => 360);
-
-$mp = $zinc->add('curve', $top, [-300, 0, -250, 100, -80, 20]);
-$zinc->itemconfigure($mp, -filled => 1, -linewidth => 4, -linecolor => 'yellow',
-    -fillcolor => 'tan', -fillpattern => AlphaStipple8);
-$zinc->itemconfigure($mp, -marker => AtcSymbol9 , -markercolor => 'red');
-
-###################################################
 # Map info
 ###################################################
-$mw->mapinfo('mpessai', 'create');
-$mw->mapinfo('mpessai', 'add', 'text', 'normal', 'simple', 0, 200, "Et voilà");
-$mw->mapinfo('mpessai', 'add', 'line', 'simple', 0,  0, 0, 0, 200);
+#$mw->mapinfo('mpessai', 'create');
+#$mw->mapinfo('mpessai', 'add', 'text', 'normal', 'simple', 0, 200, "Et voilà");
+#$mw->mapinfo('mpessai', 'add', 'line', 'simple', 0,  0, 0, 0, 200);
 #$mw->mapinfo('mpessai', 'add', 'line', 'simple', 5, -100, 100, 0, 0);
-$zinc->itemconfigure($map3, -mapinfo => 'mpessai');
+#$zinc->itemconfigure($map3, -mapinfo => 'mpessai');
+
+#$c1= $zinc->add('curve', $radar, [],
+#		-filled => 1,
+#		-linewidth => 1,
+#		-fillcolor => 'blue');
+#$zinc->coords($c1, [200, 200, 300, 200, 300, 300, 200, 300]);
+#$zinc->bind($c1, '<1>', sub {$zinc->coords($c1, 'remove', 0);});
+#$zinc->bind($c1, '<2>', sub {$zinc->coords($c1, 'add', 0, [0, 0]);});
+#$zinc->bind($c1, '<3>', sub {$zinc->coords($c1, []);});
+#my $c = $zinc->add('curve', $radar, [],
+#		   -filled => 1,
+#		   -fillcolor => 'red');
+#$zinc->contour($c, 'union', [100, 0, 0, 0, 0, 100, 100, 100]);
+#$zinc->contour($c, 'diff', [75, 75, 25, 75, 25, 25, 75, 25]);
+#print join(' ', $zinc->coords($c, 0)), "\n";
+#print join(' ', $zinc->coords($c, 1)), "\n";
 
-print "mapinfo count line : ", $mw->mapinfo('mpessai', 'count', 'line'),"\n";
-print "mapinfo get line 3: ", join('|',$mw->mapinfo('mpessai', 'get', 'line', 0)),"\n";
 ###################################################
-# tests diverses methodes 
+# Création fonctions de contrôle à la souris
 ###################################################
+new Controls($zinc);
 
-for ($zinc->find('all')) {
-    print $_, " -> ", $zinc->type($_),"\n";
+###################################################
+# Rafraichissement des pistes
+###################################################
+$zinc->repeat($delay, [\&refresh, $zinc]);
+
+sub refresh {
+    my ($zinc) = @_;
+    my $t;
+
+    foreach $t (values(%tracks)) {
+	$t->{'x'} += $t->{'vx'} * $rate;
+	$t->{'y'} += $t->{'vy'} * $rate;
+	$zinc->itemconfigure($t->{'item'},
+			     -position => [$t->{'x'}, $t->{'y'}]);
+    }
 }
-$zinc->Tk::bind("<2>", [sub {
-    print $_[1], "@" ,$_[2], ", closest: ",
-    join(' ',$zinc->find('closest', $_[1], $_[2])),"\n";
-    }, Ev('x'), Ev('y')]);
-
-
-$zinc->Tk::bind('<ButtonPress-1>',
-    [ sub {($origx, $origy) = ($_[1], $_[2]); }, Ev('x'), Ev('y') ]);
-
-$zinc->Tk::bind('<ButtonRelease-1>',
-    [ sub {&finditems($_[1], $_[2]); }, Ev('x'), Ev('y') ]);
-
-$zinc->Tk::bind("<2>", sub {$zinc->translate($top, 10,10); });
-$zinc->Tk::bind("<3>", sub {$zinc->scale($top, 1.1, 1.1); });
-
-
-MainLoop;
 
 sub borders {
     my($widget, $onoff) = @_;
@@ -239,10 +452,15 @@ sub borders {
 
 sub finditems {
     my($cornerx, $cornery) = @_;
+
     print "--- enclosed --->",
     join('|', $zinc->find('enclosed',$origx, $origy, $cornerx, $cornery)),"\n";
     print "--- overlapping --->",
     join('|',$zinc->find('overlapping',$origx, $origy, $cornerx, $cornery)),"\n\n";
 }
 
+
+MainLoop();
+
+
 1;