ViewVC Help
View File | Revision Log | Show Annotations | Download File
/cvs/kgsueme/kgsueme/game.pl
Revision: 1.73
Committed: Fri Jul 25 17:35:20 2003 UTC (20 years, 10 months ago) by pcg
Content type: text/plain
Branch: MAIN
Changes since 1.72: +20 -11 lines
Log Message:
*** empty log message ***

File Contents

# Content
1 use utf8;
2
3 package game::goclock;
4
5 # Lo and Behold! I admit it! The rounding stuff etc.. in goclock
6 # is completely borked.
7
8 use Time::HiRes ();
9
10 use KGS::Constants;
11
12 use base gtk::widget;
13
14 sub new {
15 my $class = shift;
16 my $self = $class->SUPER::new(@_);
17
18 $self->{widget} = new Gtk2::Label;
19
20 $self->{set} = sub { };
21 $self->{format} = sub { "ERROR" };
22
23 $self;
24 }
25
26 sub configure {
27 my ($self, $timesys, $main, $interval, $count) = @_;
28
29 if ($timesys == TIMESYS_ABSOLUTE) {
30 $self->{set} = sub { $self->{time} = $_[0] };
31 $self->{format} = sub { util::format_time $_[0] };
32
33 } elsif ($timesys == TIMESYS_BYO_YOMI) {
34 my $low = $interval * $count;
35
36 $self->{set} = sub { $self->{time} = $_[0] };
37
38 $self->{format} = sub {
39 if ($_[0] > $low) {
40 util::format_time $_[0] - $low;
41 } else {
42 sprintf "%s (%d)",
43 util::format_time int (($_[0] - 1) % $interval + 1),
44 ($_[0] - 1) / $interval;
45 }
46 };
47
48 } elsif ($timesys == TIMESYS_CANADIAN) {
49 $self->{set} = sub { $self->{time} = $_[0]; $self->{moves} = $_[1] };
50
51 $self->{format} = sub {
52 if (!$self->{moves}) {
53 util::format_time $_[0] - $low;
54 } else {
55 my $time = int (($_[0] - 1) % $interval + 1);
56
57 sprintf "%s/%d =%d",
58 util::format_time $time,
59 $self->{moves},
60 $time / ($self->{moves} || 1);
61
62 }
63 };
64
65 } else {
66 # none, or unknown
67 $self->{set} = sub { };
68 $self->{format} = sub { "---" }
69 }
70 }
71
72 sub refresh {
73 my ($self, $timestamp) = @_;
74 my $timer = $self->{time} + $self->{start} - $timestamp;
75
76 # we round the timer value slightly... the protocol isn't exact anyways,
77 # and this gives smoother timers ;)
78 my @format = $self->{format}->(int ($timer + 0.4));
79 $self->{widget}->set_text ($self->{format}->(int ($timer + 0.4)));
80
81 $timer - int $timer;
82 }
83
84 sub set_time {
85 my ($self, $time) = @_;
86
87 # we ignore requests to re-set the time of a running clock.
88 # this is the easiest way to ensure that commentary etc.
89 # doesn't re-set the clock. yes, this is frickle design,
90 # but I think the protocol is to blame here, which gives
91 # very little time information. (cgoban2 also has had quite
92 # a lot of small time update problems...)
93 unless ($self->{timeout}) {
94 $self->{set}->($time->[0], $time->[1]);
95 $self->refresh ($self->{start});
96 }
97 }
98
99 sub start {
100 my ($self, $when) = @_;
101
102 $self->stop;
103
104 $self->{start} = $when;
105
106 my $timeout; $timeout = sub {
107 my $next = $self->refresh (Time::HiRes::time) * 1000;
108 $next += 1000 if $next < 0;
109 $self->{timeout} = add Glib::Timeout $next, $timeout;
110 0;
111 };
112
113 $timeout->();
114 }
115
116 sub stop {
117 my ($self) = @_;
118
119 remove Glib::Source delete $self->{timeout} if $self->{timeout};
120 }
121
122 sub destroy {
123 my ($self) = @_;
124 $self->stop;
125 $self->SUPER::destroy;
126 }
127
128 package game::userpanel;
129
130 use base gtk::widget;
131
132 sub new {
133 my $class = shift;
134 my $self = $class->SUPER::new(@_);
135
136 $self->{widget} = new Gtk2::HBox;
137
138 $self->{widget}->add (my $vbox = new Gtk2::VBox);
139
140 $vbox->add ($self->{name} = new Gtk2::Label $self->{name});
141 $vbox->add ($self->{info} = new Gtk2::Label "");
142 $vbox->add (($self->{clock} = new game::goclock)->widget);
143
144 $vbox->add ($self->{imagebox} = new Gtk2::VBox);
145
146 $self;
147 }
148
149 sub configure {
150 my ($self, $app, $user, $rules) = @_;
151
152 if ($self->{name}->get_text ne $user->as_string) {
153 $self->{name}->set_text ($user->as_string);
154
155 $self->{imagebox}->remove ($_) for $self->{imagebox}->get_children;
156 $self->{imagebox}->add (gtk::image_from_data undef);
157 $self->{imagebox}->show_all;
158
159 if ($user->has_pic) {
160 # the big picture...
161 $app->userpic ($user->{name}, sub {
162 return unless $self->{imagebox};
163
164 if ($_[0]) {
165 $self->{imagebox}->remove ($_) for $self->{imagebox}->get_children;
166 $self->{imagebox}->add (gtk::image_from_data $_[0]);
167 $self->{imagebox}->show_all;
168 }
169 });
170 }
171 }
172
173 $self->{clock}->configure (@{$rules}{qw(timesys time interval count)});
174 }
175
176 sub set_state {
177 my ($self, $captures, $timer, $when) = @_;
178
179 $self->{clock}->stop unless $when;
180 $self->{clock}->set_time ($timer);
181 $self->{clock}->start ($when) if $when;
182
183 $self->{info}->set_text ("$captures pris.");
184 }
185
186 package game;
187
188 use KGS::Constants;
189 use KGS::Game::Board;
190
191 use base KGS::Listener::Game;
192 use base KGS::Game;
193
194 use base gtk::widget;
195
196 use POSIX qw(ceil);
197
198 sub new {
199 my $self = shift;
200 $self = $self->SUPER::new(@_);
201
202 $self->listen($self->{conn});
203
204 $self->{window} = new Gtk2::Window 'toplevel';
205 gtk::state $self->{window}, "game::window", undef, window_size => [600, 500];
206
207 $self->{window}->signal_connect(delete_event => sub {
208 $self->part;
209 $self->destroy;
210 1;
211 });
212
213 $self->{window}->add($self->{hpane} = new Gtk2::HPaned);
214 gtk::state $self->{hpane}, "game::hpane", undef, position => 500;
215
216 # LEFT PANE
217
218 $self->{hpane}->pack1(($self->{left} = new Gtk2::VBox), 1, 0);
219
220 $self->{boardbox} = new Gtk2::VBox;
221
222 $self->{hpane}->pack1((my $vbox = new Gtk2::VBox), 1, 1);
223
224 # challenge
225
226 $self->{challenge} = new challenge channel => $self->{channel};
227
228 # board box (aspect/canvas)
229
230 $self->{boardbox}->pack_start((my $frame = new Gtk2::Frame), 0, 1, 0);
231
232 {
233 $frame->add (my $vbox = new Gtk2::VBox);
234 $vbox->add ($self->{title} = new Gtk2::Label $title);
235
236 $vbox->add (my $hbox = new Gtk2::HBox);
237
238 $hbox->pack_start (($self->{board_label} = new Gtk2::Label), 0, 1, 0);
239
240 $self->{moveadj} = new Gtk2::Adjustment 1, 1, 1, 1, 5, 0;
241
242 $hbox->pack_start ((my $scale = new Gtk2::HScale $self->{moveadj}), 1, 1, 0);
243 $scale->set_draw_value (0);
244 $scale->set_digits (0);
245
246 $self->{moveadj}->signal_connect (value_changed => sub { $self->update_board });
247 }
248
249 $self->{boardbox}->add ($self->{board} = new Gtk2::GoBoard size => $self->{size});
250
251 # RIGHT PANE
252
253 $self->{hpane}->pack2(($self->{vpane} = new Gtk2::VPaned), 1, 1);
254 $self->{hpane}->set(position_set => 1);
255 gtk::state $self->{vpane}, "game::vpane", $self->{name}, position => 80;
256
257 $self->{vpane}->add(my $sw = new Gtk2::ScrolledWindow);
258 $sw->set_policy("automatic", "always");
259
260 $sw->add(($self->{userlist} = new userlist)->widget);
261
262 $self->{vpane}->add(my $vbox = new Gtk2::VBox);
263
264 $vbox->pack_start((my $hbox = new Gtk2::HBox 1), 0, 1, 0);
265 $hbox->add (($self->{userpanel}[WHITE] = new game::userpanel colour => WHITE)->widget);
266 $hbox->add (($self->{userpanel}[BLACK] = new game::userpanel colour => BLACK)->widget);
267
268 $vbox->pack_start(($self->{chat} = new chat), 1, 1, 0);
269
270 $self->{chat}->signal_connect(command => sub {
271 my ($chat, $cmd, $arg) = @_;
272 if ($cmd eq "rsave") {
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 }
277 });
278
279 $self->event_update_game;
280 $self;
281 }
282
283 sub event_update_users {
284 my ($self, $add, $update, $remove) = @_;
285
286 return unless $self->{userlist};
287
288 $self->{userlist}->update ($add, $update, $remove);
289
290 my %important;
291 $important{$self->{user1}{name}}++;
292 $important{$self->{user2}{name}}++;
293 $important{$self->{user3}{name}}++;
294
295 if (my @users = grep $important{$_->{name}}, @$add) {
296 $self->{chat}->append_text ("\n<header>Joins:</header>");
297 $self->{chat}->append_text (" <user>" . $_->as_string . "</user>") for @users;
298 }
299 if (my @users = grep $important{$_->{name}}, @$remove) {
300 $self->{chat}->append_text ("\n<header>Parts:</header>");
301 $self->{chat}->append_text (" <user>" . $_->as_string . "</user>") for @users;
302 }
303
304 }
305
306 sub join {
307 my ($self) = @_;
308 return if $self->{joined};
309
310 $self->SUPER::join;
311
312 $self->{window}->show_all;
313 }
314
315 sub part {
316 my ($self) = @_;
317
318 $self->SUPER::part;
319 $self->destroy;
320 }
321
322 sub update_board {
323 my ($self) = @_;
324 return unless $self->{path};
325
326 my $move = int $self->{moveadj}->get_value;
327
328 my $running = $move == @{$self->{path}};
329
330 $self->{board_label}->set_text ("Move " . ($move - 1));
331
332 $self->{cur_board} = new KGS::Game::Board $self->{size};
333 $self->{cur_board}->interpret_path ([@{$self->{path}}[0 .. $move - 1]]);
334
335 for my $colour (WHITE, BLACK) {
336 $self->{userpanel}[$colour]->set_state (
337 $self->{cur_board}{captures}[$colour],
338 $self->{cur_board}{timer}[$colour],
339 ($running && $self->{lastmove_colour} == !$colour)
340 ? $self->{lastmove_time} : 0
341 );
342 }
343
344 $self->{board}->set_board ($self->{cur_board});
345 }
346
347 sub event_update_tree {
348 my ($self) = @_;
349
350 $self->{path} = $self->get_path;
351
352 if ($self->{moveadj}) {
353 my $upper = $self->{moveadj}->upper;
354 my $pos = $self->{moveadj}->get_value;
355 my $move = scalar @{$self->{path}};
356
357 $self->{moveadj}->upper ($move);
358
359 $self->{moveadj}->changed;
360 if ($pos == $upper) {
361 $self->{moveadj}->value ($move);
362 $self->{moveadj}->value_changed;
363 }
364 }
365 }
366
367 sub event_update_comments {
368 my ($self, $node, $comment, $newnode) = @_;
369 $self->SUPER::event_update_comments($node, $comment, $newnode);
370
371 my $text;
372
373 $text .= "\n<header>Move <move>$node->{move}</move>, Node <node>$node->{id}</node></header>"
374 if $newnode;
375
376 for (split /\n/, $comment) {
377 $text .= "\n";
378 if (s/^([0-9a-zA-Z]+ \[[0-9dkp\?\-]+\])://) {
379 $text .= "<user>" . (util::toxml $1) . "</user>:";
380 }
381
382 # coords only for 19x19 so far
383 $_ = util::toxml $_;
384 s{
385 (
386 \b
387 (?:[bw])?
388 [, ]{0,2}
389 [a-hj-t] # valid for upto 19x19
390 \s?
391 [1-9]?[0-9]
392 \b
393 )
394 }{
395 "<coord>$1</coord>";
396 }sgexi;
397
398 $text .= $_;
399 }
400
401 $self->{chat}->append_text ($text);
402 }
403
404 sub event_join {
405 my ($self) = @_;
406 $self->SUPER::event_join;
407 }
408
409 sub event_part {
410 my ($self) = @_;
411 $self->SUPER::event_part;
412 $self->destroy;
413 }
414
415 sub event_move {
416 my ($self, $pass) = @_;
417 sound::play 1, $pass ? "pass" : "move";
418 }
419
420 sub event_update_game {
421 my ($self) = @_;
422 $self->SUPER::event_update_game;
423
424 return unless $self->{window};
425
426 my $title = defined $self->{channel}
427 ? $self->owner->as_string . " " . $self->opponent_string
428 : "Game Window";
429 $self->{window}->set_title("KGS Game $title");
430 $self->{title}->set_text ($title);
431
432 $self->{user}[BLACK] = $self->{user1};
433 $self->{user}[WHITE] = $self->{user2};
434
435 # show board
436
437 $self->{left}->remove ($_) for $self->{left}->get_children;
438 if ($self->is_valid) {
439 $self->{left}->add ($self->{boardbox});
440 (delete $self->{challenge})->destroy if $self->{challenge};
441 } else {
442 $self->{left}->add ($self->{challenge}->widget);
443 }
444 $self->{left}->show_all;
445
446 # view text
447
448 eval { #d#
449 my @ga;
450 $ga[0] = "\nType: " . (util::toxml $gametype{$self->type})
451 . " (" . (util::toxml $gameopt{$self->option}) . ")";
452 $ga[1] = "\nFlags:";
453 $ga[1] .= " valid" if $self->is_valid;
454 $ga[1] .= " adjourned" if $self->is_adjourned;
455 $ga[1] .= " scored" if $self->is_scored;
456 $ga[1] .= " saved" if $self->is_saved;
457
458 $ga[2] = "\nOwner: <user>" . (util::toxml $self->{user3}->as_string) . "</user>" if $self->{user3}->is_valid;
459
460 $ga[3] = "\nPlayers: <user>" . (util::toxml $self->{user2}->as_string) . "</user>"
461 . " vs. <user>" . (util::toxml $self->{user1}->as_string) . "</user>"
462 if $self->is_valid;
463
464 if ($self->is_valid) {
465 $ga[4] = "\nHandicap: " . $self->{handicap};
466 $ga[5] = "\nKomi: " . $self->{komi};
467 $ga[6] = "\nSize: " . $self->size_string;
468 }
469
470 if ($self->is_scored) {
471 $ga[7] = "\nResult: " . $self->score_string;
472 }
473
474 $text = "\n<infoblock><header>Game Update</header>";
475 for (0..7) {
476 if ($self->{gatext}[$_] ne $ga[$_]) {
477 $text .= $ga[$_];
478 }
479 }
480 $text .= "</infoblock>";
481
482 $self->{gatext} = \@ga;
483 };
484
485 $self->{chat}->append_text ($text);
486 }
487
488 sub event_update_rules {
489 my ($self, $rules) = @_;
490
491 $self->{userpanel}[$_]->configure ($self->{app}, $self->{user}[$_], $rules)
492 for BLACK, WHITE;
493
494 sound::play 3, "gamestart";
495
496 my $text = "\n<header>Game Rules</header>";
497
498 $text .= "\nRuleset: " . $ruleset{$rules->{ruleset}};
499
500 $text .= "\nTime: ";
501
502 if ($rules->{timesys} == TIMESYS_NONE) {
503 $text .= "UNLIMITED";
504 } elsif ($rules->{timesys} == TIMESYS_ABSOLUTE) {
505 $text .= util::format_time $rules->{time};
506 $text .= " ABS";
507 } elsif ($rules->{timesys} == TIMESYS_BYO_YOMI) {
508 $text .= util::format_time $rules->{time} - $rules->{interval} * $rules->{count};
509 $text .= sprintf " + %s (%d) BY", util::format_time $rules->{interval}, $rules->{count};
510 } elsif ($rules->{timesys} == TIMESYS_CANADIAN) {
511 $text .= util::format_time $rules->{time};
512 $text .= sprintf " + %s/%d CAN", util::format_time $rules->{interval}, $rules->{count};
513 }
514
515 $self->{chat}->append_text ("<infoblock>$text</infoblock>");
516 }
517
518 sub inject_resign_game {
519 my ($self, $msg) = @_;
520
521 sound::play 3, "resign";
522
523 $self->{chat}->append_text ("\n<infoblock><header>Resign</header>"
524 . "\n<user>"
525 . (util::toxml $self->{user}[$msg->{player}]->as_string)
526 . "</user> resigned.</infoblock>");
527 }
528
529 sub inject_final_result {
530 my ($self, $msg) = @_;
531
532 $self->{chat}->append_text ("<infoblock>\n<header>Game Over</header>"
533 . "\nWhite Score " . (util::toxml $msg->{whitescore}->as_string)
534 . "\nBlack Score " . (util::toxml $msg->{blackscore}->as_string)
535 . "</infoblock>"
536 );
537 }
538
539 sub event_challenge {
540 my ($self, $challenge) = @_;
541
542 use KGS::Listener::Debug;
543 $self->{chat}->append_text ("\n".KGS::Listener::Debug::dumpval($challenge));
544 }
545
546 sub destroy {
547 my ($self) = @_;
548
549 delete $self->{app}{gamelist}{game}{$self->{channel}};
550 $self->{userpanel}[$_] && (delete $self->{userpanel}[$_])->destroy
551 for BLACK, WHITE;
552 $self->SUPER::destroy;
553 }
554
555 1;
556