Re^2: Why is Tk::Animation so slow?

Very nice work. Is the problem caused by transparency? If so I can detect that and use your process to avoid the wait.

I mentioned a 22MB GIF that didn't load after 45 minutes. It's actually 28MB and your code loads it in ~7 seconds! A tremendous improvement.

The 28MB GIF I was working with is some gorgeous footage of Comet ISON grazing the sun taken with the Large Angle Coronagraph on NASA/ESA's Solar Heliospheric Observatory. This version of your script downloads and displays it (The minor glitches in the upper left corner are not part of the GIF. Maybe fixable by setting a proper DisposalMethod):

#!/usr/bin/perl

use strict;
use warnings;

use HTTP::Tiny;
use MIME::Base64;
use Time::HiRes 'time';

use Imager ':handy';
use Tk;
use Tk::Animation;
use Tk::Photo;

my $file = 'http://web.archive.org/web/20131202114602if_/'.
'http://science.nasa.gov/media/medialibrary/2013/12/01/ghost_anim.gif'
+;

print "Downloading image $file \n";

my $path = HTTP::Tiny->new->get($file)->{content};

die 'Download failed!' unless $path;

my $size = length $path;

my $mw = MainWindow-> new;
$mw-> configure( -title => 'Comet ISON via SOHO LASCO C3' );
my $top = $mw-> Frame-> pack;

my $start = time;
my $backdrop;
my @frames = map {
    if ( $backdrop ) {              # not 1st?
        my $mask = $_-> copy;
        my @mask_plt = map NC( 255, 255, 255 ), $mask-> getcolors;
        my $trans_idx = $mask-> tags( name => 'gif_trans_index' );
        $mask_plt[ $trans_idx ] = NC( 0, 0, 0 ) if $trans_idx;
        $mask-> setcolors( colors => \@mask_plt );
        $backdrop-> compose( src => $_, mask => $mask );
    }
    else {
        $backdrop = $_
    }

    $backdrop-> write( data => \my $data, type => 'bmp' );
    $mw-> Photo( -data => encode_base64( $data ));
} Imager-> read_multi( data => $path );

my $image_2 = $mw-> Animation;
$image_2-> add_frame( @frames );

print "\nImager & Tk::Animation took ", time - $start,
    " seconds for $size bytes \n";

$top-> Label( -image => $image_2 )-> pack;
$image_2-> start_animation;

MainLoop;

__END__

Imager & Tk::Animation took 6.60826396942139 seconds for 28042970 byte
+s
[download]

Hopefully someone can use this information to figure out what's wrong with Tk::Photo and get it fixed!

Comment on Re^2: Why is Tk::Animation so slow? Download Code

Replies are listed 'Best First'.
Re^3: Why is Tk::Animation so slow? (re: glitches) by vr (Curate) on Dec 23, 2019 at 11:44 UTC
Ah, I knew it: code runs with result (almost) as expected on 1st attempt: no errors, no typos even. Then something _must_ be wrong with it:). Because of those "glitches" I said "almost" and "didn't investigate", though I should have :) First thing, "copy" method doesn't copy gif tags (bug in Imager?), $trans_idx was undefined, mask always blank. However, "compose" method apparently works, even if source image is converted to 3 channel RGB (no alpha) with "to_rgb8", and mask attribute not supplied at all. Statement in fragment further below could be replaced with `$backdrop-> rubthrough( src => $_-> to_rgb8, tx => $left, ty => $top );` [download] and animation would still work. Where and why Imager gets transparency information in this case -- I don't know. I'd expect the result be the same as with "paste" method (you can try it if you wish -- that's where there are no masks, no transparency). Further, I should have checked for offsets of gif frames -- they are not always zero. Whole "if else" fragment can be replaced with the following (though mask may be unnecessary(?), I'm not omitting it): `if ( $backdrop ) { # not 1st? my $mask = $_-> copy; my @mask_plt = map NC( 255, 255, 255 ), $_-> getcolors; my $trans_idx = $_-> tags( name => 'gif_trans_index' ); my $left = $_-> tags( name => 'gif_left' ); my $top = $_-> tags( name => 'gif_top' ); $mask_plt[ $trans_idx ] = NC( 0, 0, 0 ) if defined $trans_idx; $mask-> setcolors( colors => \@mask_plt ); $backdrop-> compose( src => $_, mask => $mask, tx => $left, ty => $top ); } else { $backdrop = $_-> to_rgb8 }` [download]	[reply] [d/l] [select]

Replies are listed 'Best First'.

Re^3: Why is Tk::Animation so slow? (re: glitches)
by vr (Curate) on Dec 23, 2019 at 11:44 UTC

Ah, I knew it: code runs with result (almost) as expected on 1st attempt: no errors, no typos even. Then something _must_ be wrong with it:). Because of those "glitches" I said "almost" and "didn't investigate", though I should have :)

First thing, "copy" method doesn't copy gif tags (bug in Imager?), $trans_idx was undefined, mask always blank.

However, "compose" method apparently works, even if source image is converted to 3 channel RGB (no alpha) with "to_rgb8", and mask attribute not supplied at all. Statement in fragment further below could be replaced with

$backdrop-> rubthrough( src => $_-> to_rgb8, 
                        tx => $left, ty => $top );
[download]

and animation would still work. Where and why Imager gets transparency information in this case -- I don't know. I'd expect the result be the same as with "paste" method (you can try it if you wish -- that's where there are no masks, no transparency).

Further, I should have checked for offsets of gif frames -- they are not always zero. Whole "if else" fragment can be replaced with the following (though mask may be unnecessary(?), I'm not omitting it):

    if ( $backdrop ) {              # not 1st?
        my $mask = $_-> copy;
        my @mask_plt = map NC( 255, 255, 255 ), $_-> getcolors;
        my $trans_idx = $_-> tags( name => 'gif_trans_index' );
        my $left      = $_-> tags( name => 'gif_left' );
        my $top       = $_-> tags( name => 'gif_top' );

        $mask_plt[ $trans_idx ] = NC( 0, 0, 0 ) 
            if defined $trans_idx;
        $mask-> setcolors( colors => \@mask_plt );
        $backdrop-> compose( src => $_, mask => $mask, 
                             tx => $left, ty => $top );
    }
    else {
        $backdrop = $_-> to_rgb8
    }
[download]

[reply]
[d/l]
[select]