package MTools::Anim::MTranslator; # 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 # ################################################################## # MTranslator permet de realiser une animation de translation sur l'objet # # proprietes : # * -visible : permet d'activer ou non l'animation # * from_x, from_y : valeur initiale de la transformation # * to_x, to_y : valeur finale de la transformation # * duration : duree de l'animation # * loop : marque le caractere repetitif ou non de l'animation # * targets : objet ou tableau d'objet cibles de cette animation # Evenements : # * ANIMATION_END : Notifie lorque l'annimation se termine # * MOTION : Notifie lorsque la position est changee au cours de l'animation # * ANIMATION_ABORD : Notifie lorsque l'animation est stoppee avant la fin # Fonctions : # * start : demarre l'animation # * stop: arrete l'animation # * isRunning : test si l'animation est en cours use strict; use MTools; use MTools::MObjet; use Anim; use Anim::Pacing::Linear; use Anim::Path::Rectilinear; use vars qw /@ISA/; BEGIN { @ISA = qw /MTools::MObjet/; } use Tk; sub new { my ($class, %options) = @_; my $self = {}; bless $self, $class; $self -> recordProperty ('-visible', 0); $self -> recordProperty ('from_x', $options {from_x} ? $options {from_x} : 0); $self -> recordProperty ('from_y', $options {from_y} ? $options {from_y} : 0); $self -> recordProperty ('to_x', $options {to_x} ? $options {to_x} : 0); $self -> recordProperty ('to_y', $options {to_y} ? $options {to_y} : 0); $self -> recordProperty ('duration', $options {duration} ? $options {duration} : 1); $self -> recordProperty ('loop', $options {loop} ? $options {loop} : 0); $self -> recordProperty ('targets', $options {targets}); $self -> recordEvent ('ANIMATION_END'); $self -> recordEvent ('MOTION'); $self -> recordEvent ('ANIMATION_ABORDED'); $self -> plisten ('-visible', sub { my ($src, $key, $val) = @_; if ($val == 0) { $self -> stop (); } else { $self -> start (); } }); $self -> {__animation} = undef; $self -> mconfigure (%options); return $self; } sub stop { my ($self) = @_; if (defined $self -> {__animation}) { $self -> {__animation} -> stop (); } } sub start { my ($self) = @_; my $pacing = new Anim::Pacing::Linear (-duration => $self -> mget ('duration')); $self -> {__xdep} = my $xdep = $self -> mget ('from_x'); $self -> {__ydep} = my $ydep = $self -> mget ('from_y'); my $animationpath = new Anim::Path::Rectilinear ( -xdep => 0, -ydep => 0, -xdest => $self -> mget ('to_x') - $xdep, -ydest => $self -> mget ('to_y') - $ydep, ); $self -> {__x} = $xdep; $self -> {__y} = $ydep; $self -> {__animation} = my $animation = new Anim ( -pacing => $pacing, -resources => [ $animationpath, -command => sub { $self -> event (@_)}, -endcommand => sub { $self -> {__animation} = undef; $self -> notify ('ANIMATION_END'); }, ], -stopcommand => sub { $self -> {__animation} = undef; $self -> notify ('ANIMATION_ABORDED', $self -> {__x}, $self -> {__y}); }, -loop => $self -> mget ('loop'), ); $animation -> start (); } sub isRunning { my ($self) = @_; return defined $self -> {__animation}; } sub event { my ($self, $x, $y) = @_; $x += $self -> {__xdep}; $y += $self -> {__ydep}; my @targets = (); my $target = $self -> mget ('targets'); if (ref ($target) eq 'ARRAY') { @targets = @{$target}; } else { push (@targets, $target); } for (my $i = 0; $i < @targets; $i++) { if (ref ($targets [$i]) eq 'MTools::Comp::MMover') { $target -> setPos ($x, $y); $target -> notify ('MOVED', $x, $y, "mvd"); } else { $targets [$i] -> translate ($x - $self -> {__x}, $y - $self -> {__y}); } } $self -> {__x} = $x; $self -> {__y} = $y; $self -> notify ('MOTION', $x, $y); } 1;