File Coverage

blib/lib/Tk/StyleDialog.pm

Criterion	Covered	Total	%
statement	7	9	77.7
branch			n/a
condition			n/a
subroutine	3	3	100.0
pod			n/a
total	10	12	83.3

################################################################################
# Tk::StyleDialog - Stylish Dialogboxes with Custom Icons		       #
################################################################################
package Tk::StyleDialog;

use strict;
use warnings;
use Tk;
use Tk::Toplevel;
use Tk::PNG;
use Tk::Widget;

our $VERSION = '0.04';
Tk::Widget->Construct ('StyleDialog');

# CORE Built-in icons.
# attention, error, info, question
our $BUILTIN_ICONS = {
	'attention' => 'iVBORw0KGgoAAAANSUhEUgAAACIAAAAiBAMAAAG/biZnAAAAElBMVEUAAACAgACZmZnAwMD//wAA
AABjkWUwAAAAAXRSTlMAQObYZgAAAPNJREFUKM9lkEsOgzAMRA3KAVrJ7KOcoAvYV2DvEU3uf5X6
BwqtJZAZXjzjAGi9AVKTpwKMxZS0Q3oDsX0Pq0pYs7Q0y0ci2jLASco/JZjlP1OGtNEOyLQCkbzG
UmxoesURkeN04rqGxNXFpN3qlFZ2u0omNqtymkfhfk2OcRKUT4/LDZf5CKyF7yAdh++EDiIx0eEJ
2G0Hi8KeRfIpiNLNBqInlW6IfAC2demCPh/wE5q24yaoyVLuiGx+5DtyhyRsaz0kiCodhKFckE7Z
2qebZBtMnV0s3Nn5kouecsgR0skBhRLFJV9XQ37KrsMv5iz4ry/n4U7to4iyMAAAAABJRU5ErkJg
gg==',
	'error' => 'iVBORw0KGgoAAAANSUhEUgAAACIAAAAiBAMAAAG/biZnAAAAD1BMVEUAAAD/AACZmZn///9gAADt
zF8pAAAAAXRSTlMAQObYZgAAAPVJREFUKM9dko2twyAMhGmUAd4BAyD0FrBYoETsP1PPP7RNLSVx
Ps7mcJIS4wFe0uyZmpKEmoA0s70DTwpKgd9JJnryOGHF+EsYwqLC25SR2QxZS6k+WiiXlUxoGBmC
oTKKxwBq80w0O1HgqwptkXGs1Vu6xzKDvkWktkXdSNTFg83K0OVJl9wjmxXdNzKJrARjhRTB5bWw
LDr3fY6sZo6Nbv6Ob6OL8e3Zh2AWP9Y9njfF5+gE9A83Wt9k+MTMgHUhMgD1631LAFwtiGpuhIri
6GoxGIn2VQ9y2hy1l0r6r8M469pg9f2H/Btb1xvoZCx+v2PEC2oELiZOaMTkAAAAAElFTkSuQmCC',
	'info' => 'iVBORw0KGgoAAAANSUhEUgAAACIAAAAiBAMAAADIaRbxAAAAD1BMVEVlYXIAAP+ZmZn///8AAADI
hm6AAAAAAXRSTlMAQObYZgAAAAFiS0dEAIgFHUgAAAAJcEhZcwAACxMAAAsTAQCanBgAAAAHdElN
RQfVAQUJAhHTzodBAAAAn0lEQVQoz63S0Q3EIAgAUGNcgNwChusCrQ5wUfef6UQQzHn9Kx9tfEGi
oHM3gT3WtcfUA6PBO424lAQ6zRRaAND3YyknwKv/sqWIcBJX4V2cpHWHRNlkUaaA1DFJKvEx0RMO
yfhX/CpldLLyCYky9zYsd5DOVr3nbH8QykWbfzSCVmxCHlulLet88CCJ6xBJfuZcNwmbuLaJx/3F
3D2lL2ZNO/7TbRBBAAAAAElFTkSuQmCC',
	'question' => 'iVBORw0KGgoAAAANSUhEUgAAACIAAAAiBAMAAADIaRbxAAAAD1BMVEVlYXIAAP+ZmZn///8AAADI
hm6AAAAAAXRSTlMAQObYZgAAAAFiS0dEAIgFHUgAAAAJcEhZcwAACy8AAAsTAXMiW84AAAAHdElN
RQfVAQUINxbuWbpjAAAAp0lEQVQoz4XS0Q3EIAgGYGNcgLiA4bpAiwNc1P1nOrQIpqY5Xpp++dEU
6txLIdf67pG4MBl8aNSlJMA0I6T1tcgJEPmRLRIJQEMjEjmlobspiiRpUqEybwI5x0SOYUkm9JT4
X2axyHdKJqOKXD7Er1LGJKt15Xu2YTlXJlsn5Dn+IJSLDv9oHVqxDXlstbes+8GjS1qX2OWx57pJ
2MS1TTzuf8zbr/QD5Iw9gr+vgAwAAAAASUVORK5CYII=',
};

sub new {
	my $proto = shift;
	my $mw = shift;
	my $class = ref($proto) || $proto || 'Tk::StyleDialog';

	my $self = {
		mw => $mw,
		@_,
	};

	bless ($self,$class);
	return $self->Show;
}

sub Show {
	my ($args) = @_;

	# Args:
	# mw = parent window
	# -title	  = Dialog Title
	# -text	          = Dialog message text
	# -icon	          = The icon to use inside the dialog
	# -buttons        = Arrayref of button labels
	# -default_button = The default button
	# -button_states  = Arrayref of button states (normal|disabled)

	# Prepare default arguments.
	my $title   = 'Error';
	my $text    = 'An error has occurred.';
	my $icon    = 'error';
	my $center  = 1;
	my $winicon = 'error';
	my $winmask = 'error';
	my $buttons = [ '  Ok  ' ];
	my $default_button = undef;
	my $cancel_button = undef;
	my $button_states  = [];
	my $standalone = 0;
	my $grab = '';

	# Collect args.
	$title = delete $args->{'-title'} if exists $args->{'-title'};
	$text  = delete $args->{'-text'}  if exists $args->{'-text'};
	$icon  = delete $args->{'-icon'}  if exists $args->{'-icon'};
	$center  = delete $args->{'-center'} if exists $args->{'-center'};
	$winicon = delete $args->{'-winicon'} if exists $args->{'-winicon'};
	$winmask = delete $args->{'-winmask'} if exists $args->{'-winmask'};
	$buttons = delete $args->{'-buttons'} if exists $args->{'-buttons'};
	$default_button = delete $args->{'-default_button'} if exists $args->{'-default_button'};
	$cancel_button  = delete $args->{'-cancel_button'} if exists $args->{'-cancel_button'};
	$button_states  = delete $args->{'-button_states'} if exists $args->{'-button_states'};
	$standalone = delete $args->{'-standalone'} if exists $args->{'-standalone'};
	$grab = delete $args->{'-grab'} if exists $args->{'-grab'};

	# Default default button = the first button.
	$default_button = $buttons->[0] unless defined $default_button;

	# Default cancel button = the last button.
	$cancel_button = $buttons->[-1] unless defined $cancel_button;

	# Internal variables.
	my $selectedbutton = undef;

	#######################################################
	## Create the Dialog Window                          ##
	#######################################################

	# Create the window.
	my $win = $args->{mw}->Toplevel (
		-title => $title || 'Error',
	);

	# Handle the clicking of the "X" button.
	$win->protocol ('WM_DELETE_WINDOW' => sub {
		$selectedbutton = $cancel_button;
	});

	# Handle keypresses.
	$win->bind ('', sub {
		$selectedbutton = $default_button;
	});
	$win->bind ('', sub {
		$selectedbutton = $default_button;
	});
	$win->bind ('', sub {
		$selectedbutton = $cancel_button;
	});

	# Unless standalone, make it a child of the main window.
	unless ($standalone) {
		$win->transient ($win->Parent->toplevel);
	}

	# Divide the window into frames.
	my $bottom_frame = $win->Frame->pack (-side => 'bottom', -fill => 'x');
	my $top_half     = $win->Frame->pack (-side => 'bottom', -fill => 'both', -expand => 1);
	my $icon_frame   = $top_half->Frame->pack (-side => 'left', -fill => 'y');
	my $label_frame  = $top_half->Frame->pack (-side => 'left', -fill => 'both', -expand => 1);
	my $button_frame = $bottom_frame->Frame->pack (-side => 'top', -fill => 'y');

	#######################################################
	## Button Frame			                     ##
	#######################################################

	# Draw the window buttons.
	for (my $i = 0; $i < scalar @{$buttons}; $i++) {
		my $label = $buttons->[$i];

		# Get this button's state.
		my $state = 'normal';
		if (scalar @{$button_states} > $i) {
			$state = (defined $button_states->[$i] ? $button_states->[$i] : 'normal');
		}

		# If this is the default button, draw a border around it.
		if ($label eq $default_button) {
			my $border = $button_frame->Frame (
				-background => '#000000',
			)->pack (-side => 'left', -padx => 10, -pady => 10);
			my $btn = $border->Button (
				-text    => $label,
				-state   => $state,
				-command => sub {
					$selectedbutton = $label;
				},
				-highlightthickness => 0,
			)->pack (-side => 'top', -padx => 1, -pady => 1);
		}
		else {
			my $btn = $button_frame->Button (
				-text    => $label,
				-state   => $state,
				-command => sub {
					$selectedbutton = $label;
				},
				-highlightthickness => 0,
			)->pack (-side => 'left', -padx => 10, -pady => 10);
		}
	}

	#######################################################
	## Icon Frame				             ##
	#######################################################

	# If they gave us a Photo object, use it.
	my $photo = undef;
	if (ref($icon)) {
		$photo = $icon;
	}
	else {
		# Get the internal one. Does it exist?
		if (!exists $BUILTIN_ICONS->{$icon}) {
			# Load Tk::StyleDialog::Builtins.
			require Tk::StyleDialog::Builtins;
		}
		$icon = 'error' unless exists $BUILTIN_ICONS->{$icon};

		if (exists $BUILTIN_ICONS->{$icon}) {
			$photo = $win->Photo (
				-data   => $BUILTIN_ICONS->{$icon},
				-format => 'PNG',
				-width  => 34,
				-height => 34,
			);
		}
	}

	my $iconimg = $icon_frame->Label (
		-image  => $photo,
		-border => 0,
	)->pack (-side => 'top', -pady => 10, -padx => 20);

	#######################################################
	## Label Frame			                     ##
	#######################################################

	my $label = $label_frame->Label (
		-text => $text,
		-justify => 'left',
	)->pack (-side => 'top', -anchor => 'nw', -pady => 20, -padx => 10);

	# Update the window to get realistic dimensions.
	$win->withdraw;
	$win->update;

	# Center the window?
	if ($center) {
		my $screenwidth = $args->{mw}->screenwidth;
		my $screenheight = $args->{mw}->screenheight;
		my $posX = ($screenwidth - $win->width) / 2;
		my $posY = ($screenheight - $win->height) / 2;
		$win->MoveToplevelWindow (int($posX),int($posY));
	}

	# Set the minsize to be its default size.
	$win->minsize ($win->width,$win->height);

	# Set the app icon.
	$win->Icon (-image => $photo);

	$win->deiconify;

	# Grab.
	if ($grab eq 'global') {
		$win->grabGlobal;
	}
	else {
		$win->grab;
	}

	# Wait for a button.
	$win->focusForce;
	$win->waitVariable (\$selectedbutton);
	$win->destroy;

	# Return the selected button.
	return $selectedbutton;
}

1;
__END__