package MTools::Comp::MAntiRecouvrementItem; # 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 # ################################################################## # Les objets heritant de MAntiRecouvrementItem peuvent etre geres par un objet MAntiRecouvrement et ainsi pris en charge # par un algorithme d'anti-recouvrement. # # parametres : # * $parent : parent de l'objet... # * %options : table de hash permettant d'initialiser les proprietes # Les ?v?nements : # * TRANSLATED : notifie lorsque l'objet est translate... # attibuts : # followed_by : MAntiRecouvrementItem permet aux objets contenus dans ce tableau de suivre ses deplacements # (permet un chainage des objets) # Les propietes : # * xmin, ymin, xmax, ymax : definissent les caract?risiques de l'espace dans lequel l'objet est contraint. # * height, width : definissent la base rectangulaire de l'objet # * auto_sizing : si width ou height ne sont pas pass?s en param?tre, les caracteristiques # sont auto-determinees en fonction de la bbox de l'objet. On peut bien evidemment choisir cette definition automatique, cependant # attention, la bbox de l'objet ne correspond par toujours a la bbox visible de l'objet. # * x, y : determinent la position de l'objet et sont mis a jour automatiquement au cours des deplacement de l'objet. # * anchors : permet d'active ou ne le suivi des objets contenus dans 'followed_by' # Les fonctions : # * update_bbox : permet de demander une remise ? jour du calcul automatique des dimensions de l'objet (util uniquement si auto_sizing == 1) use MTools; use vars qw /@ISA/; use MTools::GUI::MGroup; require Exporter; BEGIN { @ISA = qw /MTools::GUI::MGroup Exporter/; @EXPORT = qw / translate scale rotate /; } use strict; use Tk; sub new { my ($class, $parent, %options) = @_; my $self = new MTools::GUI::MGroup ($parent); bless $self, $class; $self -> recordEvent ('TRANSLATED'); $self -> recordProperty ('auto_sizing', (!defined $options{width}) || (!defined $options{height})); $self -> recordProperty ('height', 0); $self -> recordProperty ('width', 0); $self -> recordProperty ('x', 0); $self -> recordProperty ('y', 0); $self -> recordProperty ('xmin', 0); $self -> recordProperty ('ymin', 0); $self -> recordProperty ('xmax', 1500); $self -> recordProperty ('ymax', 1500); $self -> recordProperty ('anchors', 1); $self -> recordEvent ('__HANDLE_MOVING'); $self -> recordEvent ('__PUSH_BACK'); $self -> recordEvent ('__ENQUEUE_MOVING'); $self -> mconfigure (%options); return $self; } sub translate { my ($self, $delta_x, $delta_y) = @_; if ($self -> {__added}) { if ((abs ($delta_x) >= __max_of(2, $self -> mget ('width') / 2)) or (abs ($delta_y) >= __max_of(2, $self -> mget ('height') / 2))) { my ($mini_dx, $mini_dy) = (int ($delta_x / 2), int ($delta_y / 2)); $self -> translate ($mini_dx, $mini_dy); $self -> translate ($delta_x - $mini_dx, $delta_y - $mini_dy); } else { $self -> __try_move ($delta_x, $delta_y, []); $self -> notify ('__HANDLE_MOVING'); } } else { $self -> __update_xy ($delta_x, $delta_y); } } sub __search { my ($val, @tab) = @_; my $result = 0; if (($#tab != -1) and (defined $val)) { foreach (@tab) { if (($_ eq $val) or ($_ =~ m/$val/)) { $result = 1; last; } } } return $result; } sub __try_move { my ($self, $delta_x, $delta_y, $path) = @_; return if __search ($self, @{$path}); push (@{$path}, $self); $self -> __update_xy ($delta_x, $delta_y); my $label_coords_x = $self -> mget ('x'); my $label_coords_y = $self -> mget ('y'); my $x_min = $self -> mget ('xmin'); my $x_max = $self -> mget ('xmax'); my $y_min = $self -> mget ('ymin'); my $y_max = $self -> mget ('ymax'); my ($push_x, $push_y) = (0, 0); $push_x = $x_min - $label_coords_x if $label_coords_x < $x_min; $push_x = $x_max - $label_coords_x if $label_coords_x > $x_max; $push_y = $y_min - $label_coords_y if $label_coords_y < $y_min; $push_y = $y_max - $label_coords_y if $label_coords_y > $y_max; $self -> notify ('__PUSH_BACK', $self, $push_x, $push_y, $path) if (($push_x != 0) or ($push_y != 0)); if ($self -> mget ('anchors')) { if (defined $self -> {followed_by}) { foreach (@{$self -> {followed_by}}) { $_ -> __try_move($delta_x + $push_x, $delta_y + $push_y, $path); } } } my @other_path = @{$path}; $self -> notify ('__ENQUEUE_MOVING', $self, $delta_x + $push_x, $delta_y + $push_y, [@other_path]); pop @{$path}; } sub __update_xy { my ($self, $delta_x, $delta_y) = @_; MTools::translate ($self, $delta_x, $delta_y); $self -> mconfigure ('x' => $self -> mget ('x') + $delta_x); $self -> mconfigure ('y' => $self -> mget ('y') + $delta_y); $self -> notify ('TRANSLATED', $delta_x, $delta_y); } sub __max_of { my (@values) = @_; my $res = $values [0]; foreach (@values) { $res = $_ if ($_ >= $res); } return $res; } sub scale { my ($self, @params) = @_; MTools::scale ($self, @params); $self -> update_bbox (); $self -> translate (0, 0); } sub rotate { my ($self, @params) = @_; MTools::rotate ($self, @params); $self -> update_bbox (); $self -> translate (0, 0); } sub update_bbox { my ($self) = @_; if ($self -> mget ('auto_sizing')) { my @rect = $self -> bbox (); $self -> mconfigure (width => $rect [2] - $rect [0]); $self -> mconfigure (height => $rect [3] - $rect [1]); } } 1;