Tk::Animation - GIFs in er Perl-GUI animieren

Animierte Bilder können mit Tk::Animation in einer Perl/Tk-GUI angezeigt werden. Eine Anwendungsmöglichkeit ist es beispielsweise ein GIF zu laden. Die einzelnen Frames der GIF-Datei werden dann in eine Sequenz aus Tk::Photo-Objekten zerlegt und können abgespielt werden.

Eine wichtige Methode für Tk::Animation ist set_disposal_method(BOOL). Damit wird definiert, ob der Bereich, in dem die einzelnen Frames gezeichnet werden vor dem nächsten Frame abgeräumt werden oder nicht. Das ist für transparente GIFs relevant, da sonst Reste des vorherigen Frames sichtbar sind.


Perl-Quellcode

#!perl

use strict;
use warnings;
use Tk;
use Tk::Animation;

my $mw = MainWindow->new();
$mw->configure(-background=>"black");
$mw->geometry("200x100");

my $canvas = $mw->Canvas(
    -width => 200,
    -height => 100,
    -background => 'black',
)->pack(
    -expand => 1,
    -fill => 'both',
);

my $image  = $mw->Animation(
    -format => 'gif',
    -file => 'oi.gif',
    # please use this one: http://images1.wikia.nocookie.net/vaultarmory/images/2/23/Gif_dancinggir.gif
);

# -- clear transparent background while drawing
$image->set_disposal_method( 1 );

my $id_of_image_in_canvas = $canvas->createImage(
    50, 50,
    -image=> $image,
);
$image->start_animation(80);

# -- store the current mving direction
my $direction = 'moving2left';
$mw->repeat(600, \&move_item_in_canvas);

$mw->MainLoop();
exit(0);


sub move_item_in_canvas {
    # -- get current location
    my ($x1, $y1, $x2, $y2) = $canvas->bbox($id_of_image_in_canvas);

    # -- compute if to move left or right
    my $min_left = 0;
    my $max_right = 200;
    if( $direction eq 'moving2left' && $x1 > $min_left ) {
        # continue moving left
        $canvas->move($id_of_image_in_canvas, -10, 0);

    }elsif( $direction eq 'moving2left' && $x1 <= $min_left ) {
        # change direction, move to the right
        $direction = 'moving2right';
        $canvas->move($id_of_image_in_canvas, 10, 0);

    }elsif( $direction eq 'moving2right' && $x2 < $max_right ) {
        # move right
        $canvas->move($id_of_image_in_canvas, 10, 0);

    }elsif( $direction eq 'moving2right' && $x2 >= $max_right ){
        # change direction, move to the left
        $direction = 'moving2left';
        $canvas->move($id_of_image_in_canvas, -10, 0);

    }else{
        die('Error: don\'t know what to do in this case.');
    }

    return;
} # /move_item_in_canvas
Top