diff options
Diffstat (limited to 'src/MTools/Comp/MInertie.pm')
| -rw-r--r-- | src/MTools/Comp/MInertie.pm | 153 |
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; |