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.
74 lines
1.8 KiB
74 lines
1.8 KiB
package Milkbone::Chat; |
|
|
|
use Milkbone; |
|
|
|
our $VERSION = '1.0'; |
|
|
|
use Tk::widgets qw(Frame); |
|
use base qw(Tk::Toplevel); |
|
use strict; |
|
use warnings; |
|
|
|
Construct Tk::Widget 'MBChat'; |
|
|
|
sub ClassInit |
|
{ |
|
my ($class, $mw) = @_; |
|
$class->SUPER::ClassInit($mw); |
|
} |
|
|
|
sub Populate |
|
{ |
|
my ($self, $args) = @_; |
|
$self->SUPER::Populate($args); |
|
} |
|
|
|
sub on_msg_in |
|
{ |
|
} |
|
|
|
sub on_buddy_in |
|
{ |
|
my ($self, $buddy) = @_; |
|
$self->{blist}->insert('end', $buddy); |
|
$self->{display}->insertHTML('end', |
|
"<font color='blue'>$buddy has entered the room"); |
|
} |
|
|
|
sub on_buddy_out |
|
{ |
|
} |
|
|
|
sub init |
|
{ |
|
my ($self, $name) = @_; |
|
|
|
$self->withdraw; |
|
|
|
$self->configure(-title => "Chat Room $name"); |
|
|
|
# $self->bind('<Return>' => [$self, 'on_send']); |
|
# $self->bind("<Escape>" => [$self, "destroy"]); |
|
hook("tk_seticon", -wnd => $self); |
|
|
|
$self->{menu} = $self->Menu(-borderwidth => 0, -activeborderwidth => 0); |
|
$self->{menu_file} = $self->{menu}->cascade(-label => "File", -tearoff => 0); |
|
$self->{menu_file}->command(-label => "Close", -command => [$self, "destroy"]); |
|
|
|
$self->configure(-menu => $self->{menu}); |
|
|
|
my $top = $self->Frame; |
|
$self->{display} = $top->Browser(-background => 'white')->pack(-expand => 1, -fill => 'both', -side => 'left', -padx => 1); |
|
$self->{blist} = $top->Listbox(-background => 'white')->pack(-expand => 1, -fill => 'both', -side => 'right', -padx => 1); |
|
$top->pack(-expand => 1, -fill => 'both', -padx => 3, -pady => 5); |
|
|
|
$self->{in} = $self->BrowseEdit(-height => 4)->pack(-fill => 'x', -padx => 3, -pady => 5); |
|
|
|
$self->update; |
|
$self->geometry("+" . int(($self->screenwidth() / 2) - int($self->width() / 2)) . "+" . int(($self->screenheight() / 2) - int($self->height() / 2)) ); |
|
$self->deiconify; |
|
|
|
$self->update(); |
|
} |
|
|
|
1;
|
|
|