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 Tk::Anim; Tk::Anim::synchronous(25.0); use vars qw /@ISA/; BEGIN { @ISA = qw /MTools::MObjet/; } use Tk; sub new { my ($class, %options) = @_; my $self = new MTools::MObjet (); 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_ABORD'); $self -> plisten ('-visible', sub { my ($src, $key, $val) = @_; if ($val == 0) { $self -> stop (); } else { $self -> start (); } }); $self -> {__animation} = undef; $self -> mconfigure (%options); $self -> {__complete} = 0; return $self; } sub stop { my ($self) = @_; if (defined $self -> {__animation}) { $self -> {__animation} -> stop (); } } sub complete { my ($self) = @_; return if !$self->isRunning(); $self->event($self -> mget ('to_x') - $self -> {__xdep}, $self -> mget ('to_y') - $self -> {__ydep}); $self -> {__complete} = 1; $self->stop(); } sub start { my ($self) = @_; $self -> {__xdep} = my $xdep = $self -> mget ('from_x'); $self -> {__ydep} = my $ydep = $self -> mget ('from_y'); $self -> {__x} = $xdep; $self -> {__y} = $ydep; $self -> {__animation} = my $animation = $zinc->Anim ( -pacing => 'linear', -duration => $self -> mget ('duration') * 1000, -command => sub { $self -> event (@{$_[0]})}, ); $animation->addresource('coords', -path => [[0, 0], [$self -> mget ('to_x') - $xdep, $self -> mget ('to_y') - $ydep]]); my $loop = $self -> mget ('loop'); if ($loop != 0) { $self -> {__animation} = $animation -> repeat (); } $self -> {__animation} -> whenterminated (sub { $self -> {__animation} = undef; $self -> notify ('ANIMATION_END'); }); $self -> {__animation} -> wheninterrupted (sub { $self -> {__animation} = undef; if ($self -> {__complete}) { $self -> {__complete} = 0; $self -> notify ('ANIMATION_END'); } else { $self -> notify ('ANIMATION_ABORD', $self -> {__x}, $self -> {__y}); } }); $self -> {__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 { if (ref($targets [$i]) eq '') { translate ($targets [$i], $x - $self -> {__x}, $y - $self -> {__y}); } else { $targets [$i] -> translate ($x - $self -> {__x}, $y - $self -> {__y}); } } } $self -> {__x} = $x; $self -> {__y} = $y; $self -> notify ('MOTION', $x, $y); } 1;