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;