/usr/share/perl5/Tk/Splashscreen.pm is in libtk-splashscreen-perl 1.0-3.
This file is owned by root:root, with mode 0o644.
The actual contents of the file can be viewed below.
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 | $Tk::Splashscreen::VERSION = '1.0';
package Tk::Splashscreen;
use Tk qw/Ev/;
use Tk qw/:eventtypes/;
use Tk::waitVariableX;
use Tk::widgets qw/Toplevel/;
use base qw/Tk::Toplevel/;
Construct Tk::Widget 'Splashscreen';
sub Populate {
my ($self, $args) = @_;
$self->withdraw;
$self->overrideredirect(1);
$self->SUPER::Populate($args);
$self->{ofx} = 0; # X offset from top-left corner to cursor
$self->{ofy} = 0; # Y offset from top-left corner to cursor
$self->{tm0} = 0; # microseconds time widget was Shown
$self->ConfigSpecs(
-milliseconds => [qw/PASSIVE milliseconds Milliseconds 0/],
);
$self->bind('<ButtonPress-3>' => [$self => 'b3prs', Ev('x'), Ev('y')]);
$self->bind('<ButtonRelease-3>' => [$self => 'b3rls', Ev('X'), Ev('Y')]);
} # end Populate
# Object methods.
sub Destroy {
my ($self, $millis) = @_;
$millis = $self->cget(-milliseconds) unless defined $millis;
my $t = Tk::timeofday;
$millis = $millis - ( ($t - $self->{tm0}) * 1000 );
$millis = 0 if $millis < 0;
my $destroy_splashscreen = sub {
$self->update;
$self->after(100); # ensure 100% of PB seen
$self->destroy;
};
do { &$destroy_splashscreen; return } if $millis == 0;
while ( $self->DoOneEvent (DONT_WAIT | TIMER_EVENTS)) {}
$self->waitVariableX( [$millis, $destroy_splashscreen] );
} # end Destroy
sub Splash {
my ($self, $millis) = @_;
$millis = $self->cget(-milliseconds) unless defined $millis;
$self->{tm0} = Tk::timeofday;
$self->configure(-milliseconds => $millis);
$self->Popup;
} # end_splash
# Private methods.
sub b3prs {
my ($self, $x, $y) = @_;
$self->{ofx} = $x;
$self->{ofy} = $y;
} # end b3prs
sub b3rls {
my($self, $X, $Y) = @_;
$X -= $self->{ofx};
$Y -= $self->{ofy};
$self->geometry("+${X}+${Y}");
} # end b3rls
1;
__END__
=head1 NAME
Tk::Splashscreen - display a Splashscreen during program initialization.
=head1 SYNOPSIS
$splash = $parent->Splashscreen(-opt => val, ... );
=head1 DESCRIPTION
For programs that require large load times, it's a common practice to
display a Splashscreen that occupies the user's attention. This
Toplevel mega widget provides all the display, destroy and timing
events. All you do it create the Splashscreen mega widget, populate
it as you see fit, then invoke Splash() to display it and Destroy() to
tear it down.
Important note: be sure to sprinkle update() calls throughout your
initialization code so that any Splashscreen events are handled.
Remember, the screen may be animated, or the user may be simply moving
the Splashscreen about.
=head1 OPTIONS
The following option/value pairs are supported:
=over 4
=item B<-milliseconds>
The minimum number of milliseconds the Splashscreen should remain on
the screen. Default is 0, which means that the Splashscreen is
destroyed as soon as Destroy() is called. Otherwise, Destroy() waits
for the specified time interval to elapse before destroying the
Splashscreen.
=back
=head1 METHODS
=head2 $splash->Splash([B<milliseconds>]);
If B<milliseconds> is specified, it's the minimum number of
milliseconds the Splashscreen should remain on the screen.
This value takes precedence over that specified on the
Splashscreen constructor call.
=head2 $splash->Destroy([B<milliseconds>]);
If B<milliseconds> is specified, it's the minimum number of
milliseconds the Splashscreen should remain on the screen.
This value takes precedence over that specified on the
Splash() call, which takes precedence over that specified
during Splashscreen construction.
=head1 BINDINGS
=head2 <ButtonPress-3>
Notifies the Splashscreen to set a mark for an impending move.
=head2 <ButtonRelease-3>
Moves the Splashscreen from the mark to the cursor's current position.
=head1 ADVERTISED WIDGETS
Component subwidgets can be accessed via the B<Subwidget> method.
This mega widget has no advertised subwidgets. Instead, treat the
widget reference as a Toplevel and populate it as desired.
=head1 EXAMPLE
$splash = $mw->Splashscreen;
... populate the Splashscreen toplevel as desired ...
$splash->Splash(4000);
... program initialization ...
$splash->Destroy;
=head1 AUTHOR
Stephen.O.Lidie@Lehigh.EDU
Copyright (C) 2001 - 2002, Steve Lidie. All rights reserved.
This program is free software; you can redistribute it and/or
modify it under the same terms as Perl itself.
=head1 KEYWORDS
Splashscreen, Toplevel
=cut
|