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

Comparing kgsueme/kgsueme/game.pl (file contents):
Revision 1.69 by pcg, Tue Jul 22 21:24:50 2003 UTC vs.
Revision 1.85 by pcg, Thu May 20 23:17:25 2004 UTC

1use utf8; 1use utf8;
2
3use Scalar::Util ();
2 4
3package game::goclock; 5package game::goclock;
4 6
5# Lo and Behold! I admit it! The rounding stuff etc.. in goclock 7# Lo and Behold! I admit it! The rounding stuff etc.. in goclock
6# is completely borked. 8# is completely borked.
7 9
8use Time::HiRes (); 10use Time::HiRes ();
9 11
10use KGS::Constants; 12use KGS::Constants;
11 13
12use base gtk::widget; 14use Glib::Object::Subclass
15 Gtk2::Label;
13 16
14sub new { 17sub INIT_INSTANCE {
15 my $class = shift; 18 my $self = shift;
16 my $self = $class->SUPER::new(@_);
17 19
18 $self->{widget} = new Gtk2::Label; 20 $self->signal_connect (destroy => sub { $_[0]->stop });
19 21
20 $self->{set} = sub { }; 22 $self->{set} = sub { };
21 $self->{format} = sub { "ERROR" }; 23 $self->{format} = sub { "ERROR" };
22
23 $self;
24} 24}
25 25
26sub configure { 26sub configure {
27 my ($self, $timesys, $main, $interval, $count) = @_; 27 my ($self, $timesys, $main, $interval, $count) = @_;
28 28
… …
55 my $time = int (($_[0] - 1) % $interval + 1); 55 my $time = int (($_[0] - 1) % $interval + 1);
56 56
57 sprintf "%s/%d =%d", 57 sprintf "%s/%d =%d",
58 util::format_time $time, 58 util::format_time $time,
59 $self->{moves}, 59 $self->{moves},
60 $self->{moves} > 1
60 $time / ($self->{moves} || 1); 61 ? $time / $self->{moves}
61 62 : $interval;
62 } 63 }
63 }; 64 };
64 65
65 } else { 66 } else {
66 # none, or unknown 67 # none, or unknown
… …
74 my $timer = $self->{time} + $self->{start} - $timestamp; 75 my $timer = $self->{time} + $self->{start} - $timestamp;
75 76
76 # we round the timer value slightly... the protocol isn't exact anyways, 77 # we round the timer value slightly... the protocol isn't exact anyways,
77 # and this gives smoother timers ;) 78 # and this gives smoother timers ;)
78 my @format = $self->{format}->(int ($timer + 0.4)); 79 my @format = $self->{format}->(int ($timer + 0.4));
79 $self->{widget}->set_text ($self->{format}->(int ($timer + 0.4))); 80 $self->set_text ($self->{format}->(int ($timer + 0.4)));
80 81
81 $timer - int $timer; 82 $timer - int $timer;
82} 83}
83 84
84sub set_time { 85sub set_time {
… …
117 my ($self) = @_; 118 my ($self) = @_;
118 119
119 remove Glib::Source delete $self->{timeout} if $self->{timeout}; 120 remove Glib::Source delete $self->{timeout} if $self->{timeout};
120} 121}
121 122
122sub destroy {
123 my ($self) = @_;
124 $self->stop;
125 $self->SUPER::destroy;
126}
127
128package game::userpanel; 123package game::userpanel;
129 124
130use base gtk::widget; 125use Glib::Object::Subclass
126 Gtk2::HBox,
127 properties => [
128 Glib::ParamSpec->IV ("colour", "colour", "User Colour", 0, 1, 0, [qw(construct-only writable)]),
129 ];
131 130
132sub new { 131sub INIT_INSTANCE {
133 my $class = shift; 132 my ($self) = @_;
134 my $self = $class->SUPER::new(@_);
135 133
136 $self->{widget} = new Gtk2::HBox;
137
138 $self->{widget}->add (my $vbox = new Gtk2::VBox); 134 $self->add (my $vbox = new Gtk2::VBox);
139 135
140 $vbox->add ($self->{name} = new Gtk2::Label $self->{name}); 136 $vbox->add ($self->{name} = new Gtk2::Label $self->{name});
141 $vbox->add ($self->{info} = new Gtk2::Label ""); 137 $vbox->add ($self->{info} = new Gtk2::Label "");
142 $vbox->add (($self->{clock} = new game::goclock)->widget); 138 $vbox->add ($self->{clock} = new game::goclock); Scalar::Util::weaken $self->{clock};
143 139
144 $vbox->add ($self->{imagebox} = new Gtk2::VBox); 140 $vbox->add ($self->{imagebox} = new Gtk2::VBox);
145 141
146 $self; 142 $self;
147} 143}
… …
183 $self->{info}->set_text ("$captures pris."); 179 $self->{info}->set_text ("$captures pris.");
184} 180}
185 181
186package game; 182package game;
187 183
184use Scalar::Util qw(weaken);
185
188use KGS::Constants; 186use KGS::Constants;
189use KGS::Game::Board; 187use KGS::Game::Board;
190 188
189use Gtk2::GoBoard;
190
191use Glib::Object::Subclass
192 Gtk2::Window;
193
191use base KGS::Listener::Game; 194use base KGS::Listener::Game;
192use base KGS::Game; 195use base KGS::Game;
193 196
194use base gtk::widget;
195
196use POSIX qw(ceil); 197use POSIX qw(ceil);
197 198
198sub new { 199sub new {
199 my $self = shift; 200 my ($self, %arg) = @_;
200 $self = $self->SUPER::new(@_); 201 $self = $self->Glib::Object::new;
202 $self->{$_} = delete $arg{$_} for keys %arg;
201 203
202 $self->listen($self->{conn}); 204 $self->listen ($self->{conn});
203 205
204 $self->{window} = new Gtk2::Window 'toplevel';
205 gtk::state $self->{window}, "game::window", undef, window_size => [600, 500]; 206 gtk::state $self, "game::window", undef, window_size => [600, 500];
206 207
207 $self->{window}->signal_connect(delete_event => sub { 208 $self->signal_connect (delete_event => sub { $self->part; 1 });
208 $self->part; 209 $self->signal_connect (destroy => sub { %{$_[0]} = () });
209 $self->destroy;
210 1;
211 });
212 210
213 $self->{window}->add($self->{hpane} = new Gtk2::HPaned); 211 $self->add (my $hpane = new Gtk2::HPaned);
214 gtk::state $self->{hpane}, "game::hpane", undef, position => 500; 212 gtk::state $hpane, "game::hpane", undef, position => 500;
215 213
216 # LEFT PANE 214 # LEFT PANE
217 215
218 $self->{hpane}->pack1(($self->{left} = new Gtk2::VBox), 1, 0); 216 $hpane->pack1 (($self->{left} = new Gtk2::VBox), 1, 0);
219 217
220 $self->{boardbox} = new Gtk2::VBox; 218 $self->{boardbox} = new Gtk2::VBox;
221 219
222 $self->{hpane}->pack1((my $vbox = new Gtk2::VBox), 1, 1); 220 $hpane->pack1((my $vbox = new Gtk2::VBox), 1, 1);
223 221
224 # challenge 222 # challenge
225 223
226 $self->{challenge} = new challenge channel => $self->{channel}; 224 $self->{challenge} = new challenge channel => $self->{channel};
227 225
… …
248 246
249 $self->{boardbox}->add ($self->{board} = new Gtk2::GoBoard size => $self->{size}); 247 $self->{boardbox}->add ($self->{board} = new Gtk2::GoBoard size => $self->{size});
250 248
251 # RIGHT PANE 249 # RIGHT PANE
252 250
253 $self->{hpane}->pack2(($self->{vpane} = new Gtk2::VPaned), 1, 1); 251 $hpane->pack2 (($self->{vpane} = new Gtk2::VPaned), 1, 1);
254 $self->{hpane}->set(position_set => 1); 252 $hpane->set (position_set => 1);
255 gtk::state $self->{vpane}, "game::vpane", $self->{name}, position => 80; 253 gtk::state $self->{vpane}, "game::vpane", $self->{name}, position => 80;
256 254
257 $self->{vpane}->add(my $sw = new Gtk2::ScrolledWindow); 255 $self->{vpane}->add (my $sw = new Gtk2::ScrolledWindow);
258 $sw->set_policy("automatic", "always"); 256 $sw->set_policy ("automatic", "always");
259 257
260 $sw->add(($self->{userlist} = new userlist)->widget); 258 $sw->add ($self->{userlist} = new userlist);
261 259
262 $self->{vpane}->add(my $vbox = new Gtk2::VBox); 260 $self->{vpane}->add (my $vbox = new Gtk2::VBox);
263 261
264 $vbox->pack_start((my $hbox = new Gtk2::HBox 1), 0, 1, 0); 262 $vbox->pack_start ((my $hbox = new Gtk2::HBox 1), 0, 1, 0);
263
265 $hbox->add (($self->{userpanel}[WHITE] = new game::userpanel colour => WHITE)->widget); 264 $hbox->add ($self->{userpanel}[$_] = new game::userpanel colour => $_)
266 $hbox->add (($self->{userpanel}[BLACK] = new game::userpanel colour => BLACK)->widget); 265 for COLOUR_WHITE, COLOUR_BLACK;
267 266
268 $vbox->pack_start(($self->{text} = new gtk::text)->widget, 1, 1, 0); 267 $vbox->pack_start (($self->{chat} = new chat), 1, 1, 0);
268 weaken $self->{chat};
269 269
270 $vbox->pack_start(($self->{entry} = new Gtk2::Entry), 0, 1, 0);
271 $self->{entry}->signal_connect(activate => sub { 270 $self->{chat}->signal_connect (command => sub {
272 my $text = $self->{entry}->get_text; 271 my ($chat, $cmd, $arg) = @_;
273 $self->say($text) if $text =~ /\S/; 272 if ($cmd eq "rsave") {
274 $self->{entry}->set_text(""); 273 Storable::nstore { tree => $self->{tree}, curnode => $self->{curnode}, move => $self->{move} }, $arg;#d#
274 } else {
275 $self->{app}->do_command ($chat, $cmd, $arg, userlist => $self->{userlist}, game => $self);
276 }
275 }); 277 });
276 278
277 $self->event_update_game;
278 $self; 279 $self;
279} 280}
280 281
281sub event_update_users { 282sub event_update_users {
282 my ($self, $add, $update, $remove) = @_; 283 my ($self, $add, $update, $remove) = @_;
284
285 return unless $self->{userlist};
283 286
284 $self->{userlist}->update ($add, $update, $remove); 287 $self->{userlist}->update ($add, $update, $remove);
285 288
286 my %important; 289 my %important;
287 $important{$self->{user1}{name}}++; 290 $important{$self->{user1}{name}}++;
288 $important{$self->{user2}{name}}++; 291 $important{$self->{user2}{name}}++;
289 $important{$self->{user3}{name}}++; 292 $important{$self->{user3}{name}}++;
290 293
291 if (my @users = grep $important{$_->{name}}, @$add) { 294 if (my @users = grep $important{$_->{name}}, @$add) {
292 $self->{text}->append_text ("\n<header>Joins:</header>"); 295 $self->{chat}->append_text ("\n<header>Joins:</header>");
293 $self->{text}->append_text (" <user>" . $_->as_string . "</user>") for @users; 296 $self->{chat}->append_text (" <user>" . $_->as_string . "</user>") for @users;
294 } 297 }
295 if (my @users = grep $important{$_->{name}}, @$remove) { 298 if (my @users = grep $important{$_->{name}}, @$remove) {
296 $self->{text}->append_text ("\n<header>Parts:</header>"); 299 $self->{chat}->append_text ("\n<header>Parts:</header>");
297 $self->{text}->append_text (" <user>" . $_->as_string . "</user>") for @users; 300 $self->{chat}->append_text (" <user>" . $_->as_string . "</user>") for @users;
298 } 301 }
299 302
300} 303}
301 304
302sub join { 305sub join {
303 my ($self) = @_; 306 my ($self) = @_;
304 return if $self->{joined}; 307 return if $self->{joined};
305 308
306 $self->SUPER::join; 309 $self->SUPER::join;
307 310
308 $self->{window}->show_all; 311 $self->show_all;
309}
310
311sub part {
312 my ($self) = @_;
313
314 $self->SUPER::part;
315 $self->destroy;
316} 312}
317 313
318sub update_board { 314sub update_board {
319 my ($self) = @_; 315 my ($self) = @_;
320 return unless $self->{path}; 316 return unless $self->{path};
… …
326 $self->{board_label}->set_text ("Move " . ($move - 1)); 322 $self->{board_label}->set_text ("Move " . ($move - 1));
327 323
328 $self->{cur_board} = new KGS::Game::Board $self->{size}; 324 $self->{cur_board} = new KGS::Game::Board $self->{size};
329 $self->{cur_board}->interpret_path ([@{$self->{path}}[0 .. $move - 1]]); 325 $self->{cur_board}->interpret_path ([@{$self->{path}}[0 .. $move - 1]]);
330 326
331 for my $colour (WHITE, BLACK) { 327 for my $colour (COLOUR_WHITE, COLOUR_BLACK) {
332 $self->{userpanel}[$colour]->set_state ( 328 $self->{userpanel}[$colour]->set_state (
333 $self->{cur_board}{captures}[$colour], 329 $self->{cur_board}{captures}[$colour],
334 $self->{cur_board}{timer}[$colour], 330 $self->{cur_board}{timer}[$colour],
335 ($running && $self->{lastmove_colour} == !$colour) 331 ($running && $self->{lastmove_colour} == !$colour)
336 ? $self->{lastmove_time} : 0 332 ? $self->{lastmove_time} : 0
… …
392 }sgexi; 388 }sgexi;
393 389
394 $text .= $_; 390 $text .= $_;
395 } 391 }
396 392
397 $self->{text}->append_text ($text); 393 $self->{chat}->append_text ($text);
398} 394}
399 395
400sub event_join { 396sub event_join {
401 my ($self) = @_; 397 my ($self) = @_;
398
402 $self->SUPER::event_join; 399 $self->SUPER::event_join (@_);
400 $self->event_update_game;
403} 401}
404 402
405sub event_part { 403sub event_part {
406 my ($self) = @_; 404 my ($self) = @_;
405
407 $self->SUPER::event_part; 406 $self->SUPER::event_part;
408 $self->destroy; 407 $self->destroy;
409} 408}
410 409
411sub event_move { 410sub event_move {
… …
415 414
416sub event_update_game { 415sub event_update_game {
417 my ($self) = @_; 416 my ($self) = @_;
418 $self->SUPER::event_update_game; 417 $self->SUPER::event_update_game;
419 418
419 return unless $self->{joined};
420
420 my $title = defined $self->{channel} 421 my $title = defined $self->{channel}
421 ? $self->owner->as_string . " " . $self->opponent_string 422 ? $self->owner->as_string . " " . $self->opponent_string
422 : "Game Window"; 423 : "Game Window";
423 $self->{window}->set_title("KGS Game $title"); 424 $self->set_title("KGS Game $title");
424 $self->{title}->set_text ($title); 425 $self->{title}->set_text ($title);
425 426
426 $self->{user}[BLACK] = $self->{user1}; 427 $self->{user}[COLOUR_BLACK] = $self->{user1};
427 $self->{user}[WHITE] = $self->{user2}; 428 $self->{user}[COLOUR_WHITE] = $self->{user2};
428 429
429 # show board 430 # show board
430 431
431 $self->{left}->remove ($_) for $self->{left}->get_children;
432 if ($self->is_valid) { 432 if ($self->is_inprogress) {
433 $self->{left}->add ($self->{boardbox}); 433 $self->{left}->remove ($self->{challenge}->widget) if $self->{challenge} && $self->{boardbox}->parent;
434 (delete $self->{challenge})->destroy if $self->{challenge}; 434 $self->{left}->add ($self->{boardbox}) unless $self->{boardbox}->parent;
435 } else { 435 } else {
436 $self->{left}->add ($self->{challenge}->widget); 436 $self->{left}->remove ($self->{boardbox}) if $self->{boardbox}->parent;
437 $self->{left}->add ($self->{challenge}->widget) unless $self->{challenge}->widget->parent;
437 } 438 }
438 $self->{left}->show_all; 439 $self->{left}->show_all;
439 440
440 # view text 441 # view text
441 442
442 eval { #d# 443 eval { #d#
443 my @ga; 444 my @ga;
444 $ga[0] = "\nType: " . (util::toxml $gametype{$self->type}) 445 $ga[0] = "\nType: " . (util::toxml $gametype{$self->type})
445 . " (" . (util::toxml $gameopt{$self->option}) . ")"; 446 . " (" . (util::toxml $gameopt{$self->option}) . ")";
446 $ga[1] = "\nFlags:"; 447 $ga[1] = "\nFlags:";
447 $ga[1] .= " valid" if $self->is_valid; 448 $ga[1] .= " started" if $self->is_inprogress;
448 $ga[1] .= " adjourned" if $self->is_adjourned; 449 $ga[1] .= " adjourned" if $self->is_adjourned;
449 $ga[1] .= " scored" if $self->is_scored; 450 $ga[1] .= " scored" if $self->is_scored;
450 $ga[1] .= " saved" if $self->is_saved; 451 $ga[1] .= " saved" if $self->is_saved;
451 452
452 $ga[2] = "\nOwner: <user>" . (util::toxml $self->{user3}->as_string) . "</user>" if $self->{user3}->is_valid; 453 $ga[2] = "\nOwner: <user>" . (util::toxml $self->{user3}->as_string) . "</user>"
454 if $self->{user3}->is_inprogress;
453 455
454 $ga[3] = "\nPlayers: <user>" . (util::toxml $self->{user2}->as_string) . "</user>" 456 $ga[3] = "\nPlayers: <user>" . (util::toxml $self->{user2}->as_string) . "</user>"
455 . " vs. <user>" . (util::toxml $self->{user1}->as_string) . "</user>" 457 . " vs. <user>" . (util::toxml $self->{user1}->as_string) . "</user>"
456 if $self->is_valid; 458 if $self->is_inprogress;
457 459
458 if ($self->is_valid) { 460 if ($self->is_inprogress) {
459 $ga[4] = "\nHandicap: " . $self->{handicap}; 461 $ga[4] = "\nHandicap: " . $self->{handicap};
460 $ga[5] = "\nKomi: " . $self->{komi}; 462 $ga[5] = "\nKomi: " . $self->{komi};
461 $ga[6] = "\nSize: " . $self->size_string; 463 $ga[6] = "\nSize: " . $self->size_string;
462 } 464 }
463 465
… …
474 $text .= "</infoblock>"; 476 $text .= "</infoblock>";
475 477
476 $self->{gatext} = \@ga; 478 $self->{gatext} = \@ga;
477 }; 479 };
478 480
479 $self->{text}->append_text ($text); 481 $self->{chat}->append_text ($text);
480} 482}
481 483
482sub event_update_rules { 484sub event_update_rules {
483 my ($self, $rules) = @_; 485 my ($self, $rules) = @_;
484 486
487 if ($self->{user}) {
485 $self->{userpanel}[$_]->configure ($self->{app}, $self->{user}[$_], $rules) 488 $self->{userpanel}[$_]->configure ($self->{app}, $self->{user}[$_], $rules)
486 for BLACK, WHITE; 489 for COLOUR_BLACK, COLOUR_WHITE;
490 }
487 491
488 sound::play 3, "gamestart"; 492 sound::play 3, "gamestart";
489 493
490 my $text = "\n<header>Game Rules</header>"; 494 my $text = "\n<header>Game Rules</header>";
491 495
… …
497 $text .= "UNLIMITED"; 501 $text .= "UNLIMITED";
498 } elsif ($rules->{timesys} == TIMESYS_ABSOLUTE) { 502 } elsif ($rules->{timesys} == TIMESYS_ABSOLUTE) {
499 $text .= util::format_time $rules->{time}; 503 $text .= util::format_time $rules->{time};
500 $text .= " ABS"; 504 $text .= " ABS";
501 } elsif ($rules->{timesys} == TIMESYS_BYO_YOMI) { 505 } elsif ($rules->{timesys} == TIMESYS_BYO_YOMI) {
502 $text .= util::format_time $rules->{time} - $rules->{interval} * $rules->{count}; 506 $text .= util::format_time $rules->{time};
503 $text .= sprintf " + %s (%d) BY", util::format_time $rules->{interval}, $rules->{count}; 507 $text .= sprintf " + %s (%d) BY", util::format_time $rules->{interval}, $rules->{count};
504 } elsif ($rules->{timesys} == TIMESYS_CANADIAN) { 508 } elsif ($rules->{timesys} == TIMESYS_CANADIAN) {
505 $text .= util::format_time $rules->{time}; 509 $text .= util::format_time $rules->{time};
506 $text .= sprintf " + %s/%d CAN", util::format_time $rules->{interval}, $rules->{count}; 510 $text .= sprintf " + %s/%d CAN", util::format_time $rules->{interval}, $rules->{count};
507 } 511 }
508 512
509 $self->{text}->append_text ("<infoblock>$text</infoblock>"); 513 $self->{chat}->append_text ("<infoblock>$text</infoblock>");
510} 514}
511 515
512sub inject_resign_game { 516sub inject_resign_game {
513 my ($self, $msg) = @_; 517 my ($self, $msg) = @_;
514 518
515 sound::play 3, "resign"; 519 sound::play 3, "resign";
516 520
517 $self->{text}->append_text ("\n<infoblock><header>Resign</header>" 521 $self->{chat}->append_text ("\n<infoblock><header>Resign</header>"
518 . "\n<user>" 522 . "\n<user>"
519 . (util::toxml $self->{user}[$msg->{player}]->as_string) 523 . (util::toxml $self->{user}[$msg->{player}]->as_string)
520 . "</user> resigned.</infoblock>"); 524 . "</user> resigned.</infoblock>");
521} 525}
522 526
523sub inject_final_result { 527sub inject_final_result {
524 my ($self, $msg) = @_; 528 my ($self, $msg) = @_;
525 529
526 $self->{text}->append_text ("<infoblock>\n<header>Game Over</header>" 530 $self->{chat}->append_text ("<infoblock>\n<header>Game Over</header>"
527 . "\nWhite Score " . (util::toxml $msg->{whitescore}->as_string) 531 . "\nWhite Score " . (util::toxml $msg->{whitescore}->as_string)
528 . "\nBlack Score " . (util::toxml $msg->{blackscore}->as_string) 532 . "\nBlack Score " . (util::toxml $msg->{blackscore}->as_string)
529 . "</infoblock>" 533 . "</infoblock>"
530 ); 534 );
531} 535}
532 536
533sub event_challenge { 537sub event_challenge {
534 my ($self, $challenge) = @_; 538 my ($self, $challenge) = @_;
535 539
536 use KGS::Listener::Debug; 540 use KGS::Listener::Debug;
537 $self->{text}->append_text ("\n".KGS::Listener::Debug::dumpval($challenge)); 541 $self->{chat}->append_text ("\n".KGS::Listener::Debug::dumpval($challenge));
538}
539
540sub destroy {
541 my ($self) = @_;
542 $self->{userpanel}[$_] && (delete $self->{userpanel}[$_])->destroy
543 for BLACK, WHITE;
544 $self->SUPER::destroy;
545 delete $self->{app}{gamelist}{game}{$self->{channel}};
546} 542}
547 543
5481; 5441;
549 545

Diff Legend

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