ViewVC Help
View File | Revision Log | Show Annotations | Download File
/cvs/kgsueme/kgsueme/app.pl
Revision: 1.6
Committed: Sat Aug 16 21:39:38 2003 UTC (20 years, 9 months ago) by pcg
Content type: text/plain
Branch: MAIN
CVS Tags: stable
Changes since 1.5: +1 -1 lines
Log Message:
*** empty log message ***

File Contents

# Content
1 package app;
2
3 use KGS::Protocol::Client;
4
5 use Scalar::Util;
6
7 use base KGS::Listener;
8 use base gtk::widget;
9
10 my %context_id;
11
12 sub status {
13 my ($type, $text) = @_;
14
15 $self->{status}->pop($context_id{$type}) if $context_id{$type};
16 $self->{status}->push($context_id{$type} ||= $self->{status}->get_context_id($type), $text) if $text;
17 }
18
19 sub new {
20 my $self = shift;
21 $self = $self->SUPER::new(@_);
22
23 $app::self = $self; # singleton
24 Scalar::Util::weaken $app::self;
25
26 $self->{conn} = new KGS::Protocol::Client;
27
28 #KGS::Listener::Debug->new->listen($self->{conn}, "any"); #d# debug only :)
29
30 $self->listen($self->{conn}, qw(login userpic idle_warn msg_chat));
31
32 $self->{roomlist} = new roomlist conn => $self->{conn}, app => $self;
33
34 $self->{window} = new Gtk2::Window 'toplevel';
35 $self->{window}->set_title('kgsueme');
36 gtk::state $self->{window}, "main::window", undef, window_size => [400, 400];
37 $self->{window}->signal_connect(delete_event => sub { main_quit Gtk2; 1 });
38
39 $self->{window}->add(my $vbox = new Gtk2::VBox);
40
41 $vbox->pack_start(($buttonbox = new Gtk2::HButtonBox), 0, 1, 0);
42 $buttonbox->set_spacing(0);
43
44 my $button = sub {
45 $buttonbox->add(my $button = new Gtk2::Button $_[0]);
46 signal_connect $button clicked => $_[1];
47 };
48
49 $button->("Login", sub { $self->login; });
50 $button->("Roomlist", sub { $self->{roomlist}->show; });
51 $button->("Save Config & Layout", \&util::save_config);
52 $button->("Quit", sub { main_quit Gtk2 });
53
54 $vbox->pack_start((my $hbox = new Gtk2::HBox), 0, 1, 0);
55
56 $hbox->add(new Gtk2::Label "Login");
57
58 $hbox->add($self->{login} = new_with_max_length Gtk2::Entry 12);
59 $self->{login}->set_text($::config->{login});
60
61 $hbox->add(new Gtk2::Label "Password");
62 $hbox->add($self->{password} = new Gtk2::Entry);
63 $self->{password}->set_visibility(0);
64
65 $self->{gamelist} = new gamelist conn => $self->{conn}, app => $self;
66 $vbox->pack_start ($self->{gamelist}->widget, 1, 1, 0);
67
68 $vbox->pack_start(($self->{status} = new Gtk2::Statusbar), 0, 1, 0);
69
70 $self->{window}->show_all;
71
72 $self;
73 }
74
75 sub login {
76 my ($self) = @_;
77
78 $self->{conn}->disconnect;
79
80 # initialize new socket and connection
81 #my $sock = new IO::Socket::INET PeerHost => "kgs.kiseido.com", PeerPort => "2379"
82 my $sock = new IO::Socket::INET PeerHost => $ENV{KGSHOST} || "kgs.kiseido.com", PeerPort => "2379"
83 or die;
84
85 $sock->blocking(1);
86 $self->{conn}->handshake($sock);
87 $sock->blocking(0);
88
89 my $input; $input = add_watch Glib::IO fileno $sock, [G_IO_IN, G_IO_ERR, G_IO_HUP], sub {
90 # this is dorked
91 my $buf;
92 my $len = sysread $sock, $buf, 16384;
93 if ($len) {
94 $self->{conn}->feed_data($buf);
95 } elsif (defined $len || (!$!{EINTR} and !$!{EAGAIN})) {
96 warn "disconnected";#d#
97 remove Glib::Source $input;
98 $self->event_disconnect;
99 }
100 1;
101 }, G_PRIORITY_HIGH;
102
103 # now login
104 $ENV{KGSUEME_CLIENTVER} = "1.4.1_01:Swing app:Sun Microsystems Inc."; # he asked for it...#d#
105 $self->{conn}->login($ENV{KGSUEME_CLIENTVER} || "kgsueme $VERSION $^O", # allow users to overwrite
106 $self->{login}->get_text,
107 $self->{password}->get_text);
108 }
109
110 sub inject_login {
111 my ($self, $msg) = @_;
112
113 $self->{name} = $self->{conn}{name};
114
115 $::config->{login} = $self->{name};
116
117 app::status("login", "logged in as '$self->{name}' with status '$msg->{message}' ('$msg->{reason}')");
118
119 if ($msg->{success}) {
120 # auto-join
121 $self->open_room (%$_) for values %{$::config->{rooms}};
122
123 sound::play 3, "connect";
124 } elsif ($msg->{result} eq "user unknown") {
125 sound::play 2, "user_unknown";
126 } else {
127 sound::play 2, "warning";
128 }
129 }
130
131 sub inject_idle_warn {
132 my ($self, $msg) = @_;
133
134 $self->send ("idle_reset");
135 }
136
137 sub inject_msg_chat {
138 my ($self, $msg) = @_;
139
140 if ((lc $msg->{name2}) eq (lc $self->{name})) {
141 unless ($self->{user}{lc $msg->{name}}) {
142 $self->open_user (name => $msg->{name})->inject ($msg);
143 }
144 }
145 }
146
147 my %userpic;
148 my %userpic_cb;
149
150 # static method to request the userimage and call the cb when it's available.
151 sub userpic {
152 my ($self, $name, $cb) = @_;
153 $self->get_userpic ($name, $cb);
154 }
155
156 sub get_userpic {
157 my ($self, $name, $cb) = @_;
158
159 if (exists $userpic{$name}) {
160 $cb->($userpic{$name});
161 } else {
162 if (!exists $userpic_cb{$name}) {
163 # after 10 seconds, flush callbacks
164 $self->send (req_pic => name => $name);
165 add Glib::Timeout 10000, sub {
166 $_->() for @{delete $userpic_cb{$name} || []};
167 0;
168 };
169 }
170 push @{$userpic_cb{$name}}, $cb;
171 }
172 }
173
174 sub inject_userpic {
175 my ($self, $msg) = @_;
176
177 $userpic{$msg->{name}} = $msg->{data};
178 $_->($userpic{$msg->{name}}) for @{delete $userpic_cb{$msg->{name}} || []};
179 }
180
181 sub event_disconnect { }
182
183 sub open_game {
184 my ($self, %arg) = @_;
185
186 ($self->{game}{$arg{channel}} ||= new game %arg, conn => $self->{conn}, app => $self)
187 ->join;
188 Scalar::Util::weaken $self->{game}{$arg{channel}};
189 $self->{game}{$arg{channel}};
190 }
191
192 sub open_room {
193 my ($self, %arg) = @_;
194
195 ($self->{room}{$arg{channel}} ||= new room %arg, conn => $self->{conn}, app => $self)
196 ->join;
197 Scalar::Util::weaken $self->{game}{$arg{channel}};
198 $self->{room}{$arg{channel}};
199 }
200
201 sub open_user {
202 my ($self, %arg) = @_;
203
204 ($self->{user}{lc $arg{name}} ||= new user %arg, conn => $self->{conn}, app => $self)
205 ->join;
206 Scalar::Util::weaken $self->{user}{lc $arg{name}};
207 $self->{user}{lc $arg{name}};
208 }
209
210 sub do_command {
211 my ($self, $chat, $cmd, $arg, %arg) = @_;
212
213 if ($cmd eq "say") {
214 if (my $context = $arg{game} || $arg{room} || $arg{user}) {
215 $context->say ($arg);
216 } else {
217 $chat->append_text ("\n<error>no context for message</error>");
218 }
219 } elsif ($cmd eq "whois" or $cmd eq "w") {
220 $self->open_user (name => $arg);
221 } else {
222 $chat->append_text ("\n<error>unknown command</error>");
223 }
224 }
225
226 1;
227