Premiere version

1 files changed, 573 insertions, 0 deletions

diff --git a/Perl/demos/Tk/demos/zinc_lib/transforms.pl b/Perl/demos/Tk/demos/zinc_lib/transforms.pl
new file mode 100644
index 0000000..8838a65
--- /dev/null
+++ b/Perl/demos/Tk/demos/zinc_lib/transforms.pl
@@ -0,0 +1,573 @@
+#!/usr/bin/perl -w
+
+#
+# TODO:
+#
+# Ajouter la construction des items manquants
+#
+
+use Tk;
+use Tk::Zinc;
+
+my $currentgroup;
+my $currentitem;
+my $mw = MainWindow->new();
+my $top = 1;
+
+my $inactiveAxisColor = 'black';
+my $activeAxisColor = 'red';
+my $worldAxisColor = '#a5a5a5';
+
+my $itemtype;
+my $composerot = 1;
+my $composescale = 1;
+my $drag = 0;
+
+my $text = $mw->Scrolled('Text',
+			 -relief => 'sunken',
+			 -borderwidth => 2,
+			 -setgrid => 1,
+			 -height => 12,
+			 -scrollbars => 'e');
+$text->pack(-expand => 0, -fill => 'x');
+$text->insert('0.0', 'Items are always added to the current group.
+The available commands are:
+   Button 1       on the background, add an item with initial translation
+   Button 2       on the background, add a group with initial translation
+   Button 1       on item/group axes, select/deselect that item space
+   Drag Button 1  on item/group axes, translate that item space
+   Home           reset the transformation
+   Shift-Home     reset a group direct children transformations
+   PageUp/Down    scale up/down
+   End/Del        rotate right/left
+   Ins            swap the Y axis
+   4 arrows       translate in the 4 directions');
+$text->configure(-state => 'disabled');
+
+my $zinc = $mw->Zinc(-borderwidth => 3,
+		     -highlightthickness => 0,
+		     -relief => 'sunken',
+		     -takefocus => 1);
+$zinc->pack(-expand => 1, -fill => 'both');
+$zinc->configure(-width => 500, -height => 500);
+
+my $rc = $mw->Frame()->pack(-expand => 0, -fill => 'x');
+my $option = $rc->Optionmenu(-options => ['rectangle', 'arc',
+					  'bezier', 'curve',
+					  'icon', 'tabular',
+					  'text', 'track',
+					  'triangles', 'waypoint'],
+#			     -command => sub { $zinc->Tk::focus(); },
+			     -variable => \$itemtype)->grid(-row => 0,
+							    -column => 1,
+							    -sticky => 'w');
+
+$rc->Button(-text => 'Add item',
+	    -command => \&additem)->grid(-row => 0,
+					 -column => 2,
+					 -padx => 10,
+					 -sticky => 'ew');
+$rc->Button(-text => 'Add group',
+	    -command => \&addgroup)->grid(-row => 0,
+					  -column => 3,
+					  -padx => 10,
+					  -sticky => 'ew');
+$rc->Button(-text => 'Remove',
+	    -command => \&removeitem)->grid(-row => 0,
+					    -column => 4,
+					    -padx => 10,
+					    -sticky => 'ew');
+
+$rc->Checkbutton(-text => '-composescale',
+		 -command => \&togglecomposescale,
+		 -variable => \$composescale)->grid(-row => 0,
+						    -column => 6,
+						    -sticky => 'w');
+
+$rc->Checkbutton(-text => '-composesrotation',
+		 -command => \&togglecomposerot,
+		 -variable => \$composerot)->grid(-row => 1,
+						  -column => 6,
+						  -sticky => 'w');
+
+
+my $world = $zinc->add('group', $top);
+$zinc->add('curve', $top, [0, 0, 80, 0],
+	   -linewidth => 3,
+	   -linecolor => $worldAxisColor,
+	   -lastend => [6,8,3],
+	   -tags => ["axis:$world"]);
+$zinc->add('curve', $top, [0, 0, 0, 80],
+	   -linewidth => 3,
+	   -linecolor => $worldAxisColor,
+	   -lastend => [6,8,3],
+	   -tags => ["axis:$world"]);
+$zinc->add('rectangle', $top, [-2, -2, 2, 2],
+	   -filled => 1,
+	   -fillcolor => $worldAxisColor,
+	   -linecolor => $worldAxisColor,
+	   -linewidth => 3,
+	   -tags => ["axis:$world"]);
+$zinc->add('text', $top,
+	   -text => "This is the origin\nof the world",
+	   -anchor => 's',
+	   -color => $worldAxisColor,
+	   -alignment => 'center',
+	   -tags => ["axis:$world"]);
+
+
+$currentgroup = $world;
+
+$zinc->Tk::bind('<1>', [\&mouseadd, 'item']);
+$zinc->Tk::bind('<2>', [\&mouseadd, 'group']);
+$zinc->Tk::bind('<Up>', \&moveup);
+$zinc->Tk::bind('<Left>', \&moveleft);
+$zinc->Tk::bind('<Right>', \&moveright);
+$zinc->Tk::bind('<Down>', \&movedown);
+$zinc->Tk::bind('<Next>', \&scaledown);
+$zinc->Tk::bind('<Prior>', \&scaleup);
+$zinc->Tk::bind('<Home>', \&reset);
+$zinc->Tk::bind('<Shift-Home>', \&resetchildren);
+$zinc->Tk::bind('<End>', \&rotateleft);
+$zinc->Tk::bind('<Delete>', \&rotateright);
+$zinc->Tk::bind('<Insert>', \&swapaxis);
+
+$zinc->Tk::bind('<Configure>', [\&resize]);
+
+$zinc->Tk::focus();
+$zinc->focusFollowsMouse();
+
+
+MainLoop();
+
+sub resize {
+  my $ev = $zinc->XEvent();
+  my $x = $ev->w/2;
+  my $y = $ev->h/2;
+
+  $zinc->treset($world);
+  $zinc->treset("axis:$world");
+  $zinc->translate($world, $x, $y);
+  $zinc->translate("axis:$world", $x, $y);
+}
+
+sub swapaxis {
+  if (defined($currentitem)) {
+    $zinc->scale($currentitem, 1, -1);
+    $zinc->scale("axisgrp:$currentitem", 1, -1);
+  }
+}
+
+sub togglecomposerot {
+  if (defined($currentitem)) {
+    $zinc->itemconfigure($currentitem, -composerotation => $composerot);
+    $zinc->itemconfigure("axisgrp:$currentitem", -composerotation => $composerot);
+  }
+}
+
+sub togglecomposescale {
+  my $bool;
+
+  if (defined($currentitem)) {
+    $zinc->itemconfigure($currentitem, -composescale => $composescale);
+    $zinc->itemconfigure("axisgrp:$currentitem", -composescale => $composescale);
+  }
+}
+
+sub dragitem {
+  $drag = 1;
+  return if (!defined($currentitem));
+
+  my $ev = $zinc->XEvent();
+  my $group = $zinc->group($currentitem);
+  my ($x, $y) = $zinc->transform($group, [$ev->x, $ev->y]);
+
+  $zinc->treset($currentitem);
+  $zinc->treset("axisgrp:$currentitem");
+  $zinc->translate($currentitem, $x, $y);
+  $zinc->translate("axisgrp:$currentitem", $x, $y);
+}
+
+sub select {
+  my @tags = $zinc->gettags('current');
+  my $t;
+  foreach $t (@tags) {
+    if ($t =~ '^axis:(\d+)') {
+      changeitem($1);
+    }
+  }
+}
+
+sub changeitem {
+  my ($item) = @_;
+
+  if (defined($currentitem) && !$drag) {
+    $zinc->itemconfigure("axis:$currentitem",
+			 -linecolor => $inactiveAxisColor,
+			 -fillcolor => $inactiveAxisColor);
+    if ($currentitem != $currentgroup) {
+      $zinc->itemconfigure("axis:$currentitem",
+			   -linewidth => 1);
+    }
+  }
+  if (!defined($currentitem) || ($item != $currentitem)) {
+    $zinc->itemconfigure("axis:$item",
+			 -linecolor => $activeAxisColor,
+			 -fillcolor => $activeAxisColor,
+			 -linewidth => 3);
+    $currentitem = $item;
+    $composerot = $zinc->itemcget($currentitem, -composerotation);
+    $composescale = $zinc->itemcget($currentitem, -composescale);
+  }
+  elsif (!$drag) {
+    $currentitem = undef;
+    $composerot = $composescale = 1;
+  }
+  $drag = 0;
+}
+
+sub selectgroup {
+  my @tags = $zinc->gettags('current');
+  my $t;
+  foreach $t (@tags) {
+    if ($t =~ '^axis:(\d+)') {
+      changegroup($1);
+    }
+  }
+}
+
+sub changegroup {
+  my ($grp) = @_;
+
+  changeitem($grp);
+  $zinc->itemconfigure("axis:$currentgroup",
+		       -linewidth => 1);
+  if (defined($currentitem)) {
+    $currentgroup = $currentitem;
+  }
+  else {
+    $currentgroup = $world;
+  }
+
+  $zinc->itemconfigure("axis:$currentgroup",
+		       -linewidth => 3);
+}
+
+sub reset {
+  if (defined($currentitem)) {
+    $zinc->treset($currentitem);
+    $zinc->treset("axisgrp:$currentitem");
+  }
+}
+
+sub resetchildren {
+  my @children;
+
+  if (defined($currentitem) && ($zinc->type($currentitem) eq 'group')) {
+    @children = $zinc->addtag('rt', 'withtag', 'all', $currentitem, 0);
+    $zinc->treset('rt');
+    $zinc->dtag('rt', 'rt');
+  }
+}
+
+sub moveup {
+  move(0, 20);
+}
+
+sub movedown {
+  move(0, -20);
+}
+
+sub moveright {
+  move(20, 0);
+}
+
+sub moveleft {
+  move(-20, 0);
+}
+
+sub move {
+  my ($dx, $dy) = @_;
+
+  if (defined($currentitem)) {
+    $zinc->translate($currentitem, $dx, $dy);
+    $zinc->translate("axisgrp:$currentitem", $dx, $dy);
+  }
+}
+
+sub scaleup {
+  scale(1.1, 1.1);
+}
+
+sub scaledown {
+  scale(0.9, 0.9);
+}
+
+sub scale {
+  my ($dx, $dy) = @_;
+
+  if (defined($currentitem)) {
+    $zinc->scale($currentitem, $dx, $dy);
+    $zinc->scale("axisgrp:$currentitem", $dx, $dy);
+  }
+}
+
+sub rotateleft {
+  rotate(-3.14159/18);
+}
+
+sub rotateright {
+  rotate(3.14159/18);
+}
+
+sub rotate {
+  my ($angle) = @_;
+
+  if (defined($currentitem)) {
+    $zinc->rotate($currentitem, $angle);
+    $zinc->rotate("axisgrp:$currentitem", $angle);
+  }
+}
+
+sub newrect {
+  return $zinc->add('rectangle', $currentgroup,
+		    [-15, -15, 15, 15],
+		    -filled => 1,
+		    -linewidth => 0,
+		    -fillcolor => 'tan');
+}
+
+sub newarc {
+  return $zinc->add('arc', $currentgroup,
+		    [-25, -15, 25, 15],
+		    -filled => 1,
+		    -linewidth => 0,
+		    -fillcolor => 'tan');
+}
+
+sub newbezier {
+  return $zinc->add('bezier', $currentgroup,
+		    [-15, -15, -15, 15, 15, 15, 15, -15],
+		    -filled => 1,
+		    -linewidth => 0,
+		    -fillcolor => 'tan');
+}
+
+sub newcurve {
+  return $zinc->add('curve', $currentgroup,
+		    [-15, -15, -15, 15, 15, 15, 15, -15],
+		    -filled => 1,
+		    -linewidth => 0,
+		    -fillcolor => 'tan');
+}
+
+sub newtext {
+  my $item = $zinc->add('text', $currentgroup,
+			-anchor => 's');
+  $zinc->itemconfigure($item, -text => "Item id: $item");
+  return $item;
+}
+
+sub newicon {
+  my $item = $zinc->add('icon', $currentgroup,
+			-mask => 'AtcSymbol1',
+			-anchor => 'center',
+			-color => 'black');
+
+  return $item;
+}
+
+sub newtriangles {
+  my $item = $zinc->add('triangles', $currentgroup,
+			[-25, 15, -10, -15, 5, 15,
+			 20, -15, 35, 15, 50, -30],
+			-colors => ['tan', 'wheat', 'tan', 'wheat']);
+  return $item;
+}
+
+sub newtrack {
+  my $labelformat = "x80x50+0+0 a0a0^0^0 a0a0^0>1 a0a0>2>1 x30a0>3>1 a0a0^0>2";
+
+  my $item=$zinc->add('track', $currentgroup, 6,
+		      -labelformat => $labelformat,
+		      -speedvector => [30, -15],
+		      -markersize => 20);
+  $zinc->itemconfigure($item, 0,
+		       -filled => 0,
+		       -bordercolor => 'DarkGreen',
+		       -border => 'contour');
+  $zinc->itemconfigure($item, 1,
+		       -filled => 1,
+		       -backcolor => 'gray60',
+		       -text => 'AFR6128');
+  $zinc->itemconfigure($item, 2,
+		       -filled => 0,
+		       -backcolor => 'gray65',
+		       -text => '390');
+  $zinc->itemconfigure($item, 3,
+		       -filled => 0,
+		       -backcolor => 'gray65',
+		       -text => '/');
+  $zinc->itemconfigure($item, 4,
+		       -filled => 0,
+		       -backcolor => 'gray65',
+		       -text => '350');
+  $zinc->itemconfigure($item, 5,
+		       -filled => 0,
+		       -backcolor => 'gray65',
+		       -text => 'TUR');
+  return $item;
+}
+
+sub newwaypoint {
+  my $labelformat = "a0a0+0+0 a0a0>0^1";
+
+  my $item=$zinc->add('waypoint', $currentgroup, 2,
+		      -labelformat => $labelformat);
+  $zinc->itemconfigure($item, 0,
+		       -filled => 1,
+		       -backcolor => 'DarkGreen',
+		       -text => 'TUR');
+  $zinc->itemconfigure($item, 1,
+		       -text => '>>>');
+  return $item;
+}
+
+sub newtabular {
+  my $labelformat = "f700f600+0+0 f700a0^0^0 f700a0^0>1 f700a0^0>2 f700a0^0>3 f700a0^0>4 f700a0^0>5";
+
+  my $item=$zinc->add('tabular', $currentgroup, 7,
+		      -labelformat => $labelformat);
+  $zinc->itemconfigure($item, 0,
+		       -filled => 1,
+		       -border => 'contour',
+		       -bordercolor => 'black',
+		       -backcolor => 'gray60');
+  $zinc->itemconfigure($item, 1,
+		       -alignment => 'center',
+		       -text => 'AFR6128');
+  $zinc->itemconfigure($item, 2,
+		       -alignment => 'center',
+		       -text => '390');
+  $zinc->itemconfigure($item, 3,
+		       -alignment => 'center',
+		       -text => '370');
+  $zinc->itemconfigure($item, 4,
+		       -alignment => 'center',
+		       -text => '350');
+  $zinc->itemconfigure($item, 5,
+		       -alignment => 'center',
+		       -text => '330');
+  $zinc->itemconfigure($item, 6,
+		       -alignment => 'center',
+		       -text => 'TUR');
+  return $item;
+}
+
+sub addaxes {
+  my ($item, $length, $command, $infront) = @_;
+
+  my $axesgroup = $zinc->add('group', $currentgroup,
+			     -tags => ["axisgrp:$item"]);
+  $zinc->add('curve', $axesgroup, [0, 0, $length, 0],
+	     -linewidth => 2,
+	     -lastend => [6,8,3],
+	     -tags => ["axis:$item"]);
+  $zinc->add('curve', $axesgroup, [0, 0, 0, $length],
+	     -linewidth => 2,
+	     -lastend => [6,8,3],
+	     -tags => ["axis:$item"]);
+  $zinc->add('rectangle', $axesgroup, [-2, -2, 2, 2],
+	     -filled => 1,
+	     -linewidth => 0,
+	     -composescale => 0,
+	     -tags => ["axis:$item"]);
+  if ($infront) {
+    $zinc->raise($item, $axesgroup);
+  }
+  $zinc->bind("axis:$item", '<B1-Motion>', \&dragitem);
+  $zinc->bind("axis:$item", '<ButtonRelease-1>', $command);
+}
+
+sub additem {
+  my $item;
+  my $length = 25;
+  my $itemontop = 0;
+
+  if ($itemtype eq 'rectangle') {
+    $item = newrect();
+  }
+  elsif ($itemtype eq 'arc') {
+    $item = newarc();
+  }
+  elsif ($itemtype eq 'bezier') {
+    $item = newbezier();
+  }
+  elsif ($itemtype eq 'curve') {
+    $item = newcurve();
+  }
+  elsif ($itemtype eq 'triangles') {
+    $item = newtriangles();
+  }
+  elsif ($itemtype eq 'icon') {
+    $item = newicon();
+    $itemontop = 1;
+  }
+  elsif ($itemtype eq 'text') {
+    $item = newtext();
+  }
+  elsif ($itemtype eq 'track') {
+    $item = newtrack();
+    $itemontop = 1;
+  }
+  elsif ($itemtype eq 'waypoint') {
+    $item = newwaypoint();
+    $itemontop = 1;
+  }
+  elsif ($itemtype eq 'tabular') {
+    $item = newtabular();
+  }
+
+  addaxes($item, 25, \&select, $itemontop);
+  changeitem($item);
+}
+
+sub addgroup {
+  my $item = $zinc->add('group', $currentgroup);
+
+  addaxes($item, 80, \&selectgroup, 1);
+  changegroup($item);
+}
+
+sub mouseadd {
+  my ($w, $itemorgrp) = @_;
+  my $ev = $zinc->XEvent();
+  my ($x, $y) = $zinc->transform($currentgroup, [$ev->x, $ev->y]);
+  my $item = $zinc->find('withtag', 'current');
+
+  if (defined($item)) {
+    my @tags = $zinc->gettags($item);
+    foreach my $t (@tags) {
+      return if ($t =~ '^axis');
+    }
+  }
+  if ($itemorgrp eq 'group') {
+    addgroup();
+  }
+  else {
+    additem();
+  }
+  $zinc->translate($currentitem, $x, $y);
+  $zinc->translate("axisgrp:$currentitem", $x, $y);
+}
+
+sub removeitem {
+  if (defined($currentitem)) {
+    $zinc->remove($currentitem, "axisgrp:$currentitem");
+    if ($currentitem == $currentgroup) {
+      $currentgroup = $world;
+    }
+    $currentitem = undef;
+    $composescale = $composerot = 1;
+  }
+}