# 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 = "earth! wind! water! fire! spirit! MILKBONE!"; 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->packPropagate(1); $self->{status}->packForget; $self->{controls}->pack(-expand => 1, -fill => 'both'); hook("protocol_signoff"); $self->{signed_on} = 0; $self->{status_label}->configure(-text => 'Connecting to login.oscar.aol.com...'); $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', -takefocus => 0)-> 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, -takefocus => 1)-> pack(-side => 'top', -expand => 1, -fill => 'both', -padx => 5); $self->{controls}->Label(-text => $slogan, -anchor => 'c', -justify => 'center', -wraplength => 250, -takefocus => 0)->pack(-expand =>1, -fill => 'both'); # create the status frame $self->{status_label} = $self->{status}->Label(-text => "Connecting to login.oscar.aol.com...")->pack; $self->{status}->Button(-text => "Cancel", -takefocus => 0, -command => [$self, "on_cancel"])->pack(-pady => 5); $self->{logon_button} = $self->{controls}->Button(-text => 'log on', -takefocus => 0, -command => [$self, "on_logon"], -height => 0.5, -borderwidth => 1, -takefocus => 0)-> pack(-pady => 7, -padx => 3, -expand => 0, -side => 'left'); $self->{controls}->Button(-text => 'about', -command => sub { hook("show_about") }, -takefocus => 0, -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('' => [$self, 'on_logon']); $self->bind("" => [$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;