Import initial

1 files changed, 153 insertions, 0 deletions

diff --git a/src/MTools/Comp/MInertie.pm b/src/MTools/Comp/MInertie.pm
new file mode 100644
index 0000000..9b820a0
--- /dev/null
+++ b/src/MTools/Comp/MInertie.pm
@@ -0,0 +1,153 @@
+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', '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 -> {__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) = @_;
+	$self -> {timer_inertie} -> stop ();
+}
+
+sub target_pressed {
+	my ($self, $x, $y, $t) = @_;
+	$self -> interrupt ();
+	$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 -> {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} <= 2) and (abs $self -> {__vy} <= 2)) 
+	{
+		$self -> notify ($self -> {__msg_stopped});
+		$self -> {timer_inertie} -> stop();
+		return;
+  	}
+	my $dx = $self -> {__vx};
+	my $dy = $self -> {__vy};
+	my $target = $self -> mget ('target');
+	my $callback = $self -> mget ('inertie_callback');
+	$target -> $callback ($dx, $dy);
+}
+
+1;