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