ViewVC Help
View File | Revision Log | Show Annotations | Download File
/cvs/kgsueme/bin/kgsueme
(Generate patch)

Comparing kgsueme/bin/kgsueme (file contents):
Revision 1.3 by pcg, Wed May 28 22:26:25 2003 UTC vs.
Revision 1.52 by pcg, Fri Jul 25 17:35:19 2003 UTC

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

Diff Legend

– Removed lines
+ Added lines
< Changed lines
> Changed lines