From 9f9717711fed84aec81f6530266b7e97ad831ecc Mon Sep 17 00:00:00 2001 From: mertz Date: Tue, 12 Mar 2002 17:02:49 +0000 Subject: demos d�plac�es de examples/ vers demos/ ajout de nouvelles demos: tkZincLogo.pl window-contours.pl --- Perl/demos/Tk/demos/zinc_lib/all_options.pl | 151 +++++ Perl/demos/Tk/demos/zinc_lib/clipping.pl | 143 +++++ Perl/demos/Tk/demos/zinc_lib/color-circular.pl | 67 ++ Perl/demos/Tk/demos/zinc_lib/color-x.pl | 59 ++ Perl/demos/Tk/demos/zinc_lib/color-y.pl | 61 ++ Perl/demos/Tk/demos/zinc_lib/contours.pl | 199 ++++++ Perl/demos/Tk/demos/zinc_lib/counter.pl | 422 ++++++++++++ Perl/demos/Tk/demos/zinc_lib/demo.pl | 144 +++++ Perl/demos/Tk/demos/zinc_lib/groups_priority.pl | 253 ++++++++ Perl/demos/Tk/demos/zinc_lib/items.pl | 182 ++++++ Perl/demos/Tk/demos/zinc_lib/lines.pl | 93 +++ Perl/demos/Tk/demos/zinc_lib/mapinfo.pl | 127 ++++ Perl/demos/Tk/demos/zinc_lib/rotation.pl | 122 ++++ .../Tk/demos/zinc_lib/simple_interaction_track.pl | 295 +++++++++ Perl/demos/Tk/demos/zinc_lib/simpleradar.pl | 707 +++++++++++++++++++++ Perl/demos/Tk/demos/zinc_lib/tkZincLogo.pl | 152 +++++ Perl/demos/Tk/demos/zinc_lib/translation.pl | 141 ++++ Perl/demos/Tk/demos/zinc_lib/triangles.pl | 56 ++ Perl/demos/Tk/demos/zinc_lib/wheelOfFortune.pl | 88 +++ Perl/demos/Tk/demos/zinc_lib/window-contours.pl | 111 ++++ Perl/demos/Tk/demos/zinc_lib/zoom.pl | 178 ++++++ 21 files changed, 3751 insertions(+) create mode 100644 Perl/demos/Tk/demos/zinc_lib/all_options.pl create mode 100644 Perl/demos/Tk/demos/zinc_lib/clipping.pl create mode 100644 Perl/demos/Tk/demos/zinc_lib/color-circular.pl create mode 100644 Perl/demos/Tk/demos/zinc_lib/color-x.pl create mode 100644 Perl/demos/Tk/demos/zinc_lib/color-y.pl create mode 100644 Perl/demos/Tk/demos/zinc_lib/contours.pl create mode 100644 Perl/demos/Tk/demos/zinc_lib/counter.pl create mode 100644 Perl/demos/Tk/demos/zinc_lib/demo.pl create mode 100644 Perl/demos/Tk/demos/zinc_lib/groups_priority.pl create mode 100644 Perl/demos/Tk/demos/zinc_lib/items.pl create mode 100644 Perl/demos/Tk/demos/zinc_lib/lines.pl create mode 100644 Perl/demos/Tk/demos/zinc_lib/mapinfo.pl create mode 100644 Perl/demos/Tk/demos/zinc_lib/rotation.pl create mode 100644 Perl/demos/Tk/demos/zinc_lib/simple_interaction_track.pl create mode 100644 Perl/demos/Tk/demos/zinc_lib/simpleradar.pl create mode 100644 Perl/demos/Tk/demos/zinc_lib/tkZincLogo.pl create mode 100644 Perl/demos/Tk/demos/zinc_lib/translation.pl create mode 100644 Perl/demos/Tk/demos/zinc_lib/triangles.pl create mode 100644 Perl/demos/Tk/demos/zinc_lib/wheelOfFortune.pl create mode 100644 Perl/demos/Tk/demos/zinc_lib/window-contours.pl create mode 100644 Perl/demos/Tk/demos/zinc_lib/zoom.pl (limited to 'Perl') diff --git a/Perl/demos/Tk/demos/zinc_lib/all_options.pl b/Perl/demos/Tk/demos/zinc_lib/all_options.pl new file mode 100644 index 0000000..3a89072 --- /dev/null +++ b/Perl/demos/Tk/demos/zinc_lib/all_options.pl @@ -0,0 +1,151 @@ +#!/usr/bin/perl -w +# $Id$ +# This simple demo has been developped by C. Mertz + +use Tk; +use Tk::Zinc; +use Tk::Pane; + +use strict; + +my $mw = MainWindow->new(); + +# The explanation displayed when running this demo +my $label=$mw->Label(-text => +"Click on one of the following +buttons to get a list of Item +attributes (or zinc options) +with their types.\n", + -justify => 'left')->pack(-padx => 10, -pady => 10); + + +# Creating the zinc widget +my $zinc = $mw->Zinc(-width => 1, -height => 1, + -font => "10x20", # usually fonts are sets in resources + # but for this example it is set in the code! + -borderwidth => 0, -relief => 'sunken', + )->pack; + +# Creating an instance of every item type +my %itemtypes; + +# These Items have fields! So the number of fields must be given at creation time +foreach my $type qw(tabular track waypoint) { + $itemtypes{$type} = $zinc->add($type, 1, 0); +} + +# These items needs no specific initial values +foreach my $type qw(group icon map reticle text window) { + $itemtypes{$type} = $zinc->add($type, 1); +} + +# These items needs some coordinates at creation time +# However curves and bezier usually needs more than 2 points. +foreach my $type qw(arc bezier curve rectangle) { + $itemtypes{$type} = $zinc->add($type, 1, [0,0 , 1,1]); +} +# Triangles item needs at least 3 points for the coordinates +foreach my $type qw(triangles) { + $itemtypes{$type} = $zinc->add($type, 1, [0,0 , 1,1 , 2,2]); +} + + +sub showAllOptions { + my ($type) = @_; + + my $tl = MainWindow->new()->toplevel; + my $title = "All options of an item $type"; + my @options; + if ($type eq 'zinc') { + @options = $zinc->configure(); + $title = "All options of zinc widget"; + } + else { + @options = $zinc->itemconfigure($itemtypes{$type}); + $title = "All attributes of an item $type"; + } + $tl->title($title); + my $frame = $tl->Scrolled('Pane', + -scrollbars => 'e', + -height => 600, + ); + $frame->pack(-padx => 10, -pady => 10, + -ipadx => 10, + -fill => 'both', + -expand => 1, + ); + + my $fm = $frame->LabFrame(-labelside => 'acrosstop', + -label => $title, + )->pack(-padx => 10, -pady => 10, + -ipadx => 10, + -fill => 'both'); + my $bgcolor = 'ivory'; + $fm->Label(-text => 'Option', -background => $bgcolor, -relief => 'ridge') + ->grid(-row => 1, -col => 1, -ipady => 10, -ipadx => 5, -sticky => 'nswe'); + $fm->Label(-text => ($type eq 'zinc') ? 'optionClass' : 'Type', + -background => $bgcolor, -relief => 'ridge') + ->grid(-row => 1, -col => 2, -ipady => 10, -ipadx => 5, -sticky => 'nswe'); + $fm->Label(-text => ($type eq 'zinc') ? 'defaultValue' : 'ReadOnly', + -background => $bgcolor, -relief => 'ridge') + ->grid(-row => 1, -col => 3, -ipady => 10, -ipadx => 5, -sticky => 'nswe'); + my $i = 2; + my %options; #we used this hastable to sort the options by their names + + if ($type eq 'zinc') { + for my $elem (@options) { +# print "$elem @$elem\n"; + my ($optionName, $optionDatabaseName, $optionClass, $default, $optionValue) = @$elem; + $options{$optionName} = [$optionClass, $default, "", $optionValue]; + } + } + else { + for my $elem (@options) { + my ($optionName, $optionType, $readOnly, $empty, $optionValue) = @$elem; + $options{$optionName} = [$optionType, $readOnly, $empty, $optionValue]; + } + } + for my $optionName (sort keys %options) { + my ($optionType, $readOnly, $empty, $optionValue) = @{$options{$optionName}}; + $fm->Label(-text => $optionName, -relief => 'ridge') + ->grid(-row => $i, -col => 1, -ipady => 10, -ipadx => 5, -sticky => 'nswe'); + $fm->Label(-text => $optionType, -relief => 'ridge') + ->grid(-row => $i, -col => 2, -ipady => 10, -ipadx => 5, -sticky => 'nswe'); + + # $empty is for provision by Zinc + if ($type ne 'zinc') { + if ($readOnly) {$readOnly = "read only"} else { $readOnly = "" } + } + $fm->Label(-text => $readOnly, -relief => 'ridge') + ->grid(-row => $i, -col => 3, -ipady => 10, -ipadx => 5, -sticky => 'nswe'); + # we do not display $optionValue for these fake items + $i++; + } + $tl->Button(-text => 'Close', + -command => sub {$tl->destroy})->pack; + +} + +my $col = $mw->Frame()->pack(); + +my $width=0; +foreach my $type (sort keys %itemtypes) { + if (length ($type) > $width) { + $width = length ($type); + } +} + +foreach my $type (sort keys %itemtypes) { + $col->Button(-text => "$type", + -width => $width, + -command => sub {&showAllOptions ($type);}, + )->pack(-pady => 4); +} +$col->Button(-text => "zinc widget options", + -command => sub {&showAllOptions ('zinc');}, + )->pack(-pady => 4); + +MainLoop(); + + +1; diff --git a/Perl/demos/Tk/demos/zinc_lib/clipping.pl b/Perl/demos/Tk/demos/zinc_lib/clipping.pl new file mode 100644 index 0000000..8ee9f63 --- /dev/null +++ b/Perl/demos/Tk/demos/zinc_lib/clipping.pl @@ -0,0 +1,143 @@ +#!/usr/bin/perl +# $Id$ +# this simple sample has been developped by C. Mertz mertz@cena.fr + +use Tk; +use Tk::Zinc; +use strict; +use Tk::Checkbutton; + +my $defaultfont = '-adobe-helvetica-bold-r-normal-*-120-*-*-*-*-*-*'; +my $mw = MainWindow->new(); +my $zinc = $mw->Zinc(-width => 700, -height => 600, + -font => "10x20", # usually fonts are sets in resources + # but for this example it is set in the code! + -borderwidth => 3, -relief => 'sunken', + )->pack; + +my $display_clipping_area_limits = 1; +my $clip = 1; + +$zinc->add('text', 1, + -font => $defaultfont, + -text => "You can drag and drop the objects.\n". + "There are two groups of objects, a \"tan group\" and a \"blue group\".\n". + "Try to move them and discover the clipping area which is a curve.\n". + "with two contours", + -anchor => 'nw', + -position => [10, 10]); + + +my $clipped_group = $zinc->add('group', 1, -visible => 1); + +my $clipping_item = $zinc->add('curve', $clipped_group, + [10,100, 690,100, 690,590, 520,300, + 350,590, 180,300, 10,590], + -closed => 1, + -linewidth => $display_clipping_area_limits); +$zinc->contour($clipping_item, "diff", [200,200, 500,200, 500,250, 200,250]); + +############### creating the tan_group objects ################ +# the tan_group is atomic, that is is makes all children as a single object +# and sensitive to tan_group callbacks +my $tan_group = $zinc->add('group', $clipped_group, + -visible => 1, + -atomic => 1, + -sensitive => 1, + ); + +my $arc = $zinc->add('arc', $tan_group, + [200, 220, 280, 300], + -filled => 1, -linewidth => 1, + -startangle => 45, -extent => 270, + -pieslice => 1, -closed => 1, + -fillcolor => "tan", + ); + +my $bezier = $zinc->add('bezier', $tan_group, + [400,400, 400,500, 500,500, 500,400], + -filled => 1, -fillcolor => "tan", + -linecolor => "tan", + ); + +############### creating the blue_group objects ################ +# the blue_group is atomic too, that is is makes all children as a single object +# and sensitive to blue_group callbacks +my $blue_group = $zinc->add('group', $clipped_group, + -visible => 1, + -atomic => 1, + -sensitive => 1, + ); + +my $arc = $zinc->add('rectangle', $blue_group, + [570,180, 470,280], + -filled => 1, -linewidth => 1, + -fillcolor => "blue2", + ); + +my $bezier = $zinc->add('bezier', $blue_group, + [200,400, 200,500, 300,500, 300,400, 300,300], + -filled => 1, -fillcolor => "blue", + -linewidth => 0, + ); + + +$zinc->itemconfigure($clipped_group, -clip => $clipping_item); + + +###################### drag and drop callbacks ############ +# for both tan_group and blue_group +$zinc->bind($tan_group, '' => [\&press, $tan_group, \&motion]); +$zinc->bind($tan_group, '' => \&release); +$zinc->bind($blue_group, '' => [\&press, $blue_group, \&motion]); +$zinc->bind($blue_group, '' => \&release); + +my ($x_orig, $y_orig); +sub press { + my ($zinc, $group, $action) = @_; + my $ev = $zinc->XEvent(); + $x_orig = $ev->x; + $y_orig = $ev->y; + $zinc->Tk::bind('', [$action, $group]); +} + +sub motion { + my ($zinc, $group) = @_; + my $ev = $zinc->XEvent(); + my $x = $ev->x; + my $y = $ev->y; + + $zinc->translate($group, $x-$x_orig, $y-$y_orig); + $x_orig = $x; + $y_orig = $y; +} + +sub release { + my ($zinc) = @_; + $zinc->Tk::bind('', ''); +} +###################### toggle buttons at the bottom ####### +my $row = $mw->Frame()->pack(); +$row->Checkbutton(-text => 'Show clipping limits', + -variable => \$display_clipping_area_limits, + -command => \&display_clipping_area)->pack; + +$row->Checkbutton(-text => 'Clip', + -variable => \$clip, + -command => \&clip)->pack; + +sub display_clipping_area { + $zinc->itemconfigure($clipping_item, -linewidth => $display_clipping_area_limits); +} + +sub clip { + if ($clip) { + $zinc->itemconfigure($clipped_group, -clip => $clipping_item); + } + else { + print "unclip\n"; + $zinc->itemconfigure($clipped_group, -clip => undef); + } +} + +MainLoop; diff --git a/Perl/demos/Tk/demos/zinc_lib/color-circular.pl b/Perl/demos/Tk/demos/zinc_lib/color-circular.pl new file mode 100644 index 0000000..38f25d2 --- /dev/null +++ b/Perl/demos/Tk/demos/zinc_lib/color-circular.pl @@ -0,0 +1,67 @@ +#!/usr/bin/perl +# $Id$ +# these simple samples have been developped by C. Mertz mertz@cena.fr + +use Tk; +use Tk::Zinc; +use strict; + +my $defaultfont = '-adobe-helvetica-bold-r-normal-*-120-*-*-*-*-*-*'; +my $mw = MainWindow->new(); +my $zinc = $mw->Zinc(-width => 700, -height => 600, + -borderwidth => 3, -relief => 'sunken', + -render => 1, # for activating the openGL render + )->pack; + +die "no openGL rendering on this X server" unless $zinc->cget(-render); + + +$zinc->add('rectangle', 1, [0, 0, 100, 100], -fillcolor => "red|blue(50 50", -filled => 1); + +$zinc->add('text', 1, + -font => $defaultfont, + -text => "Radial variation from non-transparent red to non-transparent blue\nin a squarre.\n", + -anchor => 'nw', + -position => [120, 20]); + +$zinc->add('arc', 1, [0, 100, 100, 200], -fillcolor => "red:40|blue:40(50 150", -filled => 1); + +$zinc->add('text', 1, + -font => $defaultfont, + -text => "Radial variation from 40%transparent red to 40% transparent blue\nin a disc.", + -anchor => 'nw', + -position => [120, 120]); + +$zinc->add('arc', 1, [0, 200, 100, 300], -fillcolor => "red:40|green:40 50|blue:40(50 250", -filled => 1); + +$zinc->add('text', 1, + -font => $defaultfont, + -text => "A variation from 40%transparent red to 40% transparent blue.\n". + "through a 40%green on the middle of the disc", + -anchor => 'nw', + -position => [120, 220]); + +$zinc->add('text', 1, + -font => $defaultfont, + -text => "Two overlaping radialy, transparently colored items on a white background", + -anchor => 'nw', + -position => [20, 320]); + +$zinc->add('rectangle', 1, [10, 340, 690, 590], -fillcolor => "white", -filled => 1); + +$zinc->add('rectangle', 1, [20, 365, 220, 565], -fillcolor => "red:40|green:40 50|blue:40(120 465", -filled => 1); + +$zinc->add('arc', 1, [150, 365, 350, 565], -fillcolor => "yellow:40|black:40 50|cyan:40(250 465", -filled => 1); + +$zinc->add('arc', 1, [280, 365, 480, 565], -fillcolor => "black:100|black:100 20|white:40(380 465", -filled => 1, -linewidth => 0); + +$zinc->add('arc', 1, [480, 365, 580, 500], -fillcolor => "black:100|white:40(520 465", -filled => 1); + +$zinc->add('arc', 1, [580, 410, 680, 580], -fillcolor => "black:50|white:40(600 450", -filled => 1); +$zinc->add('arc', 1, [580, 410, 680, 580], -fillcolor => "black:50|white:40(680 580", -filled => 1); + + + + +MainLoop; + diff --git a/Perl/demos/Tk/demos/zinc_lib/color-x.pl b/Perl/demos/Tk/demos/zinc_lib/color-x.pl new file mode 100644 index 0000000..e3a1ea1 --- /dev/null +++ b/Perl/demos/Tk/demos/zinc_lib/color-x.pl @@ -0,0 +1,59 @@ +#!/usr/bin/perl +# $Id$ +# these simple samples have been developped by C. Mertz mertz@cena.fr + +use Tk; +use Tk::Zinc; +use strict; + +my $defaultfont = '-adobe-helvetica-bold-r-normal-*-120-*-*-*-*-*-*'; +my $mw = MainWindow->new(); +my $zinc = $mw->Zinc(-width => 700, -height => 600, + -borderwidth => 3, -relief => 'sunken', + -render => 1, # for activating the openGL render + )->pack; + +die "no openGL rendering on this X server" unless $zinc->cget(-render); + +$zinc->add('rectangle', 1, [10,10, 690, 100], -fillcolor => "red|blue", -filled => 1); + +$zinc->add('text', 1, + -font => $defaultfont, + -text => "A variation from non transparent red to non transparent blue.\n", + -anchor => 'nw', + -position => [20, 20]); + + +$zinc->add('rectangle', 1, [10,110, 690, 200], -fillcolor => "red:40|blue:40", -filled => 1); + +$zinc->add('text', 1, + -font => $defaultfont, + -text => "A variation from 40%transparent red to 40% transparent blue.", + -anchor => 'nw', + -position => [20, 120]); + +$zinc->add('rectangle', 1, [10, 210, 690, 300], -fillcolor => "red:40|green:40 50|blue:40", -filled => 1); + +$zinc->add('text', 1, + -font => $defaultfont, + -text => "A variation from 40%transparent red to 40% transparent blue.\n". + "through a 40%green on the middle", + -anchor => 'nw', + -position => [20, 220]); + +$zinc->add('text', 1, + -font => $defaultfont, + -text => "Two overlaping transparently colored rectangles on a white background", + -anchor => 'nw', + -position => [20, 320]); + +$zinc->add('rectangle', 1, [10, 340, 690, 590], -fillcolor => "white", -filled => 1); +$zinc->add('rectangle', 1, [200, 350, 500, 580], -fillcolor => "red:40|green:40 50|blue:40", -filled => 1); + +$zinc->add('rectangle', 1, [10, 400, 690, 500], -fillcolor => "yellow:40|black:40 50|cyan:40", -filled => 1); + + + + +MainLoop; + diff --git a/Perl/demos/Tk/demos/zinc_lib/color-y.pl b/Perl/demos/Tk/demos/zinc_lib/color-y.pl new file mode 100644 index 0000000..bc00d0a --- /dev/null +++ b/Perl/demos/Tk/demos/zinc_lib/color-y.pl @@ -0,0 +1,61 @@ +#!/usr/bin/perl +# $Id$ +# these simple samples have been developped by C. Mertz mertz@cena.fr + + +use Tk; +use Tk::Zinc; +use strict; + +my $defaultfont = '-adobe-helvetica-bold-r-normal-*-120-*-*-*-*-*-*'; +my $mw = MainWindow->new(); +my $zinc = $mw->Zinc(-width => 700, -height => 600, + -borderwidth => 3, -relief => 'sunken', + -render => 1, # for activating the openGL render + )->pack; + +die "no openGL rendering on this X server" unless $zinc->cget(-render); + + +$zinc->add('rectangle', 1, [10, 10, 690, 100], -fillcolor => "red|blue/90", -filled => 1); + +$zinc->add('text', 1, + -font => $defaultfont, + -text => "A variation from non transparent red to non transparent blue.\n", + -anchor => 'nw', + -position => [20, 20]); + + +$zinc->add('rectangle', 1, [10,110, 690, 200], -fillcolor => "red:40|blue:40/90", -filled => 1); + +$zinc->add('text', 1, + -font => $defaultfont, + -text => "A variation from 40%transparent red to 40% transparent blue.", + -anchor => 'nw', + -position => [20, 120]); + +$zinc->add('rectangle', 1, [10, 210, 690, 300], -fillcolor => "red:40|green:40 50|blue:40/90", -filled => 1); + +$zinc->add('text', 1, + -font => $defaultfont, + -text => "A variation from 40%transparent red to 40% transparent blue.\n". + "through a 40%green on the middle", + -anchor => 'nw', + -position => [20, 220]); + +$zinc->add('text', 1, + -font => $defaultfont, + -text => "Two overlaping transparently colored rectangles on a white background", + -anchor => 'nw', + -position => [20, 320]); + +$zinc->add('rectangle', 1, [10, 340, 690, 590], -fillcolor => "white", -filled => 1); +$zinc->add('rectangle', 1, [200, 350, 500, 580], -fillcolor => "red:40|green:40 50|blue:40/90", -filled => 1); + +$zinc->add('rectangle', 1, [10, 400, 690, 500], -fillcolor => "yellow:40|black:40 50|cyan:40/90", -filled => 1); + + + + +MainLoop; + diff --git a/Perl/demos/Tk/demos/zinc_lib/contours.pl b/Perl/demos/Tk/demos/zinc_lib/contours.pl new file mode 100644 index 0000000..94e2e14 --- /dev/null +++ b/Perl/demos/Tk/demos/zinc_lib/contours.pl @@ -0,0 +1,199 @@ +#!/usr/bin/perl -w +# $Id$ +# This simple demo has been developped by C. Mertz + +use Tk; +use Tk::Zinc; + +use strict; + +my $mw = MainWindow->new(); + +# The explanation displayed when running this demo +my $text = $mw->Scrolled(qw/Text -relief sunken -borderwidth 2 -setgrid true + -height 10 -scrollbars e/); +$text->pack(qw/-expand yes -fill both/); + +$text->insert('0.0', +'All visibles items are made by combinig 2 items using contours: + - the firebrick curve1 has been holed using a diff with a circle, + - the lightblue curve2 is the intersection with a circle, + - the yellow curve3 is the union with a circle, + - the dark green curve4 has benn XORed with a circle, + - the grey curve5 is diff-ed, xor-ed and union-ed with many circle. +The following operations are possible: + "Mouse Button 1" for dragging objects. + "Mouse Button 1" for dragging the black handle and + modifying the curve5 contour.'); + +# Creating the zinc widget +my $zinc = $mw->Zinc(-width => 600, -height => 500, + -font => "10x20", # usually fonts are sets in resources + # but for this example it is set in the code! + -borderwidth => 3, -relief => 'sunken', + )->pack; + + +# Creation of 2 items NOT visible, but used for creating visible +# curves[1-5] with more than one contours. +# The center of these 2 items is 200,100 +my $curve0 = $zinc->add('curve', 1, [0,100 , 100,0, 300,0 , 400,100, 300,200, 100,200], + -closed => 1, -visible => 0, -filled => 1, + ); +my $cercle100 = $zinc->add('arc', 1, [150,50, 250,150], + -visible => 0, + ); + +# cloning curve0 as curve1 and moving it +my $curve1 = $zinc->clone($curve0, -visible => 1, -fillcolor => "firebrick1"); +# adding a 'difference' contour to the curve1 +$zinc->contour($curve1, 'diff', $cercle100); + + +# cloning curve0 as curve2 and moving it +my $curve2 = $zinc->clone($curve0, -visible => 1, -fillcolor => "lightblue2"); +$zinc->translate($curve2,100,90); +# adding an 'intersection' contour to the curve2 +$zinc->contour($curve2, 'inter', $cercle100); +# ... translate to make it more visible +$zinc->translate($curve2, -10,20); + + +# cloning curve0 as curve3 and moving it +my $curve3 = $zinc->clone($curve0, -visible => 1, -fillcolor => "yellow3"); +$zinc->translate($curve3,0,290); +# adding an 'union' contour to the curve3 +$zinc->contour($curve3, 'union', $cercle100); +# ... translate to make it more visible +$zinc->translate($curve3, -50,-100); + + + +# cloning curve0 as curve4 and moving it slightly +my $curve4 = $zinc->clone($curve0, -visible => 1, -fillcolor => "DarkGreen"); +$zinc->translate($curve4,-20,-90); +# adding an 'XOR' contour to the curve4 +$zinc->contour($curve4, 'xor', $cercle100); +# ... translate to make it more visible +$zinc->translate($curve4, 230,130); + + + +# cloning curve0 as curve5 and moving it slightly +my $curve5 = $zinc->clone($curve0, -visible => 1, -fillcolor => "grey50", + -tags => ["grouped"], + # tag "grouped" of curve5 and a handle (see just below) + # is used for easily translating both + ); +my ($x,$y) = $zinc->coords($curve5,0,1); +my $handle = $zinc->add('rectangle', 1, [$x-5,$y-5,$x+5,$y+5], + -fillcolor => 'black', -filled => 1, + -tags => ["grouped"], + ); + +# adding a 'difference' contour to the curve5 +$zinc->contour($curve5, 'diff', $cercle100); +$zinc->translate('grouped',110,0); +$zinc->contour($curve5, 'diff', $cercle100); +$zinc->translate('grouped',-220,0); +$zinc->contour($curve5, 'diff', $cercle100); +$zinc->translate('grouped',110,80); +$zinc->contour($curve5, 'union', $cercle100); +$zinc->translate('grouped',0,-160); +$zinc->contour($curve5, 'union', $cercle100); + +$zinc->translate('grouped',200,80); +$zinc->contour($curve5, 'xor', $cercle100); +$zinc->translate('grouped',-350,0); +$zinc->contour($curve5, 'union', $cercle100); + +$zinc->translate('grouped',350,250); + +#my @coords = $zinc->coords($curve5, 1); print "$#coords : @coords\n"; #seems buggy! +#my @coords2 = $zinc->coords($curve1, 1); print "$#coords2 : @coords2\n"; #seems buggy! + +# Deleting no more usefull items: curve0 and cercle100: +$zinc->remove($curve0, $cercle100); + +# adding drag and drop callback to each visible curve! +foreach my $item ($curve1, $curve2, $curve3, $curve4) { + # Some bindings for dragging the items + $zinc->bind($item, '' => [\&press, $item, \&motion]); + $zinc->bind($item, '' => \&release); +} + +# adding drag and drop on curve5 which also moves handle +$zinc->bind($curve5, '' => [\&press, $curve5, \&motionWithHandle]); +$zinc->bind($curve5, '' => \&release); + +# adding drag and drop on handle which also modify curve5 +$zinc->bind($handle, '' => [\&press, $handle, \&moveHandle]); +$zinc->bind($handle, '' => \&release); + +# callback for starting a drag +my ($x_orig, $y_orig); +sub press { + my ($zinc, $item, $action) = @_; + my $ev = $zinc->XEvent(); + $x_orig = $ev->x; + $y_orig = $ev->y; + $zinc->Tk::bind('', [$action, $item]); +} + +# Callback for moving an item +sub motion { + my ($zinc, $item) = @_; + my $ev = $zinc->XEvent(); + my $x = $ev->x; + my $y = $ev->y; + + $zinc->translate($item, $x-$x_orig, $y-$y_orig); + $x_orig = $x; + $y_orig = $y; +} + +# Callback for moving an item and its handle +sub motionWithHandle { + my ($zinc, $item) = @_; + my $ev = $zinc->XEvent(); + my $x = $ev->x; + my $y = $ev->y; + + my ($tag) = $zinc->itemcget($item, -tags); + $zinc->translate($tag, $x-$x_orig, $y-$y_orig); + $x_orig = $x; + $y_orig = $y; +} + +# BUG BUG BUG +# Callback for moving the handle and modifying curve5 +# this code is far from being generic. Only for demonstrating how we can +# modify a contour with a unique handle! +sub moveHandle { + my ($zinc, $handle) = @_; + my $ev = $zinc->XEvent(); + my $x = $ev->x; + my $y = $ev->y; + + $zinc->translate($handle, $x-$x_orig, $y-$y_orig); + print "Translating of ", $x-$x_orig, ",", $y-$y_orig, "\n"; + # LA LIGNE SUIVANTE EST OK LA 1ERE FOIS ET BUGGUE LES SUIVANTES! + # NB: CELA MARCHOTTE POUR LE CONTOUR 0, MAIS CE N'EST PAS CORRECT! + my ($vertexX,$vertxY) = $zinc->coords($curve5,1,1); + print "Vertex: $vertexX,$vertxY\n"; + $zinc->coords($curve5,1,1, [$x-$x_orig, $y-$y_orig]); + $x_orig = $x; + $y_orig = $y; +} + +# Callback when releasing the mouse button. It removes any motion callback +sub release { + my ($zinc) = @_; + $zinc->Tk::bind('', ''); +} + + +MainLoop(); + + +1; diff --git a/Perl/demos/Tk/demos/zinc_lib/counter.pl b/Perl/demos/Tk/demos/zinc_lib/counter.pl new file mode 100644 index 0000000..a9bd20d --- /dev/null +++ b/Perl/demos/Tk/demos/zinc_lib/counter.pl @@ -0,0 +1,422 @@ +#!/usr/bin/perl +# This simple demo has been developped by C. Schlienger + + +use Tk; +use Tk::Zinc; +use strict; +use constant; + +my constant $PI=3.1416; + +my $boldfont = '-adobe-helvetica-bold-r-normal--20-240-100-100-p-182-iso8859-1'; + +my $mw = MainWindow->new(); + +########################################### +# Text zone +########################################### + +my $text = $mw->Scrolled(qw/Text -relief sunken -borderwidth 2 -setgrid true + -height 6 -scrollbars e/); +$text->pack(qw/-expand yes -fill both/); + +$text->insert('0.0', + 'This toy-appli shows a simple counter.It is made thanks to clips and contours : this is the only way to do this. +The following operations are possible: + Drag and drop the counter to move it. Observe that the colour of the backgound of the counter is the same as the one of the window (use of clips)' ); + +################################################### +# Zinc +################################################### + +my $zinc = $mw->Zinc(-width => 700, -height => 400, + -font => "10x20", + -borderwidth => 3, + -relief => 'sunken', + -render => 1, + )->pack; + +my $r = $zinc->add('rectangle', 1, + [0,0,700,700], + -filled => 1, -linewidth => 0, + -fillcolor => "red:40|green:40 50|blue:40/90" + ); + +################################################### +# Les positions +################################################### + +#-------------------------------- +# Carre dans lequel sera inscrit le cercle du compteur +#--------------------------------- + +my $x0=250; +my $y0=100; +my $x1=$x0+200; +my $y1=$y0+200; + +#-------------------------------- +# Rectangle dans lequel defileront les chiffres +#--------------------------------- + +my $x2=$x0+50; +my $y2=$y0+130; +my $x3=$x1-50; +my $y3=$y1-50; + + +################################################### +# Chiffres clippes +################################################### + +my $general_group = $zinc->add('group',1, -visible => 1); + +my $clipped_group1 = $zinc->add('group',$general_group, -visible => 1); + +#-------------------------------- +# Clipping items +#--------------------------------- + +my $clipping_item1 = $zinc->add('curve', $clipped_group1, + [$x2,$y2,$x3,$y2,$x3,$y3,$x2,$y3,$x2,$y2] + ); + +#-------------------------------- +# Clipped items +#--------------------------------- + +my $group1=$zinc->add('group',$clipped_group1); + +my $ecart=17; + +# Il y a deux listes de chifres pour centaines, dizaines, unites, +# pour assurer l'enchainement des chiffres quand le temps passe +# (cf. : actions automatiques) + +#-------------------------------- +# Centaines +#--------------------------------- + +my $cent = $zinc->add('group',$group1, -visible => 1,); +my $xc=$x2+20; +my $yc=$y2; + + +my $nbc1=$zinc->add('text', $cent, + -font => $boldfont, + -text => "0 +1 +2 +3 +4 +5 +6 +7 +8 +9", + -anchor => 'nw', + -position => [$xc, $yc], +); +my $nbc2=$zinc->add('text', $cent, + -font => $boldfont, + -text => "0 +1 +2 +3 +4 +5 +6 +7 +8 +9", + -anchor => 'nw', + -position => [$xc, $yc+210], +); +#-------------------------------- +# Dixaines +#--------------------------------- + +my $dix = $zinc->add('group',$group1, -visible => 1); + +my $xd=$xc+30; +my $yd=$y2; +my $nbd1=$zinc->add('text', $dix, + -font => $boldfont, + -text => "0 +1 +2 +3 +4 +5 +6 +7 +8 +9", + -anchor => 'nw', + -position => [$xd,$yd]); + +my $nbd2=$zinc->add('text', $dix, + -font => $boldfont, + -text => "0 +1 +2 +3 +4 +5 +6 +7 +8 +9", + -anchor => 'nw', + -position => [$xd,$yd+210]); +#-------------------------------- +# Unites +#--------------------------------- + +my $unit = $zinc->add('group',$group1, -visible => 1); +my $xu=$xd+30; +my $yu=$y2; +my $nbu1=$zinc->add('text', $unit, + -font => $boldfont, + -text => "0 +1 +2 +3 +4 +5 +6 +7 +8 +9", + -anchor => 'nw', + -position => [$xu, $yu]); + +my $nbu2=$zinc->add('text', $unit, + -font => $boldfont, + -text => "0 +1 +2 +3 +4 +5 +6 +7 +8 +9", + -anchor => 'nw', + -position => [$xu, $yu+210]); + +#-------------------------------- +# Clip +#--------------------------------- + +$zinc->itemconfigure($clipped_group1, -clip => $clipping_item1); + + +################################################### +# Cadran clippe +################################################### + +my $clipped_group2 = $zinc->add('group',$general_group, -visible => 1); + +#-------------------------------- +# Clipping items +#--------------------------------- + +my $clipping_item2 = $zinc->add('curve', $clipped_group2, + [0,0,700,0,700,700,0,700,0,0], + -linewidth=>0, + ); + +$zinc->contour($clipping_item2,"diff",[$x2,$y2,$x3,$y2,$x3,$y3,$x2,$y3,$x2,$y2]); + +#-------------------------------- +# Clipped items +#--------------------------------- + +my $group2=$zinc->add('group',$clipped_group2); + +my $cercle=$zinc->add('arc',$group2,[$x0,$y0,$x1,$y1], + -visible=>1, + -filled=>1, + -fillcolor=>"yellow",); + +my $fleche=$zinc-> add('curve', $group2, [$x0+40,$y0+40,$x1-100,$y1-25], + -firstend => [10, 10, 10], + -linewidth => 7, + -linecolor=>"red", + ); + +#-------------------------------- +# Clip +#--------------------------------- + +$zinc->itemconfigure($clipped_group2, -clip => $clipping_item2); + + +################################################### +# Actions automatiques +################################################### + +#-------------------------------- +# Variables +#--------------------------------- +# Pour le timer +my $repeat=10; + +# Pour la rotation +my @centre=($x1-100,$y1-25); +my $pas=40; +my $angle=+$PI/$pas; +my $nb_tot=12; +my $nb=0; + +# Pour la translation des centaines +my @c_c1=$zinc->itemcget($nbc1,-position); +my @c_c2=$zinc->itemcget($nbc2,-position); +my $nbtour_cent=2; + +# Pour la translation des dizaines +my @c_d1=$zinc->itemcget($nbd1,-position); +my @c_d2=$zinc->itemcget($nbd2,-position); +my $nbtour_dix=2; + +# Pour la translation des unites +my @c_u1=$zinc->itemcget($nbu1,-position); +my @c_u2=$zinc->itemcget($nbu2,-position); +my $nbtour_unit=2; + + +#-------------------------------- +# Timer +#--------------------------------- +$zinc->repeat($repeat, [\&refresh]); + +#-------------------------------- +# Actions +#--------------------------------- +sub refresh { + #-------------------------------- + # Rotation de la fleche + #--------------------------------- + $zinc->rotate("$fleche",$angle,$centre[0],$centre[1]); + $nb+=1; + if (($nb==$nb_tot)&&($angle==$PI/$pas)) + { + $nb=0; + $angle=-$PI/$pas; + } + else{ + if(($nb==$nb_tot)&&($angle==-$PI/$pas)){ + $nb=0; + $angle=+$PI/$pas; + } + } + #-------------------------------- + # Deplacement du texte + #--------------------------------- + + #-------------------------------- + # Centaines + #--------------------------------- + $zinc->translate("$cent",0,-0.01); + + my @coords_c1=$zinc->transform($cent,$group1,[$c_c1[0],$c_c1[1]]); + if(int($coords_c1[1])==$yc-210){ + $zinc->itemconfigure($nbc1,-position=>[$xc,$yc+($nbtour_cent*210)]); + $nbtour_cent+=1; + @c_c1=$zinc->itemcget($nbc1,-position); + } + + my @coords_c2=$zinc->transform($cent,$group1,[$c_c2[0],$c_c2[1]]); + if($coords_c2[1]==$yc-210){ + $zinc->itemconfigure($nbc2,-position=>[$xc,$yc+($nbtour_cent*210)]); + $nbtour_cent+=1; + @c_c2=$zinc->itemcget($nbc2,-position); + } + + #-------------------------------- + #Dixaines + #--------------------------------- + $zinc->translate("$dix",0,-0.1); + + my @coords_d1=$zinc->transform($dix,$group1,[$c_d1[0],$c_d1[1]]); + if(int($coords_d1[1])==$yd-210){ + $zinc->itemconfigure($nbd1,-position=>[$xd,$yd+($nbtour_dix*210)]); + $nbtour_dix+=1; + @c_d1=$zinc->itemcget($nbd1,-position); + } + + my @coords_d2=$zinc->transform($dix,$group1,[$c_d2[0],$c_d2[1]]); + if($coords_d2[1]==$yd-210){ + $zinc->itemconfigure($nbd2,-position=>[$xd,$yd+($nbtour_dix*210)]); + $nbtour_dix+=1; + @c_d2=$zinc->itemcget($nbd2,-position); + } + + + #-------------------------------- + # Unites + #--------------------------------- + $zinc->translate("$unit",0,-1); + + my @coords_u1=$zinc->transform($unit,$group1,[$c_u1[0],$c_u1[1]]); + if($coords_u1[1]==$yu-210){ + $zinc->itemconfigure($nbu1,-position=>[$xu,$yu+($nbtour_unit*210)]); + $nbtour_unit+=1; + @c_u1=$zinc->itemcget($nbu1,-position); + } + + my @coords_u2=$zinc->transform($unit,$group1,[$c_u2[0],$c_u2[1]]); + if($coords_u2[1]==$yu-210){ + $zinc->itemconfigure($nbu2,-position=>[$xu,$yu+($nbtour_unit*210)]); + $nbtour_unit+=1; + @c_u2=$zinc->itemcget($nbu2,-position); + } + +} + +################################################### +# Actions manuelles +################################################### + +#--------------------------------------------- +# Drag and drop the counter +#--------------------------------------------- + +$zinc -> bind("$cercle",''=>[sub{ + move_on($_[1],$_[2]); #"move_on" state + },Ev('x'),Ev('y')]); + +#"move_on" state# +sub move_on{ + my ($xi,$yi)=@_; + $zinc -> bind("$cercle",''=>""); + $zinc -> bind("$cercle",''=> + [sub{move($xi,$yi,$_[1],$_[2]); #move the counter + $xi=$_[1]; + $yi=$_[2]; + },Ev('x'),Ev('y')]); + $zinc -> bind("$cercle",''=>sub{ + move_off();}); #"move_off" state +} + + +#"move_off" state# +sub move_off{ + $zinc -> bind("$cercle",''=>[sub{ + move_on($_[1],$_[2]); #"move_on" state + },Ev('x'),Ev('y')]); + $zinc -> bind("$cercle",''=>""); + $zinc -> bind("$cercle",''=>""); +} + +#move the counter# +sub move{ + my ($xi,$yi,$x,$y)=@_; + $zinc->translate("$clipped_group1",$x-$xi,$y-$yi); + $zinc->translate("$clipped_group2",$x-$xi,$y-$yi); +} + +MainLoop; diff --git a/Perl/demos/Tk/demos/zinc_lib/demo.pl b/Perl/demos/Tk/demos/zinc_lib/demo.pl new file mode 100644 index 0000000..40ea0da --- /dev/null +++ b/Perl/demos/Tk/demos/zinc_lib/demo.pl @@ -0,0 +1,144 @@ +#!/usr/bin/perl +# $Id$ +# This software is under CENA Copyright. +# However, the copyright has been retained under GPL licence +# This demo launcher has been initially developped by Daniel Etienne +# and modified by Christophe Mertz +# Feel free to contribute and please read our call to help below : "We need You!" + +BEGIN { + unshift(@INC, "/usr/share/doc/zinc-perl/examples/"); +} + +use strict; +use Tk; +use SeeCode; + +my @examples = + ( + "Examples of items" => "items.pl", + "All Options and their types of all items" => "all_options.pl", + "Examples of line style and line termination" => "lines.pl", + "Groups and Priorities" => "groups_priority.pl", + "Interactions on graphical objects" => "", + "Simple Interactions on a track item" => "simple_interaction_track.pl", + "Maps, uses and creations" => "", + "Transformations examples" => "", + "Clipping examples (with simple or multiple contours)" => "clipping.pl", + "Curves with mutliple contours examples" => "contours.pl", + "A simple graphical button based on pixmaps" => "", + "A simple graphical button based on openGL (needs openGL)" => "", + "A Zinc Goodie: \"ZincDebug.pm\"" => "", + "Axial color variation on the X axis (needs openGL)" => "color-x.pl", + "Axial color variation on the Y axis (needs openGL)" => "color-y.pl", + "Circular color variation (needs openGL)" => "color-circular.pl", + "The triangles item (needs openGL)" => "triangles.pl", + "A simple animated application \"the Wheel of Fortune\". It is\n". + "An example of the use of groups, clipping and transformations" => "wheelOfFortune.pl", + "A simple radar display" => "simpleradar.pl", + ); + +my $defaultfont = '-adobe-helvetica-bold-r-normal-*-120-*-*-*-*-*-*'; +my $mw = MainWindow->new(); +$mw->title("Zinc Demonstrations"); +my $frame1 = $mw->Frame(-width => 520, -height => 400,-borderwidth => 3, + -relief => 'sunken')->pack(-padx => 5, -pady => 5, + -ipadx => 10, -ipady => 10); + +my $demoCounter=1; +for (my $i = 0; $i < @examples-1; $i += 2) { + my $demoTitle = $examples[$i]; + if ($examples[$i+1] ne "") { + $demoTitle = $demoCounter . ". " . $demoTitle; + $demoCounter++; + } + else { + $demoTitle = "x. " . $demoTitle; + } + + my $lb = + $frame1->Label(-text => $demoTitle, + -width => 55, + -anchor => 'w', + -justify => 'left', + )->grid(-column => 1, -row => ($i+1)/2, -pady => 10); + if ($examples[$i+1] ne "") { + my $cmd = Tk::findINC($examples[$i+1]); + $frame1->Button(-text => "Run", + -command => sub { + $lb->configure(-foreground => 'gray40'); + system("/usr/bin/perl $cmd &"); + }, + )->grid(-column => 2, -row => ($i+1)/2); + } + else { + $frame1->Button(-text => "ToBeDone", + -state => "disable", + )->grid(-column => 2, -row => ($i+1)/2); + } +} + +my $frame2 = $mw->Frame()->pack(-expand => 1, -side => 'bottom', -fill => 'both', + -ipady => 5); + + +$frame2->Button(-text => 'We need You!', + -width => 8, -height => 1, + -command => \&we_need_you, + )->pack(-side => 'top', -expand => 1); + +$frame2->Button(-text => 'Quit', + -width => 8, -height => 1, + -command => sub {exit;}, + )->pack(-side => 'top', -expand => 1); + +sub we_need_you { + my $WNY = MainWindow->new(); # WNY means We Need You! + $WNY->title("We need You!"); + # Create a top-level window that displays a call for help! + + my $t = $WNY->Scrolled(qw/Text -relief sunken -borderwidth 2 -setgrid true + -height 30 -scrollbars e/); + $t->pack(qw/-expand yes -fill both/); + + $t->insert('0.0', +'The TkZinc widget has been developped by the CENA for its own +need of prototyping environment. It is now heavily used by more +than a dozen living projects involving advanced HMI. As we +are convinced in the interest of Freee Software, Zinc is free +Software under LGPL. +Zinc is available at http://www.openatc.org/zinc or +http://freshmeat.net/projects/zincisnotcanvas/ + +People in charge of Zinc at CENA are good in producing good code. +They are not so good in producing extensive documentation and +examples. + +This simple demo is a first try to demontrate the hidden power +behind Zinc. + +If you feel happy with Zinc, feel free to contribute too! +One simple way is by producing simple samples like these +available in demo.pl + +Please send us your production at pii-contact@cena.fr and +we will add it in the next release of Zinc. + + The CENA community of Zinc developpers and users. +'); + + $t->mark(qw/set insert 0.0/); + my $frame = $WNY->Frame()->pack(-expand => 1, -side => 'bottom', -fill => 'both', + -ipady => 5); + $frame->Button(-text => 'Quit', + -width => 8, -height => 1, + -command => sub {$WNY->destroy;}, + )->pack(-side => 'top', -expand => 1); + + +} # end we_need_you + + +MainLoop; + + diff --git a/Perl/demos/Tk/demos/zinc_lib/groups_priority.pl b/Perl/demos/Tk/demos/zinc_lib/groups_priority.pl new file mode 100644 index 0000000..e6e78f1 --- /dev/null +++ b/Perl/demos/Tk/demos/zinc_lib/groups_priority.pl @@ -0,0 +1,253 @@ +#!/usr/bin/perl -w +# $Id$ +# This simple demo has been developped by C. Mertz + +use Tk; +use Tk::Zinc; + +use strict; + +my $mw = MainWindow->new(); + +# The explanation displayed when running this demo +my $text = $mw->Scrolled(qw/Text -relief sunken -borderwidth 2 -setgrid true + -height 12 -scrollbars e/); +$text->pack(qw/-expand yes -fill both/); + +$text->insert('0.0', +'There are two groups (a red one and a green one) each containing + 4 rectangles. Those rectangles display their current priority. +The following operations are possible: + "Mouse Button 1" for dragging objects. + "Mouse Button 2" for dragging a colored group. + "Key +" on a rectangle to raise it inside its group. + "Key -" on a rectangle to lower it inside its group. + "Key l" on a rectangle to lower its colored group. + "Key r" on a rectangle to raise its colored group. + "Key t" on a rectangle to change its group (but not its color!). + "Key [0-9] on a rectangle to set the priority to [0-9] +Raising or lowering an item inside a group modify its priority if necessary'); + +# Creating the zinc widget +my $zinc = $mw->Zinc(-width => 600, -height => 500, + -font => "10x20", # usually fonts are sets in resources + # but for this example it is set in the code! + -borderwidth => 3, -relief => 'sunken', + )->pack; + +#########################################################################" +# Creating the redish group +my $group1 = $zinc->add('group', 1, -visible => 1); + +my $counter=0; +# Adding 4 rectangles with text to redish group +foreach my $data ( [200,100, 'red'], [210,210,'red1'], + [390,110,'red2'], [395,215,'red3'] ) { + $counter += 2; + my ($centerx,$centery,$color) = @{$data}; + # this small group is for merging together : + # the rectangle and the text showing its name + my $g = $zinc->add('group', $group1, + -visible => 1, + -atomic => 1, + -sensitive => 1, + -priority => $counter, + ); + my $rec = $zinc->add('rectangle', $g, [$centerx-100,$centery-60, + $centerx+100, $centery+60], + -fillcolor => $color, -filled => 1, + ); + my $txt = $zinc->add('text', $g, + -position => [$centerx,$centery], + -text => "pri=$counter", + -anchor => 'center', + ); + # Some bindings for dragging the rectangle or the full group + $zinc->bind($g, '' => [\&press, $g, \&motion]); + $zinc->bind($g, '' => \&release); + $zinc->bind($g, '' => [\&press, $g, \&groupMotion]); + $zinc->bind($g, '' => \&release); +} + +#########################################################################" +# Creating the greenish group +my $group2 = $zinc->add('group', 1, -visible => 1); +$counter=0; + +# Adding 4 rectangles with text to greenish group +foreach my $data ( [200,300,'green1'], [210,410,'green2'], + [390,310,'green3'], [395,415,'green4'] ) { + $counter++; + my ($centerx,$centery,$color) = @{$data}; + # this small group is for merging together a rectangle + # and the text showing its priority + my $g = $zinc->add('group', $group2, + -atomic => 1, + -sensitive => 1, + -priority => $counter, + ); + my $rec = $zinc->add('rectangle', $g, [$centerx-100,$centery-60, + $centerx+100, $centery+60], + -fillcolor => $color, -filled => 1, + ); + my $txt = $zinc->add('text', $g, + -position => [$centerx,$centery], + -text => "pri=$counter", + -anchor => 'center', + ); + # Some bindings for dragging the rectangle or the full group + $zinc->bind($g, '' => [\&press, $g, \&motion]); + $zinc->bind($g, '' => \&release); + $zinc->bind($g, '' => [\&press, $g, \&groupMotion]); + $zinc->bind($g, '' => \&release); +} + + +#########################################################################" +# adding the key bindings + +# the focus on the widget is ABSOLUTELY necessary for key bindings! +$zinc->Tk::focus(); + +$zinc->Tk::bind('' => \&raiseGroup); +$zinc->Tk::bind('' => \&lowerGroup); +$zinc->Tk::bind('' => \&raise); +$zinc->Tk::bind('' => \&raise); +$zinc->Tk::bind('' => \&lower); +$zinc->Tk::bind('' => \&lower); +$zinc->Tk::bind('' => \&toggleItemGroup); + +for my $i (0..9) { + $zinc->Tk::bind("" => [\&setPriorrity, $i]); + $zinc->Tk::bind("" => [\&setPriorrity, $i]); +} + +# The following binding is currently not possible; only text items +# with focus can get a KeyPress or KeyRelease event +# $zinc->bind($g, '' => [\&raise, $g]); + +#########################################################################" +# Definition of all callbacks + +sub updateLabel { + my ($group) = @_; + my $priority = $zinc->itemcget($group, -priority); + # we get the text item from this group: + my $textitem = $zinc->find('withtype', 'text', $group); + $zinc->itemconfigure($textitem, -text => "pri=$priority"); +} + +sub setPriorrity { + my ($zinc, $priority) = @_; + my $item = $zinc->find('withtag', 'current'); + return unless $item; + $zinc->itemconfigure ($item, -priority => $priority); + &updateLabel($item); +} + + +# Callback to lower a small group of a rectangle and a text +sub lower { + my ($zinc) = @_; + # to get the item under the cursor! + my $item = $zinc->find('withtag', 'current'); + return unless $item; + $zinc->lower($item); + &updateLabel($item); +} + +# Callback to raise a small group of a rectangle and a text +sub raise { + my ($zinc) = @_; + # to get the item under the cursor! + my $item = $zinc->find('withtag', 'current'); + return unless $item; + $zinc->raise($item); + &updateLabel($item); +} + +# Callback to raise the group of groups of a rectangle and a text +sub lowerGroup { + my ($zinc) = @_; + # to get the item under the cursor! + my $item = $zinc->find('withtag', 'current'); + return unless $item; + my $coloredGroup = $zinc->group($item); + $zinc->lower($coloredGroup); +} + +# Callback to raise the group of groups of a rectangle and a text +sub raiseGroup { + my ($zinc) = @_; + # to get the item under the cursor! + my $item = $zinc->find('withtag', 'current'); + return unless $item; + my $coloredGroup = $zinc->group($item); + $zinc->raise($coloredGroup); + &updateLabel($item); +} + +# Callback to change the group of groups of a rectangle and a text +sub toggleItemGroup { + my ($zinc) = @_; + # to get the item under the cursor! + my $item = $zinc->find('withtag', 'current'); + return unless $item; + my $newgroup; + if ($group1 == $zinc->group($item)) { + $newgroup = $group2; + } + else { + $newgroup = $group1; + } + + $zinc->chggroup($item,$newgroup); + &updateLabel($item); +} + +# callback for starting a drag +my ($x_orig, $y_orig); +sub press { + my ($zinc, $group, $action) = @_; + my $ev = $zinc->XEvent(); + $x_orig = $ev->x; + $y_orig = $ev->y; + $zinc->Tk::bind('', [$action, $group]); +} + +# Callback for moving a small group of a rectangle and a text +sub motion { + my ($zinc, $group) = @_; + my $ev = $zinc->XEvent(); + my $x = $ev->x; + my $y = $ev->y; + + $zinc->translate($group, $x-$x_orig, $y-$y_orig); + $x_orig = $x; + $y_orig = $y; +} + +# Callback for moving a group of groups of a rectangle and a text +sub groupMotion { + my ($zinc, $group) = @_; + my $ev = $zinc->XEvent(); + my $x = $ev->x; + my $y = $ev->y; + + my $coloredGroup = $zinc->group($group); + $zinc->translate($coloredGroup, $x-$x_orig, $y-$y_orig); + $x_orig = $x; + $y_orig = $y; +} + +# Callback when releasing the mouse button. It removes any motion callback +sub release { + my ($zinc) = @_; + $zinc->Tk::bind('', ''); +} + + +MainLoop(); + + +1; diff --git a/Perl/demos/Tk/demos/zinc_lib/items.pl b/Perl/demos/Tk/demos/zinc_lib/items.pl new file mode 100644 index 0000000..5ae9774 --- /dev/null +++ b/Perl/demos/Tk/demos/zinc_lib/items.pl @@ -0,0 +1,182 @@ +#!/usr/bin/perl +# $Id$ +# these simple samples have been developped by C. Mertz mertz@cena.fr + +use Tk; +use Tk::Zinc; +use strict; + +my $defaultfont = '-adobe-helvetica-bold-r-normal-*-120-*-*-*-*-*-*'; +my $mw = MainWindow->new(); +my $zinc = $mw->Zinc(-width => 700, -height => 600, + -font => "10x20", # usually fonts are sets in resources + # but for this example it is set in the code! + -borderwidth => 3, -relief => 'sunken', +# -backcolor => "white", +# -render => 1, + )->pack; + +$zinc->add('rectangle', 1, [10,10, 100, 50], -fillcolor => "green", -filled => 1, + -linewidth => 3); + + +$zinc->add('text', 1, + -font => $defaultfont, + -text => "A filled rectangle with a border of 3 pixels.", + -anchor => 'nw', + -position => [120, 20]); + + +my $labelformat = "x82x60+0+0 x60a0^0^0 x32a0^0>1 a0a0>2>1 x32a0>3>1 a0a0^0>2"; + +my $x=20; +my $y=120; +my $track=$zinc->add('track', 1, 6, # 6 is the number of field in the flightlabel + -labelformat => $labelformat, + -position => [$x, $y], + -speedvector => [40, -10], + -speedvectormark => 1, # currently works only with openGL + -speedvectorticks => 1, # currently works only with openGL + ); +# moving the track, to display past positions +foreach my $i (0..5) { $zinc->coords("$track",[$x+$i*10,$y-$i*2]); } + +$zinc->add('text', 1, + -font => $defaultfont, + -text => "A flight track for a radar display.\n". + "(A waypoint is very similar, but has no speed neither past positions)", + -anchor => 'nw', + -position => [120, 120], + ); + +$zinc->itemconfigure($track, 0, + -filled => 0, + -bordercolor => 'DarkGreen', + -border => "contour", + ); +$zinc->itemconfigure($track, 1, + -filled => 1, + -backcolor => 'gray60', + -text => "AFR001"); +$zinc->itemconfigure($track, 2, + -filled => 0, + -backcolor => 'gray65', + -text => "360"); +$zinc->itemconfigure($track, 3, + -filled => 0, + -backcolor => 'gray65', + -text => "/"); +$zinc->itemconfigure($track, 4, + -filled => 0, + -backcolor => 'gray65', + -text => "410"); +$zinc->itemconfigure($track, 5, + -filled => 0, + -backcolor => 'gray65', + -text => "Beacon"); + + + + + +$zinc->add('arc', 1, [90, 210, 390, 310], -fillcolor => "gray20", + -filled => 0, -linewidth => 1, + -startangle => 45, -extent => 270); +$zinc->add('arc', 1, [200, 220, 280, 300], -fillcolor => "gray20", + -filled => 0, -linewidth => 1, + -startangle => 45, -extent => 270, + -pieslice => 1, -closed => 1, + ); + +$zinc->add('text', 1, + -font => $defaultfont, + -text => "Two arcs, starting at 45° with an extent of 270°.", + -anchor => 'nw', + -position => [250, 250]); + +$zinc->add('curve', 1, [10, 324, 24, 300, 45, 432, 247, 356, 128, 401], + -filled => 0, + ); +$zinc->add('text', 1, + -font => $defaultfont, + -text => "An open curve.", + -anchor => 'nw', + -position => [50, 350]); + +# Bug: this bezier does not display with openGL (zinc-perl v3.2.3e) +$zinc->add('bezier', 1, [310, 324, 324, 300, 345, 432, 547, 356, 428, 401, 534, 407], + -filled => 0, + ); +$zinc->add('text', 1, + -font => $defaultfont, + -text => "An open bezier.", + -anchor => 'nw', + -position => [450, 320]); + +$zinc->add('text', 1, + -font => $defaultfont, + -text => "A waypoint", + -anchor => 'nw', + -position => [10, 480], + ); +my $waypoint = $zinc->add('waypoint', 1, 6, -position => [100,520], + -labelformat => $labelformat, + -symbol => "AtcSymbol2", + -labeldistance => 30); + +foreach my $fieldId (1..5) { + $zinc->itemconfigure($waypoint, $fieldId, + -filled => 0, + -bordercolor => 'DarkGreen', + -border => "contour", # does not work with openGL (zinc-perl v3.2.3e) + -text => "field$fieldId", + ); +} + +my $waypoint = $zinc->add('waypoint', 1, 6, -position => [100,520], + -labelformat => $labelformat, + -symbol => "AtcSymbol2", + -labeldistance => 30); + + +$zinc->add('text', 1, + -font => $defaultfont, + -text => "3 tabulars of 2 fields,\nattached together", + -anchor => 'nw', + -position => [310, 480], + ); + +#my $labelformat2 = "80x24 a7a1+0+0 f3f1+0+10"; +my $labelformat2 = "x72x40 x72a0^0^0 x34a0^0>1"; + +my $tabular1 = $zinc->add('tabular', 1, 6, -position => [490,420], + -labelformat => $labelformat2, + ); +my $tabular2 = $zinc->add('tabular', 1, 6, -connecteditem => $tabular1, + -labelformat => $labelformat2, + ); +my $tabular3 = $zinc->add('tabular', 1, 6, -connecteditem => $tabular2, + -labelformat => $labelformat2, + ); +my $count=1; +foreach my $tab ($tabular1, $tabular2, $tabular3) { + $zinc->itemconfigure($tab, 1, -filled => 0, + -bordercolor => 'DarkGreen', + -border => "contour", -text => "tabular", + ); + $zinc->itemconfigure($tab, 2, -filled => 0, + -bordercolor => 'DarkGreen', + -border => "contour", -text => "n°$count", + ); + $count++; +} + +$zinc->add('text', 1, + -font => $defaultfont, + -text => "Items not yet demonstrated are map, reticle, group...", + -anchor => 'nw', + -position => [50, 570]); + + +MainLoop; + diff --git a/Perl/demos/Tk/demos/zinc_lib/lines.pl b/Perl/demos/Tk/demos/zinc_lib/lines.pl new file mode 100644 index 0000000..26d52c6 --- /dev/null +++ b/Perl/demos/Tk/demos/zinc_lib/lines.pl @@ -0,0 +1,93 @@ +#!/usr/bin/perl +# $Id$ +# these simple samples have been developped by C. Mertz mertz@cena.fr + +use Tk; +use Tk::Zinc; +use strict; + +my $defaultfont = '-adobe-helvetica-bold-r-normal-*-120-*-*-*-*-*-*'; +my $mw = MainWindow->new(); +my $zinc = $mw->Zinc(-width => 700, -height => 600, + -font => "10x20", # usually fonts are sets in resources + # but for this example it is set in the code! + -borderwidth => 3, -relief => 'sunken', + )->pack; + +$zinc->add('text', 1, + -font => $defaultfont, + -text => "A set of lines with different styles of lines and termination\n". + "NB: some attributes such as line styles are not necessarily\n". + " available with an openGL rendering system" , + -anchor => 'nw', + -position => [20, 20]); + +$zinc-> add('curve', 1, [20, 100, 320, 100]); # default options +$zinc-> add('curve', 1, [20, 120, 320, 120], + -linewidth => 20, + ); +$zinc-> add('curve', 1, [20, 160, 320, 160], + -linewidth => 20, + -capstyle => "butt", + ); +$zinc-> add('curve', 1, [20, 200, 320, 200], + -linewidth => 20, + -capstyle => "projecting", + ); +$zinc-> add('curve', 1, [20, 240, 320, 240], + -linewidth => 20, + -linepattern => "AlphaStipple7", + -linecolor => "red", + ); + +# right column +$zinc-> add('curve', 1, [340, 100, 680, 100], + -firstend => [10, 10, 10], + -lastend => [10, 25, 45], + ); +$zinc-> add('curve', 1, [340, 140, 680, 140], + -linewidth => 2, + -linestyle => 'dashed', + ); +$zinc-> add('curve', 1, [340, 180, 680, 180], + -linewidth => 4, + -linestyle => 'mixed', + ); +$zinc-> add('curve', 1, [340, 220, 680, 220], + -linewidth => 2, + -linestyle => 'dotted', + ); + +$zinc->add('curve', 1, [20, 300, 140, 360, 320, 300, 180, 260], + -closed => 1, + -filled => 1, + -fillpattern => "Tk", + -fillcolor => "grey60", + -linecolor => "red", + -marker => "AtcSymbol7", + -markercolor => "blue", + + ); + + +$zinc->add('curve', 1, [340, 300, 440, 360, 620, 300, 480, 260], + -closed => 1, + -linewidth => 10, + -joinstyle => "miter", #"round", # "bevel" | "miter" + -linecolor => "red", + ); +$zinc->add('curve', 1, [400, 300, 440, 330, 560, 300, 480, 280], + -closed => 1, + -linewidth => 10, + -joinstyle => "round", # "bevel" | "miter" + -tile => Tk::findINC("Xcamel.gif"), + -fillcolor => "grey60", + -filled => 1, + -linecolor => "red", + ); + +# -tile => Tk::findINC("Xcamel.gif"), + +MainLoop; + + diff --git a/Perl/demos/Tk/demos/zinc_lib/mapinfo.pl b/Perl/demos/Tk/demos/zinc_lib/mapinfo.pl new file mode 100644 index 0000000..ec9202c --- /dev/null +++ b/Perl/demos/Tk/demos/zinc_lib/mapinfo.pl @@ -0,0 +1,127 @@ +#!/usr/bin/perl +# $Id$ +# This simple demo has been developped by C. Schlienger + +use Tk; +use Tk::Zinc; +use strict; + + +my $defaultfont = '-adobe-helvetica-bold-r-normal-*-120-*-*-*-*-*-*'; +my $mw = MainWindow->new(); + +########################################### +# Text zone +########################################### + +my $text = $mw->Scrolled(qw/Text -relief sunken -borderwidth 2 -setgrid true + -height 4 -scrollbars e/); +$text->pack(qw/-expand yes -fill both/); + +$text->insert('0.0', + 'This toy-appli shows zoom actions on map item. +The following operations are possible: + Click "-" to zoom out + Click "+" to zoom in ' ); + +########################################### +# Zinc +########################################### +my $zinc_width=600; +my $zinc_height=500; +my $zinc = $mw->Zinc(-width => $zinc_width, -height => $zinc_height, + -font => "10x20", + -borderwidth => 3, -relief => 'sunken', + )->pack; + +########################################### +# Waypoints and sector +########################################### + +my $mapinfo=$mw->mapinfo("mapinfo","create"); #creation of mapinfo + +#-------------------------------- +# Waypoints +#-------------------------------- +$mw->mapinfo("mapinfo","add","symbol",200,100,0); +$mw->mapinfo("mapinfo","add","symbol",300,150,0); +$mw->mapinfo("mapinfo","add","symbol",400,50,0); +$mw->mapinfo("mapinfo","add","symbol",350,450,0); +$mw->mapinfo("mapinfo","add","symbol",300,250,0); +$mw->mapinfo("mapinfo","add","symbol",170,240,0); +$mw->mapinfo("mapinfo","add","symbol",550,200,0); + +#-------------------------------- +# Waypoints names +#-------------------------------- +$mw->mapinfo("mapinfo","add","text","normal","simple",170,100,"DO"); +$mw->mapinfo("mapinfo","add","text","normal","simple",270,160,"RE"); +$mw->mapinfo("mapinfo","add","text","normal","simple",410,50,"MI"); +$mw->mapinfo("mapinfo","add","text","normal","simple",345,470,"FA"); +$mw->mapinfo("mapinfo","add","text","normal","simple",280,265,"SOL"); +$mw->mapinfo("mapinfo","add","text","normal","simple",150,240,"LA"); +$mw->mapinfo("mapinfo","add","text","normal","simple",555,200,"SI"); + +#-------------------------------- +# Routes +#-------------------------------- + +$mw->mapinfo("mapinfo","add","line","simple",1,200,100,300,150); +$mw->mapinfo("mapinfo","add","line","simple",1,300,150,400,50); +$mw->mapinfo("mapinfo","add","line","simple",1,300,150,350,450); +$mw->mapinfo("mapinfo","add","line","simple",1,300,250,170,240); +$mw->mapinfo("mapinfo","add","line","simple",1,300,250,550,200); + +#-------------------------------- +# Sectors +#--------------------------------- +$mw->mapinfo("mapinfo","add","line","simple",1,300,0,400,50); +$mw->mapinfo("mapinfo","add","line","simple",1,400,50,500,100); +$mw->mapinfo("mapinfo","add","line","simple",1,500,100,550,200); +$mw->mapinfo("mapinfo","add","line","simple",1,550,200,550,400); +$mw->mapinfo("mapinfo","add","line","simple",1,550,400,350,450); +$mw->mapinfo("mapinfo","add","line","simple",1,350,450,170,240); +$mw->mapinfo("mapinfo","add","line","simple",1,170,240,200,100); +$mw->mapinfo("mapinfo","add","line","simple",1,200,100,300,0); + +#-------------------------------- +# Sectors +#--------------------------------- +my $gpe = $zinc ->add('group',1); +my $map = $zinc ->add('map',$gpe,#creation of the map object which has 'mapinfo' information + -mapinfo=>"mapinfo", + -symbols=>['AtcSymbol15']); + + +################################################### +# control panel +################################################### +my $rc = $mw->Frame()->pack(); + +#the reference of the scale function is top-left corner of the zinc object +#so we first translate the group to zoom in order to put its center on top-left corner +#change the scale of the group +#translate the group to put it back at the center of the zinc object + +my $minus=$rc->Button(-width => 2, + -height => 2, + -text => '-', + -command=>sub{ + $zinc->translate($gpe,-$zinc_width/2,-$zinc_height/2); + $zinc->scale($gpe,0.8,0.8); + $zinc->translate($gpe, $zinc_width/2,$zinc_height/2); + })->pack(-side=>'left'); + + +my $plus=$rc->Button(-width => 2, + -height => 2, + -text => '+', + -command=>sub{ + $zinc->translate($gpe, -$zinc_width/2,-$zinc_height/2); + $zinc->scale($gpe,1.2,1.2); + $zinc->translate($gpe,$zinc_width/2,$zinc_height/2); + })->pack(-side => 'right'); + + + +MainLoop; diff --git a/Perl/demos/Tk/demos/zinc_lib/rotation.pl b/Perl/demos/Tk/demos/zinc_lib/rotation.pl new file mode 100644 index 0000000..e8978dc --- /dev/null +++ b/Perl/demos/Tk/demos/zinc_lib/rotation.pl @@ -0,0 +1,122 @@ +#!/usr/bin/perl +# $Id$ +# This simple demo has been developped by C. Schlienger + + +use Tk; +use Tk::Zinc; +use strict; +use constant; + +my constant $PI=3.1416; + +my $defaultfont = '-adobe-helvetica-bold-r-normal-*-120-*-*-*-*-*-*'; +my $mw = MainWindow->new(); + + +########################################### +# Text zone +########################################### + +my $text = $mw->Scrolled(qw/Text -relief sunken -borderwidth 2 -setgrid true + -height 4 -scrollbars e/); +$text->pack(qw/-expand yes -fill both/); + +$text->insert('0.0', + 'This toy-appli shows rotations on waypoint items. +The following operations are possible: + Click "<-" for negative rotation + Click "->" for positive rotation' ); + + +########################################### +# Zinc +########################################### +my $zinc_width=600; +my $zinc_height=500; +my $zinc = $mw->Zinc(-width => $zinc_width, -height => $zinc_height, + -font => "10x20", + -borderwidth => 3, -relief => 'sunken', + )->pack; + +########################################### +# Waypoints +########################################### + +my $wp_group = $zinc->add('group', 1, -visible => 1); + +my $p1=[200, 200]; +my $wp1 = $zinc->add('waypoint',$wp_group, 1, + -position => $p1, + -connectioncolor => 'green', + -symbolcolor => 'blue', + -labelformat => 'x20x18+0+0', + -leaderwidth=>'0', + -labeldx=>'-20' + ); +$zinc->itemconfigure($wp1, 0, + -text => "DO", + ); + +my $p2=[300, 300]; +my $wp2 = $zinc->add('waypoint',$wp_group, 1, + -position => $p2, + -connecteditem => $wp1, + -connectioncolor => 'blue', + -symbolcolor => 'blue', + -labelformat => 'x20x18+0+0', + -leaderwidth=>'0', + -labeldx=>'-20', + #-labeldy=>'30' + ); + +$zinc->itemconfigure($wp2, 0, + -text => "RE", + ); + +my $p3=[400, 150]; +my $wp3 = $zinc->add('waypoint', $wp_group, 2, + -position => $p3, + -connecteditem => $wp2, + -connectioncolor => 'blue', + -symbolcolor => 'blue', + -labelformat => 'x20x18+0+0', + -leaderwidth=>'0', + -labeldx=>'20', + -labeldy=>'+10' + ); +$zinc->itemconfigure($wp3, 0, + -text => "MI", + ); + +################################################### +# control panel +################################################### +my $rc = $mw->Frame()->pack(); + +my $left=$rc->Button(-width => 2, + -height => 2, + -text => '<-', + -command=>sub{ + #-------------------------------- + # Negative rotation + #-------------------------------- + my @centre=$zinc->coords("$wp2"); #the center of the rotation is $wp2 + $zinc->rotate("$wp_group",-$PI/6,$centre[0],$centre[1]); + })->pack(-side => 'left'); + +my $right=$rc->Button(-width => 2, + -height => 2, + -text => '->', + -command=>sub{ + #-------------------------------- + # Positive rotation + #-------------------------------- + my @centre=$zinc->coords("$wp2");#the center of the rotation is $wp2 + $zinc->rotate("$wp_group",+$PI/6,$centre[0],$centre[1]); + })->pack(-side=>'right'); + + + + +MainLoop; diff --git a/Perl/demos/Tk/demos/zinc_lib/simple_interaction_track.pl b/Perl/demos/Tk/demos/zinc_lib/simple_interaction_track.pl new file mode 100644 index 0000000..a506151 --- /dev/null +++ b/Perl/demos/Tk/demos/zinc_lib/simple_interaction_track.pl @@ -0,0 +1,295 @@ +#!/usr/bin/perl +# $Id$ +# This simple demo has been developped by C. Schlienger + +use Tk; +use Tk::Zinc; +use strict; + +my $mw = MainWindow->new(); + + + +########################################### +# Text zone +########################################### + +my $text = $mw->Scrolled(qw/Text -relief sunken -borderwidth 2 -setgrid true + -height 6 -scrollbars e/); +$text->pack(qw/-expand yes -fill both/); + +$text->insert('0.0', + 'This toy-appli shows some interactions on different parts of a flight track item. +The following operations are possible: + Drag Button 1 on the track to move it. + Please Note the position history (past positions) + Enter/Leave flight label fields + Enter/Leave the speedvector, symbol (i.e. current position), label leader' ); + + +########################################### +# Zinc +########################################### +my $zinc_width=600; +my $zinc_height=500; +my $zinc = $mw->Zinc(-width => $zinc_width, -height => $zinc_height, + -font => "10x20", + -borderwidth => 3, -relief => 'sunken', + )->pack; + +########################################### +# Track +########################################### + +#the label format (6 formats for 6 fields)# +my $labelformat = "x80x60+0+0 x60a0^0^0 x30a0^0>1 a0a0>2>1 x30a0>3>1 a0a0^0>2"; + +#the track# +my $x=250; +my $y=200; +my $track=$zinc->add('track', 1, 6, # 6 is the number of field in the flightlabel + -labelformat => $labelformat, + -position => [$x, $y],#position of the marker + -speedvector => [30, -15],#ccords of the speed vector + -markersize => 10, + ); +# moving the track, to display past positions +foreach my $i (0..5) { $zinc->coords("$track",[$x+$i*10,$y-$i*5]); } + +#fields of the label# +$zinc->itemconfigure($track, 0,#configuration of field 0 of the label + -filled => 0, + -bordercolor => 'DarkGreen', + -border => "contour", + ); +$zinc->itemconfigure($track, 1, + -filled => 1, + -backcolor => 'gray60', + -text => "AFR6128"); +$zinc->itemconfigure($track, 2, + -filled => 0, + -backcolor => 'gray65', + -text => "390"); +$zinc->itemconfigure($track, 3, + -filled => 0, + -backcolor => 'gray65', + -text => "/"); +$zinc->itemconfigure($track, 4, + -filled => 0, + -backcolor => 'gray65', + -text => "350"); +$zinc->itemconfigure($track, 5, + -filled => 0, + -backcolor => 'gray65', + -text => "TUR"); + + + +########################################### +# Events on the track +########################################### +#--------------------------------------------- +# Enter/Leave a field of the label of the track +#--------------------------------------------- + +foreach my $field (0..5) { + #Entering the field $field higlights it# + $zinc->bind("$track:$field", + '', + sub { + if ($field==0){ + higlight_label_on(); + print "CP=", $zinc->currentpart, "\n"; + } + else{ + highlight_fields_on($field); + print "CP=", $zinc->currentpart, "\n"; + } + + }); + #Leaving the field cancels the highlight of $field# + $zinc->bind("$track:$field", + '', + sub { + if($field==0){ + higlight_label_off(); + } + else{ + if ($field==1){ + highlight_field1_off(); + } + else{ + highlight_other_fields_off($field); + } + } + }); +} + +#fonction# +sub higlight_label_on{ + $zinc->itemconfigure('current', 0, + -filled => 0, + -bordercolor => 'red', + -border => "contour", + ); + +} +sub higlight_label_off{ + $zinc->itemconfigure('current', 0, + -filled => 0, + -bordercolor => 'DarkGreen', + -border => "contour", + ); + + +} + +sub highlight_fields_on{ + my $field=$_[0]; + $zinc->itemconfigure('current', $field, + -border => 'contour', + -filled => 1, + -color => 'white' + ); + +} +sub highlight_field1_off{ + $zinc->itemconfigure('current', 1, + -border => '', + -filled => 1, + -color => 'black', + -backcolor => 'gray60' + ); + +} + +sub highlight_other_fields_off{ + my $field=$_[0]; + $zinc->itemconfigure('current', $field, + -border => '', + -filled => 0, + -color => 'black', + -backcolor => 'gray65' + ); +} +#--------------------------------------------- +# Enter/Leave other parts of the track +#--------------------------------------------- +$zinc->bind("$track:position", + '', + sub { $zinc->itemconfigure("$track", + -symbolcolor=>"red", + ); + print "CP=", $zinc->currentpart, "\n"; + }); +$zinc->bind("$track:position", + '', + sub { $zinc->itemconfigure("$track", + -symbolcolor=>"black", + ); + }); + +$zinc->bind("$track:speedvector", + '', + sub { $zinc->itemconfigure("$track", + -speedvectorcolor=>"red", + ); + }); +$zinc->bind("$track:speedvector", + '', + sub { $zinc->itemconfigure("$track", + -speedvectorcolor=>"black", + ); + }); + +$zinc->bind("$track:leader", + '', + sub { $zinc->itemconfigure("$track", + -leadercolor=>"red", + ); + }); + +$zinc->bind("$track:leader", + '', + sub { $zinc->itemconfigure("$track", + -leadercolor=>"black", + ); + }); + +# $zinc->bind("$track:marker", +# '', +# sub { $zinc->itemconfigure("$track", +# -markercolor=>"red", +# ); +# }); +# +# $zinc->bind("$track:marker", +# '', +# sub { $zinc->itemconfigure("$track", +# -markercolor=>"black", +# ); +# }); + +#--------------------------------------------- +# Drag and drop the track +#--------------------------------------------- +#Binding to ButtonPress event -> "move_on" state# +$zinc -> bind("$track",''=>[sub{ + select_color_on(); #change the color + move_on($_[1],$_[2]); #"move_on" state + },Ev('x'),Ev('y')]); + + +#"move_on" state# +sub move_on{ + my ($xi,$yi)=@_; + #ButtonPress event not allowed on track + $zinc -> bind("$track",''=>""); + #Binding to Motion event -> move the track# + $zinc -> bind("$track",''=> + [sub{move($xi,$yi,$_[1],$_[2]); #move the track + $xi=$_[1]; + $yi=$_[2]; + },Ev('x'),Ev('y')]); + #Binding to ButtonRelease event -> "move_off" state# + $zinc -> bind("$track",''=>sub{select_color_off(); #change the color + move_off();}); #"move_off" state +} + +#"move_off" state# +sub move_off{ + #Binding to ButtonPress event -> "move_on" state# + $zinc -> bind("$track",''=>[sub{ + select_color_on(); #change the color + move_on($_[1],$_[2]); #"move_on" state + },Ev('x'),Ev('y')]); + + #Motion event not allowed on track + $zinc -> bind("$track",''=>""); + #ButtonRelease event not allowed on track + $zinc -> bind("$track",''=>""); +} + +#move the track# +sub move{ + my ($xi,$yi,$x,$y)=@_; + select_color_on(); + my @coords=$zinc->coords("$track"); + $zinc->coords("$track",[$coords[0]+$x-$xi,$coords[1]+$y-$yi]); +} + + +sub select_color_on{ +$zinc->itemconfigure("$track", + -speedvectorcolor=>"white", + -markercolor=>"white", + -leadercolor=>"white" ); +} + +sub select_color_off{ + $zinc->itemconfigure("$track", + -speedvectorcolor=>"black", + -markercolor=>"black", + -leadercolor=>"black" ); + } +MainLoop; diff --git a/Perl/demos/Tk/demos/zinc_lib/simpleradar.pl b/Perl/demos/Tk/demos/zinc_lib/simpleradar.pl new file mode 100644 index 0000000..adc3a69 --- /dev/null +++ b/Perl/demos/Tk/demos/zinc_lib/simpleradar.pl @@ -0,0 +1,707 @@ +#!/usr/bin/perl -w +# $Id$ +# This simple radar has been initially developped by P. Lecoanet +# It has been adapted by C. Mertz for demo purpose. + +use Tk; +use Tk::Zinc; + +use strict; +# to find the SimpleRadarControls module. Should be included in this source file! +use lib Tk->findINC('demos/zinc_lib'); +use SimpleRadarControls; + +# to find some maps needed by these demo +my $map_path = Tk->findINC('demos/zinc_data'); + +my $mw = MainWindow->new(); + +my $text = $mw->Scrolled(qw/Text -relief sunken -borderwidth 2 -setgrid true + -height 10 -scrollbars e/); +$text->pack(qw/-expand yes -fill both/); + +$text->insert('0.0', + 'This a very simple radar display, where you can see flight tracks, a so-called ministrip (green) and and extend flight label (tan background). + The following operations are possible: + Shift-Button 1 for using a squarre lasso (result in the terminal). + Click Button 2 for identifiying the closest item (result in the terminal). + Button 3 for dragging most items, but not the ministrip (not in the same group). + Shift-Button 3 for zooming independently on X and Y axis. + Ctrl-Button 3 for rotationg graphic objects. + Enter/Leave in flight label fields, speed vector, position and leader, and in the ministrip fields. + Click Button 1 on flight track to display a route.'); + + + +################################################### +# creation zinc +################################################### +my $top = 1; +my $scale = 1.0; +my $center_x = 0.0; +my $center_y = 0.0; +my $zinc_width = 800; +my $zinc_height = 500; +my $delay = 2000; +my $rate = 0.3; +my %tracks = (); + +my $pause = 0; # if true the flight are no more moving +my $zinc = $mw->Zinc(-backcolor => 'gray65', + -relief => 'sunken', + -font => "10x20"); +$zinc->pack(-expand => 1, -fill => 'both'); +$zinc->configure(-width => $zinc_width, -height => $zinc_height); +#$radar = $top; +my $radar = $zinc->add('group', $top, -tags => ['controls', 'radar']); +$zinc->configure(-overlapmanager => $radar); + + +################################################### +# creation panneau controle +################################################### +my $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 => 'Pause', + -command => sub { $pause = ! $pause; + })->grid(-row => 0, + -column => 6); + +################################################### +# Code de reconfiguration lors d'un +# redimensionnement. +################################################### +$zinc->Tk::bind('', [\&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); +} + +sub update_transform { + my ($zinc) = @_; + $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); +} + + +################################################### +# Creation de pistes. +################################################### +my $one_of_track_item; +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); + $one_of_track_item = $item; + $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, + -circlehistory => 1, + -labelformat => "x80x60+0+0 x63a0^0^0 x33a0^0>1 a0a0>2>1 x33a0>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 => sprintf ("AFR%03i",$i)); + $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", '', $b_on); + $zinc->bind($item.":$j", '', $b_off); + $zinc->bind($item, '<1>', $tog_b); + $zinc->bind($item, '', sub {}); + } + $zinc->bind($item, '', + sub {$zinc->itemconfigure('current', + -historycolor => 'red3', + -symbolcolor => 'red3', + -markercolor => 'red3', + -leaderwidth => 2, + -leadercolor => 'red3', + -speedvectorwidth => 2, + -speedvectorcolor => 'red3')}); + $zinc->bind($item, '', + 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', '', sub { }); + $track->{'route'} = 0; + } +} + +create_tracks(); + +################################################### +# creation way point +################################################### +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', '', + sub {$zinc->itemconfigure('current', 0, -border => 'contour')}); + $zinc->bind($wp.':position', '', + sub {$zinc->itemconfigure('current', -symbolcolor => 'red')}); + $zinc->bind($wp.':leader', '', + sub {$zinc->itemconfigure('current', -leadercolor => 'red')}); + $zinc->bind($wp.':connection', '', + sub {$zinc->itemconfigure('current', -connectioncolor => 'red')}); + $zinc->bind($wp.':0', '', + sub {$zinc->itemconfigure('current', 0, -border => '')}); + $zinc->bind($wp.':position', '', + sub {$zinc->itemconfigure('current', -symbolcolor => 'green')}); + $zinc->bind($wp.':leader', '', + sub {$zinc->itemconfigure('current', -leadercolor => 'black')}); + $zinc->bind($wp.':connection', '', + 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', '', ''); + $zinc->bind($wp.':position', '', ''); + $zinc->bind($wp.':leader', '', ''); + $zinc->bind($wp.':leader', '', ''); + $zinc->bind($wp.':connection', '', ''); + $zinc->bind($wp.':connection', '', ''); + $zinc->bind($wp.':0', '', ''); + $zinc->bind($wp.':0', '', ''); + $zinc->remove($wp); + $wp = $track->{'route'}; + } + $track->{'route'} = 0; + } +} + +################################################### +# suppression waypoint intermediaire +################################################### +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; + } + } +} + + +################################################### +# creation macro +################################################### +my $macro = $zinc->add("tabular", $radar, 10, + -labelformat => "x73x20+0+0 x20x20+0+0 x53x20+20+0" + ); +$zinc->itemconfigure($macro, 0, -backcolor => "tan1", -filled => 1, + -fillpattern => "AlphaStipple7", + -bordercolor => "red3"); +$zinc->itemconfigure($macro, 1 , -text => "a"); +$zinc->itemconfigure($macro, 2, -text => "macro"); + +$zinc->itemconfigure($macro, -connecteditem => $one_of_track_item); +foreach my $part (0..2) { + $zinc->bind("$macro:$part", "", [ \&borders, "on"]); + $zinc->bind("$macro:$part", "", [ \&borders, "off"]); +} +################################################### +# creation ministrip +################################################### +my $ministrip = $zinc->add("tabular", 1, 10, + -labelformat => "x153x80^0^0 x93x20^0^0 x63a0^0>1 a0a0>2>1 x33a0>3>1 a0a0^0>2", + -position => [100, 10]); +$zinc->itemconfigure($ministrip, 0 , + -filled => 1, + -backcolor => "grey70", + -border => "contour", + -bordercolor => "green", + ); +$zinc->itemconfigure($ministrip, 1 , + -text => 'ministrip', -color => "darkgreen", + -backcolor => "grey40", + ); +$zinc->itemconfigure($ministrip, 2 , + -text => 'field1', -color => "darkgreen", + -backcolor => "grey40", + ); +$zinc->itemconfigure($ministrip, 3 , + -text => 'field2', -color => "darkgreen", + -backcolor => "grey40", + ); +$zinc->itemconfigure($ministrip, 4 , + -text => 'f3', -color => "darkgreen", + -backcolor => "grey40", + ); +$zinc->itemconfigure($ministrip, 5 , + -text => 'field4', -color => "darkgreen", + -backcolor => "grey40", + ); + +foreach my $field (1..5) { + $zinc->bind("$ministrip:$field", '', + sub { + $zinc->itemconfigure('current', $field, + -border => 'contour', + -filled => 1, + -color => 'white' + ) + }); +$zinc->bind("$ministrip:$field", '', + sub {$zinc->itemconfigure('current', $field, + -border => '', + -filled => 0, + -color => 'darkgreen' + )}); +} + +################################################### +# creation map +################################################### +$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"); + +my $map = $zinc->add("map", $radar, + -color => 'gray80'); +$zinc->itemconfigure($map, + -mapinfo => 'orly'); + +my $map2 = $zinc->add("map", $radar, + -color => 'gray60', + -filled => 1, + -priority => 0, + -fillpattern => "AlphaStipple6"); +$zinc->itemconfigure($map2, + -mapinfo => 'paris-ouest'); + +my $map3 = $zinc->add("map", $radar, + -color => 'gray50'); +$zinc->itemconfigure($map3, + -mapinfo => "paris-w"); + + +################################################### +# Création fonctions de contrôle à la souris +################################################### +new SimpleRadarControls($zinc); + +################################################### +# Rafraichissement des pistes +################################################### +$zinc->repeat($delay, [\&refresh, $zinc]); + +sub refresh { + my ($zinc) = @_; + + return if $pause; + foreach my $t (values(%tracks)) { + $t->{'x'} += $t->{'vx'} * $rate; + $t->{'y'} += $t->{'vy'} * $rate; + $zinc->itemconfigure($t->{'item'}, + -position => [$t->{'x'}, $t->{'y'}]); + } +} + +sub borders { + my($widget, $onoff) = @_; + $onoff = "on" unless $onoff; + my $contour = "noborder"; + $contour = "contour" if ($onoff eq 'on'); + $zinc->itemconfigure('current', 0, -border => $contour); +} + + +MainLoop(); + + +# $Id$ +# This simple radar has been initially developped by P. Lecoanet +# It has been adapted by C. Mertz for demo purpose. +# Thanks to Dunnigan,Jack [Edm]" for a bug correction. + +package SimpleRadarControls; + +$top = 1; + +sub new { + 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('', [\&start_lasso, $self]); + $zinc->Tk::bind('', [\&fin_lasso, $self]); + + $zinc->Tk::bind('', sub { my $ev = $zinc->XEvent(); + my @closest = $zinc->find('closest', + $ev->x, $ev->y); + print "at point=$closest[0]\n" }); + + $zinc->Tk::bind('', [\&press, $self, \&motion]); + $zinc->Tk::bind('', [\&release, $self]); + + $zinc->Tk::bind('', [\&press, $self, \&zoom]); + $zinc->Tk::bind('', [\&release, $self]); + + $zinc->Tk::bind('', [\&press, $self, \&rotate]); + $zinc->Tk::bind('', [\&release, $self]); + + $zinc->Tk::bind('current', '', [\&showbox, $self]); + $zinc->Tk::bind('current', '', [\&hidebox, $self]); + + bless ($self, $type); + return $self; +} + +# +# Controls for the window transform. +# +sub press { + 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('', [$action, $self]); +} + +sub motion { + my ($zinc, $self) = @_; + my $ev = $zinc->XEvent(); + my $lx = $ev->x; + my $ly = $ev->y; + my @it; + my @res; + + @it = $zinc->find('withtag', 'controls'); + if (scalar(@it) == 0) { + return; + } + @res = $zinc->transform($it[0], [$lx, $ly, $self->{'cur_x'}, $self->{'cur_y'}]); + $zinc->translate('controls', $res[0] - $res[2], $res[1] - $res[3]); + $self->{'cur_x'} = $lx; + $self->{'cur_y'} = $ly; +} + +sub zoom { + 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 > $self->{'cur_x'}) { + $maxx = $lx; + } else { + $maxx = $self->{'cur_x'}; + } + if ($ly > $self->{'cur_y'}) { + $maxy = $ly + } else { + $maxy = $self->{'cur_y'}; + } + #avoid illegal division by zero + return unless ($maxx && $maxy); + + $sx = 1.0 + ($lx - $self->{'cur_x'})/$maxx; + $sy = 1.0 + ($ly - $self->{'cur_y'})/$maxy; + $self->{'cur_x'} = $lx if ($lx>0); # avoid ZnTransfoDecompose :singular matrix + $self->{'cur_y'} = $ly if ($ly>0); # error messages + $zinc->scale('controls', $sx, $sy); +# $main::scale *= $sx; +# main::update_transform($zinc); +} + +sub rotate { + 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 - $self->{'cur_angle'})); + $self->{'cur_angle'} = $langle; +} + +sub release { + my ($zinc, $self) = @_; + $zinc->Tk::bind('', ''); +} + +sub start_lasso { + my ($zinc, $self) = @_; + my $ev = $zinc->XEvent(); + my $lx = $ev->x; + my $ly = $ev->y; + my @coords; + + $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->raise('lasso'); + $zinc->Tk::bind('', [\&lasso, $self]); +} + +sub lasso { + my ($zinc, $self) = @_; + my $ev = $zinc->XEvent(); + my $lx = $ev->x; + my $ly = $ev->y; + my @coords; + + $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 ($zinc, $self) = @_; + my $enclosed; + my $overlapping; + + $zinc->Tk::bind('', ''); + $zinc->itemconfigure('lasso', -visible => 0); + $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')) { + @it = $zinc->find('withtag', 'current'); + if (scalar(@it) == 0) { + return; + } + @coords = $zinc->transform($top, $zinc->bbox('current')); + + $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 ($zinc, $self) = @_; + my $ev = $zinc->XEvent(); + my $lx = $ev->x; + my $ly = $ev->y; + my @next; + + @next = $zinc->find('closest', $lx, $ly); + if ((scalar(@next) == 0) || + ! $zinc->hastag($next[0], 'currentbbox') || + $zinc->hastag('current', 'currentbbox')) { + $zinc->itemconfigure('currentbbox', -visible => 0); + } +} + + + diff --git a/Perl/demos/Tk/demos/zinc_lib/tkZincLogo.pl b/Perl/demos/Tk/demos/zinc_lib/tkZincLogo.pl new file mode 100644 index 0000000..076bc0f --- /dev/null +++ b/Perl/demos/Tk/demos/zinc_lib/tkZincLogo.pl @@ -0,0 +1,152 @@ +#!/usr/bin/perl +# $Id$ +# this simple demo has been adapted by C. Mertz from the original +# work of JL. Vinot + +use Tk; +use Tk::Zinc; +use strict; +use LogoZinc; # this module implements a class which instances are Zinc logo! + + +my $defaultfont = '-adobe-helvetica-bold-r-normal-*-140-*-*-*-*-*-*'; +my $mw = MainWindow->new(); +my $text = $mw->Scrolled(qw/Text -relief sunken -borderwidth 2 -setgrid true + -height 5 -scrollbars ''/); +$text->pack(qw/-expand yes -fill both/); + +$text->insert('0.0', + 'This tkZinc logo should used openGL for a correct rendering! + You can transform this logo with your mouse: + Drag-Button 1 for moving the logo, + Drag-Button 2 for zooming the logo, + Drag-Button 3 for rotating the logo.'); + +my $zinc = $mw->Zinc(-width => 350, -height => 250, + -render => 1, + -font => "10x20", # usually fonts are sets in resources + # but for this example it is set in the code! + -borderwidth => 3, -relief => 'sunken', + )->pack; + +my $group = $zinc->add('group', 1, ); + + +my $logo = $zinc->LogoZinc(-parent => $group, + -position => [40, 70], + -priority => 800, + -scale => [.6, .6], + ); + + +$zinc->Tk::bind('', [\&press, \&motion]); +$zinc->Tk::bind('', [\&release]); + +$zinc->Tk::bind('', [\&press, \&zoom]); +$zinc->Tk::bind('', [\&release]); + +$zinc->Tk::bind('', [\&press, \&rotate]); +$zinc->Tk::bind('', [\&release]); + + +$zinc->Tk::bind('', [\&press, \&modifyAlpha]); +$zinc->Tk::bind('', [\&release]); + +$zinc->Tk::bind('', [\&press, \&modifyGradient]); +$zinc->Tk::bind('', [\&release]); + +$zinc->Tk::bind('', [\&press, \&rotate]); +$zinc->Tk::bind('', [\&release]); + +# +# Controls for the window transform. +# +my ($cur_x, $cur_y, $cur_angle); +sub press { + my ($zinc, $action) = @_; + my $ev = $zinc->XEvent(); + $cur_x = $ev->x; + $cur_y = $ev->y; + $cur_angle = atan2($cur_y, $cur_x); + $zinc->Tk::bind('', [$action]); +} + +sub modifyAlpha { + my ($zinc) = @_; + my $ev = $zinc->XEvent(); + my $lx = $ev->x; + my $ly = $ev->y; + my @res; + + my $xrate = $lx / $zinc->cget(-width); + my $yrate = $ly / $zinc->cget(-height); + + $xrate = 0 if $xrate < 0; + $xrate = 1 if $xrate > 1; + $yrate = 0 if $yrate < 0; + $yrate = 1 if $yrate > 1; + + my $alpha = $yrate * 100; + + $zinc->itemconfigure($group, -alpha => $yrate * 100); +} + + +sub motion { + my ($zinc) = @_; + my $ev = $zinc->XEvent(); + my $lx = $ev->x; + my $ly = $ev->y; + my @res; + + @res = $zinc->transform($group, [$lx, $ly, $cur_x, $cur_y]); + $zinc->translate($group, $res[0] - $res[2], $res[1] - $res[3]); + $cur_x = $lx; + $cur_y = $ly; +} + +sub zoom { + 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) { + $maxx = $lx; + } else { + $maxx = $cur_x; + } + if ($ly > $cur_y) { + $maxy = $ly + } else { + $maxy = $cur_y; + } + $sx = 1.0 + ($lx - $cur_x)/$maxx; + $sy = 1.0 + ($ly - $cur_y)/$maxy; + $cur_x = $lx; + $cur_y = $ly; + $zinc->scale($group, $sx, $sy); +} + +sub rotate { + my ($zinc) = @_; + my $ev = $zinc->XEvent(); + my $lx = $ev->x; + my $ly = $ev->y; + my $langle; + + $langle = atan2($ly, $lx); + $zinc->rotate($group, -($langle - $cur_angle)); + $cur_angle = $langle; +} + +sub release { + my ($zinc) = @_; + $zinc->Tk::bind('', ''); +} + +MainLoop; diff --git a/Perl/demos/Tk/demos/zinc_lib/translation.pl b/Perl/demos/Tk/demos/zinc_lib/translation.pl new file mode 100644 index 0000000..2aaed2b --- /dev/null +++ b/Perl/demos/Tk/demos/zinc_lib/translation.pl @@ -0,0 +1,141 @@ +#!/usr/bin/perl +# $Id$ +# This simple demo has been developped by C. Schlienger + + +use Tk; +use Tk::Zinc; +use strict; + + +my $defaultfont = '-adobe-helvetica-bold-r-normal-*-120-*-*-*-*-*-*'; +my $mw = MainWindow->new(); + +########################################### +# Text zone +########################################### + +my $text = $mw->Scrolled(qw/Text -relief sunken -borderwidth 2 -setgrid true + -height 6 -scrollbars e/); +$text->pack(qw/-expand yes -fill both/); + +$text->insert('0.0', + 'This toy-appli shows translations on waypoint items. +The following operations are possible: + Click "Up" for up translation + Click "Left" for left translation + Click "Right" for right translation + Click "Down" for down translation' ); + +########################################### +# Zinc +########################################### +my $zinc_width=600; +my $zinc_height=400; +my $zinc = $mw->Zinc(-width => $zinc_width, -height => $zinc_height, + -font => "10x20", + -borderwidth => 3, -relief => 'sunken', + )->pack; + +########################################### +# Waypoints +########################################### + +my $wp_group = $zinc->add('group', 1, -visible => 1); + +my $p1=[200, 200]; +my $wp1 = $zinc->add('waypoint',$wp_group, 1, + -position => $p1, + -connectioncolor => 'green', + -symbolcolor => 'blue', + -labelformat => 'x20x18+0+0', + -leaderwidth=>'0', + -labeldx=>'-20' + ); +$zinc->itemconfigure($wp1, 0, + -text => "DO", + ); + +my $p2=[300, 300]; +my $wp2 = $zinc->add('waypoint',$wp_group, 1, + -position => $p2, + -connecteditem => $wp1, + -connectioncolor => 'blue', + -symbolcolor => 'blue', + -labelformat => 'x20x18+0+0', + -leaderwidth=>'0', + -labeldx=>'-20', + #-labeldy=>'30' + ); + +$zinc->itemconfigure($wp2, 0, + -text => "RE", + ); + +my $p3=[400, 150]; +my $wp3 = $zinc->add('waypoint', $wp_group, 2, + -position => $p3, + -connecteditem => $wp2, + -connectioncolor => 'blue', + -symbolcolor => 'blue', + -labelformat => 'x20x18+0+0', + -leaderwidth=>'0', + -labeldx=>'20', + -labeldy=>'+10' + ); +$zinc->itemconfigure($wp3, 0, + -text => "MI", + ); + +################################################### +# control panel +################################################### +my $rc = $mw->Frame()->pack(); +my $up=$rc->Button(-width => 2, + -height => 2, + -text => 'Up', + -command=>sub{ + #-------------------------------- + # Up translation + #-------------------------------- + $zinc->translate("$wp_group",0,-10); + })->grid(-row => 0, + -column => 1); + +my $left=$rc->Button(-width => 2, + -height => 2, + -text => 'Left', + -command=>sub{ + #-------------------------------- + # Left translation + #-------------------------------- + $zinc->translate("$wp_group",-10,0); + })->grid(-row => 1, + -column => 0); + +my $right=$rc->Button(-width => 2, + -height => 2, + -text => 'Right', + -command=>sub{ + #-------------------------------- + # Right translation + #-------------------------------- + $zinc->translate("$wp_group",10,0); + })->grid(-row => 1, + -column => 2); + +my $down=$rc->Button(-width => 2, + -height => 2, + -text => 'Down', + -command=>sub{ + #-------------------------------- + # Down translation + #-------------------------------- + $zinc->translate("$wp_group",0,10); + })->grid(-row => 2, + -column => 1); + + + + +MainLoop; diff --git a/Perl/demos/Tk/demos/zinc_lib/triangles.pl b/Perl/demos/Tk/demos/zinc_lib/triangles.pl new file mode 100644 index 0000000..7114c7e --- /dev/null +++ b/Perl/demos/Tk/demos/zinc_lib/triangles.pl @@ -0,0 +1,56 @@ +#!/usr/bin/perl +# $Id$ +# these simple samples have been developped by C. Mertz mertz@cena.fr and N. Banoun banoun@cena.fr + +use Tk; +use Tk::Zinc; +use strict; + + +my $defaultfont = '-adobe-helvetica-bold-r-normal-*-120-*-*-*-*-*-*'; +my $mw = MainWindow->new(); +my $zinc = $mw->Zinc(-width => 700, -height => 300, + -font => "10x20", # usually fonts are sets in resources + # but for this example it is set in the code! + -render => 1, + -borderwidth => 3, -relief => 'sunken', + )->pack; + +# 6 equilateral triangles around a point +$zinc->add('text', 1, + -position => [ 5,10 ], + -text => "Triangles item without transparency"); + +my ($x0,$y0) = (200,150); +my @coords=($x0,$y0); +for my $i (0..6) { + my $angle = $i * 6.28/6; + push @coords, ($x0 + 100 * cos ($angle), $y0 - 100 * sin ($angle) ); +} + +my $tr1 = $zinc->add('triangles', 1, + \@coords, + -fan => 1, + -colors => ['white', 'yellow', 'magenta', 'blue', 'cyan', 'green', 'red', 'yellow'], + -visible => 1, + ); + +$zinc->add('text', 1, + -position => [ 370, 10 ], + -text => "Triangles item with transparency"); + + +# using the clone method to make a copy and then modify the clone'colors +my $tr2 = $zinc->clone($tr1); +$zinc->translate($tr2,300,0); +$zinc->itemconfigure($tr2, +# -colors => ['#00ed00','#ffff00:50','#006aed:50','#e00000:50'], # this lines bugs zincGL 3.2.3b + -colors => ['white:50', 'yellow:50', 'magenta:50', 'blue:50', 'cyan:50', 'green:50', 'red:50', 'yellow:50'], + ); + + + +MainLoop; + + + diff --git a/Perl/demos/Tk/demos/zinc_lib/wheelOfFortune.pl b/Perl/demos/Tk/demos/zinc_lib/wheelOfFortune.pl new file mode 100644 index 0000000..733f598 --- /dev/null +++ b/Perl/demos/Tk/demos/zinc_lib/wheelOfFortune.pl @@ -0,0 +1,88 @@ +#!/usr/bin/perl +# +# This short script tries to demonstrate with a simple example what you can +# do with Tk Zinc widget, in particular how to use group item, clipping, and +# transformations. +# $Id$ +# this demo has been developped by D. Etienne etienne@cena.fr +# + +use Tk; +# Zinc module is loaded... +use Tk::Zinc; + +# to find the Wheel class. Should be included in this source file! +use lib Tk->findINC('demos/widget_lib'); + +# my Wheel object class too. See below... +use Wheel; + + +# We create a classical root widget called MainWindow; then we create Zinc +# widget child with size, color and relief attributes, and we display it using +# the geometry manager called 'pack'. +my $mw = MainWindow->new; +$mw->geometry("320x565"); +$mw->resizable(0,0); +my $zinc = $mw->Zinc(-width => 300, -height => 500, -backcolor => 'gray70', + -borderwidth => 3, -relief => 'sunken'); +$zinc->pack; + +# Then we create a gray filled rectangle, in which we will display explain text. +$zinc->add('rectangle', 1 , [10, 400, 290, 490], + -linewidth => 0, + -filled => 1, + -fillcolor => 'gray80', + ); +my $text = $zinc->add('text', 1, + -position => [150, 445], + -anchor => 'center', + ); + +# Create the Wheel object (see Wheel.pm) +my $wheel = Wheel->new($zinc, 150, 500, 100); + +# Display comment +&comment("Strike any key to begin"); + +# Create Tk binding +$mw->Tk::bind('', \&openmode); + + + +MainLoop; + + + +# Callback bound to '' event when wheel is unmapped +sub openmode { + return if $wheel->ismoving; + # set binding to unmap the wheel + $mw->Tk::bind('', \&closemode); + # set binding to rotate the hand + $zinc->bind($wheel, '<1>', sub {$wheel->rotatehand(300)}); + # map the wheel + $wheel->show(150, 150); + # and then inform user + &comment("Click on the wheel to rotate the hand.\n". + "Strike any other key to hide the wheel."); +} + +# Callback bound to '' event when wheel is already mapped +sub closemode { + return if $wheel->ismoving; + # set binding to map the wheel + $mw->Tk::bind('', \&openmode); + # unmap the wheel + $wheel->hide(150, 400); + # and then inform user + &comment("Strike any key to show the wheel"); +} + +# Just display comment +sub comment { + my $string = shift; + $zinc->itemconfigure($text, -text => $string); +} + + diff --git a/Perl/demos/Tk/demos/zinc_lib/window-contours.pl b/Perl/demos/Tk/demos/zinc_lib/window-contours.pl new file mode 100644 index 0000000..17a8373 --- /dev/null +++ b/Perl/demos/Tk/demos/zinc_lib/window-contours.pl @@ -0,0 +1,111 @@ +#!/usr/bin/perl -w +# $Id$ +# This simple demo has been developped by C. Mertz + +use Tk; +use Tk::Zinc; + +use strict; + +my $mw = MainWindow->new(); + +# The explanation displayed when running this demo +my $text = $mw->Scrolled(qw/Text -relief sunken -borderwidth 2 -setgrid true + -height 10 -scrollbars e/); +$text->pack(qw/-expand yes -fill both/); + +$text->insert('0.0', +'These "windows" are simply rectangles holed by 4 smaller rectangles. +You can see text appearing behind the "windows"! +The following operations are possible: + "Mouse Button 1" for dragging text or "windows".'); + +# Creating the zinc widget +my $zinc = $mw->Zinc(-width => 600, -height => 500, + -font => "10x20", # usually fonts are sets in resources + # but for this example it is set in the code! + -borderwidth => 3, -relief => 'sunken', +# -backcolor => "white", + )->pack; + + +# Text in background +my $backtext = $zinc->add('text', 1, + -position=> [50,200], + -text => "This text appears\nthrough holes of curves", + -font => "-adobe-helvetica-bold-o-normal--34-240-100-100-p-182-iso8859-1", + #"10x20" + ); + +my $window = $zinc->add('curve', 1, [100,100 , 300,100, 300,400 , 100,400 ], + -closed => 1, -visible => 1, -filled => 1, + -fillcolor => "grey66", + ); + +my $aGlass= $zinc->add('rectangle', 1, [120,120 , 190,240]); +$zinc->contour($window, 'diff', $aGlass); + +$zinc->translate($aGlass, 90,0); +$zinc->contour($window, 'diff', $aGlass); + +$zinc->translate($aGlass, 0,140); +$zinc->contour($window, 'diff', $aGlass); + +$zinc->translate($aGlass, -90,0); +$zinc->contour($window, 'diff', $aGlass); + +# deleting $aGlass which is no more usefull +$zinc->remove($aGlass); + +# cloning $window +my $window2 = $zinc->clone($window); + +# changing its background, moving it and scaling it! +$zinc->itemconfigure($window2, -fillcolor => "grey50"); +$zinc->translate($window2, 30,50); +$zinc->scale($window, 0.8, 0.8); + + + + +# adding drag and drop callback to the two windows and backtext +foreach my $item ($window, $window2, $backtext) { + # Some bindings for dragging the items + $zinc->bind($item, '' => [\&press, $item, \&motion]); + $zinc->bind($item, '' => \&release); +} + +# callback for starting a drag +my ($x_orig, $y_orig); +sub press { + my ($zinc, $item, $action) = @_; + my $ev = $zinc->XEvent(); + $x_orig = $ev->x; + $y_orig = $ev->y; + $zinc->Tk::bind('', [$action, $item]); +} + +# Callback for moving an item +sub motion { + my ($zinc, $item) = @_; + my $ev = $zinc->XEvent(); + my $x = $ev->x; + my $y = $ev->y; + + $zinc->translate($item, $x-$x_orig, $y-$y_orig); + $x_orig = $x; + $y_orig = $y; +} + + +# Callback when releasing the mouse button. It removes any motion callback +sub release { + my ($zinc) = @_; + $zinc->Tk::bind('', ''); +} + + +MainLoop(); + + +1; diff --git a/Perl/demos/Tk/demos/zinc_lib/zoom.pl b/Perl/demos/Tk/demos/zinc_lib/zoom.pl new file mode 100644 index 0000000..b5bc4e5 --- /dev/null +++ b/Perl/demos/Tk/demos/zinc_lib/zoom.pl @@ -0,0 +1,178 @@ +#!/usr/bin/perl +# $Id$ +# This simple demo has been developped by C. Schlienger + + +use Tk; +use Tk::Zinc; +use strict; + + +my $defaultfont = '-adobe-helvetica-bold-r-normal-*-120-*-*-*-*-*-*'; +my $mw = MainWindow->new(); + +########################################### +# Text zone +########################################### + +my $text = $mw->Scrolled(qw/Text -relief sunken -borderwidth 2 -setgrid true + -height 4 -scrollbars e/); +$text->pack(qw/-expand yes -fill both/); + +$text->insert('0.0', + 'This toy-appli shows zoom actions on waypoint and curve items. +The following operations are possible: + Click "-" to zoom out + Click "+" to zoom in ' ); + +########################################### +# Zinc +########################################### +my $zinc_width=600; +my $zinc_height=500; +my $zinc = $mw->Zinc(-width => $zinc_width, -height => $zinc_height, + -font => "10x20", + -borderwidth => 3, -relief => 'sunken', + )->pack; + +########################################### +# Waypoints and sector +########################################### + +my $wp_group = $zinc->add('group', 1, -visible => 1); + +my $p1=[200, 100]; +my $wp1 = $zinc->add('waypoint',$wp_group, 1, + -position => $p1, + -connectioncolor => 'green', + -symbolcolor => 'blue', + -labelformat => 'x20x18+0+0', + -leaderwidth=>'0', + -labeldx=>'-20' + ); +$zinc->itemconfigure($wp1, 0, + -text => "DO", + ); + +my $p2=[300, 150]; +my $wp2 = $zinc->add('waypoint',$wp_group, 1, + -position => $p2, + -connecteditem => $wp1, + -connectioncolor => 'blue', + -symbolcolor => 'blue', + -labelformat => 'x20x18+0+0', + -leaderwidth=>'0', + -labeldx=>'-20', + ); + +$zinc->itemconfigure($wp2, 0, + -text => "RE", + ); + +my $p3=[400, 50]; +my $wp3 = $zinc->add('waypoint', $wp_group, 2, + -position => $p3, + -connecteditem => $wp2, + -connectioncolor => 'blue', + -symbolcolor => 'blue', + -labelformat => 'x20x18+0+0', + -leaderwidth=>'0', + -labeldx=>'20', + -labeldy=>'+10' + ); +$zinc->itemconfigure($wp3, 0, + -text => "MI", + ); + +my $p4=[350, 450]; +my $wp4 = $zinc->add('waypoint', $wp_group, 2, + -position => $p4, + -connecteditem => $wp2, + -connectioncolor => 'blue', + -symbolcolor => 'blue', + -labelformat => 'x20x18+0+0', + -leaderwidth=>'0', + -labeldy=>'-15' + ); +$zinc->itemconfigure($wp4, 0, + -text => "FA", + ); + + +my $p5=[300, 250]; +my $wp5 = $zinc->add('waypoint', $wp_group, 2, + -position => $p5, + -connectioncolor => 'blue', + -symbolcolor => 'blue', + -labelformat => 'x20x18+0+0', + -leaderwidth=>'0', + -labeldy=>'-15' + ); +$zinc->itemconfigure($wp5, 0, + -text => "SOL", + ); + + +my $p6=[170, 240]; +my $wp6 = $zinc->add('waypoint', $wp_group, 2, + -position => $p6, + -connecteditem => $wp5, + -connectioncolor => 'blue', + -symbolcolor => 'blue', + -labelformat => 'x20x18+0+0', + -leaderwidth=>'0', + -labeldx=>'-20' + ); +$zinc->itemconfigure($wp6, 0, + -text => "LA", + ); + +my $p7=[550, 200]; +my $wp7 = $zinc->add('waypoint', $wp_group, 2, + -position => $p7, + -connecteditem => $wp5, + -connectioncolor => 'blue', + -symbolcolor => 'blue', + -labelformat => 'x20x18+0+0', + -leaderwidth=>'0', + -labeldx=>'20' + ); +$zinc->itemconfigure($wp7, 0, + -text => "SI", + ); + + +my $sector = $zinc ->add('curve',$wp_group,[300,0,400,50,500,100,550,200,550,400,350,450,170,240,200,100,300,0]); + +################################################### +# control panel +################################################### +my $rc = $mw->Frame()->pack(); + +#the reference of the scale function is top-left corner of the zinc object +#so we first translate the group to zoom in order to put its center on top-left corner +#change the scale of the group +#translate the group to put it back at the center of the zinc object + +my $minus=$rc->Button(-width => 2, + -height => 2, + -text => '-', + -command=>sub{ + $zinc->translate($wp_group,-$zinc_width/2,-$zinc_height/2); + $zinc->scale($wp_group,0.8,0.8); + $zinc->translate($wp_group, $zinc_width/2,$zinc_height/2); + })->pack(-side=>'left'); + + +my $plus=$rc->Button(-width => 2, + -height => 2, + -text => '+', + -command=>sub{ + $zinc->translate($wp_group, -$zinc_width/2,-$zinc_height/2); + $zinc->scale($wp_group,1.2,1.2); + $zinc->translate($wp_group,$zinc_width/2,$zinc_height/2); + })->pack(-side => 'right'); + + + +MainLoop; -- cgit v1.1