ViewVC Help
View File | Revision Log | Show Annotations | Download File
/cvs/kgsueme/bin/kgsueme
Revision: 1.2
Committed: Wed May 28 22:17:09 2003 UTC (21 years ago) by pcg
Branch: MAIN
Changes since 1.1: +21 -14 lines
Log Message:
*** empty log message ***

File Contents

# Content
1 #!/opt/bin/perl
2
3 use PApp::Util qw(dumpval); # debug only
4
5 use Gtk;
6 use Gtk::Gdk;
7
8 use KGS::Protocol;
9 use KGS::Listener::Debug;
10
11 use IO::Socket::INET;
12
13 use Errno;
14
15 init Gtk;
16
17 our $config;
18
19 {
20 use Storable ();
21 use Scalar::Util ();
22
23 my $staterc = "$ENV{HOME}/.kgsueme";
24
25 my $state = -r $staterc ? Storable::retrieve($staterc) : {};
26 my @widgets;
27
28 $config = $state->{config} ||= {};
29
30 # grr... more gtk+ brokenness
31 my %get = (
32 hpane_position => sub { ($_[0]->children)[0]->allocation->[2] },
33 vpane_position => sub { ($_[0]->children)[0]->allocation->[3] },
34 window_size => sub { [ @{$_[0]->allocation}[2,3] ] },
35 #window_pos => sub { die PApp::Util::dumpval [ $_[0]->get_root_origin ] },
36 clist_column_widths => sub {
37 $_[0]{column_widths};
38 },
39 );
40
41 my %set = (
42 hpane_position => sub { $_[0]->set_position($_[1]) },
43 vpane_position => sub { $_[0]->set_position($_[1]) },
44 window_size => sub { $_[0]->set_default_size(@{$_[1]}) },
45 #window_pos => sub { $_[0]->set_uposition(@{$_[1]}) if @{$_[1]} },
46 clist_column_widths => sub {
47 my ($w, $v) = @_;
48 $v->[$_] && $w->set_column_width($_, $v->[$_]) for 0..$#$v;
49 $w->{column_widths} = $v;
50 $w->signal_connect(resize_column => sub { $v->[$_[1]] = $_[2]; });
51 },
52 );
53
54 sub state {
55 my ($widget, $class, $instance, %attr) = @_;
56
57 while (my ($k, $v) = each %attr) {
58 my ($set, $get) = $k =~ /=/ ? split /=/, $k : ($k, $k);
59 $v = $state->{$class}{"*"}{$get} if exists $state->{$class}{"*"}{$get};
60 $v = $state->{$class}{$instance}{$get} if exists $state->{$class}{$instance}{$get};
61 $set{$get} ? $set{$get}->($widget, $v) : $widget->set($set => $v);
62 }
63
64 $widget = [$widget, $class, $instance, \%attr];
65 Scalar::Util::weaken $widget->[0];
66
67 @widgets = (grep $_->[0], @widgets, $widget);
68 }
69
70 sub save_state {
71 for (@widgets) {
72 if ($_->[0]) {
73 my ($widget, $class, $instance, $attr) = @$_;
74 while (my ($k, $v) = each %$attr) {
75 my ($set, $get) = $k =~ /=/ ? split /=/, $k : ($k, $k);
76 $v = $get{$get} ? $get{$get}->($widget) : $widget->get($get);
77
78 $state->{$class}{"*"}{$get} = $v;
79 $state->{$class}{$instance}{$get} = $v;
80 }
81 }
82 ::status("save_state", "layout saved");
83 }
84
85 Storable::nstore($state, $staterc);
86 }
87 }
88
89 # make a clist unselectable
90 sub clist_autosort {
91 my $w = shift;
92 my ($c, $o) = (-1);
93 for (0..$w->columns-1) {
94 $w->signal_connect(click_column => sub {
95 if ($_[1] != $c) {
96 $c = $_[1];
97 $o = 0;
98 } else {
99 $o = !$o;
100 }
101 $w->set_sort_column($c);
102 $w->set_sort_type($o ? "descending" : "ascending");
103 $w->sort;
104 });
105 }
106
107 }
108
109 {
110 my $main = new kgsueme;
111
112 my %context_id;
113
114 sub status {
115 my ($type, $text) = @_;
116
117 $main->{status}->pop($context_id{$type}) if $context_id{$type};
118 $main->{status}->push($context_id{$type} ||= $main->{status}->get_context_id($type), $text) if $text;
119 }
120 }
121
122 main Gtk;
123
124 #############################################################################
125
126 package kgsueme;
127
128 use base KGS::Listener;
129
130 sub new {
131 my $self = shift;
132 $self = $self->SUPER::new(@_);
133
134 $self->{conn} = new KGS::Protocol;
135
136 KGS::Listener::Debug->new->listen($self->{conn}); #d# debug only :)
137
138 $self->listen($self->{conn});
139
140 $self->{window} = new Gtk::Window 'toplevel';
141 $self->{window}->set_title('kgsueme');
142 ::state $self->{window}, "main::window", undef, window_size => [400, 100];
143 $self->{window}->signal_connect(delete_event => sub { main_quit Gtk });
144
145 $self->{window}->add(my $vbox = new Gtk::VBox);
146
147 $vbox->pack_start(($self->{buttonbox} = new Gtk::HButtonBox), 0, 1, 0);
148
149 my $button = sub {
150 $self->{buttonbox}->add(my $button = new Gtk::Button $_[0]);
151 signal_connect $button clicked => $_[1];
152 };
153
154 $button->("Login", sub {
155 $self->login;
156 });
157 $button->("Roomlist", sub {
158 $self->{roomlist} ||= new roomlist conn => $self->{conn};
159 $self->{roomlist}->show;
160 });
161 $button->("Save Config & Layout", sub { ::save_state });
162
163 $vbox->pack_start((my $hbox = new Gtk::HBox), 0, 1, 0);
164
165 $hbox->add(new Gtk::Label "Login");
166
167 $hbox->add($self->{login} = new_with_max_length Gtk::Entry 12);
168 $self->{login}->set_text($::config->{login});
169
170 $hbox->add(new Gtk::Label "Password");
171 $hbox->add($self->{password} = new Gtk::Entry);
172 $self->{password}->set_visibility(0);
173
174 $vbox->pack_start(($self->{status} = new Gtk::Statusbar), 0, 1, 0);
175
176 $self->{window}->show_all;
177
178 $self;
179 }
180
181 sub login {
182 my ($self) = @_;
183
184 $self->{conn}->disconnect;
185
186 # initialize new socket and connection
187 my $sock = new IO::Socket::INET PeerHost => "kgs.kiseido.com", PeerPort => "2379"
188 or die;
189
190 $sock->blocking(1);
191 $self->{conn}->handshake($sock);
192 $sock->blocking(0);
193
194 my $input; $input = input_add Gtk::Gdk fileno $sock, "read", sub {
195 # this is dorked
196 my $buf;
197 if (0 >= sysread $sock, $buf, 16384
198 and !$!{EINTR} and !$!{EAGAIN}) {
199 input_remove Gtk::Gdk $input;
200 $self->event_disconnect;
201 }
202 $self->{conn}->feed_data($buf);
203 };
204
205 # now login
206 $self->{conn}->login($self->{login}->get_text, $self->{password}->get_text);
207 }
208
209 sub inject_login {
210 my ($self, $msg) = @_;
211
212 ::status("login", "logged in as '$self->{conn}{name}' with status '$msg->{result}'");
213 $::config->{login} = $self->{conn}{name};
214
215 $self->{window}->show_all;
216 }
217
218 sub event_disconnect { }
219
220 #############################################################################
221
222 package roomlist;
223
224 use base KGS::Listener::Roomlist;
225
226 sub new {
227 my $self = shift;
228 $self = $self->SUPER::new(@_);
229
230 $self->listen($self->{conn});
231
232 $self->{window} = new Gtk::Window 'toplevel';
233 $self->{window}->set_title('KGS Rooms');
234 ::state $self->{window}, "roomlist::window", undef, window_size => [400, 200];
235
236 $self->{window}->signal_connect(delete_event => sub { hide $self->{window} });
237
238 $self->{window}->add(my $vbox = new Gtk::VBox);
239
240 $vbox->pack_start((my $sw = new Gtk::ScrolledWindow), 1, 1, 0);
241 $sw->set_policy("automatic", "always");
242
243 $sw->add($self->{roomlist} = new_with_titles Gtk::CList "Group", "Room Name", "Users", "Games", "Flags", "Channel");
244 $self->{roomlist}->set_selection_mode('multiple');
245 ::clist_autosort $self->{roomlist};
246 ::state $self->{roomlist}, "roomlist::roomlist", undef, clist_column_widths => [20, 200];
247
248 $self->{roomlist}->signal_connect(select_row => sub {
249 my $room = $self->{roomlist}->get_row_data($_[1])
250 or return;
251 $self->{room}{$room->{channel}} ||= new room %$room, conn => $self->{conn}, users => {};
252 $self->{room}{$room->{channel}}->join;
253 $self->{roomlist}->unselect_all;
254 });
255
256 $self;
257 }
258
259 sub show {
260 my ($self, $msg) = @_;
261
262 $self->msg(list_rooms => group => $_) for 0..5; # fetch all room names (should not!)
263 $self->{window}->show_all;
264 }
265
266 sub event_update {
267 my ($self) = @_;
268
269 $self->{event_update} ||= Gtk->timeout_add(200, sub {
270 my $l = $self->{roomlist};
271
272 $l->freeze;
273 my $pos = $l->get_vadjustment->get_value;
274 $l->clear;
275
276 my $row = 0;
277 for (values %{$self->{rooms}}) {
278 $l->append($_->{group}, $_->{name}, $_->{users}, $_->{games}, $_->{flags}, $_->{channel});
279 $l->set_row_data($row++, $_);
280 }
281 $l->sort;
282 $l->get_vadjustment->set_value($pos);
283 $l->thaw;
284
285 delete $self->{event_update};
286 0;
287 });
288 }
289
290 #############################################################################
291
292 package room;
293
294 use base KGS::Listener::Room;
295
296 sub new {
297 my $self = shift;
298 $self = $self->SUPER::new(@_);
299
300 $self->listen($self->{conn});
301
302 $self->{window} = new Gtk::Window 'toplevel';
303 $self->{window}->set_title("KGS Room $self->{name}");
304 ::state $self->{window}, "room::window", $self->{name}, window_size => [600, 400];
305
306 $self->{window}->signal_connect(delete_event => sub { $self->part });
307
308 $self->{window}->add(my $hpane = new Gtk::HPaned);
309 ::state $hpane, "room::hpane", $self->{name}, hpane_position => 200;
310
311 $hpane->add(my $vpane = new Gtk::VPaned);
312 ::state $vpane, "room::vpane", $self->{name}, vpane_position => 200;
313
314 $vpane->add(my $sw = new Gtk::ScrolledWindow);
315 $sw->set_policy("automatic", "always");
316
317 $sw->add($self->{gamelist} = new_with_titles Gtk::CList "T", "Black", "White", "Rules", "Notes");
318 ::clist_autosort $self->{gamelist};
319 ::state $self->{gamelist}, "room::gamelist", $self->{name}, clist_column_widths => [20, 120, 120, 120];
320
321 $self->{gamelist}->signal_connect(select_row => sub {
322 my $game = $self->{gamelist}->get_row_data($_[1])
323 or return;
324 $self->{game}{$game->{channel}} ||= new game %$game, conn => $self->{conn};
325 $self->{game}{$game->{channel}}->join;
326 $self->{gamelist}->unselect_all;
327 });
328
329 $vpane->add(my $vbox = new Gtk::VBox);
330
331 $vbox->pack_start((my $sw = new Gtk::ScrolledWindow), 1, 1, 0);
332 $sw->set_policy("automatic", "always");
333
334 $sw->add($self->{text} = new Gtk::Text);
335
336 $vbox->pack_start(($self->{entry} = new Gtk::Entry), 0, 1, 0);
337 $self->{entry}->signal_connect(activate => sub {
338 my $text = $self->{entry}->get_text;
339 $self->say($text) if $text =~ /\S/;
340 $self->{entry}->set_text("");
341 });
342
343 $hpane->add(my $sw = new Gtk::ScrolledWindow);
344 $sw->set_policy("automatic", "always");
345
346 $sw->add($self->{userlist} = new_with_titles Gtk::CList "User", "Rank", "Flags");
347 ::clist_autosort $self->{userlist};
348 ::state $self->{userlist}, "room::userlist", $self->{name}, clist_column_widths => [120, 30];
349
350 $self;
351 }
352
353 sub event_update {
354 my ($self) = @_;
355
356 $self->{event_update} ||= Gtk->timeout_add(200, sub {
357 my $l = $self->{userlist};
358
359 $l->freeze;
360 my $pos = $l->get_vadjustment->get_value;
361 $l->clear;
362
363 my $row = 0;
364 for (values %{$self->{users}}) {
365 $l->append($_->{name});
366 $l->set_row_data($row++, $_);
367 }
368 $l->sort;
369 $l->get_vadjustment->set_value($pos);
370 $l->thaw;
371
372 delete $self->{event_update};
373 0;
374 });
375 }
376
377 sub event_update_games {
378 my ($self) = @_;
379
380 $self->{event_update_games} ||= Gtk->timeout_add(200, sub {
381 my $l = $self->{gamelist};
382
383 $l->freeze;
384 my $pos = $l->get_vadjustment->get_value;
385 $l->clear;
386
387 my $row = 0;
388 for (values %{$self->{games}}) {
389 $l->append($_->type, $_->user0, $_->user1, $_->rules, $_->notes);
390 $l->set_row_data($row++, $_);
391 }
392 $l->sort;
393 $l->get_vadjustment->set_value($pos);
394 $l->thaw;
395
396 delete $self->{event_update_games};
397 0;
398 });
399 }
400
401 sub join {
402 my ($self) = @_;
403 $self->SUPER::join;
404
405 $self->{window}->show_all;
406 }
407
408 sub part {
409 my ($self) = @_;
410 $self->SUPER::part;
411
412 $self->{window}->hide_all;
413 $self->event_update;
414 $self->event_update_games;
415 }
416
417 sub event_update_roominfo {
418 my ($self) = @_;
419
420 $self->{text}->insert(undef, undef, undef, "$self->{owner}: $self->{description}\n\n");
421 }
422
423 sub inject_msg_room {
424 my ($self, $msg) = @_;
425 return unless $self->{channel} == $msg->{channel};
426
427 $self->{text}->insert(undef, undef, undef, "$msg->{name}: $msg->{message}\n");
428 }
429
430 #############################################################################
431
432 package game;
433
434 use base KGS::Listener::Game;
435 use base KGS::Game;
436
437 sub new {
438 my $self = shift;
439 $self = $self->SUPER::new(@_);
440
441 $self->listen($self->{conn});
442
443 $self->{window} = new Gtk::Window 'toplevel';
444 $self->{window}->set_title("KGS Game ".$self->user0." ".$self->user1);
445 ::state $self->{window}, "game::window", undef, window_size => [600, 500];
446
447 $self->{window}->signal_connect(delete_event => sub { $self->part });
448
449 $self->{window}->add(my $hpane = new Gtk::HPaned);
450 ::state $hpane, "game::hpane", undef, hpane_position => 500;
451
452 $hpane->add(my $board = new Gtk::Table $self->{size}, $self->{size}, 1);
453
454 for my $x (0 .. $self->{size} - 1) {
455 for my $y (0 .. $self->{size} - 1) {
456 my $cell = new Gtk::Label;
457 $board->attach_defaults($cell, $x, $x + 1, $y, $y + 1);
458 $self->{board}[$x][$y] = $cell;
459 }
460 }
461
462 $hpane->add(my $vpane = new Gtk::VPaned);
463 ::state $vpane, "game", $self->{name}, vpane_position => 80;
464
465 $vpane->add(my $sw = new Gtk::ScrolledWindow);
466 $sw->set_policy("automatic", "always");
467
468 $sw->add($self->{userlist} = new_with_titles Gtk::CList "User", "Rank", "Flags");
469 ::clist_autosort $self->{userlist};
470 ::state $self->{userlist}, "room::userlist", $self->{name}, clist_column_widths => [120, 30];
471
472 $vpane->add(my $vbox = new Gtk::VBox);
473
474 $vbox->pack_start((my $sw = new Gtk::ScrolledWindow), 1, 1, 0);
475 $sw->set_policy("automatic", "always");
476
477 $sw->add($self->{text} = new Gtk::Text);
478
479 $vbox->pack_start(($self->{entry} = new Gtk::Entry), 0, 1, 0);
480 $self->{entry}->signal_connect(activate => sub {
481 my $text = $self->{entry}->get_text;
482 # add message
483 $self->{entry}->set_text("");
484 });
485
486 $self;
487 }
488
489 sub event_update {
490 my ($self) = @_;
491
492 $self->{event_update} ||= Gtk->timeout_add(200, sub {
493 my $l = $self->{userlist};
494
495 $l->freeze;
496 my $pos = $l->get_vadjustment->get_value;
497 $l->clear;
498
499 my $row = 0;
500 for (values %{$self->{users}}) {
501 $l->append($_->{name});
502 $l->set_row_data($row++, $_);
503 }
504 $l->sort;
505 $l->get_vadjustment->set_value($pos);
506 $l->thaw;
507
508 delete $self->{event_update};
509 0;
510 });
511 }
512
513 sub join {
514 my ($self) = @_;
515 $self->SUPER::join;
516
517 $self->{window}->show_all;
518 }
519
520 sub part {
521 my ($self) = @_;
522 $self->SUPER::part;
523
524 $self->{window}->hide_all;
525 $self->event_update;
526 }
527
528 sub event_update_tree {
529 my ($self) = @_;
530
531 for my $x (0 .. $self->{size} - 1) {
532 for my $y (0 .. $self->{size} - 1) {
533 $self->{board}[$x][$y]->set_text("");
534 }
535 }
536
537 for (0..$self->{node}) {
538 while (my ($k, $v) = each %{$self->{tree}[$_]}) {
539 if ($k eq "move7") {
540 if ($v->[1] < 255) {
541 $self->{board}[$v->[1]][$v->[2]]->set_text(("X", "O", "-")[$v->[0]]);
542 }
543 }
544 }
545 }
546 }
547
548 1;
549
550
551