← Back to branch summary

~ubuntu-branches/ubuntu/raring/perl-tk/raring

« back to all changes in this revision

Viewing changes to Tk/Animation.pm

  • Committer: Bazaar Package Importer
  • Author(s): Colin Tuckley
  • Date: 2008-02-15 13:56:59 UTC
  • mfrom: (1.1.3 upstream) (4.1.1 hardy)
  • Revision ID: james.westby@ubuntu.com-20080215135659-ru2oqlykuju20fav
Tags: 1:804.028-1
http://bugs.debian.org/463080
http://bugs.debian.org/411129
* New Upstream Release (Closes: #463080).
* Update to Debhelper v5.
* Build with XFT=1 (Closes: #411129).

Show diffs side-by-side

added added

removed removed

Lines of Context:
Tk/Animation.pm
1
1
package Tk::Animation;
2
2
 
3
3
use vars qw($VERSION);
4
 
$VERSION = '4.006'; # $Id: //depot/Tkutf8/Tk/Animation.pm#8 $
 
4
$VERSION = '4.008'; # $Id: //depot/Tkutf8/Tk/Animation.pm#8 $
5
5
 
6
6
use Tk::Photo;
7
7
use base  qw(Tk::Photo);
45
45
    }
46
46
  }
47
47
 $obj->set_image( 0 );
48
 
 $obj->{_delta_} = 1;
49
 
 $obj->{_blank_} = 0;
 
48
 $obj->_get_gif_info;
50
49
 return $obj;
51
50
}
52
51
 
74
73
    return @$frames;
75
74
}
76
75
 
77
 
sub blank {
 
76
sub set_disposal_method {
78
77
    my( $self, $blank ) = @_;
79
78
    $blank = 1 if not defined $blank;
80
79
    $self->{_blank_} = $blank;
95
94
sub next_image
96
95
{
97
96
 my ($obj, $delta)  = @_;
 
97
 $obj->_next_image($delta);
 
98
}
 
99
 
 
100
sub _next_image
 
101
{
 
102
 my ($obj, $delta, $in_animation)  = @_;
98
103
 $delta = $obj->{_delta_} unless $delta;
99
104
 my $frames = $obj->{'_frames_'};
100
105
 return unless $frames && @$frames;
101
 
 $obj->set_image((($obj->{'_frame_index_'} || 0) + $delta) % @$frames);
 
106
 my $next_index = (($obj->{'_frame_index_'} || 0) + $delta);
 
107
 if ($next_index > @$frames && $in_animation && $obj->{'_loop_'} ne 'forever')
 
108
  {
 
109
   return 0; # signal to stop animation
 
110
  }
 
111
 $next_index %= @$frames;
 
112
 $obj->set_image($next_index);
 
113
 1;
102
114
}
103
115
 
104
116
sub prev_image { shift->next_image( -1 ) }
105
117
 
 
118
sub next_image_in_animation
 
119
{
 
120
 my ($obj, $delta) = @_;
 
121
 my $continue = $obj->_next_image($delta, 1);
 
122
 if (!$continue && $self->{'_NextId_'})
 
123
  {
 
124
   $obj->pause_animation;
 
125
  }
 
126
}
 
127
 
106
128
sub pause_animation { 
107
129
    my $self = shift;
108
130
    my $id = delete $self->{'_NextId_'};
116
138
    }
117
139
    $period = $self->{'_period_'};
118
140
    my $w = $self->MainWindow;
119
 
    $self->{'_NextId_'} = $w->repeat( $period => [ $self => 'next_image' ] );
 
141
    $self->{'_NextId_'} = $w->repeat( $period => [ $self => 'next_image_in_animation' ] );
120
142
}
121
143
 
122
144
sub start_animation
123
145
{
124
146
 my ($obj,$period) = @_;
125
 
 $period ||= 100;
126
147
 my $frames = $obj->{'_frames_'};
127
148
 return unless $frames && @$frames;
128
149
 my $w = $obj->MainWindow;
129
150
 $obj->stop_animation;
130
 
 $obj->{'_period_'} = $period;
131
 
 $obj->{'_NextId_'} = $w->repeat($period,[$obj,'next_image']);
 
151
 $obj->{'_period_'} = $period if $period;
 
152
 $obj->{'_NextId_'} = $w->repeat($obj->{'_period_'},[$obj,'next_image_in_animation']);
132
153
}
133
154
 
134
155
sub stop_animation
139
160
 $obj->set_image(0);
140
161
}
141
162
 
 
163
sub _get_gif_info
 
164
{
 
165
 my ($obj) = @_;
 
166
 my $info;
 
167
 if (defined(my $file = $obj->cget(-file)) && eval { require Image::Info; 1; })
 
168
  {
 
169
   $info = Image::Info::image_info($file);
 
170
  }
 
171
 elsif (defined(my $data = $obj->cget(-data)))
 
172
  {
 
173
   if ($data =~ m{^GIF8} && eval { require Image::Info; 1; })
 
174
    {
 
175
     $info = Image::Info::image_info(\$data);
 
176
    }
 
177
   elsif (eval { require Image::Info; require MIME::Base64; 1; })
 
178
    {
 
179
     $data = MIME::Base64::decode_base64($data);
 
180
     $info = Image::Info::image_info(\$data);
 
181
    }
 
182
  }
 
183
 if ($info)
 
184
  {
 
185
   $obj->{'_blank_'} = $info->{DisposalMethod} == 2 || $info->{DisposalMethod} == 3;
 
186
   $obj->{'_period_'} = $info->{Delay}*1000 if defined $info->{Delay};
 
187
   $obj->{'_loop_'} = $info->{GIF_Loop};
 
188
  }
 
189
 $obj->{'_blank_'} = 0 if !defined $obj->{'_blank_'};
 
190
 $obj->{'_period_'} = 100 if !defined $obj->{'_period_'};
 
191
 $obj->{'_loop_'} = 'forever' if !defined $obj->{'_loop_'};
 
192
 $obj->{'_delta_'} = 1;
 
193
}
 
194
 
142
195
1;
 
196
 
143
197
__END__
144
198
 
145
 
=cut
146
 
 
147
199
#
148
200
# This almost works for changing the animation on the fly
149
201
# but does not resize things correctly