From d587ffb205c30c978c3f44429266025728616178 Mon Sep 17 00:00:00 2001 From: didier Date: Fri, 9 Nov 2007 14:23:52 +0000 Subject: 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... --- src/MTools/Widget/MArrow.pm | 297 +++++++++++++++++++++++++++++++++++++ src/MTools/Widget/MBouton.pm | 4 +- src/MTools/Widget/MControlBoard.pm | 192 ++++++++++++++++++++++++ 3 files changed, 491 insertions(+), 2 deletions(-) create mode 100644 src/MTools/Widget/MArrow.pm create mode 100644 src/MTools/Widget/MControlBoard.pm (limited to 'src') diff --git a/src/MTools/Widget/MArrow.pm b/src/MTools/Widget/MArrow.pm new file mode 100644 index 0000000..abfb5a3 --- /dev/null +++ b/src/MTools/Widget/MArrow.pm @@ -0,0 +1,297 @@ +package MTools::Widget::MArrow; +# 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 Math::Trig; +require Exporter; +use Tk::Zinc::Graphics; +use MTools; +use MTools::GUI::MGroup; + +use vars qw /@ISA/; +@ISA = qw(Exporter); +my @EXPORT = qw(&arrowCoords); + +# orientation des flèches +my $direction2angle = {'left' => 180, + 'top'=> 90, + 'right' => 0, + 'bottom' => 270, + 'w' => 180, + 'nw'=> 135, + 'n' => 90, + 'ne'=> 45, + 'e' => 0, + 'se' => 315, + 's' => 270, + 'sw' => 225 + }; + + +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; + + # coords + $self -> coords ($options {'coords'}) if ($options {'coords'}); + + # coordonnées de la ligne support de flèche + if ($options {'linecoords'}) { + $self -> {'linecoords'} = $options {'linecoords'}; + $self -> {'length'} = &distance(@{$self -> {'linecoords'}->[-1]}, + @{$self -> {'linecoords'}->[-2]}); + } else { + $self -> {'length'} = (defined $options {'length'}) ? $options {'length'} : 100; + $self -> {'linecoords'} = [[0,0],[$self -> {'length'},0]]; + } + + $self -> {'width'} = ($options{'width'}) ? $options{'width'} : $self -> {'length'}; + + + # paramètres de direction + if (defined $options {angle}) { + $self -> {'angle'} = $options {'angle'}; + $self -> {'direction'} = undef; + + } else { + $self -> {'direction'} = ($options {'direction'}) ? $options {'direction'} : 'right'; + } + + + # paramètres de forme + # (style, longueur et angle du marqueur flèche, épaisseur et rayon du tracé) + $self -> {'head_style'} = $options {'head_style'}; + $self -> {'head_length'} = (defined $options {'head_length'}) ? $options {'head_length'} : $self -> {'length'}/2; + + $self -> {'thick'} = ($options{'thick'}) + ? $options{'thick'} : $self -> {'length'}/5; + $self -> {'radius'} = (defined $options{'radius'}) + ? $options{'radius'} : $self -> {'thick'}/2; + $self -> {'head_angle'} = ($options{'head_angle'}) + ? $options{'head_angle'} : 45; + + # style graphique + $self -> {'style'} = $options {style}; + + + $self -> build; + + return $self; +} + + +sub build { + my $self = shift; + + # le group de transformation (rotation) de la flèche + $self -> {'r_group'} = new MTools::GUI::MGroup ($self -> {instance}); + + # calcul des coordonnées de la curve + my $coords = $self->arrowCoords; + + # style de l'item zinc + my $style = {-itemtype => 'curve', + -coords => $coords, + -params => {-closed => 1, + %{$self -> {'style'}}, + }, + }; + + # item TkZinc de forme de la flèche + $self -> {'-form'} = &buildZincItem($zinc, $self -> {'r_group'} -> {instance}, %{$style}); + + # orientation + $self->direction; + +} + + +sub arrowCoords { + my ($self, %options) = @_; + my @pts; + + my $width = ($options{'width'}) ? $options{'width'} : $self -> {'width'};; + my $head_length = ($options{'head_length'}) ? $options{'head_length'} : $self -> {'head_length'}; + my $thick = ($options{'thick'}) ? $options{'thick'} : $self -> {'thick'}; + my $head_angle = ($options{'head_angle'}) ? $options{'head_angle'} : $self -> {'head_angle'}; + my $linecoords = ($options{'linecoords'}) ? $options{'linecoords'} : $self -> {'linecoords'}; + my $radius = ($options{'radius'}) ? $options{'radius'} : $self -> {'radius'}; + + my ($pt0,$pt1) = reverse @{$linecoords}; + my $endangle = &lineAngle($pt0,$pt1); + + + # points de flèche + my ($ptA,$ptB); + + if (!defined $head_length) { + my $b_sin = sin(deg2rad($endangle + $head_angle)); + $head_length = ($b_sin) ? abs(($width/2) / $b_sin) : $width/2; + + } elsif ($head_length) { + my ($x2,$y2) = &rad_point($pt0, $head_length, $endangle -90 - $head_angle); + $ptA = [$x2,$y2]; + my ($x3,$y3) = &rad_point($pt0, $head_length, $endangle -90 + $head_angle); + $ptB = [$x3,$y3]; + } + + # dl décalage de ligne = épaisseur forme /2 + my $dl = $thick/2; + + # la liste des points de la flèche + # (si $head_length = 0 pas de marker pointe) + my @vertex = reverse @{$linecoords}; + pop @vertex; + push (@vertex, @{$linecoords}); + if ($head_length) { + push(@vertex, ($ptA,$pt0,$ptB)); + } else { + push(@vertex, $pt1); + } + + # liste (booleens) du type raccord des sommets + my @corners; + + my $numfaces = scalar(@vertex); + my $previous = $vertex[-1]; + + # on parcours la forme d'arete en arete + for (my $i = 0; $i < $numfaces; $i++) { + my $pt = $vertex[$i]; + my $next = ($i < ($numfaces -1)) ? $vertex[$i+1] : $vertex[0]; + my ($angle,$bis); + + # angle du sommet + ($angle,$bis) = &vertexAngle($previous, $pt, $next); + + # angle plat : projection du contour + if ($angle < 1) { + $angle = &lineNormal($pt,$next); + my ($x2,$y2) = &rad_point($pt, $dl, $angle-90); + my ($x1,$y1) = &rad_point($pt, $dl, $angle+90); + push (@pts, [$x1,$y1]); + push (@pts, [$x2,$y2]); + + # accumulation d'un raccord supplémentaire + push(@corners, 1); + + + } else { + + # distance au centre du cercle inscrit : rayon/sinus demi-angle + my $sin = sin(deg2rad($angle/2)); + my $delta = ($sin) ? abs($dl/$sin) : $dl; + + # calcul du point de contour (projection angulaire sur mediatrice) + my ($x,$y) = &rad_point($pt, $delta, $bis-90); + push (@pts, [$x,$y]); + + } + + # ajout d'un raccord + push(@corners, 1); + + # nouveau point précédent + $previous = $pt; + } + + + # calcul des raccords d'angle si option radius + if ($radius) { + if ($head_length) { + push @pts, shift @pts; + $corners[-1] = 0; + $corners[-7] = 0; + + if (scalar @{$linecoords} > 2) { + @corners[0] = 0; + for (my $il = 2; $il < scalar @{$linecoords}; $il++) { + $corners[$il*2] = 0; + } + } + } + my $newpts = &roundedCurveCoords(\@pts, + -radius => $radius, + -corners => \@corners); + @pts = @{$newpts}; + } + + return \@pts; +} + + +sub direction { + my $self = shift; + my $angle; + + if (defined $self -> {'angle'}) { + $angle = $self -> {'angle'}; + $self -> {'direction'} = undef; + + } else { + + if ($self -> {'direction'}) { + $angle = $direction2angle->{$self -> {'direction'}}; + } else { + $self -> {'direction'} = 'right'; + $angle = $direction2angle->{'right'}; + } + + } + + if (defined $angle) { + $self -> {'r_group'} -> treset; + $self -> {'r_group'} -> rotate (deg2rad($angle)*-1); + } + +} + + +sub distance +{ + my @p = @_; + my $d = @p / 2; # nombre de dimensions + + # 2 dimensions + return sqrt(($_[0] - $_[2])**2 + ($_[1] - $_[3])**2) + if ($d == 2); + + my $S = 0; + my @p0 = splice @p, 0, $d; # point de départ + + for (my $i = 0; $i < $d; $i++) { + my $di = $p0[$i] - $p[$i]; + $S += $di * $di; + } + + return sqrt($S); + +} + + +1; + diff --git a/src/MTools/Widget/MBouton.pm b/src/MTools/Widget/MBouton.pm index f49af90..acabe65 100644 --- a/src/MTools/Widget/MBouton.pm +++ b/src/MTools/Widget/MBouton.pm @@ -38,7 +38,7 @@ sub new { my $on = minstance ($options {g_on}, $self); my $off = minstance ($options {g_off}, $self); - my $over = defined $options {g_over} ? minstance ($options {g_over}, $self) : $on; + my $over = defined $options {g_over} && $options {g_over} ne ''? minstance ($options {g_over}, $self) : $on; my $eventOn = defined $options {e_press} ? $options {e_press} : 'PRESS'; my $eventOff = defined $options {e_release} ? $options {e_release} : 'RELEASED'; my $cb = $options {call} if (defined $options {call}); @@ -55,7 +55,7 @@ sub new { my @gover; push (@gover, $over); - if (defined $options {g_text}) + if (defined $options {g_text} && $options {g_text} ne "") { $self -> recordProperty ('text', $options {text}); my $txt = minstance ($options {g_text}, $self); 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 () + { + $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; + -- cgit v1.1