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 : objets cible de cette animation # Evenements : # * ANIMATION_END : Notifie lorque l'annimation se termine # * SCALED : Notifie lorsque la valeur de l'opacite 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 = 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) = @_; 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 -> notify ('ANIMATION_END');$self -> {__animation} = undef;}, ], -stopcommand => sub {$self -> notify ('ANIMATION_ABORD', $self -> {__x}, $self -> {__y});$self -> {__animation} = undef;}, -loop => $self -> mget ('loop'), ); $animation -> start (); } sub stop { my ($self) = @_; if (defined $self -> {__animation}) { $self -> {__animation} -> 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++) { scale ($targets [$i], $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;