aboutsummaryrefslogtreecommitdiff
path: root/src/MTools/Widget/MArrow.pm
diff options
context:
space:
mode:
Diffstat (limited to 'src/MTools/Widget/MArrow.pm')
-rw-r--r--src/MTools/Widget/MArrow.pm297
1 files changed, 297 insertions, 0 deletions
diff --git a/src/MTools/Widget/MArrow.pm b/src/MTools/Widget/MArrow.pm
new file mode 100644
index 0000000..abfb5a3
--- /dev/null
+++ b/src/MTools/Widget/MArrow.pm
@@ -0,0 +1,297 @@
+package MTools::Widget::MArrow;
+# This program is free software; you can redistribute it and/or
+# modify it under the terms of the GNU LGPL Libray General Public License
+# as published by the Free Software Foundation; either version 2
+# of the License, or (at your option) any later version.
+#
+# This program is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+# GNU Library General Public License for more details.
+#
+# You should have received a copy of the GNU Library General Public License
+# along with this program; if not, write to the Free Software
+# Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA,
+# or refer to http://www.gnu.org/copyleft/lgpl.html
+#
+##################################################################
+
+use strict;
+use Math::Trig;
+require Exporter;
+use Tk::Zinc::Graphics;
+use MTools;
+use MTools::GUI::MGroup;
+
+use vars qw /@ISA/;
+@ISA = qw(Exporter);
+my @EXPORT = qw(&arrowCoords);
+
+# orientation des flèches
+my $direction2angle = {'left' => 180,
+ 'top'=> 90,
+ 'right' => 0,
+ 'bottom' => 270,
+ 'w' => 180,
+ 'nw'=> 135,
+ 'n' => 90,
+ 'ne'=> 45,
+ 'e' => 0,
+ 'se' => 315,
+ 's' => 270,
+ 'sw' => 225
+ };
+
+
+BEGIN
+{
+ @ISA = qw /MTools::GUI::MGroup/;
+}
+
+sub new {
+ my ($class, %options) = @_;
+ my $parentgroup = $options {'parent'} ? $options {'parent'} : 1;
+ my $self = new MTools::GUI::MGroup ($parentgroup);
+
+
+ bless $self, $class;
+
+ # coords
+ $self -> coords ($options {'coords'}) if ($options {'coords'});
+
+ # coordonnées de la ligne support de flèche
+ if ($options {'linecoords'}) {
+ $self -> {'linecoords'} = $options {'linecoords'};
+ $self -> {'length'} = &distance(@{$self -> {'linecoords'}->[-1]},
+ @{$self -> {'linecoords'}->[-2]});
+ } else {
+ $self -> {'length'} = (defined $options {'length'}) ? $options {'length'} : 100;
+ $self -> {'linecoords'} = [[0,0],[$self -> {'length'},0]];
+ }
+
+ $self -> {'width'} = ($options{'width'}) ? $options{'width'} : $self -> {'length'};
+
+
+ # paramètres de direction
+ if (defined $options {angle}) {
+ $self -> {'angle'} = $options {'angle'};
+ $self -> {'direction'} = undef;
+
+ } else {
+ $self -> {'direction'} = ($options {'direction'}) ? $options {'direction'} : 'right';
+ }
+
+
+ # paramètres de forme
+ # (style, longueur et angle du marqueur flèche, épaisseur et rayon du tracé)
+ $self -> {'head_style'} = $options {'head_style'};
+ $self -> {'head_length'} = (defined $options {'head_length'}) ? $options {'head_length'} : $self -> {'length'}/2;
+
+ $self -> {'thick'} = ($options{'thick'})
+ ? $options{'thick'} : $self -> {'length'}/5;
+ $self -> {'radius'} = (defined $options{'radius'})
+ ? $options{'radius'} : $self -> {'thick'}/2;
+ $self -> {'head_angle'} = ($options{'head_angle'})
+ ? $options{'head_angle'} : 45;
+
+ # style graphique
+ $self -> {'style'} = $options {style};
+
+
+ $self -> build;
+
+ return $self;
+}
+
+
+sub build {
+ my $self = shift;
+
+ # le group de transformation (rotation) de la flèche
+ $self -> {'r_group'} = new MTools::GUI::MGroup ($self -> {instance});
+
+ # calcul des coordonnées de la curve
+ my $coords = $self->arrowCoords;
+
+ # style de l'item zinc
+ my $style = {-itemtype => 'curve',
+ -coords => $coords,
+ -params => {-closed => 1,
+ %{$self -> {'style'}},
+ },
+ };
+
+ # item TkZinc de forme de la flèche
+ $self -> {'-form'} = &buildZincItem($zinc, $self -> {'r_group'} -> {instance}, %{$style});
+
+ # orientation
+ $self->direction;
+
+}
+
+
+sub arrowCoords {
+ my ($self, %options) = @_;
+ my @pts;
+
+ my $width = ($options{'width'}) ? $options{'width'} : $self -> {'width'};;
+ my $head_length = ($options{'head_length'}) ? $options{'head_length'} : $self -> {'head_length'};
+ my $thick = ($options{'thick'}) ? $options{'thick'} : $self -> {'thick'};
+ my $head_angle = ($options{'head_angle'}) ? $options{'head_angle'} : $self -> {'head_angle'};
+ my $linecoords = ($options{'linecoords'}) ? $options{'linecoords'} : $self -> {'linecoords'};
+ my $radius = ($options{'radius'}) ? $options{'radius'} : $self -> {'radius'};
+
+ my ($pt0,$pt1) = reverse @{$linecoords};
+ my $endangle = &lineAngle($pt0,$pt1);
+
+
+ # points de flèche
+ my ($ptA,$ptB);
+
+ if (!defined $head_length) {
+ my $b_sin = sin(deg2rad($endangle + $head_angle));
+ $head_length = ($b_sin) ? abs(($width/2) / $b_sin) : $width/2;
+
+ } elsif ($head_length) {
+ my ($x2,$y2) = &rad_point($pt0, $head_length, $endangle -90 - $head_angle);
+ $ptA = [$x2,$y2];
+ my ($x3,$y3) = &rad_point($pt0, $head_length, $endangle -90 + $head_angle);
+ $ptB = [$x3,$y3];
+ }
+
+ # dl décalage de ligne = épaisseur forme /2
+ my $dl = $thick/2;
+
+ # la liste des points de la flèche
+ # (si $head_length = 0 pas de marker pointe)
+ my @vertex = reverse @{$linecoords};
+ pop @vertex;
+ push (@vertex, @{$linecoords});
+ if ($head_length) {
+ push(@vertex, ($ptA,$pt0,$ptB));
+ } else {
+ push(@vertex, $pt1);
+ }
+
+ # liste (booleens) du type raccord des sommets
+ my @corners;
+
+ my $numfaces = scalar(@vertex);
+ my $previous = $vertex[-1];
+
+ # on parcours la forme d'arete en arete
+ for (my $i = 0; $i < $numfaces; $i++) {
+ my $pt = $vertex[$i];
+ my $next = ($i < ($numfaces -1)) ? $vertex[$i+1] : $vertex[0];
+ my ($angle,$bis);
+
+ # angle du sommet
+ ($angle,$bis) = &vertexAngle($previous, $pt, $next);
+
+ # angle plat : projection du contour
+ if ($angle < 1) {
+ $angle = &lineNormal($pt,$next);
+ my ($x2,$y2) = &rad_point($pt, $dl, $angle-90);
+ my ($x1,$y1) = &rad_point($pt, $dl, $angle+90);
+ push (@pts, [$x1,$y1]);
+ push (@pts, [$x2,$y2]);
+
+ # accumulation d'un raccord supplémentaire
+ push(@corners, 1);
+
+
+ } else {
+
+ # distance au centre du cercle inscrit : rayon/sinus demi-angle
+ my $sin = sin(deg2rad($angle/2));
+ my $delta = ($sin) ? abs($dl/$sin) : $dl;
+
+ # calcul du point de contour (projection angulaire sur mediatrice)
+ my ($x,$y) = &rad_point($pt, $delta, $bis-90);
+ push (@pts, [$x,$y]);
+
+ }
+
+ # ajout d'un raccord
+ push(@corners, 1);
+
+ # nouveau point précédent
+ $previous = $pt;
+ }
+
+
+ # calcul des raccords d'angle si option radius
+ if ($radius) {
+ if ($head_length) {
+ push @pts, shift @pts;
+ $corners[-1] = 0;
+ $corners[-7] = 0;
+
+ if (scalar @{$linecoords} > 2) {
+ @corners[0] = 0;
+ for (my $il = 2; $il < scalar @{$linecoords}; $il++) {
+ $corners[$il*2] = 0;
+ }
+ }
+ }
+ my $newpts = &roundedCurveCoords(\@pts,
+ -radius => $radius,
+ -corners => \@corners);
+ @pts = @{$newpts};
+ }
+
+ return \@pts;
+}
+
+
+sub direction {
+ my $self = shift;
+ my $angle;
+
+ if (defined $self -> {'angle'}) {
+ $angle = $self -> {'angle'};
+ $self -> {'direction'} = undef;
+
+ } else {
+
+ if ($self -> {'direction'}) {
+ $angle = $direction2angle->{$self -> {'direction'}};
+ } else {
+ $self -> {'direction'} = 'right';
+ $angle = $direction2angle->{'right'};
+ }
+
+ }
+
+ if (defined $angle) {
+ $self -> {'r_group'} -> treset;
+ $self -> {'r_group'} -> rotate (deg2rad($angle)*-1);
+ }
+
+}
+
+
+sub distance
+{
+ my @p = @_;
+ my $d = @p / 2; # nombre de dimensions
+
+ # 2 dimensions
+ return sqrt(($_[0] - $_[2])**2 + ($_[1] - $_[3])**2)
+ if ($d == 2);
+
+ my $S = 0;
+ my @p0 = splice @p, 0, $d; # point de départ
+
+ for (my $i = 0; $i < $d; $i++) {
+ my $di = $p0[$i] - $p[$i];
+ $S += $di * $di;
+ }
+
+ return sqrt($S);
+
+}
+
+
+1;
+
generated by cgit v1.1 at 2024-09-21 10:59:48 +0000