Import initial

8 files changed, 638 insertions, 0 deletions

diff --git a/src/MTools/GUI/MAntiRecouvrementGroup.pm b/src/MTools/GUI/MAntiRecouvrementGroup.pm
new file mode 100644
index 0000000..4e8dbc7
--- /dev/null
+++ b/src/MTools/GUI/MAntiRecouvrementGroup.pm
@@ -0,0 +1,191 @@
+package MTools::GUI::MAntiRecouvrementGroup;
+#	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
+#
+##################################################################
+
+
+# Les objets heritant de MAntiRecouvrementGroup peuvent etre geres par un objet MAntiRecouvrement et ainsi pris en charge
+# par un algorithme d'anti-recouvrement.
+#
+# parametres :
+#	* $parent : parent de l'objet...
+#	* %options : table de hash permettant d'initialiser les proprietes
+# Les ?v?nements :
+#	* TRANSLATED : notifie lorsque l'objet est translate...
+# attibuts : 
+#	followed_by : MAntiRecouvrementGroup permet aux objets contenus dans ce tableau de suivre ses deplacements 
+#	(permet un chainage des objets)
+# Les propietes :
+#	* xmin, ymin, xmax, ymax : definissent les caract?risiques de l'espace dans lequel l'objet est contraint.
+#	* height, width : definissent la base rectangulaire de l'objet
+#	* auto_sizing : si width ou height ne sont pas pass?s en param?tre, les caracteristiques 
+#	sont auto-determinees en fonction de la bbox de l'objet. On peut bien evidemment choisir cette definition automatique, cependant
+#	attention, la bbox de l'objet ne correspond par toujours a la bbox visible de l'objet.
+#	* x, y : determinent la position de l'objet et sont mis a jour automatiquement au cours des deplacement de l'objet.
+# 	* anchors : permet d'active ou ne le suivi des objets contenus dans 'followed_by'
+# Les fonctions :
+#	* update_bbox : permet de demander une remise ? jour du calcul automatique des dimensions de l'objet (util uniquement si auto_sizing == 1)
+
+use MTools;
+
+use vars qw /@ISA/;
+
+
+use MTools::MGroup;
+require Exporter;
+
+BEGIN 
+{
+	@ISA = qw /MTools::MGroup Exporter/;
+	@EXPORT = qw / translate scale rotate /;
+}
+
+use strict;
+use Tk;
+
+sub new {
+	my ($class, $parent, %options) = @_;
+	my $self = new MTools::MGroup ($parent);
+	bless $self, $class;
+
+	$self -> recordEvent ('TRANSLATED');	
+	$self -> recordProperty ('auto_sizing', (!defined $options{width}) || (!defined $options{height}));
+	$self -> recordProperty ('height', 0);
+	$self -> recordProperty ('width', 0);
+	$self -> recordProperty ('x', 0);
+	$self -> recordProperty ('y', 0);
+	$self -> recordProperty ('xmin', 0);
+	$self -> recordProperty ('ymin', 0);
+	$self -> recordProperty ('xmax', 1500);
+	$self -> recordProperty ('ymax', 1500);
+	$self -> recordProperty ('anchors', 1);
+	
+	$self -> recordEvent ('__HANDLE_MOVING');
+	$self -> recordEvent ('__PUSH_BACK');
+	$self -> recordEvent ('__ENQUEUE_MOVING');
+
+	$self -> mconfigure (%options);
+	return $self;
+}
+
+sub translate {
+	my ($self, $delta_x, $delta_y) = @_;
+	if ($self -> {__added})
+	{
+		if ((abs ($delta_x) >= $self -> mget ('width') / 2) or (abs ($delta_y) >= $self -> mget ('height') / 2)) 
+		{
+	    	my ($mini_dx, $mini_dy) = (int ($delta_x / 2), int ($delta_y / 2));
+			$self -> translate ($mini_dx, $mini_dy);
+			$self -> translate ($delta_x - $mini_dx, $delta_y - $mini_dy);
+		}
+		else 
+		{
+			$self -> __try_move ($delta_x, $delta_y, []);
+			$self -> notify ('__HANDLE_MOVING');
+		}
+	}
+	else
+	{
+		$self -> __update_xy ($delta_x, $delta_y);
+	}
+}
+
+sub __search {
+	my ($val, @tab) = @_;
+	my $result = 0;
+	if (($#tab != -1) and (defined $val)) 
+	{
+		foreach (@tab) 
+		{
+			if (($_ eq $val) or ($_ =~ m/$val/)) 
+			{
+				$result = 1;
+				last;
+			}
+		}
+	}
+	return $result;
+}
+
+sub __try_move {
+	my ($self, $delta_x, $delta_y, $path) = @_;
+	return if __search ($self, @{$path});
+	push (@{$path},	$self);
+	$self -> __update_xy ($delta_x, $delta_y);
+
+	my $label_coords_x = $self -> mget ('x');
+	my $label_coords_y = $self -> mget ('y');
+	my $x_min = $self -> mget ('xmin');
+	my $x_max = $self -> mget ('xmax');
+	my $y_min = $self -> mget ('ymin');
+	my $y_max = $self -> mget ('ymax');
+	
+	my ($push_x, $push_y) = (0, 0);
+	$push_x = $x_min - $label_coords_x if $label_coords_x < $x_min;
+	$push_x = $x_max - $label_coords_x if $label_coords_x > $x_max;
+	$push_y = $y_min - $label_coords_y if $label_coords_y < $y_min;
+	$push_y = $y_max - $label_coords_y if $label_coords_y > $y_max;
+	$self -> notify ('__PUSH_BACK', $self, $push_x, $push_y, $path) if (($push_x != 0) or ($push_y != 0));
+	
+	if ($self -> mget ('anchors')) 
+	{
+		if (defined $self -> {followed_by})
+		{
+	    	foreach (@{$self -> {followed_by}}) 
+	    	{
+				$_ -> __try_move($delta_x + $push_x, $delta_y + $push_y, $path);
+	    	}
+		}
+	}
+	
+	my @other_path = @{$path};
+	$self -> notify ('__ENQUEUE_MOVING', $self, $delta_x + $push_x, $delta_y + $push_y, [@other_path]);
+	pop @{$path};
+}
+
+sub __update_xy {
+	my ($self, $delta_x, $delta_y) = @_;
+	MTools::translate ($self, $delta_x, $delta_y);
+	$self -> mconfigure ('x' => $self -> mget ('x') + $delta_x);
+	$self -> mconfigure ('y' => $self -> mget ('y') + $delta_y);
+	$self -> notify ('TRANSLATED', $delta_x, $delta_y);
+}
+
+sub scale {
+	my ($self, @params) = @_;
+	MTools::scale ($self, @params);
+	$self -> update_bbox ();
+	$self -> translate (0, 0);
+}
+
+sub rotate {
+	my ($self, @params) = @_;
+	MTools::rotate ($self, @params);
+	$self -> update_bbox ();
+	$self -> translate (0, 0);
+}
+
+sub update_bbox {
+	my ($self) = @_;
+	if ($self -> mget ('auto_sizing'))
+	{
+		my @rect = $self -> bbox ();
+		$self -> mconfigure (width => $rect [2] - $rect [0]);
+		$self -> mconfigure (height => $rect [3] - $rect [1]);
+	}
+}
+
+1;
diff --git a/src/MTools/GUI/MCircle.pm b/src/MTools/GUI/MCircle.pm
new file mode 100644
index 0000000..35463ef
--- /dev/null
+++ b/src/MTools/GUI/MCircle.pm
@@ -0,0 +1,51 @@
+package MTools::GUI::MCircle;
+#	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
+#
+##################################################################
+
+# Encapsule la creation d'un cercle
+# Parametres : 
+# 	* parent : pere de l'objet.
+# 	* x, y : coordonnees du centre du cercle
+#	* r : rayon du cercle
+#	* %options : table de hash pass?e en parametre de la cr?ation de l'objet zinc arc
+
+use strict;
+
+use MTools;
+use MTools::MObjet;
+use vars qw / @ISA /;
+
+BEGIN 
+{
+	@ISA = qw /MTools::MObjet/;
+}
+
+sub new {
+	my ($class, $parent, $x, $y, $r, %options) = @_;
+	my $self = {};
+	bless $self, $class;
+	$self -> {instance} = $zinc -> add('arc', 
+		ref ($parent) eq '' ? $parent : $parent -> {instance}, 
+		[$x - $r, $y - $r, $x + $r, $y + $r],
+		-pieslice => 0,
+		-priority => 10,
+		%options,
+	);
+	return $self;
+}
+
+1;
diff --git a/src/MTools/GUI/MClip.pm b/src/MTools/GUI/MClip.pm
new file mode 100644
index 0000000..248e395
--- /dev/null
+++ b/src/MTools/GUI/MClip.pm
@@ -0,0 +1,90 @@
+package MTools::GUI::MClip;
+#	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
+#
+##################################################################
+
+# Encapsule le clipping d'un objet
+# Parametres : 
+# 	* clipped : group zinc clippe
+#	* path : description de l'objet clippant
+#		- soit une descrition sous forme [_type, _coords] creant un objet zinc de type _type et de coordonnees _coords
+#		- soit un objet existant qui prendra pour p?re le group $clipped.
+
+use strict;
+
+use MTools;
+use MTools::MObjet;
+use vars qw / @ISA /;
+
+BEGIN 
+{
+	@ISA = qw /MTools::MObjet/;
+}
+
+sub new {
+	my ($class, $clipped, $path, $debug) = @_;
+	my $self = {};
+	bless $self, $class;
+
+	if (!defined $debug) {$debug = 0}
+	
+	my $clip = $path;
+	if(ref ($path) eq 'ARRAY')
+	{
+		my $type = shift @{$path};
+		$clip = $zinc -> add ($type, $clipped -> {instance}, $path, 
+			-filled => 1, 
+			-priority => 10,
+			-linewidth => 0,
+			-fillcolor => "#000000",
+			-visible => $debug,
+			-sensitive => 0,
+		);
+	}
+	elsif(ref ($path) eq '')
+	{
+		$clip = minstance ($clip, $clipped);
+		MTools::chggroup ($clip, $clipped);
+		MTools::mconfigure  ($clip, -visible => $debug, -sensitive => 0);
+	}
+	else
+	{
+		MTools::chggroup ($clip, $clipped);
+		MTools::mconfigure (-visible => $debug, -sensitive => 0);
+		$clip = minstance ($clip);
+	}
+	$self -> {__clipped} = $clipped;
+	$self -> {__clip} = $clip;
+	mconfigure ($clipped, -clip => $clip);
+	return $self;
+}
+
+sub translate {
+	my ($self, @args) = @_;
+	MTools::translate ($self -> {__clip}, @args);
+}
+
+sub scale {
+	my ($self, @args) = @_;
+	MTools::scale ($self -> {__clip}, @args);
+}
+
+sub rotate {
+	my ($self, @args) = @_;
+	MTools::rotate ($self -> {__clip}, @args);
+}
+
+1;
diff --git a/src/MTools/GUI/MCurve.pm b/src/MTools/GUI/MCurve.pm
new file mode 100644
index 0000000..3458e49
--- /dev/null
+++ b/src/MTools/GUI/MCurve.pm
@@ -0,0 +1,54 @@
+package MTools::GUI::MCurve;
+#	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
+#
+##################################################################
+
+# Encapsule la creation d'une curve
+# Parametres : 
+# 	* parent : pere de l'objet.
+# 	* coords : coordonnees de la curve (cf. format zinc)
+#	* %options : table de hash pass?e en param?tre de la creation de l'objet zinc curve
+
+
+use strict;
+
+use MTools;
+use MTools::MObjet;
+use vars qw / @ISA /;
+
+BEGIN 
+{
+	@ISA = qw /MTools::MObjet/;
+}
+
+sub new {
+	my ($class, $parent, $coords, %options) = @_;
+	my $self = {};
+	bless $self, $class;
+	$self -> {instance} = $zinc -> add('curve', 
+		ref ($parent) eq '' ? $parent : $parent -> {instance}, 
+		$coords,
+		-priority => 10,
+		-visible => 1,
+		-filled => 0,
+		-linecolor => 'black',
+		-linewidth => 1,
+		%options,
+	);
+	return $self;
+}
+
+1;
diff --git a/src/MTools/GUI/MImage.pm b/src/MTools/GUI/MImage.pm
new file mode 100644
index 0000000..94a20b6
--- /dev/null
+++ b/src/MTools/GUI/MImage.pm
@@ -0,0 +1,69 @@
+package MTools::GUI::MImage;
+#	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
+#
+##################################################################
+
+# Encapsule la creation d'une image
+# Parametres : 
+# 	* parent : pere de l'objet.
+# 	* image : nom de l'image
+#	* %options : table de hash passee en parametre de la creation de l'objet zinc icon
+
+
+use strict;
+
+use MTools;
+use MTools::MObjet;
+use vars qw / @ISA /;
+
+use Tk::PNG;
+
+BEGIN 
+{
+	@ISA = qw /MTools::MObjet/;
+}
+
+sub new {
+	my ($class, $parent, $image, %options) = @_;
+	my $self = new MTools::MObjet ();
+	bless $self, $class;
+	
+	my $image = __getImage ($zinc, $image);
+	$self -> {instance}  = $zinc -> add('icon', minstance ($parent),
+		-priority => 10,
+		-image => $image,
+		-composealpha => 1,
+		%options
+	);
+	return $self;
+}
+
+
+sub __getImage {
+	my ($widget, $imagefile) = @_;
+	my $image;
+	if (index ($imagefile, '.png') != -1)
+	{
+		$image = $widget -> Photo(-file => Tk::findINC($imagefile), -format => 'png');
+	}
+	else
+	{
+		$image = $widget -> Photo(-file => Tk::findINC($imagefile));
+	}
+    return $image;
+}
+
+1;
diff --git a/src/MTools/GUI/MRect.pm b/src/MTools/GUI/MRect.pm
new file mode 100644
index 0000000..e28b044
--- /dev/null
+++ b/src/MTools/GUI/MRect.pm
@@ -0,0 +1,54 @@
+package MTools::GUI::MRect;
+#	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
+#
+##################################################################
+
+# Encapsule la creation d'un rectangle
+# Parametres : 
+# 	* parent : pere de l'objet.
+# 	* x, y : de l'angle en haut a gauche du rectangle
+#	* w, h : largeur et hauteur du rectangle
+#	* %options : table de hash passee en parametre de la creation de l'objet zinc rectangle
+
+
+use strict;
+
+use MTools;
+use MTools::MObjet;
+use vars qw / @ISA /;
+
+BEGIN 
+{
+	@ISA = qw /MTools::MObjet/;
+}
+
+sub new {
+	my ($class, $parent, $x, $y, $w, $h, %options) = @_;
+	my $self = new MTools::MObjet ();
+	bless $self, $class;
+	if ((defined $options {-fillcolor}) && (!defined $options {-filled})) 
+	{
+		$options{-filled} = 1;
+	}
+	$self -> {instance} = $zinc -> add ('rectangle', 
+		minstance ($parent), 
+		[$x, $y, $x + $w, $y + $h],
+		%options,
+	);
+	return $self;
+}
+
+1;
diff --git a/src/MTools/GUI/MText.pm b/src/MTools/GUI/MText.pm
new file mode 100644
index 0000000..71d99ec
--- /dev/null
+++ b/src/MTools/GUI/MText.pm
@@ -0,0 +1,54 @@
+package MTools::GUI::MText;
+#	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
+#
+##################################################################
+
+# Encapsule la creation d'un text
+# Parametres : 
+# 	* parent : pere de l'objet.
+#	* text : text !
+# 	* x, y : coordonnees de l'emplacement de l'objet
+#	* %options : table de hash passee en parametre de la creation de l'objet zinc text
+
+
+use strict;
+
+use MTools;
+use MTools::MObjet;
+use vars qw / @ISA /;
+
+BEGIN 
+{
+	@ISA = qw /MTools::MObjet/;
+}
+
+sub new {
+	my ($class, $parent, $text, $x, $y, %options) = @_;
+	my $self = new MTools::MObjet ();
+	bless $self, $class;
+	if (!defined $x) {$x = 0;}
+	if (!defined $y) {$y = 0;}
+	if (!defined $text) {$text = "";}
+	$self -> {instance} = $zinc -> add ('text', 
+		minstance ($parent), 
+		-text => $text,
+		%options,
+	);
+	$self -> translate ($x, $y);
+	return $self;
+}
+
+1;
diff --git a/src/MTools/GUI/MTexture.pm b/src/MTools/GUI/MTexture.pm
new file mode 100644
index 0000000..f3dff9e
--- /dev/null
+++ b/src/MTools/GUI/MTexture.pm
@@ -0,0 +1,75 @@
+package MTools::GUI::MTexture;
+#	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
+#
+##################################################################
+
+# Permet d'appliquer un texture a un objet
+# Parametres : 
+# 	* parent : pere de l'objet.
+#	* target : group zinc destine a contenir les images de texture
+# 	* image_name : nom de l'image texture
+
+use strict;
+
+use MTools;
+use MTools::MGroup;
+use MTools::GUI::MImage;
+
+use vars qw / @ISA /;
+
+
+BEGIN 
+{
+	@ISA = qw /MTools::MGroup/;
+}
+
+sub new {
+	my ($class, $parent, $target, $image_name) = @_;
+	my $self = new MTools::MGroup ($parent);
+	bless $self, $class;
+	
+	chggroup ($target, $self);
+	
+	my $image = new MTools::GUI::MImage ($self, $image_name);
+	
+	my @bb = bbox ($image);
+	my $img_w = $bb [2] - $bb [0];
+	my $img_h = $bb [3] - $bb [1];
+	
+	my @bb = bbox ($target);
+	my $w = $bb [2] - $bb [0];
+	my $h = $bb [3] - $bb [1];
+	
+	mdelete ($image);
+	
+	for (my $x = 0; $x < $w; $x += $img_w)
+	{
+		for (my $y = 0; $y < $h; $y += $img_h)
+		{
+				$image = new MTools::GUI::MImage ($self, $image_name);
+				$image -> translate ($x + $bb [0], $y + $bb [1]);
+		}
+	}
+	
+	my $clip = $zinc -> clone ($target);
+	mconfigure ($clip, -visible => 0);
+	new MTools::GUI::MClip ($self, $clip);
+	return $self;
+}
+
+
+
+1;