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::GUI::MAntiRecouvrementGroup
#
# 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::GUI::MAntiRecouvrementGroup 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 -> {__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} = 1;
	$ob -> translate (0, 0);
}

sub removeObject {
	my ($self, $target) = @_;
	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;