Splash screen increasing load time

[Phinix]

Good evening,

I have a fairly complex Tk application that takes a while to load, and I wanted to incorporate a splash screen so that the user doesn't think they failed to double click or something isn't working.

In researching I landed on Tk::Splashscreen however have been having some issues, specifically that when included the actual program itself doesn't even start loading until the splash screen display timer has run out.

Here is the code I was using, included before the main loop. I also tried it in a begin block with the same result:

my $ssw = MainWindow->new(-title=>'text');
my $sp = $ssw->Splashscreen();
$sp->Label(-image => $ssw->Photo(-file => "$imgpath\\splash.jpg"))->pa
+ck;
$sp->Splash(5000);$sp->update; $ssw->withdraw;
$sp->Destroy();    $ssw->destroy;

What I want is for the splash screen to display WHILE the app is loading, and if the app finishes loading before the splash screen timer runs out, kill the splash screen. But with the above code I have timed it, and the splash screen first runs for the duration specified (5000) and THEN the program starts to load, effectively defeating the purpose of having a splash screen by ADDING its interval to the load time rather than providing simple distraction during it.

[Khen1950fx]

This worked for me.

#!/usr/local/bin/perl 

BEGIN {
    $|  = 1;
    $^W = 1;
}

use strict;
use warnings;
use Tk;
use Tk::Splashscreen;
use Tk::widgets qw/Photo/;

my $ssw = MainWindow->new;
$ssw->Button(
    -text    => 'Quit', 
    -command => \&exit,
)->pack;

my $sp= $ssw->Splashscreen(-milliseconds => 5000);

my $giffer = '/path/to/some.gif';
$sp->Label(
    -image => $ssw->Photo(
    -file  => $giffer,
    ))->pack;
$sp->Splash;
$ssw->after(1000);

print "Waiting for Splashscreen to finish...\n";
$sp->Destroy;        
$ssw->deiconify;    
 
MainLoop;

[zentara]

Here is a home-rolled splash for anyone looking.

#!/usr/bin/perl
use warnings;
use strict;
use Tk;

my $mw = new MainWindow;
$mw->withdraw; #make it not visible

my $init_value = '';
my $countdown = 10;

my $tl = $mw->Toplevel(-bg=>'lightyellow' );
$tl->withdraw;
$tl->overrideredirect(1);
$tl->title("Splash");
#centers window 
CenterWindow($tl, 300, 200);

my $message = "
My Cool App
FooBaz Corp
Someplace, Somewhere

Click a button to continue";

$tl->Label(-text=>$message)->pack(-pady =>10);

$tl->Label(-textvariable=>\$countdown)->pack();


my $tlbframe = $tl->Frame()->pack(-expand => 1, -fill =>'x');

$tlbframe->Button(-text => "Option1",
            -command=> \&option1)
        ->pack(-side =>'left',-padx=>5); 
$tlbframe->Button(-text => "Option2",
            -command=> \&option2)
        ->pack(-side =>'left',-padx=>5); 
$tlbframe->Button(-text => "Exit",
            -command=> sub { do_quit(-3)} )
        ->pack(-side =>'right',-padx=>5); 

$tl->deiconify();

my $tltimer = $mw->repeat(1000,
                    sub{ $countdown--;
                         if($countdown == 0){ do_quit(-1) }
                         });


MainLoop;

#########################################################
sub option1{
    $tltimer->cancel;  
    $tl->withdraw;
    $tl->destroy;
    
    my $rb = 'first button';
    my $rb1 = $mw->Radiobutton(-text => "Button One",
                    -value => 'button1',
                    -variable => \$rb)->pack;
    my $rb2 = $mw->Radiobutton(-text => "Button Two",
                    -value => 'button2',
                -variable => \$rb)->pack;
   my $b1 = $mw->Button(-text => 'Show', -command => [ \&showRB, \$rb 
+])->pack;

   $mw->Button(-text=>'Exit',
               -command=> sub{
                 do_quit(-10);
                })->pack(); 
   CenterWindow($mw, 500, 500);    
   $mw->deiconify;    

  my $tltimer = $mw->after(15000,
                    sub{ do_quit(-100) });

}

########################################################
sub option2{  
    $tltimer->cancel;
    $tl->withdraw;
    $tl->destroy;
    
   my $tFrame = $mw->Frame->pack( -side => 'top' );        
   my $bFrame = $mw->Frame->pack( -side => 'bottom' );        
   my $lFrame = $bFrame->Frame->pack( -side => 'left' );
   my $rFrame = $bFrame->Frame->pack( -side => 'right', -fill => 'y' )
+;

   $tFrame->Label( -text => "Frame Packing Option2")
           ->pack( -side => 'top' );

   my $count = 1;
   my $frame;

  while ( $count <= 19 ) {
     if ( $count % 2 ) {
          load_frame( $count, $rFrame );
     }
     else {
         load_frame( $count, $lFrame );
     }
     $count++;
}

   $mw->Button(-text=>'Exit',
               -command=> sub{
                 do_quit(-20);
                })->pack( ); 
   CenterWindow($mw, 500, 500);    
   $mw->deiconify;    

  my $tltimer = $mw->after(15000,
                    sub{ do_quit(-200) });

}

#########################################################
sub do_quit{
    my $status = shift;
    
    print "exit_status-> $status\n";    
    exit $status;
}

##########################################################
sub CenterWindow {
my($window, $width, $height) = @_;
$window->idletasks;
$width  = $window->reqwidth  unless $width;
$height = $window->reqheight unless $height;

my $x = int(($window->screenwidth  / 2) - ($width  / 2));
my $y = int(($window->screenheight / 2) - ($height / 2));

$window->geometry("=${width}x${height}+${x}+${y}");

}
#############################################################
sub showRB {
     print "Arg list is @_\n";
     my $state_ref = shift;
     my $state = $$state_ref;
    $mw->messageBox(-title => 'Status',
                   -type  => 'OK',
                   -message  => "Status is :$state:.");
}
##########################################################            
+                      
sub load_frame {
    my $count = shift;
    my $frame = shift;

    $frame->Radiobutton(
        -text  => $count,
        -value => $count,
        -width => 10,
    )->pack;
}

__END__

[Anonymous Monk]

...

The docs say

 $splash = $mw->Splashscreen;

 ... populate the Splashscreen toplevel as desired ...

 $splash->Splash(4000);

 ... program initialization ...

 $splash->Destroy;

The code you posted doesn't follow this pattern but it should

[Phinix]

Thanks guys. I managed to get it working. The only problem I am having now is there is a delay before the splash pops up. The delay occurs just running the non-packed script so it is not an issue of Perl copying its files over from the EXE first causing the delay. I also tried using a begin block. It is only three seconds or so, but it would be nice to have it pop up instantly.

[Anonymous Monk]

blah blah blah Tk::FastSplash

[Phinix]

Yeah, I saw that (FlashSplash, sorry, replied to wrong post). Sadly I am using Tk version 804.029 which Slaven says is not compatible. There is probably a way to get into the guts and modify this, but I'm not sure how. It might also still work, though I haven't yet tested it.