Import initial

1 files changed, 128 insertions, 0 deletions

diff --git a/src/MTools/MObjet.pm b/src/MTools/MObjet.pm
new file mode 100644
index 0000000..b35c07f
--- /dev/null
+++ b/src/MTools/MObjet.pm
@@ -0,0 +1,128 @@
+package MTools::MObjet;
+#	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
+#
+##################################################################
+
+# Le composant MObject est l'objet racine des composants MTools. 
+# Il defini les fonctions applicables uniquement aux objets MTools. 
+#
+# IMPORTANT : Une autre partie des fonctions applicables aux objets MTools est definie dans la classe MTools. 
+# La difference entre ces deux classes de fonctions est que les fonctions definies dans MTools sont egalement
+# applicables ? des objets zinc tandis que les fonctions definies ici ne peuvent etre appliquees que a des objets heritant de MTools::MObjet.
+#
+# Concepts :
+#	* Objet MTools : objet heritant de MObjet
+#	* Les PROPERTY :  Les proprietes sont des attributs particuliers et modifiables
+#	par un appel a "mconfigure". Elles peuvent etre ecoutees et synchronisees avec d'autres proprietes 
+#	MTools ou meme zinc ! (cf MTools::plink et MTools::plisten). En consequence elles sont la pour engendrer un comportement 
+#	consecutif ? leur modification et doivent etre distinguees des attibuts qui peuvent se contenter d'etre ds clef de hash de l'objet.
+#	* Les EVENT : les evenements peuvent etre emis par n'importe quel objet MTools et capter par un binding.
+#
+# Les fonctions public :
+# 	* recordEvent : permet de permettre a un objet MObjet d'emettre un evenement.
+# 	* recordProperty : permet de declarer et initialiser une propriete.
+# 	NOTA : Il pourrait manquer une declaration collective des proprietes. Initialement, 
+#	celle-ci n'a pas ete effectuee pour essayer de limiter l'usage des proprietes 
+#	et ne pas les utiliser comme des attributs. 
+#	* notify : permet a un objet MTools de notifier un evenement prealablement enregistre par recordEvent
+#	* propagate : permet a un objet de propager un evenement emis par un autre objet 
+#	(correspond a un recordEvent puis un binding sur un evenement d'un objet effectuant le notify du meme evt 
+#	depuis l'objet declarant la propagation)
+
+use strict;
+use MTools;
+use vars qw /@ISA @EXPORT @EXPORT_OK/;
+
+BEGIN 
+{
+	@ISA = qw //;
+}
+
+sub new {
+	my ($class) = @_;
+	my $self = {};
+	$self -> {instance} = -1;
+	bless $self, $class;
+	return $self;
+}
+
+sub recordEvent {
+	my ($self, $event) = @_;
+	if (!(defined $self -> {__events} -> {$event}))
+	{
+		$self -> {__events} -> {$event} = [];
+	}
+}
+
+sub recordProperty {
+	my ($self, $prop, $val) = @_;
+	$self -> {__properties} -> {$prop} -> {val} = $val;
+}
+
+sub notify {
+	my ($self, $event, @params) = @_;
+	if (!defined $self -> {__events} -> {$event})
+	{
+		print "ERREUR $self : Vous essayer de notifier l'evenement $event qui n'est pas declare\n";
+		return;
+	}
+	my @tb = @{$self -> {__events} -> {$event}};
+	for (my $i = 0; $i < @tb; $i++)
+	{
+		executer ($tb[$i], @params);
+	}
+}
+
+sub propagate {
+	my ($self, $from, $event, @nargs) = @_;
+	$self -> recordEvent ($event);
+	$from -> __addListener ($event, 
+		sub { 
+			my (@args) = @_; 
+			$self -> notify  ($event, @args, @nargs);
+		}
+	);
+}
+
+sub __addListener {
+	my ($self, $event, $methode) = @_;
+	if (defined $self -> {__events} -> {$event})
+	{
+		push (@{$self -> {__events} -> {$event}}, $methode);
+		return $methode;
+	}
+	else
+	{
+		print "ERREUR : l'objet $self n'?met jamais l'evt $event... L'abonnement est donc inutile\n";
+	}
+}
+
+sub __removeListener {
+	my ($self, $event, $methode) = @_;
+	if (defined $self -> {__events} -> {$event})
+	{
+		my @events = @{$self -> {__events} -> {$event}};
+		for (my $i = @events - 1; $i >= 0; $i--) 
+		{
+			if ($events [$i] == $methode) 
+			{
+				splice (@{$self -> {__events} -> {$event}}, $i, 1);
+			}
+		}
+	}
+}
+
+1;