package MTools::Comp::MInertie;
#	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 MTools;
use MTools::MObjet;
use Time::HiRes;

use MTools::MTimer;

use vars qw /@ISA/;

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

use Tk;

sub new {
	my ($class, $target, %options) = @_;
	my $self = new MTools::MObjet ();
	bless $self, $class;

	my $msg_pressed = defined $options {msg_pressed} ? $options {msg_pressed} : 'PRESSED';
	my $msg_moved = defined $options {msg_moved} ? $options {msg_moved} : 'MOVED';
	my $msg_released = defined $options {msg_released} ? $options {msg_released} : 'RELEASED';
	my $msg_stopped = defined $options {msg_stopped} ? $options {msg_stopped} : 'INERTIE_STOPPED';
	
	delete $options {msg_pressed};
	delete $options {msg_moved};
	delete $options {msg_released};
	delete $options {msg_stopped};

	$self -> recordProperty	('target', $target);
	$self -> recordProperty	('-visible', 1);
	$self -> recordProperty	('rate', 0.85);
	$self -> recordProperty	('inertie_callback', [$target, 'translate']);

	$self -> recordEvent ($msg_stopped);
	$self -> mconfigure (%options);

	$self -> {__old_t} = 0;
	$self -> {__old_x} = 0;
	$self -> {__old_y} = 0;
	$self -> {__x} = 0;
	$self -> {__y} = 0;
	$self -> {__t} = 0;
	$self -> {__vx} = 0;
	$self -> {__vy} = 0;

	$self -> {__isRunning} = 0;
	
	$self -> {__msg_stopped} = $msg_stopped;
	
	$target -> binding ($msg_pressed, [$self, 'target_pressed']);
	$target -> binding ($msg_moved, [$self, 'target_moved']);
	$target -> binding ($msg_released, [$self, 'target_released']);
	
	$self -> {timer_inertie} = new MTools::MTimer (1000/60, 1, [$self, 'inertie']);
	
	return $self;
}

sub interrupt {
	my ($self) = @_;
	if ($self -> {__isRunning}) {
		$self -> {__isRunning} = 0;
		$self -> {timer_inertie} -> stop ();
		$self -> notify ($self -> {__msg_stopped});
	}
}

sub target_pressed {
	my ($self, $x, $y, $t) = @_;
	$self -> {__old_x} = 0;
	$self -> {__old_y} = 0;
	$self -> {__old_t} = 0;
	$self -> {__x} = 0;
	$self -> {__y} = 0;
	$self -> {__t} = 0;
}

sub target_moved {
	my ($self, $x, $y, $t) = @_;
	if (!defined $t) {
		$t = Time::HiRes::gettimeofday();
	}
	$self -> {__old_x} = $self -> {__x};
	$self -> {__old_y} = $self -> {__y};
	$self -> {__old_t} = $self -> {__t};
	$self -> {__x} = $x;
	$self -> {__y} = $y;
	$self -> {__t} = $t;
}

sub target_released {
	my ($self, $x, $y, $t) = @_;
	if (!defined $t) {
		$t = Time::HiRes::gettimeofday();
	}
	my $dt = $self -> {__t} - $self -> {__old_t};
	my $dx = $self -> {__x} - $self -> {__old_x};
	my $dy = $self -> {__y} - $self -> {__old_y};
	if ($dt && $self -> mget ('-visible')) {
		$self -> {__vx} = ($dx * 1000) / ($dt * 60);
		$self -> {__vy} = ($dy * 1000) / ($dt * 60);
		$self -> {__isRunning} = 1;
		$self -> {timer_inertie} -> start();
	}
	else {
		$self -> notify ($self -> {__msg_stopped});
	}
	$self -> {__old_x} = 0;
	$self -> {__old_y} = 0;
	$self -> {__old_t} = 0;
	$self -> {__x} = 0;
	$self -> {__y} = 0;
	$self -> {__t} = 0;
}

sub inertie {
	my ($self) = @_;
	my $rate = $self -> mget ('rate');
	$self -> {__vx} *= $rate;
 	$self -> {__vy} *= $rate;
	if ((abs $self -> {__vx} <= 1) and (abs $self -> {__vy} <= 1)) {
		$self -> interrupt ();
		return;
  	}
	my $dx = $self -> {__vx};
	my $dy = $self -> {__vy};
	my $target = $self -> mget ('target');
	my $callback = $self -> mget ('inertie_callback');
	executer ($callback, $dx, $dy);
#	$target -> $callback ($dx, $dy);
}

1;