use strict;
our $VERSION = '0.16';
use Tkx;
use base qw(Tkx::widget Tkx::MegaConfig);
__PACKAGE__->_Mega('tkx_SplashScreen');
__PACKAGE__->_Config();
#----------------------------------------------------------------------------
# Method : _Populate
# Purpose : Create a new splash screen
# Notes :
#----------------------------------------------------------------------------
sub _Populate {
my ($class, $widget, $path, %opt) = @_;
my $self = $class->new($path)->_parent->new_toplevel(
-name => $path,
-class => 'tkx_SplashScreen'
);
$self->_class($class);
# Withdraw window
$self->g_wm_withdraw();
# Data
my $data = $self->_data();
$data->{-title} = delete $opt{-title};
$data->{-image} = delete $opt{-image};
$data->{-override} = defined $opt{-override} ? $opt{-override} : 1;
$data->{-width} = defined $opt{-width } ? $opt{-width} : 400;
$data->{-height} = defined $opt{-height} ? $opt{-height} : 300;
$data->{-alpha} = defined $opt{-alpha} ? $opt{-alpha} : 1.0;
$data->{-show} = defined $opt{-show} ? $opt{-show} : 1;
$data->{-posx} = defined $opt{-posx} ? $opt{-posx} : -1;
$data->{-posy} = defined $opt{-posy} ? $opt{-posy} : -1;
$data->{-hideonclick} = defined $opt{-hideonclick} ? $opt{-hideonclick} : 0;
$data->{-topmost} = defined $opt{-topmost} ? $opt{-topmost} : 0;
$data->{-delay} = defined $opt{-delay} ? $opt{-delay} : 0;
# Initialize
$self->_obj_init();
# Widget
return $self;
}
#----------------------------------------------------------------------------
# Method : _obj_init
# Purpose : Initializes splashscreen
# Notes :
#----------------------------------------------------------------------------
sub _obj_init {
my ($self) = @_;
my $data = $self->_data();
# Title
if (defined $data->{-title}) {
$self->g_wm_title($data->{-title});
}
# Override redirect
if ($data->{-override}) {
$self->g_wm_overrideredirect(1);
}
# Alpha channel
if ($data->{-alpha}) {
if (Tkx::tk_windowingsystem() eq 'win32') {
$self->g_wm_attributes(-alpha => $data->{-alpha});
}
}
# Topmost
if ($data->{-topmost}) {
$self->g_wm_attributes(-topmost => $data->{-topmost});
}
# Fullscreen
if ($data->{-fullscreen}) {
$self->g_wm_attributes(-fullscreen => $data->{-fullscreen});
}
# Set width/height
my ($image_width, $image_height);
my ($width, $height);
if ($data->{-image}) {
$image_width = Tkx::image_width($data->{-image});
$image_height = Tkx::image_height($data->{-image});
}
else {
$image_width = 400;
$image_height = 300;
}
if (($data->{-width} eq 'auto') or ($data->{-width} < 0)) {
$width = $image_width;
}
else {
$width = $data->{-width};
}
if (($data->{-height} eq 'auto') or ($data->{-height} < 0)) {
$height = $image_height;
}
else {
$height = $data->{-height};
}
# Set position
my ($posx, $posy);
if (($data->{-posx} eq 'auto') or ($data->{-posx} < 0)) {
$posx = int(($self->g_winfo_screenwidth() - $width) / 2);
}
else {
$posx = $data->{-posx};
}
if (($data->{-posy} eq 'auto') or ($data->{-posy} < 0)) {
$posy = int(($self->g_winfo_screenheight() - $height) / 2);
}
else {
$posy = $data->{-posy};
}
# Set image
my $canvas = $data->{canvas} = $self->new_canvas(
-width => $width,
-height => $height,
-highlightthickness => 0,
);
$canvas->g_pack();
if ($data->{-image}) {
$canvas->create_image(qw(0 0), -anchor => 'nw', -image => $data->{-image});
}
# Hide on click
if ($data->{-hideonclick}) {
Tkx::bind($canvas, '<ButtonPress-1>', sub {
$self->hide();
});
}
# Hide on delay
if ($data->{-delay}) {
Tkx::after($data->{-delay}, sub {
$self->hide();
})
}
# Set geometry
$self->g_wm_geometry("${width}x${height}+${posx}+${posy}");
# Show window
if ($data->{-show}) {
$self->show();
}
}
#----------------------------------------------------------------------------
# Method : show
# Purpose : Show splashscreen toplevel
# Notes :
#----------------------------------------------------------------------------
sub show {
my ($self) = @_;
$self->g_wm_deiconify();
$self->g_raise();
$self->g_focus();
}
#----------------------------------------------------------------------------
# Method : hide
# Purpose : Hide splashscreen
# Notes :
#----------------------------------------------------------------------------
sub hide {
my ($self) = @_;
$self->g_wm_withdraw();
}
#----------------------------------------------------------------------------
# Method : canvas
# Purpose : Return canvas
# Notes :
#----------------------------------------------------------------------------
sub canvas {
my ($self) = @_;
return $self->_data->{canvas};
}
1;
__END__
=pod
=head1 NAME
Tkx::SplashScreen - splashscreen megawidget for Tkx.
=head1 VERSION
This documentation referers to Tkx::SplashScreen version 0.16
=head1 SYNOPSIS
use Tkx;
use Tkx::SplashScreen;
Tkx::package_require('img::png');
my $mw = Tkx::widget->new('.');
$mw->g_wm_withdraw();
my $sr = $mw->new_tkx_SplashScreen(
-image => Tkx::image_create_photo(-file => './image.png'),
-width => 'auto',
-height => 'auto',
-show => 1,
-topmost => 1,
);
my $cv = $sr->canvas();
$cv->create_text(qw(10 10), -text => 'Loading...', -anchor => 'w');
# Do some stuff.
# Destroy splash screen and show main window.
Tkx::after(5000 => sub {
$sr->g_destroy();
$mw->g_wm_deiconify();
});
=head1 DESCRIPTION
Tkx::SplashScreen is a megawidget that describes an image that
appears while application is loading.
=head1 OPTIONS
The options bellow are passed through the constructor of megawidget.
=head2 C<-image =E<gt> I<image>>
Background image.
=head2 C<-width =E<gt> I<width>>
Width. Default is 400.
=head2 C<-height =E<gt> I<height>>
Height. Default is 300.
=head2 C<-posx =E<gt> I<x>>
Position X of top left corner.
By default window fits center the screen.
=head2 C<-posy =E<gt> I<y>>
Position Y of top left corner.
By default window fits center the screen.
=head2 C<-delay =E<gt> I<ms>>
Delay in milliseconds after window will be hidden.
=head2 C<-alpha =E<gt> I<level>>
Alpha transparency level of the window (only win32).
Default is 1.0
=head2 C<-override =E<gt> I<overrideredirect>>
Override redirect flag. Enable by default.
=head2 C<-show =E<gt> I<show>>
Show splash screen after construction.
=head2 C<-hideonclick =E<gt> I<hideonclick>>
Hide splash screen on mouse click
=head1 METHODS
Tkx::SplashScreen methods.
=head2 C<new>
Constructor.
=head2 C<configure>
Configure widget properties after constructing.
=head2 C<show>
Show splash screen.
=head2 C<hide>
Hide splash screen.
=head2 C<canvas>
Returns canvas for the splash screen.
=head1 BUGS AND LIMITATIONS
None known at this time.
=head1 SUPPORT
You can find documentation for this module with the perldoc command.
perldoc Tkx::SplashScreen
=head1 AUTHOR
Alexander Nusov <alexander.nusov+cpan <at> gmail.com>
=head1 COPYRIGHTS AND LICENSE
Copyright (C) 2009-2010 Alexander Nusov
This library is free software; you can redistribute it and/or modify
it under the same terms as Perl itself.
=cut