ViewVC Help
View File | Revision Log | Show Annotations | Download File
/cvs/kgsueme/kgsueme/game.pl
Revision: 1.64
Committed: Sun Jun 22 20:47:12 2003 UTC (20 years, 11 months ago) by pcg
Content type: text/plain
Branch: MAIN
Changes since 1.63: +8 -343 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, $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 appwin::userpic ($user->{name}, sub {
162 return unless $self->{imagebox};
163 if ($_[0]) {
164 $self->{imagebox}->remove ($_) for $self->{imagebox}->get_children;
165 $self->{imagebox}->add (gtk::image_from_data $_[0]);
166 $self->{imagebox}->show_all;
167 }
168 });
169 }
170 }
171
172 $self->{clock}->configure (@{$rules}{qw(timesys time interval count)});
173 }
174
175 sub set_state {
176 my ($self, $captures, $timer, $when) = @_;
177
178 $self->{clock}->stop unless $when;
179 $self->{clock}->set_time ($timer);
180 $self->{clock}->start ($when) if $when;
181
182 $self->{info}->set_text ("$captures pris.");
183 }
184
185 package game;
186
187 use KGS::Constants;
188 use KGS::Game::Board;
189
190 use base KGS::Listener::Game;
191 use base KGS::Game;
192
193 use base gtk::widget;
194
195 use POSIX qw(ceil);
196
197 sub new {
198 my $self = shift;
199 $self = $self->SUPER::new(@_);
200
201 $self->listen($self->{conn});
202
203 $self->{window} = new Gtk2::Window 'toplevel';
204 gtk::state $self->{window}, "game::window", undef, window_size => [600, 500];
205
206 $self->{window}->signal_connect(delete_event => sub {
207 $self->part;
208 $self->destroy;
209 1;
210 });
211
212 $self->{window}->add($self->{hpane} = new Gtk2::HPaned);
213 gtk::state $self->{hpane}, "game::hpane", undef, position => 500;
214
215 # LEFT PANE
216
217 $self->{hpane}->pack1(($self->{left} = new Gtk2::VBox), 1, 0);
218
219 $self->{boardbox} = new Gtk2::VBox;
220
221 $self->{hpane}->pack1((my $vbox = new Gtk2::VBox), 1, 1);
222
223 # challenge
224
225 $self->{challenge} = new challenge channel => $self->{channel};
226
227 # board box (aspect/canvas)
228
229 $self->{boardbox}->pack_start((my $frame = new Gtk2::Frame), 0, 1, 0);
230
231 {
232 $frame->add(my $vbox = new Gtk2::VBox);
233 $vbox->add($self->{title} = new Gtk2::Label $title);
234
235 $self->{moveadj} = new Gtk2::Adjustment 1, 1, 1, 1, 5, 0;
236
237 $vbox->add(my $scale = new Gtk2::HScale $self->{moveadj});
238 $scale->set_draw_value (0);
239 $scale->set_digits (0);
240
241 $self->{moveadj}->signal_connect (value_changed => sub { $self->update_board });
242 }
243
244 $self->{boardbox}->pack_start((my $aspect_frame = new Gtk2::AspectFrame "", 0.5, 0.5, 1, 0), 1, 1, 0);
245 $aspect_frame->set (border_width => 0, shadow_type => 'none', label_xalign => 0.5);
246 $self->{board_label} = $aspect_frame->get_label_widget;
247
248 $aspect_frame->add($self->{board} = new board size => $self->{size});
249
250 # RIGHT PANE
251
252 $self->{hpane}->pack2(($self->{vpane} = new Gtk2::VPaned), 1, 1);
253 $self->{hpane}->set(position_set => 1);
254 gtk::state $self->{vpane}, "game::vpane", $self->{name}, position => 80;
255
256 $self->{vpane}->add(my $sw = new Gtk2::ScrolledWindow);
257 $sw->set_policy("automatic", "always");
258
259 $sw->add(($self->{userlist} = new userlist)->widget);
260
261 $self->{vpane}->add(my $vbox = new Gtk2::VBox);
262
263 $vbox->pack_start((my $hbox = new Gtk2::HBox 1), 0, 1, 0);
264 $hbox->add (($self->{userpanel}[WHITE] = new game::userpanel colour => WHITE)->widget);
265 $hbox->add (($self->{userpanel}[BLACK] = new game::userpanel colour => BLACK)->widget);
266
267 $vbox->pack_start(($self->{text} = new gtk::text)->widget, 1, 1, 0);
268
269 $vbox->pack_start(($self->{entry} = new Gtk2::Entry), 0, 1, 0);
270 $self->{entry}->signal_connect(activate => sub {
271 my $text = $self->{entry}->get_text;
272 $self->say($text) if $text =~ /\S/;
273 $self->{entry}->set_text("");
274 });
275
276 $self->event_update_game;
277 $self;
278 }
279
280 sub event_update_users {
281 my ($self, $add, $update, $remove) = @_;
282
283 $self->{userlist}->update ($add, $update, $remove);
284
285 my %important;
286 $important{$self->{user1}{name}}++;
287 $important{$self->{user2}{name}}++;
288 $important{$self->{user3}{name}}++;
289
290 if (my @users = grep $important{$_->{name}}, @$add) {
291 $self->{text}->append_text ("\n<header>Joins:</header>");
292 $self->{text}->append_text (" <user>" . $_->as_string . "</user>") for @users;
293 }
294 if (my @users = grep $important{$_->{name}}, @$remove) {
295 $self->{text}->append_text ("\n<header>Parts:</header>");
296 $self->{text}->append_text (" <user>" . $_->as_string . "</user>") for @users;
297 }
298
299 }
300
301 sub join {
302 my ($self) = @_;
303 return if $self->{joined};
304
305 $self->SUPER::join;
306
307 $self->{window}->show_all;
308 }
309
310 sub part {
311 my ($self) = @_;
312
313 $self->SUPER::part;
314 $self->destroy;
315 }
316
317 sub update_board {
318 my ($self) = @_;
319 return unless $self->{path};
320
321 my $move = int $self->{moveadj}->get_value;
322
323 my $running = $move == @{$self->{path}};
324
325 $self->{board_label}->set_text ("Move " . ($move - 1));
326
327 $self->{cur_board} = new KGS::Game::Board $self->{size};
328 $self->{cur_board}->interpret_path ([@{$self->{path}}[0 .. $move - 1]]);
329
330 for my $colour (WHITE, BLACK) {
331 $self->{userpanel}[$colour]->set_state (
332 $self->{cur_board}{captures}[$colour],
333 $self->{cur_board}{timer}[$colour],
334 ($running && $self->{lastmove_colour} == !$colour)
335 ? $self->{lastmove_time} : 0
336 );
337 }
338
339 $self->{board}->set_board ($self->{cur_board});
340 }
341
342 sub event_update_tree {
343 my ($self) = @_;
344
345 $self->{path} = $self->get_path;
346
347 if ($self->{moveadj}) {
348 my $upper = $self->{moveadj}->upper;
349 my $pos = $self->{moveadj}->get_value;
350 my $move = scalar @{$self->{path}};
351
352 $self->{moveadj}->upper ($move);
353
354 $self->{moveadj}->changed;
355 if ($pos == $upper) {
356 $self->{moveadj}->value ($move);
357 $self->{moveadj}->value_changed;
358 }
359 }
360 }
361
362 sub event_update_comments {
363 my ($self, $node, $comment, $newnode) = @_;
364 $self->SUPER::event_update_comments($node, $comment, $newnode);
365
366 my $text;
367
368 $text .= "\n<header>Move <move>$node->{move}</move>, Node <node>$node->{id}</node></header>"
369 if $newnode;
370
371 for (split /\n/, $comment) {
372 $text .= "\n";
373 if (s/^([0-9a-zA-Z]+ \[[0-9dkp\?\-]+\])://) {
374 $text .= "<user>" . (util::toxml $1) . "</user>:";
375 }
376
377 # coords only for 19x19 so far
378 $_ = util::toxml $_;
379 s{
380 (
381 \b
382 (?:[bw])?
383 [, ]{0,2}
384 [a-hj-t] # valid for upto 19x19
385 \s?
386 [1-9]?[0-9]
387 \b
388 )
389 }{
390 "<coord>$1</coord>";
391 }sgexi;
392
393 $text .= $_;
394 }
395
396 $self->{text}->append_text ($text);
397 }
398
399 sub event_join {
400 my ($self) = @_;
401 $self->SUPER::event_join;
402 }
403
404 sub event_part {
405 my ($self) = @_;
406 $self->SUPER::event_part;
407 $self->destroy;
408 }
409
410 sub event_move {
411 my ($self, $pass) = @_;
412 sound::play 1, $pass ? "pass" : "move";
413 }
414
415 sub event_update_game {
416 my ($self) = @_;
417 $self->SUPER::event_update_game;
418
419 my $title = $self->{channel} ? $self->owner->as_string . " " . $self->opponent_string : "Game Window";
420 $self->{window}->set_title("KGS Game $title");
421 $self->{title}->set_text ($title);
422
423 $self->{user}[BLACK] = $self->{user1};
424 $self->{user}[WHITE] = $self->{user2};
425
426 # show board
427
428 $self->{left}->remove ($_) for $self->{left}->get_children;
429 if ($self->is_valid) {
430 $self->{left}->add ($self->{boardbox});
431 (delete $self->{challenge})->destroy if $self->{challenge};
432 } else {
433 $self->{left}->add ($self->{challenge}->widget);
434 }
435 $self->{left}->show_all;
436
437 # view text
438
439 eval { #d#
440 my @ga;
441 $ga[0] = "\nType: " . (util::toxml $gametype{$self->type})
442 . " (" . (util::toxml $gameopt{$self->option}) . ")";
443 $ga[1] = "\nFlags:";
444 $ga[1] .= " valid" if $self->is_valid;
445 $ga[1] .= " adjourned" if $self->is_adjourned;
446 $ga[1] .= " scored" if $self->is_scored;
447 $ga[1] .= " saved" if $self->is_saved;
448
449 $ga[2] = "\nOwner: <user>" . (util::toxml $self->{user3}->as_string) . "</user>" if $self->{user3}->is_valid;
450
451 $ga[3] = "\nPlayers: <user>" . (util::toxml $self->{user2}->as_string) . "</user>"
452 . " vs. <user>" . (util::toxml $self->{user1}->as_string) . "</user>"
453 if $self->is_valid;
454
455 if ($self->is_valid) {
456 $ga[4] = "\nHandicap: " . $self->{handicap};
457 $ga[5] = "\nKomi: " . $self->{komi};
458 $ga[6] = "\nSize: " . $self->size_string;
459 }
460
461 if ($self->is_scored) {
462 $ga[7] = "\nResult: " . $self->score_string;
463 }
464
465 $text = "\n<infoblock><header>Game Update</header>";
466 for (0..7) {
467 if ($self->{gatext}[$_] ne $ga[$_]) {
468 $text .= $ga[$_];
469 }
470 }
471 $text .= "</infoblock>";
472
473 $self->{gatext} = \@ga;
474 };
475
476 $self->{text}->append_text ($text);
477 }
478
479 sub event_update_rules {
480 my ($self, $rules) = @_;
481
482 $self->{userpanel}[$_]->configure ($self->{user}[$_], $rules)
483 for BLACK, WHITE;
484
485 sound::play 3, "gamestart";
486
487 my $text = "\n<header>Game Rules</header>";
488
489 $text .= "\nRuleset: " . $ruleset{$rules->{ruleset}};
490
491 $text .= "\nTime: ";
492
493 if ($rules->{timesys} == TIMESYS_NONE) {
494 $text .= "UNLIMITED";
495 } elsif ($rules->{timesys} == TIMESYS_ABSOLUTE) {
496 $text .= util::format_time $rules->{time};
497 $text .= " ABS";
498 } elsif ($rules->{timesys} == TIMESYS_BYO_YOMI) {
499 $text .= util::format_time $rules->{time} - $rules->{interval} * $rules->{count};
500 $text .= sprintf " + %s (%d) BY", util::format_time $rules->{interval}, $rules->{count};
501 } elsif ($rules->{timesys} == TIMESYS_CANADIAN) {
502 $text .= util::format_time $rules->{time};
503 $text .= sprintf " + %s/%d CAN", util::format_time $rules->{interval}, $rules->{count};
504 }
505
506 $self->{text}->append_text ("<infoblock>$text</infoblock>");
507 }
508
509 sub inject_resign_game {
510 my ($self, $msg) = @_;
511
512 sound::play 3, "resign";
513
514 $self->{text}->append_text ("\n<infoblock><header>Resign</header>"
515 . "\n<user>"
516 . (util::toxml $self->{user}[$msg->{player}]->as_string)
517 . "</user> resigned.</infoblock>");
518 }
519
520 sub inject_final_result {
521 my ($self, $msg) = @_;
522
523 $self->{text}->append_text ("<infoblock>\n<header>Game Over</header>"
524 . "\nWhite Score " . (util::toxml $msg->{whitescore}->as_string)
525 . "\nBlack Score " . (util::toxml $msg->{blackscore}->as_string)
526 . "</infoblock>"
527 );
528 }
529
530 sub destroy {
531 my ($self) = @_;
532 $self->{userpanel}[$_] && (delete $self->{userpanel}[$_])->destroy
533 for BLACK, WHITE;
534 $self->SUPER::destroy;
535 delete $appwin::gamelist->{game}{$self->{channel}};
536 }
537
538 1;
539