diff options
| -rw-r--r-- | src/MTools/Anim/MPath.pm | 57 | ||||
| -rw-r--r-- | src/MTools/GUI/MClip.pm | 90 |
2 files changed, 74 insertions, 73 deletions
diff --git a/src/MTools/Anim/MPath.pm b/src/MTools/Anim/MPath.pm index eb8b221..6d73cff 100644 --- a/src/MTools/Anim/MPath.pm +++ b/src/MTools/Anim/MPath.pm @@ -98,34 +98,35 @@ sub pathchanged { } sub start { - my ($self) = @_; - - my @points = @{$self -> mget ('path')}; - if (!@points) {return;} - $self -> {__x} = $points [0] -> [0]; - $self -> {__y} = $points [0] -> [1]; - my $pacing = new Anim::Pacing::Linear (-duration => $self -> mget ('duration')); - $self -> {__percentage} = 0; - my $animationpath = new Anim::Path::Rectilinear ( - -xdep => 0, - -ydep => 0, - -xdest => 100, - -ydest => 0, - ); - $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 -> __getPoint ($self -> {__percentage})); - $self -> {__animation} = undef; - }, - -loop => $self -> mget ('loop'), - ); - $animation -> start (); + my ($self) = @_; + + my @points = @{$self -> mget ('path')}; + if (!@points) {return;} + $self -> {__x} = $points [0] -> [0]; + $self -> {__y} = $points [0] -> [1]; + my $pacing = new Anim::Pacing::Linear (-duration => $self -> mget ('duration')); + $self -> {__percentage} = 0; + my $animationpath = new Anim::Path::Rectilinear ( + -xdep => 0, + -ydep => 0, + -xdest => 100, + -ydest => 0, + ); + $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 -> __getPoint ($self -> {__percentage})); + $self -> {__animation} = undef; + }, + -loop => $self -> mget ('loop'), + ); + $animation -> start (); } sub stop { diff --git a/src/MTools/GUI/MClip.pm b/src/MTools/GUI/MClip.pm index bc8405d..cf4f850 100644 --- a/src/MTools/GUI/MClip.pm +++ b/src/MTools/GUI/MClip.pm @@ -34,55 +34,55 @@ BEGIN } sub new { - my ($class, $clipped, $path, $debug) = @_; - my $self = new MTools::MObjet (); - bless $self, $class; - - $self -> recordProperty ('-visible', 1); - $self -> plisten ('-visible', sub { - my ($src, $key, $val) = @_; - if ($val == 0) - { - mconfigure($self->{__clipped}, -clip => undef); - } - else - { - mconfigure($self->{__clipped}, -clip => $self->{__clip}); - } - }); - - if (!defined $debug) {$debug = 0} - - my $clip = $path; - if(ref ($path) eq 'ARRAY') - { - my $type = shift @{$path}; - $clip = $zinc -> add ($type, $clipped -> {instance}, $path, - -filled => 1, - -priority => 10, - -linewidth => 0, - -fillcolor => "#000000", - -visible => $debug, - -sensitive => 0, - ); - } - elsif(ref ($path) eq '') - { - $clip = minstance ($clip, $clipped); - MTools::chggroup ($clip, $clipped); - MTools::mconfigure ($clip, -visible => $debug, -sensitive => 0); - } - else - { - MTools::chggroup ($clip, $clipped); - MTools::mconfigure (-visible => $debug, -sensitive => 0); - $clip = minstance ($clip); - } + my ($class, $clipped, $path, $debug) = @_; + my $self = new MTools::MObjet (); + bless $self, $class; + + if (!defined $debug) {$debug = 0} + + my $clip = $path; + if(ref ($path) eq 'ARRAY') + { + my $type = shift @{$path}; + $clip = $zinc -> add ($type, $clipped -> {instance}, $path, + -filled => 1, + -priority => 10, + -linewidth => 0, + -fillcolor => "#000000", + -visible => $debug, + -sensitive => 0, + ); + } + elsif(ref ($path) eq '') + { + $clip = minstance ($clip, $clipped); + MTools::chggroup ($clip, $clipped); + MTools::mconfigure ($clip, -visible => $debug, -sensitive => 0); + } + else + { + MTools::chggroup ($clip, $clipped); + MTools::mconfigure ($clip, -visible => $debug, -sensitive => 0); + $clip = minstance ($clip); + } $self -> {__clipped} = $clipped; $self -> {__clip} = $clip; mconfigure ($clipped, -clip => $clip); + + $self -> recordProperty ('-visible', 1); + $self -> plisten ('-visible', sub { + my ($src, $key, $val) = @_; + if ($val == 0) + { + mconfigure($self->{__clipped}, -clip => undef); + } + else + { + mconfigure($self->{__clipped}, -clip => $self->{__clip}); + } + }); return $self; -} + } sub translate { my ($self, @args) = @_; |