# -----------------------------------------------------------------------------
# Author(s)	:	Bill Atkins
# Title		:	Tk-Win32 initialization file
# Date		:	1.22.02
# Desc		:	initializes the Tk-GUI plugin
# Notes		:	for more information see the plugin documentation
# License	:	it's on our TODO list...
# -----------------------------------------------------------------------------

package TkGUI;

use warnings;

use Tk;
use Tk::ItemStyle;
use Milkbone;

my $mw = MainWindow->new();
$mw->withdraw();
$mw->OnDestroy(\&on_destroy);

if(win32())
{
    $defaultFont = 'tahoma';
}
else
{
    $defaultFont = 'arial';
}

$mw->optionAdd("*font", "-*-$defaultFont-norma-r-*-*-*-120-*-*-*-*-*-*");
$mw->optionAdd("*borderWidth", 1);
$mw->optionAdd("*highlightThickness", 0);

$mw->optionAdd("*background", option("ThemeColor")) if(option("ThemeColor"));

my $icon = $mw->Photo(-file => path("images/icon.bmp"));

register_hook("tk_seticon", sub { $ARGS{-wnd}->Icon(-image => $icon); });
register_hook("tk_get_default_font", sub { $defaultFont });

register_hook("tick", \&tick);
register_hook("tk_getmain", sub {
	return $mw;
});

register_hook("tk_bindwheel", sub {
    if($^O =~ /win32/i)
    {
	$ARGS{-window}->bind('<MouseWheel>', 
	    [ sub { $_[0]->yview('scroll', -($_[1] / 120), 'units') }, Tk::Ev('D')]);
    }
    else
    {
	$ARGS{-window}->bind('<4>' => sub { $_[0]->yview('scroll', -1, 'units') unless $Tk::strictMotif;
	});

	$ARGS{-window}->bind('<5>' => sub { $_[0]->yview('scroll', 1, 'units') unless $Tk::strictMotif;
	});
    }
});

register_hook("after", sub {
	$mw->after($ARGS{-time}, $ARGS{-code});
});


sub tick
{
	return unless $mw;

	$mw->DoOneEvent(Tk::ALL_EVENTS);
}

sub on_destroy
{
	abort();
}

register_hook("error", sub {
	my $text = $ARGS{-short};
	($text) = $text =~ m/^(.*?)\n/;
	my $error_box = $mw->Toplevel(-title => "Milkbone Error");
	$error_box->Label(-text => $ARGS{-short}, -wraplength => 200)->pack;
	$error_box->Button(-text => "OK", -command => [sub {
		my ($self, $fatal) = @_;
		$self->destroy;
		hook("protocol_signoff") if $fatal;
		$mw->destroy if $fatal  && hook("protocol_signed_in");
	}, $error_box, $ARGS{-fatal}])->pack->focus;
	hook("tk_seticon", -wnd => $error_box);
	$error_box->withdraw;
	$error_box->geometry("+" . int(($mw->screenwidth() / 2) - int($error_box->width() / 2)) . "+" . int(($mw->screenheight() / 2) - int($error_box->height() / 2)) );
	$error_box->deiconify;
	$error_box->update;
        $error_box->focus;
});


1;