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

Comparing kgsueme/bin/kgsueme (file contents):
Revision 1.5 by pcg, Thu May 29 01:13:32 2003 UTC vs.
Revision 1.61 by pcg, Sun May 30 02:22:01 2004 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 = ".";
31 35
32 # grr... more gtk+ brokenness 36 use KGS::Constants;
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 37
43 my %set = ( 38 for (qw(util.pl gtk.pl chat.pl superchat.pl sound.pl user.pl gamelist.pl userlist.pl challenge.pl
44 hpane_position => sub { $_[0]->set_position($_[1]) }, 39 game.pl room.pl roomlist.pl app.pl)) {
45 vpane_position => sub { $_[0]->set_position($_[1]) }, 40 require (KGS::Constants::findfile "KGS/kgsueme/$_");
46 window_size => sub { $_[0]->set_default_size(@{$_[1]}) }, 41 die if $@;
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 45if ($ENV{KGSUEME_DEBUG}) {
92sub clist_autosort { 46 use KGS::Constants;
93 my $w = shift; 47
94 my ($c, $o) = (-1); 48 for (19) {
95 for (0..$w->columns-1) { 49 my $game = new game size => $_;
96 $w->signal_connect(click_column => sub { 50
97 if ($_[1] != $c) { 51 $game->event_challenge (
98 $c = $_[1]; 52bless( {
99 $o = 0; 53 type => 0,
100 } else { 54 black => bless( {
101 $o = !$o; 55 flags => 2633,
56 name => 'dorkusx'
57 }, 'KGS::User' ),
58 rules => bless( {
59 count => 5,
60 time => 900,
61 timesys => 2,
62 interval => 30,
63 komi => '6.5',
64 size => 19,
65 ruleset => 0,
66 handicap => 2,
67 }, 'KGS::Rules' ),
68 white => bless( {
69 flags => 436220808,
70 name => 'Nerdamus'
71 }, 'KGS::User' )
72 }, 'KGS::Challenge' ));
73
74
75 if (0) {
76 my $data = Storable::retrieve "board2.dat";
77 while (my ($k, $v) = each %$data) {
78 $game->{$k} = $v;
102 } 79 }
103 $w->set_sort_column($c); 80 $game->event_update_tree;
104 $w->set_sort_type($o ? "descending" : "ascending");
105 $w->sort;
106 }); 81 }
82
83 if (0) {
84 $game->{cur_board} = new KGS::Game::Board;
85 my @x = (
86 #MARK_B,
87 #MARK_W,
88 #MARK_GRAY_B | MARK_SMALL_W,
89 #MARK_GRAY_W | MARK_SMALL_B,
90 #MARK_W | MARK_TRIANGLE,
91 0, 0, 0,
92 );
93 for $x (0..18) {
94 for $y (0..18) {
95 $game->{cur_board}{board}[$x][$y] =
96 $x[rand @x];
97 }
98 }
99
100 $game->{cur_board}{board}[0][0] = MARK_B;
101 $game->{cur_board}{board}[1][1] = MARK_GRAY_B | MARK_SMALL_W;
102 $game->{cur_board}{board}[2][2] = MARK_W | MARK_TRIANGLE;
103 $game->{cur_board}{board}[1][2] = MARK_B | MARK_LABEL;
104 $game->{cur_board}{label}[1][2] = "198";
105 $game->{cur_board}{board}[0][2] = MARK_W | MARK_LABEL;
106 $game->{cur_board}{label}[0][2] = "AWA";
107 $game->{board}->set_board ($game->{cur_board});
108 }
107 } 109 }
108 110 main Gtk2;
111
109} 112}
110 113
111{ 114our $app = new app;
112 my $main = new kgsueme;
113 115
114 my %context_id; 116main Gtk2;
115 117
116 sub status { 118$app->destroy;
117 my ($type, $text) = @_;
118 119
119 $main->{status}->pop($context_id{$type}) if $context_id{$type}; 120Gtk2->main_iteration while Gtk2->events_pending;
120 $main->{status}->push($context_id{$type} ||= $main->{status}->get_context_id($type), $text) if $text;
121 }
122}
123
124main Gtk;
125
126#############################################################################
127
128package kgsueme;
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->{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
188sub 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
216sub 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 warn "hiya\n";
224 for (keys %{$::config->{rooms}}) {
225 warn "hiya $_\n";
226 $self->{roomlist}->join_room($_);
227 }
228 }
229
230 warn PApp::Util::dumpval($::config);
231}
232
233sub event_disconnect { }
234
235#############################################################################
236
237package roomlist;
238
239use base KGS::Listener::Roomlist;
240
241sub new {
242 my $self = shift;
243 $self = $self->SUPER::new(@_);
244
245 $self->listen($self->{conn});
246
247 $self->{window} = new Gtk::Window 'toplevel';
248 $self->{window}->set_title('KGS Rooms');
249 ::state $self->{window}, "roomlist::window", undef, window_size => [400, 200];
250
251 $self->{window}->signal_connect(delete_event => sub { $self->{window}->hide });
252
253 $self->{window}->add(my $vbox = new Gtk::VBox);
254
255 $vbox->pack_start((my $sw = new Gtk::ScrolledWindow), 1, 1, 0);
256 $sw->set_policy("automatic", "always");
257
258 $sw->add($self->{roomlist} = new_with_titles Gtk::CList "Group", "Room Name", "Users", "Games", "Flags", "Channel");
259 $self->{roomlist}->set_selection_mode('multiple');
260 ::clist_autosort $self->{roomlist};
261 ::state $self->{roomlist}, "roomlist::roomlist", undef, clist_column_widths => [20, 200];
262
263 $self->{roomlist}->signal_connect(select_row => sub {
264 my $room = $self->{roomlist}->get_row_data($_[1])
265 or return;
266 $self->{roomlist}->unselect_all;
267 $self->join_room($room->{channel});
268 });
269
270 $self;
271}
272
273sub join_room {
274 my ($self, $channel) = @_;
275
276 $self->{room}{$channel} ||= room->new(channel => $channel, conn => $self->{conn}, users => {});
277 $self->{room}{$channel}->join;
278}
279
280sub show {
281 my ($self, $msg) = @_;
282
283 $self->msg(list_rooms => group => $_) for 0..5; # fetch all room names (should not!)
284 $self->{window}->show_all;
285}
286
287sub event_update {
288 my ($self) = @_;
289
290 $self->{event_update} ||= Gtk->timeout_add(200, sub {
291 my $l = $self->{roomlist};
292
293 $l->freeze;
294 my $pos = $l->get_vadjustment->get_value;
295 $l->clear;
296
297 my $row = 0;
298 for (values %{$self->{rooms}}) {
299 $l->append($_->{group}, $_->{name}, $_->{users}, $_->{games}, $_->{flags}, $_->{channel});
300 $l->set_row_data($row++, $_);
301 }
302 $l->sort;
303 $l->get_vadjustment->set_value($pos);
304 $l->thaw;
305
306 delete $self->{event_update};
307 0;
308 });
309}
310
311#############################################################################
312
313package room;
314
315use base KGS::Listener::Room;
316
317sub new {
318 my $self = shift;
319 $self = $self->SUPER::new(@_);
320
321 $self->listen($self->{conn});
322
323 $self->{window} = new Gtk::Window 'toplevel';
324 $self->{window}->set_title("KGS Room $self->{name}");
325 ::state $self->{window}, "room::window", $self->{name}, window_size => [600, 400];
326
327 $self->{window}->signal_connect(delete_event => sub { $self->part });
328
329 $self->{window}->add(my $hpane = new Gtk::HPaned);
330 ::state $hpane, "room::hpane", $self->{name}, hpane_position => 200;
331
332 $hpane->add(my $vpane = new Gtk::VPaned);
333 ::state $vpane, "room::vpane", $self->{name}, vpane_position => 200;
334
335 $vpane->add(my $sw = new Gtk::ScrolledWindow);
336 $sw->set_policy("automatic", "always");
337
338 $sw->add($self->{gamelist} = new_with_titles Gtk::CList "T", "Black", "White", "Rules", "Notes");
339 ::clist_autosort $self->{gamelist};
340 ::state $self->{gamelist}, "room::gamelist", $self->{name}, clist_column_widths => [20, 120, 120, 120];
341
342 $self->{gamelist}->signal_connect(select_row => sub {
343 my $game = $self->{gamelist}->get_row_data($_[1])
344 or return;
345 $self->{game}{$game->{channel}} ||= new game %$game, conn => $self->{conn};
346 $self->{game}{$game->{channel}}->join;
347 $self->{gamelist}->unselect_all;
348 });
349
350 $vpane->add(my $vbox = new Gtk::VBox);
351
352 $vbox->pack_start((my $sw = new Gtk::ScrolledWindow), 1, 1, 0);
353 $sw->set_policy("automatic", "always");
354
355 $sw->add($self->{text} = new Gtk::Text);
356
357 $vbox->pack_start(($self->{entry} = new Gtk::Entry), 0, 1, 0);
358 $self->{entry}->signal_connect(activate => sub {
359 my $text = $self->{entry}->get_text;
360 $self->say($text) if $text =~ /\S/;
361 $self->{entry}->set_text("");
362 });
363
364 $hpane->add(my $sw = new Gtk::ScrolledWindow);
365 $sw->set_policy("automatic", "always");
366
367 $sw->add($self->{userlist} = new_with_titles Gtk::CList "User", "Rank", "Flags");
368 ::clist_autosort $self->{userlist};
369 ::state $self->{userlist}, "room::userlist", $self->{name}, clist_column_widths => [120, 30];
370
371 $self;
372}
373
374sub event_update {
375 my ($self) = @_;
376
377 $self->{event_update} ||= Gtk->timeout_add(200, sub {
378 my $l = $self->{userlist};
379
380 $l->freeze;
381 my $pos = $l->get_vadjustment->get_value;
382 $l->clear;
383
384 my $row = 0;
385 for (values %{$self->{users}}) {
386 $l->append($_->{name});
387 $l->set_row_data($row++, $_);
388 }
389 $l->sort;
390 $l->get_vadjustment->set_value($pos);
391 $l->thaw;
392
393 delete $self->{event_update};
394 0;
395 });
396}
397
398sub event_update_games {
399 my ($self) = @_;
400
401 $self->{event_update_games} ||= Gtk->timeout_add(200, sub {
402 my $l = $self->{gamelist};
403
404 $l->freeze;
405 my $pos = $l->get_vadjustment->get_value;
406 $l->clear;
407
408 my $row = 0;
409 for (values %{$self->{games}}) {
410 $l->append($_->type, $_->user0, $_->user1, $_->rules, $_->notes);
411 $l->set_row_data($row++, $_);
412 }
413 $l->sort;
414 $l->get_vadjustment->set_value($pos);
415 $l->thaw;
416
417 delete $self->{event_update_games};
418 0;
419 });
420}
421
422sub join {
423 my ($self) = @_;
424 $self->SUPER::join;
425
426 $self->{window}->show_all;
427}
428
429sub part {
430 my ($self) = @_;
431 $self->SUPER::part;
432
433 delete $::config->{rooms}{$self->{channel}};
434 $self->{window}->hide_all;
435 $self->event_update;
436 $self->event_update_games;
437}
438
439sub event_join {
440 my ($self) = @_;
441 $self->SUPER::event_join;
442
443 $::config->{rooms}{$self->{channel}} = 1;
444}
445
446sub event_update_roominfo {
447 my ($self) = @_;
448
449 $self->{text}->insert(undef, undef, undef, "$self->{owner}: $self->{description}\n\n");
450}
451
452sub inject_msg_room {
453 my ($self, $msg) = @_;
454 return unless $self->{channel} == $msg->{channel};
455
456 $self->{text}->insert(undef, undef, undef, "$msg->{name}: $msg->{message}\n");
457}
458
459#############################################################################
460
461package game;
462
463use base KGS::Listener::Game;
464use base KGS::Game;
465
466sub new {
467 my $self = shift;
468 $self = $self->SUPER::new(@_);
469
470 $self->listen($self->{conn});
471
472 $self->{window} = new Gtk::Window 'toplevel';
473 $self->{window}->set_title("KGS Game ".$self->user0." ".$self->user1);
474 ::state $self->{window}, "game::window", undef, window_size => [600, 500];
475
476 $self->{window}->signal_connect(delete_event => sub { $self->part });
477
478 $self->{window}->add(my $hpane = new Gtk::HPaned);
479 ::state $hpane, "game::hpane", undef, hpane_position => 500;
480
481 $hpane->add(my $board = new Gtk::Table $self->{size}, $self->{size}, 1);
482
483 for my $x (0 .. $self->{size} - 1) {
484 for my $y (0 .. $self->{size} - 1) {
485 my $cell = new Gtk::Label;
486 $board->attach_defaults($cell, $x, $x + 1, $y, $y + 1);
487 $self->{board}[$x][$y] = $cell;
488 }
489 }
490
491 $hpane->add(my $vpane = new Gtk::VPaned);
492 ::state $vpane, "game", $self->{name}, vpane_position => 80;
493
494 $vpane->add(my $sw = new Gtk::ScrolledWindow);
495 $sw->set_policy("automatic", "always");
496
497 $sw->add($self->{userlist} = new_with_titles Gtk::CList "User", "Rank", "Flags");
498 ::clist_autosort $self->{userlist};
499 ::state $self->{userlist}, "room::userlist", $self->{name}, clist_column_widths => [120, 30];
500
501 $vpane->add(my $vbox = new Gtk::VBox);
502
503 $vbox->pack_start((my $sw = new Gtk::ScrolledWindow), 1, 1, 0);
504 $sw->set_policy("automatic", "always");
505
506 $sw->add($self->{text} = new Gtk::Text);
507
508 $vbox->pack_start(($self->{entry} = new Gtk::Entry), 0, 1, 0);
509 $self->{entry}->signal_connect(activate => sub {
510 my $text = $self->{entry}->get_text;
511 # add message
512 $self->{entry}->set_text("");
513 });
514
515 $self;
516}
517
518sub event_update {
519 my ($self) = @_;
520
521 $self->{event_update} ||= Gtk->timeout_add(200, sub {
522 my $l = $self->{userlist};
523
524 $l->freeze;
525 my $pos = $l->get_vadjustment->get_value;
526 $l->clear;
527
528 my $row = 0;
529 for (values %{$self->{users}}) {
530 $l->append($_->{name});
531 $l->set_row_data($row++, $_);
532 }
533 $l->sort;
534 $l->get_vadjustment->set_value($pos);
535 $l->thaw;
536
537 delete $self->{event_update};
538 0;
539 });
540}
541
542sub join {
543 my ($self) = @_;
544 $self->SUPER::join;
545
546 $self->{window}->show_all;
547}
548
549sub part {
550 my ($self) = @_;
551 $self->SUPER::part;
552
553 $self->{window}->hide_all;
554 $self->event_update;
555}
556
557sub event_update_tree {
558 my ($self) = @_;
559
560 for my $x (0 .. $self->{size} - 1) {
561 for my $y (0 .. $self->{size} - 1) {
562 $self->{board}[$x][$y]->set_text("");
563 }
564 }
565
566 for (0..$self->{node}) {
567 while (my ($k, $v) = each %{$self->{tree}[$_]}) {
568 if ($k eq "move7") {
569 if ($v->[1] < 255) {
570 $self->{board}[$v->[1]][$v->[2]]->set_text(("X", "O", "-")[$v->[0]]);
571 }
572 }
573 }
574 }
575}
576
577package KGS::Game::Board;
578package KGS::Game::Node;
579package KGS::Game::Tree;
580 121
5811; 1221;
582 123
583 124
584

Diff Legend

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