package MTools::Comp::MMover;
#	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
#
##################################################################

# Le composant MMover permet de donner un comportement prehensible a un objet zinc. Les deplacements peuvent etre contraints a un espace defin
#
# Parametres :
#	* src : objet source des evenements de deplacement
#	* targets : objets deplaces
#	* button : bouton de la souris utilise pour genere le deplacement
# Proprietes :
#	* x_min, y_min, x_max, y_max : contraintes de l'espace dans lequel peut se deplacer le strip
#	* allower : fonction permettre d'appliquer une contrainte plus complexe sur l'objet
#	* x, y : position de l'objet modifiee par le MMover
#	* targets : objets deplaces
#	* -visible : active ou desactive le comportement prehensible

use strict;
use MTools;
use MTools::MObjet;

use vars qw /@ISA/;

BEGIN 
{
	@ISA = qw /MTools::MObjet/;
}

use Tk;

sub new {
	my ($class, $src, $targets, $button, %options) = @_;
	my $self = {};
	bless $self, $class;

	$self -> recordProperty ('x_min', -10000);
	$self -> recordProperty ('y_min', -10000);
	$self -> recordProperty ('x_max', 10000);
	$self -> recordProperty ('y_max', 10000);
	$self -> recordProperty ('-visible', 1);
	$self -> recordProperty ('x', 0);
	$self -> recordProperty ('y', 0);
	$self -> recordProperty ('targets', $targets);
	$self -> recordProperty ('allower', undef);
	
	$self -> mconfigure (%options);
	
	$self -> recordEvent ('PRESSED');
	$self -> recordEvent ('MOVED');
	$self -> recordEvent ('RELEASED');
		
	$button = 1 if ! defined $button;
	binding ($src, "<Button-$button>", [\&__pressed, $self, Ev('x'), Ev('y'), Ev('t')]);
	binding ($src, "<Button$button-Motion>", [\&__moved, $self, Ev('x'), Ev('y'), Ev('t')]);
	binding ($src, "<ButtonRelease-$button>", [\&__released, $self, Ev('x'), Ev('y'), Ev('t')]);
		
	$self -> {__last_mouse_x} = 0;
	$self -> {__last_mouse_y} = 0;

	return $self;
}

sub setPos {
	my ($self, $x, $y) = @_;
	my $dx = $x - $self -> mget ('x');
	my $dy = $y - $self -> mget ('y');
	my $tgs = $self -> mget ('targets');
	my @targets;
	if (ref ($tgs) eq 'ARRAY')
	{
		@targets = @{$tgs};
		for (my $i = 0; $i < @targets; $i++)
		{
			$targets [$i] -> translate ($dx, $dy);
		}
	}
	else
	{
		$tgs -> translate ($dx, $dy);
	}
	$self -> mconfigure ('x', $x);
	$self -> mconfigure ('y', $y);
}

sub __pressed {
	my ($self, $x, $y, $t) = @_;
	if(!$self -> mget('-visible')) {return;}
	$self -> {__started} = 1;
	$self -> {__last_mouse_x} = $x;
	$self -> {__last_mouse_y} = $y;
	$self -> notify ('PRESSED', $self -> {__last_mouse_x}, $self -> {__last_mouse_y}, $t);
}

sub __moved {
	my ($self, $x, $y, $t) = @_;
	if (!$self -> {__started}) {return;}
	if(!$self -> mget('-visible')) {return;}
	
	my $dx = $x - $self -> {__last_mouse_x};
	my $dy = $y - $self -> {__last_mouse_y};

	my $x_min = $self -> mget('x_min');
	my $y_min = $self -> mget('y_min');
	my $x_max = $self -> mget('x_max');
	my $y_max = $self -> mget('y_max');
	my $current_x = $self -> mget ('x');
	my $current_y = $self -> mget ('y');
	if($current_x + $dx > $x_max)
	{
		$x -= $current_x + $dx - $x_max;	
		$dx -= $current_x + $dx - $x_max;
	}
	if($current_y + $dy > $y_max)
	{
		$y -= $current_y + $dy - $y_max;	
		$dy -= $current_y + $dy - $y_max;
	}
	if($current_x + $dx < $x_min)
	{
	
		$x -= $current_x + $dx - $x_min;	
		$dx -= $current_x + $dx - $x_min;
	}
	if($current_y + $dy < $y_min)
	{
		$y -= $current_y + $dy - $y_min;	
		$dy -= $current_y + $dy - $y_min;
	}
	if( $dx == 0 && $dy == 0 )
	{
		return;
	}
	my $allower = $self -> mget ('allower');
	if ($allower)
	{
		my ($ddx, $ddy) = executer ($allower, $current_x, $current_y, $dx, $dy);
		$x -= $ddx;
		$dx -= $ddx;
		$y -= $ddy;
		$dy -= $ddy;
		if( $dx == 0 && $dy == 0 )
		{
			return;
		}
	}
	$self -> {__last_mouse_x} = $x;
	$self -> {__last_mouse_y} = $y;
	$current_x += $dx;
	$current_y += $dy;
	$self -> notify ('MOVED', $current_x, $current_y, $t);	
	$self -> setPos ($current_x, $current_y);
}

sub __released {
	my ($self, $x, $y, $t) = @_;
	$self -> {__started} = 0;
	if(!$self -> mget('-visible')) {return;}
	$self -> notify ('RELEASED', $self -> {__last_mouse_x}, $self -> {__last_mouse_y}, $t);
}

sub translate {
	my ($self, $dx, $dy, $t) = @_;
	my $x_min = $self -> mget('x_min');
	my $y_min = $self -> mget('y_min');
	my $x_max = $self -> mget('x_max');
	my $y_max = $self -> mget('y_max');
	my $current_x = $self -> mget ('x');
	my $current_y = $self -> mget ('y');
	if($current_x + $dx > $x_max)
	{
		$dx -= $current_x + $dx - $x_max;
	}
	if($current_y + $dy > $y_max)
	{
		$dy -= $current_y + $dy - $y_max;
	}
	if($current_x + $dx < $x_min)
	{
	
		$dx -= $current_x + $dx - $x_min;
	}
	if($current_y + $dy < $y_min)
	{
		$dy -= $current_y + $dy - $y_min;
	}
	if( $dx == 0 && $dy == 0 )
	{
		return;
	}
	my $allower = $self -> mget ('allower');
	if ($allower)
	{
		my ($ddx, $ddy) = executer ($allower, $current_x, $current_y, $dx, $dy);
		$dx -= $ddx;
		$dy -= $ddy;
		if( $dx == 0 && $dy == 0 )
		{
			return;
		}
	}
	$current_x += $dx;
	$current_y += $dy;
	$self -> setPos ($current_x, $current_y);
	$self -> notify ('MOVED', $current_x, $current_y, $t);
}

1;