Ajout de 2 nouvelles widgets (Merci JL Vinot):

Une pour creer un fond d'appli selon un style passe en parametre : MControlBoard
Une pour creer une "belle" fleche : MArrow
Pour l'instant pas d'exemples les utilisant (si ce n'est l'appli approche Acropole), peut etre ulterieurement.
Un peu de robustesse pour le MBouton...

1 files changed, 192 insertions, 0 deletions

diff --git a/src/MTools/Widget/MControlBoard.pm b/src/MTools/Widget/MControlBoard.pm
new file mode 100644
index 0000000..16cf0a1
--- /dev/null
+++ b/src/MTools/Widget/MControlBoard.pm
@@ -0,0 +1,192 @@
+package MTools::Widget::MControlBoard;
+#	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 IO::Dir;
+use Data::Dumper;
+use Tk::Zinc::Graphics;
+use MTools;
+use MTools::GUI::MGroup;
+
+use vars qw /@ISA/;
+
+my @Gradiants;
+my %textures;
+my %groups;
+my %clips;
+
+
+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;
+	%groups = ();
+	my $name = $options {name};
+	$self -> {'label'} = (defined $options {label}) ? $options {label} : $name;
+	
+	$self -> {'style'} = $options {style};
+
+	$self ->{'coef'} = defined $options {coef} ? $options {coef} : {'x' =>1,'y'=>1};
+	$self -> build;
+
+	return $self;
+}
+
+
+sub build {
+	my $self = shift;
+
+	if ($self -> {'style'})
+	{
+	  my $hashtable = $self -> parse ($self -> {'style'});
+
+	  if ($hashtable) {
+	    if ($hashtable->{'gradset'}) {
+	      my $gradset = delete $hashtable->{'gradset'};
+	      $self -> createGradset ($gradset);
+
+	    }
+
+	    while (my ($name, $style) = each(%{$hashtable})) {
+
+	      push @{$self->{groups}},$self -> createZone($name, $style);
+
+	    }
+
+	  }
+	}
+}
+
+sub createGradset {
+        my ($self, $gradset) = @_;
+
+	while (my ($name, $gradiant) = each(%{$gradset})) {
+	  # cr�ation des gradiants nomm�s
+	  if (! $zinc->gname($name))
+	    {
+	      $zinc->gname($gradiant, $name);
+	    }
+	  push(@Gradiants, $name);
+	}
+}
+
+
+sub parse {
+        my ($self, $filename) = @_;
+	open FD, "<$filename" or die "Cannot open $filename";
+	my $text;
+
+	while (<FD>)
+	  {
+	    $text .= $_;
+	  }
+
+	my $d = eval $text;
+	die "Error while parsing file $filename : ", $@ if ($@);
+	return $d;
+}
+
+sub createZone {
+    my ($self, $zone, $zonestyle) = @_;
+
+    my $itemzone;
+    my %buttons;
+    my $zgroup;
+    if ($zonestyle)
+    {
+	my $name = $zonestyle->{'-name'};
+
+	# cr�ation du groupe zone
+	my $grouptags;
+	
+	my $parent_zone = $zonestyle->{'-parent'};
+	my $parent_group = getZoneGroup($parent_zone);
+
+	# item group Zone
+	$zgroup = $zinc->add('group', $parent_group);	
+	$groups{$zone} = $zgroup;	
+	$zinc->coords($zgroup, $zonestyle->{'-coords'}) if ($zonestyle->{'-coords'});
+
+	# clipping de zone si n�cessaire
+	if ($zonestyle->{'-group'}) {
+	    $zinc->itemconfigure($zgroup, %{$zonestyle->{'-group'}});
+	}
+
+	
+	# cr�ation de l'item zone
+	if ($zonestyle->{'-form'}) {
+	    $itemzone = &buildZincItem($zinc, $zgroup, %{$zonestyle->{'-form'}});
+	}
+
+	# cr�ation des "d�corations"
+	if ($zonestyle->{'-decos'}) {
+	    my %items = %{$zonestyle->{'-decos'}};
+	    my ($name, $itemstyle);
+	    while (($name, $itemstyle) = each(%items)) {
+		my $item =  &buildZincItem($zinc, $zgroup, %{$itemstyle});
+	    }
+	}
+
+	# cr�ation des zones de "feedback" dans le tray
+	if ($zonestyle->{'-feedbacks'}) {
+	    my %items = %{$zonestyle->{'-feedbacks'}};
+	    my ($name, $itemstyle);
+	    while (($name, $itemstyle) = each(%items)) {
+		my $item =  &buildZincItem($zinc, $zgroup, $itemstyle);
+	    }
+	}
+
+
+
+	# cr�ation des boutons de zone
+	if ($zonestyle->{'-buttons'}) {
+	    %buttons = &buildButtons($zgroup, $zonestyle->{'-buttons'});
+	}
+	$zinc->scale($zgroup,$self->{'coef'}->{x},$self->{'coef'}->{y});
+    }
+    return ($zgroup);
+}
+
+
+sub getZoneGroup
+{
+    my $zone = shift;
+    return $groups{$zone} if (defined $groups{$zone});
+    return 1;
+}
+
+sub mdelete
+{
+    my ($self) = @_;
+    foreach (keys %groups)
+      {
+	$zinc->remove($groups{$_}) if (defined $groups{$_});
+      }
+      MTools::GUI::MGroup::mdelete($self);
+    
+}
+
+1;
+