Tk::Animation woes - #45148 (Graphische Oberflächen)

ptk

2005-12-28 03:05

User since
2003-11-28
3645 Artikel
ModeratorIn
[default_avatar]

Ein Benutzer in einem anderen Perl-Forum hat Probleme mit animierten GIFs, die Transparenz enthalten. Bei diesen GIFs wird das vorherige Bild nicht gelöscht. Sein Skript:

Code (perl): (dl )

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

my $scale;
my $haupt = new MainWindow;
my $img = $haupt->Animation('-format' => 'gif', -file => 'icons/sc_7.gif');
my $label = $haupt->Label(-image=>$img)->pack;
$img->blank(1);

$scale = $haupt->Scale(-from => 0, -to => $#{$img->{'_frames_'}}, -orient => "horizontal", -command =>sub { $img->set_image( $scale->get ); } )->pack();

MainLoop();

Ich konnte das Problem mit einer eigenen Animation nachvollziehen (X11 + perl5.8.7, sein System war Windows).

Das Problem scheint am unglücklichen Zusammenspiel zwischen ->blank und ->copy in der Methode Tk::Animation::set_image zu liegen.

Ein Workaround wäre, die Animation selbst vorzunehmen, zum Beispiel so:

Code (perl): (dl )

use strict;
use Tk;

my $scale;
my $haupt = new MainWindow;
my @img;
for my $i (0 .. 1000) {
    my $img;
    eval {
        $img = $haupt->Photo(-file => "anim.gif", -format=> "gif -index $i");
    };
    if (!$@) {
        push @img, $img;
    } else {
        last;
    }
}

my $img_i = 0;
my $label = $haupt->Label(-image=>$img[$img_i])->pack;
$label->repeat(100, sub {
               
    $img_i++;
               
    if ($img_i > $#img) { $img_i = 0 }
               
    $label->configure(-image => $img[$img_i]);
               });
               
    

MainLoop();

Eine andere Möglichkeit wäre, die Zeile

Code: (dl )

$obj->copy($frames->[$index]);

aus Tk::Animation::set_image durch

Code: (dl )

$obj->put($frames->[$index]->data(-background => "#dddddd"))

zu ersetzen. Nachteil: die Transparenz geht dabei verloren.