package MTools::Comp::MAntiRecouvrement; # 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 # ################################################################## # Encapsule l'algorithme d'anti-recouvrement des objets et gere les objets anti-recouvres # IMPORTANT : Les objets anti-recouvre doivent heriter de MTools::Comp::MAntiRecouvrementItem # # BUG : La propriete '-visible' devrait permettre d'activer ou non l'anti-recouvrement global des objets. # Ce n'est pas le cas aujourd'hui, cette popriete est inactive # # Fonctions : # * addObject : permet d'inclure un objet heritant de MTools::Comp::MAntiRecouvrementItem dans l'algorithme d'anti-recouvrement # * removeObjet : permet de sortir un objet de l'algorithme d'anti-recouvrement use strict; use MTools; use MTools::MObjet; use vars qw /@ISA/; BEGIN { @ISA = qw /MTools::MObjet/; } use Tk; sub new { my ($class) = @_; my $self = new MTools::MObjet (); bless $self, $class; $self -> recordProperty ('-visible', 1); $self -> recordEvent ('ITEM_MOVED'); $self -> {__objects} = (); $self -> plisten ('-visible', sub { my ($src, $key, $val, $old) = @_; if (defined $self -> {__objects}) { for (my $i = @{$self -> {__objects}} - 1; $i >= 0; $i --) { @{$self -> {__objects}} [$i] -> {__added} = $val; } } }); $self -> {__known_objects} = (); $self -> {__ask_move} = (); $self -> {__ask_reaction} = (); return $self; } sub addObject { my ($self, $ob) = @_; my $ever_known = 0; if (defined $self -> {__known_objects}) { my @known = @{$self -> {__known_objects}}; for (my $i = 0; $i < @known; $i ++) { if ($known [$i] eq $ob) { $ever_known = 1; last; } } } if (!$ever_known) { binding ($ob, '__HANDLE_MOVING', [$self, \&__on_handle_moving_on_track]); binding ($ob, '__PUSH_BACK', [$self, \&__on_push_back_on_track]); binding ($ob, '__ENQUEUE_MOVING', [$self, \&__on_enqueue_moving_on_track]); push (@{$self -> {__known_objects}}, $ob); } if (!defined $ob -> {__added} || $ob -> {__added} == 0) { push (@{$self -> {__objects}}, $ob); } $ob -> update_bbox (); $ob -> {__added} = $self -> mget ('-visible'); $ob -> translate (0, 0); } sub removeObject { my ($self, $target) = @_; return if (!defined $self -> {__objects}); for (my $i = @{$self -> {__objects}} - 1; $i >= 0; $i --) { if (@{$self -> {__objects}} [$i] eq $target) { @{$self -> {__objects}} [$i] -> {__added} = 0; splice (@{$self -> {__objects}}, $i, 1); } } } sub __on_handle_moving_on_track { my ($self) = @_; my ($first_work, $first_track, $current_track, $intersection); while (scalar @{$self -> {__ask_move}} > 0) { $first_work = $self -> {__ask_move} -> [0]; $first_track = $first_work -> [0]; my ($firstx, $firsty) = ($first_track -> mget ('x'), $first_track -> mget ('y')); for (my $i = 0; $i < @{$self -> {__objects}}; $i++) { $current_track = @{$self -> {__objects}} [$i]; next if ($current_track eq $first_track); my ($x, $y) = ($current_track -> mget ('x'), $current_track -> mget ('y')); $intersection = __intersection ( $firstx, $firsty, $first_track -> mget ('width'), $first_track -> mget ('height'), $x, $y, $current_track -> mget ('width'), $current_track-> mget ('height') ); next if (($intersection -> [2] == 0) and ($intersection -> [3] == 0)); if ($intersection -> [2] < $intersection -> [3]) { if ($firstx < $x) { $current_track -> __try_move ($intersection -> [2], 0, $first_work -> [3]); } else { $current_track -> __try_move(-$intersection -> [2], 0, $first_work -> [3]); } } else { if ($firsty < $y) { $current_track -> __try_move (0, $intersection -> [3], $first_work -> [3]); } else { $current_track -> __try_move (0, -$intersection -> [3], $first_work -> [3]); } } } shift @{$self -> {__ask_move}}; } $self -> notify ('ITEM_MOVED'); } sub __on_push_back_on_track { my ($self, $track, $delta_x, $delta_y, $path) = @_; push @{$path}, $track; my @other_path = @{$path}; $self -> __on_enqueue_moving_on_track ($track, $delta_x, $delta_y, [@other_path]); $track -> __update_xy ($delta_x, $delta_y); my ($current_track, $push_x, $push_y, $intersection); my ($firstx, $firsty) = ($track -> mget ('x'), $track -> mget ('y')); for (my $i = 0; $i < @{$self -> {__objects}}; $i++) { $current_track = @{$self -> {__objects}} [$i]; next if $current_track eq $track; my ($x, $y) = ($current_track -> mget ('x'), $current_track -> mget ('y')); $intersection = __intersection ( $firstx, $firsty, $track -> mget ('width'), $track -> mget ('height'), $x, $y, $current_track -> mget ('width'), $current_track -> mget ('height') ); $push_x = 0; $push_y = 0; $push_x = $intersection -> [2] if ($intersection -> [2] <= $delta_x); $push_x = -$intersection -> [2] if ($intersection -> [2] <= -$delta_x); $push_y = $intersection -> [3] if ($intersection -> [3] <= $delta_y); $push_y = -$intersection -> [3] if ($intersection -> [3] <= -$delta_y); $self -> __on_push_back_on_track ($current_track, $push_x, $push_y, $path) if ((($push_x != 0) or ($push_y != 0)) and (__occurences ($current_track, @{$path}) < 3)); } pop @{$path}; } sub __intersection { my ($x1, $y1, $w1, $h1, $x2, $y2, $w2, $h2) = @_; my ($x, $y, $w, $h); $x = &__max_of ($x1, $x2); $w = &__min_of ($x1 + $w1, $x2 + $w2) - $x; if ($w > 0) { $y = &__max_of ($y1, $y2); $h = &__min_of ($y1 + $h1, $y2 + $h2) - $y; if ($h > 0) { return [$x, $y, $w, $h]; } } return [0, 0, 0, 0]; } sub __min_of { my (@values) = @_; my $res = $values [0]; foreach (@values) { $res = $_ if ($_ <= $res); } return $res; } sub __max_of { my (@values) = @_; my $res = $values [0]; foreach (@values) { $res = $_ if ($_ >= $res); } return $res; } sub __occurences { my ($val,@tab) = @_; my $result = 0; if (($#tab != -1) and (defined $val)) { foreach (@tab) { if (($_ eq $val) or ($_ =~ m/$val/)) { $result++; } } } return $result; } sub __on_enqueue_moving_on_track { my ($self, $track, $delta_x, $delta_y, $path) = @_; push @{$self -> {__ask_move}}, [$track, $delta_x, $delta_y, $path]; } 1;