aboutsummaryrefslogtreecommitdiff
path: root/Perl/demos
diff options
context:
space:
mode:
Diffstat (limited to 'Perl/demos')
-rw-r--r--Perl/demos/Tk/demos/zinc_lib/transforms.pl573
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;
+ }
+}
generated by cgit v1.1 at 2024-11-08 02:14:03 +0000