milkbone/plugins/Tk-Logon/Milkbone/Logon.pm

# milkbone - sign-on toplevel mega-widget

package Milkbone::Logon;

use Milkbone;

use Tk::widgets qw(Frame Label);
use base qw(Tk::Toplevel);
use strict;
use warnings;

Construct Tk::Widget 'MBLogon';

my $mw = hook("tk_getmain");

my $slogan = "when you run out of clever slogans,\n you get something like this";

sub ClassInit
{
	my ($class, $mw) = @_;
	$class->SUPER::ClassInit($mw);
}

sub Populate
{
	my ($self, $args) = @_;
	$self->SUPER::Populate($args);

	$self->ConfigSpecs('DEFAULT' => ['SELF']);
	$self->Delegates();
}

sub clear
{
	my ($self) = @_;
	$self->{sname} = "";
	$self->{pass} = "";
	$self->{signed_on} = 0;
}

sub on_destroy
{
	my ($self) = @_;

	hook("protocol_signoff") if $self->{signed_on};
	$mw->destroy;
}

sub on_logon
{
	my ($self) = @_;

	return if $self->{signed_on} == 1;

	$self->{controls}->packForget;
	$self->{status}->pack(-expand => 1, -fill => 'both');
	$self->update;

	hook("protocol_signon", -user => $self->{sname}, -pass => $self->{pass});

	$self->{signed_on} = 1;
	data("me") = $self->{sname};
}

sub on_cancel
{
	my ($self) = @_;

	$self->{status}->packForget;
	$self->{controls}->pack(-expand => 1, -fill => 'both');

	hook("protocol_signoff");
	$self->{signed_on} = 0;
	$self->{status_label}->configure(-text => 'Connecting to the Evil Empire...');
	$self->{sn_entry}->focus;
        $self->update;
}

sub on_about
{
	my ($self) = @_;

	$mw->MBAbout(-title => "About milkbone $Milkbone::VERSION")->focus;
}

sub init
{
	my ($self, $mw, %args) = @_;

	$self->{sname} = "";
	$self->{pass} = "";
	$self->{signed_on} = 0;

	$self->withdraw();
	$self->resizable(0, 0);
	$self->configure(-title => "milkbone logon $Milkbone::VERSION");
	
	# WIDGET CREATION BEGIN
	my $image = $self->Photo(-file => path("images/logon.bmp"));
	$self->Label(-image => $image)->pack(-side => 'top', -ipadx => 0, -ipady => 2);

	# separate frames are used for the logon boxes and the status area
	$self->{controls} = $self->Frame->pack(-expand => 1, -fill => 'both');
	$self->{status} = $self->Frame;
	
	# create the screen name widget and focus it
	$self->{controls}->Label(-text => 'Screen name:', -anchor => 'w',
	  -borderwidth => 0)->
    pack(-side => 'top', -expand => 1, -fill => 'both', -padx => 7);

	$self->{sn_entry} = $self->{controls}->Component('Entry' => 'sn', -background => 'white', -width => 16, -textvariable => \$self->{sname}, -insertwidth => 1)->
		pack(-side => 'top',  -fill => 'x', -padx => 5);
	$self->{sn_entry}->focus;
	
	# create the password widget
	$self->{controls}->Label(-text => 'Password:', -anchor => 'w')->
		pack(-side => 'top', -expand => 1, -fill => 'both', -padx => 7);
	$self->{pass_entry} = $self->{controls}->Component('Entry' => 'pass', -background => 'white', -width => 16, -textvariable => \$self->{pass}, -show => '*', -insertwidth => 1)->
		pack(-side => 'top', -expand => 1, -fill => 'both', -padx => 5);

	$self->{controls}->Label(-text => $slogan, -anchor => 'c', -justify => 'center', -wraplength => 250)->pack(-expand =>1, -fill => 'both');

	# create the status frame
	$self->{status_label} = $self->{status}->Label(-text => "Connecting to the Evil Empire...")->pack;
	$self->{status}->Button(-text => "Cancel", -command => [$self, "on_cancel"])->pack(-pady => 5);

	$self->{logon_button} = $self->{controls}->Button(-text => 'log on', -command => [$self, "on_logon"], 
		-height => 0.5, -borderwidth => 1)->
		pack(-pady => 7, -padx => 3, -expand => 0, -side => 'left');
	$self->{controls}->Button(-text => 'about', -command => sub { hook("show_about") }, 
		-height => 0.5)->
		pack(-pady => 7, -padx => 3, -expand => 0, -side => 'right');
	# WIDGET CREATION END

	$self->update;
	$self->geometry("+" . int(($mw->screenwidth() / 2) - int($self->width() / 2)) . "+" . int(($mw->screenheight() / 2) - int($self->height() / 2)) ) unless $^O =~ /linux/i;
        $self->packPropagate(1);
	$self->deiconify;
	
	$self->bind('<Return>' => [$self, 'on_logon']);
	$self->bind("<Escape>" => [$self, "on_destroy"]);	
	$self->OnDestroy([sub { abort unless $_[0]->{signed_on} }, $self]);
	hook("tk_seticon", -wnd => $self);
}

sub on_signed_in
{
	my ($self) = @_;

	$self->withdraw;
}

1;