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