diff options
Diffstat (limited to 'src/MTools/Widget/MControlBoard.pm')
| -rw-r--r-- | src/MTools/Widget/MControlBoard.pm | 192 |
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; + |