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;