You can not select more than 25 topics
Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.
127 lines
2.9 KiB
127 lines
2.9 KiB
# milkbone - profile dialog |
|
|
|
package Milkbone::Profile; |
|
|
|
use Milkbone; |
|
|
|
our $VERSION = '1.0'; |
|
|
|
use Tk::widgets qw(Frame Browser); |
|
use base qw(Tk::Toplevel); |
|
use strict; |
|
use warnings; |
|
|
|
Construct Tk::Widget 'MBProfile'; |
|
|
|
sub ClassInit |
|
{ |
|
my ($class, $mw) = @_; |
|
$class->SUPER::ClassInit($mw); |
|
} |
|
|
|
sub Populate |
|
{ |
|
my ($self, $args) = @_; |
|
$self->SUPER::Populate($args); |
|
|
|
$self->ConfigSpecs('DEFAULT' => ['SELF']); |
|
} |
|
|
|
sub on_receive_away |
|
{ |
|
my ($self, $away) = @_; |
|
$away = $self->process($away); |
|
|
|
$self->{text}->insertHTML('0.0', "\n-------------------------\n"); |
|
$self->{text}->insertHTML('0.0', $away); |
|
$self->{close}->focus; |
|
} |
|
|
|
sub on_receive_prof |
|
{ |
|
my ($self, $prof) = @_; |
|
$prof = $self->process($prof); |
|
|
|
$self->{text}->insertHTML('end', $prof); |
|
$self->{close}->focus; |
|
} |
|
|
|
sub on_destroy |
|
{ |
|
my ($self) = @_; |
|
|
|
$self->{destroyed} = 1; |
|
|
|
hook("remove_profile", -who => $self->{who}); |
|
} |
|
|
|
sub set_buddy |
|
{ |
|
my ($self, $buddy) = @_; |
|
$self->{buddy} = $buddy; |
|
} |
|
|
|
sub process |
|
{ |
|
my ($self, $str) = @_; |
|
|
|
$str =~ s/\%n/data("me")/eg; |
|
|
|
return $str; |
|
} |
|
|
|
sub init |
|
{ |
|
my ($self, $who) = @_; |
|
my ($mins, $hrs, $days); |
|
|
|
$self->{who} = $who; |
|
|
|
$self->withdraw; |
|
|
|
my $on_time = time - hook("protocol_on_since", -who => $who); |
|
(undef, $mins, $hrs, $days, undef, undef, undef) = gmtime($on_time); |
|
$days--; |
|
|
|
$self->Label(-text => "$who has been online for $days days, $hrs hours, $mins minutes")->pack(-ipady => 1, -anchor => 'w'); |
|
|
|
if(hook("protocol_idle_since", -who => $who)) |
|
{ |
|
use integer; |
|
|
|
my $idle_time = hook("protocol_idle_since", -who => $who); |
|
|
|
my ($mins, $hrs, $days); |
|
$mins = $idle_time / 60; |
|
|
|
$hrs = $mins / 60; |
|
$mins %= 60; |
|
|
|
$days = $hrs / 24; |
|
$hrs %= 24; |
|
|
|
$self->Label(-text => "$who has been idle for $days days, $hrs hours, $mins minutes")->pack(-ipady => 1, -anchor => 'w'); |
|
} |
|
|
|
my $warning_level = hook("protocol_evil_status", -user => $who); |
|
$self->Label(-text => "Warning Level: $warning_level \%")->pack(-ipady => 1, -anchor => 'w'); |
|
|
|
$self->Label(-text => "Profile Text:", -font => 'arial 9 bold')->pack(-ipady => 1, -anchor => 'w'); |
|
|
|
$self->{text} = $self->Frame->pack(-expand => 1, -fill => 'both')-> |
|
Scrolled("Browser", -scrollbars => 'oe', -background => 'white', -wrap => 'word')-> |
|
pack(-expand => 1, -fill => 'both'); |
|
|
|
$self->{text}->tagConfigure('away', -foreground => 'blue', -font => 'arial 10 bold'); |
|
$self->{text}->tagConfigure('prof', -foreground => 'black', -font => 'arial 10 bold'); |
|
$self->{close} = $self->Button(-text => "Close", -command => [$self, "destroy"])->pack; |
|
|
|
hook("tk_bindwheel", -window => $self->{text}); |
|
|
|
$self->geometry("600x400"); |
|
$self->deiconify; |
|
|
|
$self->OnDestroy([\&on_destroy, $self]); |
|
$self->bind("<Escape>", [$self, "destroy"]); |
|
hook("tk_seticon", -wnd => $self); |
|
}
|
|
|