Import initial

4 files changed, 656 insertions, 0 deletions

diff --git a/src/MTools/Anim/MOpacity.pm b/src/MTools/Anim/MOpacity.pm
new file mode 100644
index 0000000..e1882ba
--- /dev/null
+++ b/src/MTools/Anim/MOpacity.pm
@@ -0,0 +1,143 @@
+package MTools::Anim::MOpacity;
+#	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
+#
+##################################################################
+
+# MOpacity permet de realiser une animation sur la transparence d'un objet
+# 
+# proprietes :
+#	* -visible : permet d'activer ou non l'animation
+#	* from_opacity : valeur initiale de l'opacite au depart de l'animation
+#	* to_opacity : valeur de l'opacite a la fin de l'animation
+# 	* duration : duree de l'animation
+#	* loop : marque le caractere repetitif ou non de l'animation
+#	* targets : objets cible de cette animation
+# Evenements :
+#	* ANIMATION_END : Notifie lorque l'annimation se termine
+#	* OPACITY_CHANGED : Notifie lorsque la valeur de l'opacite est changee au cours de l'animation
+#	* ANIMATION_ABORD : Notifie lorsque l'animation est stoppee avant la fin
+# Fonctions : 
+#	* start : demarre l'animation
+#	* stop: arrete l'animation
+#	* isRunning : test si l'animation est en cours
+
+use strict;
+use MTools;
+use MTools::MObjet;
+
+use Anim;
+use Anim::Pacing::Linear;
+use Anim::Path::Rectilinear;
+
+use vars qw /@ISA/;
+
+BEGIN 
+{
+	@ISA = qw /MTools::MObjet/;
+}
+
+use Tk;
+
+sub new {
+	my ($class, %options) = @_;
+	my $self = new MTools::MObjet ();
+	bless $self, $class;
+
+	$self -> recordProperty ('-visible', 0);
+	$self -> recordProperty ('from_opacity', 0);
+	$self -> recordProperty ('to_opacity', 0);
+	$self -> recordProperty ('duration', 1);
+	$self -> recordProperty ('loop', 0);
+	$self -> recordProperty ('targets', undef);
+	$self -> recordEvent ('ANIMATION_END');
+	$self -> recordEvent ('OPACITY_CHANGED');
+	$self -> recordEvent ('ANIMATION_ABORD');
+	$self -> plisten ('-visible', sub { 
+		my ($src, $key, $val) = @_;
+		if ($val == 0)
+		{
+			$self -> stop ();
+		}
+		else
+		{
+			$self -> start ();
+		}
+	});
+	$self -> {__animation} = undef;
+	$self -> mconfigure (%options);
+	return $self;
+}
+
+sub start {
+	my ($self) = @_;
+	my $pacing = new Anim::Pacing::Linear (-duration => $self -> mget ('duration'));
+	$self -> {__opacitydep} = my $opacitydep = $self -> mget ('from_opacity');
+
+	my $animationpath = new Anim::Path::Rectilinear (
+		-xdep => 0,
+		-ydep => 0,
+		-xdest => $self -> mget ('to_opacity') - $opacitydep,
+		-ydest => 0,
+	);
+	$self -> {__opacity} = $opacitydep;
+	$self -> {__animation} = my $animation = new Anim (
+		-pacing => $pacing,
+		-resources => [
+			$animationpath,
+			-command => sub { $self -> __event (@_)},
+			-endcommand => sub {$self -> notify ('ANIMATION_END');$self -> {__animation} = undef;},
+		],
+		-stopcommand => sub {$self -> notify ('ANIMATION_ABORD', $self -> {__opacity});$self -> {__animation} = undef;},
+		-loop => $self -> mget ('loop'),
+	);
+	$animation -> start ();
+}
+
+sub stop {
+	my ($self) = @_;
+	if (defined $self -> {__animation})
+	{
+		$self -> {__animation} -> stop ();
+	}
+}
+
+sub __event {
+	my ($self, $opacity) = @_;
+	$opacity += $self -> {__opacitydep};
+	my @targets = ();
+	my $target = $self -> mget ('targets');
+	if (ref ($target) eq 'ARRAY')
+	{
+		@targets = @{$target};
+	}
+	else
+	{
+		push (@targets, $target);
+	}
+	for (my $i = 0; $i < @targets; $i++)
+	{
+		$targets [$i] -> mconfigure ('-alpha' => $opacity);
+	}
+	$self -> {__opacity} = $opacity;
+	$self -> notify ('OPACITY_CHANGED', $opacity);
+}
+
+sub isRunning {
+	my ($self) = @_;
+	return defined $self -> {__animation};
+}
+
+1;
diff --git a/src/MTools/Anim/MPath.pm b/src/MTools/Anim/MPath.pm
new file mode 100644
index 0000000..6fcbb2f
--- /dev/null
+++ b/src/MTools/Anim/MPath.pm
@@ -0,0 +1,193 @@
+package MTools::Anim::MPath;
+#	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
+#
+##################################################################
+
+# MPath permet de realiser une animation de deplacement suivant un chemin
+# 
+# proprietes :
+#	* -visible : permet d'activer ou non l'animation
+#	* path : chemin
+# 	* duration : duree de l'animation
+#	* loop : marque le caractere repetitif ou non de l'animation
+#	* targets : objets cible de cette animation
+# Evenements :
+#	* ANIMATION_END : Notifie lorque l'annimation se termine
+#	* VALUE_CHANGED : Notifie lorsque la valeur de l'opacite est changee au cours de l'animation
+#	* ANIMATION_ABORD : Notifie lorsque l'animation est stoppee avant la fin
+# Fonctions : 
+#	* start : demarre l'animation
+#	* stop: arrete l'animation
+#	* isRunning : test si l'animation est en cours
+
+use strict;
+use MTools;
+use MTools::MObjet;
+
+use Anim;
+use Anim::Pacing::Linear;
+use Anim::Path::Rectilinear;
+
+use vars qw /@ISA/;
+
+BEGIN 
+{
+	@ISA = qw /MTools::MObjet/;
+}
+
+use Tk;
+
+sub new {
+	my ($class, %options) = @_;
+	my $self = new MTools::MObjet ();
+	bless $self, $class;
+
+	$self -> recordProperty ('-visible', 0);
+	$self -> recordProperty ('path', []);
+	$self -> recordProperty ('duration', 1);
+	$self -> recordProperty ('loop', 0);
+	$self -> recordProperty ('targets', undef);
+	$self -> recordEvent ('ANIMATION_END');
+	$self -> recordEvent ('VALUE_CHANGED');
+	$self -> recordEvent ('ANIMATION_ABORD');
+	$self -> plisten ('path', [$self, 'pathchanged']);
+	$self -> plisten ('-visible', sub { 
+		my ($src, $key, $val) = @_;
+		if ($val == 0)
+		{
+			$self -> stop ();
+		}
+		else
+		{
+			$self -> start ();
+		}
+	});
+	$self -> {__animation} = undef;
+	$self -> {__length} = 0;
+	$self -> {__x} = 0;
+	$self -> {__y} = 0;
+	$self -> {__vx} = 0;
+	$self -> {__vy} = 0;
+	$self -> mconfigure (%options);
+	return $self;
+}
+
+sub pathchanged {
+	my ($self, $src, $key, $value) = @_;
+	my @points = @{$value};
+	my $length = 0;
+	for (my $i = 0; $i < @points - 1; $i ++)
+	{
+		my $x = $points [$i + 1] -> [0] - $points [$i] -> [0];
+		my $y = $points [$i + 1] -> [1] - $points [$i] -> [1];
+		$length +=  sqrt ($x * $x + $y * $y);
+	}
+	$self -> {__length} = $length;
+}
+
+sub start {
+	my ($self) = @_;
+	
+	my @points = @{$self -> mget ('path')};
+	if (!defined @points || @points <= 0) {return;}
+	$self -> {__x} = $points [0] -> [0];
+	$self -> {__y} = $points [0] -> [1];
+	my $pacing = new Anim::Pacing::Linear (-duration => $self -> mget ('duration'));
+	$self -> {__percentage} = 0;
+	my $animationpath = new Anim::Path::Rectilinear (
+		-xdep => 0,
+		-ydep => 0,
+		-xdest => 100,
+		-ydest => 0,
+	);
+	$self -> {__animation} = my $animation = new Anim (
+		-pacing => $pacing,
+		-resources => [
+			$animationpath,
+			-command => sub { $self -> __event (@_)},
+			-endcommand => sub {$self -> notify ('ANIMATION_END'); $self -> {__animation} = undef;},
+		],
+		-stopcommand => sub {
+			$self -> notify ('ANIMATION_ABORD', $self -> __getPoint ($self -> {__percentage}));
+			$self -> {__animation} = undef;
+		},
+		-loop => $self -> mget ('loop'),
+	);
+	$animation -> start ();
+}
+
+sub stop {
+	my ($self) = @_;
+	if (defined $self -> {__animation})
+	{
+		$self -> {__animation} -> stop ();
+	}
+}
+
+sub __getPoint {
+	my ($self, $percentage) = @_;
+	my @points = @{$self -> mget ('path')};
+	my $length = $self -> {__length} * $percentage / 100;
+	my $x = 0;
+	my $y = 0;
+	my $vx = 0;
+	my $vy = 0;
+	for (my $i = 0; $i < @points - 1; $i ++)
+	{
+		$vx = $x = $points [$i + 1] -> [0] - $points [$i] -> [0];
+		$vy = $y = $points [$i + 1] -> [1] - $points [$i] -> [1];
+		my $d = sqrt ($x * $x + $y * $y);
+		$length -= $d;
+		if ($length <= 0)
+		{
+			$d = ($d + $length) / $d;
+			$x = $d * $x + $points [$i] -> [0];
+			$y = $d * $y + $points [$i] -> [1];
+			$i = @points;
+		}
+	}
+	return ($x, $y, $vx, $vy);
+}
+
+sub __event {
+	my ($self, $percentage) = @_;
+	my ($x, $y, $vx, $vy) = $self -> __getPoint ($percentage);
+	my @targets = ();
+	my $target = $self -> mget ('targets');
+	if (ref ($target) eq 'ARRAY')
+	{
+		@targets = @{$target};
+	}
+	else
+	{
+		push (@targets, $target);
+	}
+	for (my $i = 0; $i < @targets; $i++)
+	{
+		$targets [$i] -> translate ($x - $self -> {__x}, $y - $self -> {__y});
+	}
+	$self -> {__x} = $x;
+	$self -> {__y} = $y;
+	$self -> {__percentage} = $percentage;
+	$self -> notify ('VALUE_CHANGED', $x, $y, $vx, $vy);
+}
+
+sub isRunning {
+	my ($self) = @_;
+	return defined $self -> {__animation};
+}
+
+1;
diff --git a/src/MTools/Anim/MScalor.pm b/src/MTools/Anim/MScalor.pm
new file mode 100644
index 0000000..cbdc49d
--- /dev/null
+++ b/src/MTools/Anim/MScalor.pm
@@ -0,0 +1,154 @@
+package MTools::Anim::MScalor;
+#	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
+#
+##################################################################
+
+# MScalor permet de realiser une animation de scale sur l'objet
+# 
+# proprietes :
+#	* -visible : permet d'activer ou non l'animation
+#	* center_x, center_y : coordonnees du centre de la transformation
+#	* from_x, from_y : valeur initiale de la transformation
+#	* to_x, to_y : valeur finale de la transformation
+# 	* duration : duree de l'animation
+#	* loop : marque le caractere repetitif ou non de l'animation
+#	* targets : objets cible de cette animation
+# Evenements :
+#	* ANIMATION_END : Notifie lorque l'annimation se termine
+#	* SCALED : Notifie lorsque la valeur de l'opacite est changee au cours de l'animation
+#	* ANIMATION_ABORD : Notifie lorsque l'animation est stoppee avant la fin
+# Fonctions : 
+#	* start : demarre l'animation
+#	* stop: arrete l'animation
+#	* isRunning : test si l'animation est en cours
+
+use strict;
+use MTools;
+use MTools::MObjet;
+
+use Anim;
+use Anim::Pacing::Linear;
+use Anim::Path::Rectilinear;
+
+use vars qw /@ISA/;
+
+BEGIN 
+{
+	@ISA = qw /MTools::MObjet/;
+}
+
+use Tk;
+
+sub new {
+	my ($class, %options) = @_;
+	my $self = new MTools::MObjet ();
+	bless $self, $class;
+
+	$self -> recordProperty ('-visible', 0);
+	$self -> recordProperty ('center_x', 0);
+	$self -> recordProperty ('center_y', 0);
+	$self -> recordProperty ('from_x', 0);
+	$self -> recordProperty ('from_y', 0);
+	$self -> recordProperty ('to_x', 0);
+	$self -> recordProperty ('to_y', 0);
+	$self -> recordProperty ('duration', 1);
+	$self -> recordProperty ('loop', 0);
+	$self -> recordProperty ('targets', undef);
+	$self -> recordEvent ('ANIMATION_END');
+	$self -> recordEvent ('SCALED');
+	$self -> recordEvent ('ANIMATION_ABORD');
+	$self -> plisten ('-visible', sub { 
+		my ($src, $key, $val) = @_;
+		if ($val == 0)
+		{
+			$self -> stop ();
+		}
+		else
+		{
+			$self -> start ();
+		}
+	});
+	$self -> {__animation} = undef;
+	$self -> mconfigure (%options);
+	return $self;
+}
+
+sub start {
+	my ($self) = @_;
+	my $pacing = new Anim::Pacing::Linear (-duration => $self -> mget ('duration'));
+	$self -> {__xdep} = my $xdep = $self -> mget ('from_x');
+	$self -> {__ydep} = my $ydep = $self -> mget ('from_y');
+
+	my $animationpath = new Anim::Path::Rectilinear (
+		-xdep => 0,
+		-ydep => 0,
+		-xdest => $self -> mget ('to_x') - $xdep,
+		-ydest => $self -> mget ('to_y') - $ydep,
+	);
+	$self -> {__x} = $xdep;
+	$self -> {__y} = $ydep;
+	$self -> {__animation} = my $animation = new Anim (
+		-pacing => $pacing,
+		-resources => [
+			$animationpath,
+			-command => sub { $self -> __event (@_)},
+			-endcommand => sub {$self -> notify ('ANIMATION_END');$self -> {__animation} = undef;},
+		],
+		-stopcommand => sub {$self -> notify ('ANIMATION_ABORD', $self -> {__x}, $self -> {__y});$self -> {__animation} = undef;},
+		-loop => $self -> mget ('loop'),
+	);
+	$animation -> start ();
+}
+
+sub stop {
+	my ($self) = @_;
+	if (defined $self -> {__animation})
+	{
+		$self -> {__animation} -> stop ();
+	}
+}
+
+sub __event {
+	my ($self, $x, $y) = @_;
+	my $cx = $self -> mget ('center_x');
+	my $cy = $self -> mget ('center_y');
+	$x += $self -> {__xdep};
+	$y += $self -> {__ydep};
+	my @targets = ();
+	my $target = $self -> mget ('targets');
+	if (ref ($target) eq 'ARRAY')
+	{
+		@targets = @{$target};
+	}
+	else
+	{
+		push (@targets, $target);
+	}
+	for (my $i = 0; $i < @targets; $i++)
+	{
+		scale ($targets [$i], $x / $self -> {__x}, $y / $self -> {__y}, $cx, $cy);
+	}
+	$self -> {__x} = $x;
+	$self -> {__y} = $y;
+	$self -> notify ('SCALED', $x, $y, $cx, $cy);
+}
+
+sub isRunning {
+	my ($self) = @_;
+	return defined $self -> {__animation};
+}
+
+1;
diff --git a/src/MTools/Anim/MTranslator.pm b/src/MTools/Anim/MTranslator.pm
new file mode 100644
index 0000000..3ac0544
--- /dev/null
+++ b/src/MTools/Anim/MTranslator.pm
@@ -0,0 +1,166 @@
+package MTools::Anim::MTranslator;
+#	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
+#
+##################################################################
+
+# MTranslator permet de realiser une animation de translation sur l'objet
+# 
+# proprietes :
+#	* -visible : permet d'activer ou non l'animation
+#	* from_x, from_y : valeur initiale de la transformation
+#	* to_x, to_y : valeur finale de la transformation
+# 	* duration : duree de l'animation
+#	* loop : marque le caractere repetitif ou non de l'animation
+#	* targets : objets cible de cette animation
+# Evenements :
+#	* ANIMATION_END : Notifie lorque l'annimation se termine
+#	* MOTION : Notifie lorsque la valeur de l'opacite est changee au cours de l'animation
+#	* ANIMATION_ABORD : Notifie lorsque l'animation est stoppee avant la fin
+# Fonctions : 
+#	* start : demarre l'animation
+#	* stop: arrete l'animation
+#	* isRunning : test si l'animation est en cours
+
+
+use strict;
+use MTools;
+use MTools::MObjet;
+
+use Anim;
+use Anim::Pacing::Linear;
+use Anim::Path::Rectilinear;
+
+use vars qw /@ISA/;
+
+BEGIN 
+{
+	@ISA = qw /MTools::MObjet/;
+}
+
+use Tk;
+
+sub new {
+	my ($class, %options) = @_;
+	my $self = {};
+	bless $self, $class;
+
+	$self -> recordProperty ('-visible', 0);
+	$self -> recordProperty ('from_x', $options {from_x} ? $options {from_x} : 0);
+	$self -> recordProperty ('from_y', $options {from_y} ? $options {from_y} : 0);
+	$self -> recordProperty ('to_x', $options {to_x} ? $options {to_x} : 0);
+	$self -> recordProperty ('to_y', $options {to_y} ? $options {to_y} : 0);
+	$self -> recordProperty ('duration', $options {duration} ? $options {duration} : 1);
+	$self -> recordProperty ('loop', $options {loop} ? $options {loop} : 0);
+	$self -> recordProperty ('targets', $options {targets});
+
+	$self -> recordEvent ('ANIMATION_END');
+	$self -> recordEvent ('MOTION');
+	$self -> recordEvent ('ANIMATION_ABORDED');
+
+	$self -> plisten ('-visible', sub { 
+		my ($src, $key, $val) = @_;
+		if ($val == 0)
+		{
+			$self -> stop ();
+		}
+		else
+		{
+			$self -> start ();
+		}
+	});
+	$self -> {__animation} = undef;
+	$self -> mconfigure (%options);
+	return $self;
+}
+
+sub stop {
+	my ($self) = @_;
+	if (defined $self -> {__animation})
+	{
+		$self -> {__animation} -> stop ();
+	}
+}
+
+sub start {
+	my ($self) = @_;
+	my $pacing = new Anim::Pacing::Linear (-duration => $self -> mget ('duration'));
+	$self -> {__xdep} = my $xdep = $self -> mget ('from_x');
+	$self -> {__ydep} = my $ydep = $self -> mget ('from_y');
+
+	my $animationpath = new Anim::Path::Rectilinear (
+		-xdep => 0,
+		-ydep => 0,
+		-xdest => $self -> mget ('to_x') - $xdep,
+		-ydest => $self -> mget ('to_y') - $ydep,
+	);
+	$self -> {__x} = $xdep;
+	$self -> {__y} = $ydep;
+	$self -> {__animation} = my $animation = new Anim (
+		-pacing => $pacing,
+		-resources => [
+			$animationpath,
+			-command => sub { $self -> event (@_)},
+			-endcommand => sub {
+				$self -> {__animation} = undef;
+				$self -> notify ('ANIMATION_END');
+			},
+		],
+		-stopcommand => sub {
+			$self -> {__animation} = undef;
+			$self -> notify ('ANIMATION_ABORDED', $self -> {__x}, $self -> {__y});
+		},
+		-loop => $self -> mget ('loop'),
+	);
+	$animation -> start ();
+}
+
+sub isRunning {
+	my ($self) = @_;
+	return defined $self -> {__animation};
+}
+
+
+sub event {
+	my ($self, $x, $y) = @_;
+	$x += $self -> {__xdep};
+	$y += $self -> {__ydep};
+	my @targets = ();
+	my $target = $self -> mget ('targets');
+	if (ref ($target) eq 'ARRAY')
+	{
+		@targets = @{$target};
+	}
+	else
+	{
+		push (@targets, $target);
+	}
+	for (my $i = 0; $i < @targets; $i++)
+	{
+		if (ref ($targets [$i]) eq 'MTools::Comp::MMover')
+		{
+			$target -> setPos ($x, $y);
+			$target -> notify ('MOVED', $x, $y, "mvd");
+		}
+		else
+		{
+			$targets [$i] -> translate ($x - $self -> {__x}, $y - $self -> {__y});
+		}
+	}
+	$self -> {__x} = $x;
+	$self -> {__y} = $y;
+	$self -> notify ('MOTION', $x, $y);
+}
+1;