package MTools::Anim::MScalor; # 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 # ################################################################## # MScalor permet de realiser une animation de scale sur l'objet # # proprietes : # * -visible : permet d'activer ou non l'animation # * center_x, center_y : coordonnees du centre de la transformation # * 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 # * SCALED : Notifie lorsque la valeur de scale 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 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 ('center_x', 0); $self -> recordProperty ('center_y', 0); $self -> recordProperty ('from_x', 0); $self -> recordProperty ('from_y', 0); $self -> recordProperty ('to_x', 0); $self -> recordProperty ('to_y', 0); $self -> recordProperty ('duration', 1); $self -> recordProperty ('loop', 0); $self -> recordProperty ('targets', undef); $self -> recordEvent ('ANIMATION_END'); $self -> recordEvent ('SCALED'); $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); return $self; } 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; $self -> notify ('ANIMATION_ABORD', $self -> {__x}, $self -> {__y}); }); $self -> {__animation} -> start (); } 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->stop(); } sub __event { my ($self, $x, $y) = @_; my $cx = $self -> mget ('center_x'); my $cy = $self -> mget ('center_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 '') { scale ($targets [$i], $x / $self -> {__x}, $y / $self -> {__y}, $cx, $cy); } else { $targets [$i] -> scale ($x / $self -> {__x}, $y / $self -> {__y}, $cx, $cy); } } $self -> {__x} = $x; $self -> {__y} = $y; $self -> notify ('SCALED', $x, $y, $cx, $cy); } sub isRunning { my ($self) = @_; return defined $self -> {__animation}; } 1;