ViewVC Help
View File | Revision Log | Show Annotations | Download File
/cvs/kgsueme/kgsueme/game.pl
Revision: 1.67
Committed: Sat Jun 28 16:46:51 2003 UTC (20 years, 11 months ago) by pcg
Content type: text/plain
Branch: MAIN
Changes since 1.66: +3 -1 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 $vbox->add (my $hbox = new Gtk2::HBox);
236
237 $hbox->pack_start (($self->{board_label} = new Gtk2::Label), 0, 1, 0);
238
239 $self->{moveadj} = new Gtk2::Adjustment 1, 1, 1, 1, 5, 0;
240
241 $hbox->pack_start ((my $scale = new Gtk2::HScale $self->{moveadj}), 1, 1, 0);
242 $scale->set_draw_value (0);
243 $scale->set_digits (0);
244
245 $self->{moveadj}->signal_connect (value_changed => sub { $self->update_board });
246 }
247
248 $self->{boardbox}->add ($self->{board} = new Gtk2::GoBoard 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 = defined $self->{channel}
420 ? $self->owner->as_string . " " . $self->opponent_string
421 : "Game Window";
422 $self->{window}->set_title("KGS Game $title");
423 $self->{title}->set_text ($title);
424
425 $self->{user}[BLACK] = $self->{user1};
426 $self->{user}[WHITE] = $self->{user2};
427
428 # show board
429
430 $self->{left}->remove ($_) for $self->{left}->get_children;
431 if ($self->is_valid) {
432 $self->{left}->add ($self->{boardbox});
433 (delete $self->{challenge})->destroy if $self->{challenge};
434 } else {
435 $self->{left}->add ($self->{challenge}->widget);
436 }
437 $self->{left}->show_all;
438
439 # view text
440
441 eval { #d#
442 my @ga;
443 $ga[0] = "\nType: " . (util::toxml $gametype{$self->type})
444 . " (" . (util::toxml $gameopt{$self->option}) . ")";
445 $ga[1] = "\nFlags:";
446 $ga[1] .= " valid" if $self->is_valid;
447 $ga[1] .= " adjourned" if $self->is_adjourned;
448 $ga[1] .= " scored" if $self->is_scored;
449 $ga[1] .= " saved" if $self->is_saved;
450
451 $ga[2] = "\nOwner: <user>" . (util::toxml $self->{user3}->as_string) . "</user>" if $self->{user3}->is_valid;
452
453 $ga[3] = "\nPlayers: <user>" . (util::toxml $self->{user2}->as_string) . "</user>"
454 . " vs. <user>" . (util::toxml $self->{user1}->as_string) . "</user>"
455 if $self->is_valid;
456
457 if ($self->is_valid) {
458 $ga[4] = "\nHandicap: " . $self->{handicap};
459 $ga[5] = "\nKomi: " . $self->{komi};
460 $ga[6] = "\nSize: " . $self->size_string;
461 }
462
463 if ($self->is_scored) {
464 $ga[7] = "\nResult: " . $self->score_string;
465 }
466
467 $text = "\n<infoblock><header>Game Update</header>";
468 for (0..7) {
469 if ($self->{gatext}[$_] ne $ga[$_]) {
470 $text .= $ga[$_];
471 }
472 }
473 $text .= "</infoblock>";
474
475 $self->{gatext} = \@ga;
476 };
477
478 $self->{text}->append_text ($text);
479 }
480
481 sub event_update_rules {
482 my ($self, $rules) = @_;
483
484 $self->{userpanel}[$_]->configure ($self->{user}[$_], $rules)
485 for BLACK, WHITE;
486
487 sound::play 3, "gamestart";
488
489 my $text = "\n<header>Game Rules</header>";
490
491 $text .= "\nRuleset: " . $ruleset{$rules->{ruleset}};
492
493 $text .= "\nTime: ";
494
495 if ($rules->{timesys} == TIMESYS_NONE) {
496 $text .= "UNLIMITED";
497 } elsif ($rules->{timesys} == TIMESYS_ABSOLUTE) {
498 $text .= util::format_time $rules->{time};
499 $text .= " ABS";
500 } elsif ($rules->{timesys} == TIMESYS_BYO_YOMI) {
501 $text .= util::format_time $rules->{time} - $rules->{interval} * $rules->{count};
502 $text .= sprintf " + %s (%d) BY", util::format_time $rules->{interval}, $rules->{count};
503 } elsif ($rules->{timesys} == TIMESYS_CANADIAN) {
504 $text .= util::format_time $rules->{time};
505 $text .= sprintf " + %s/%d CAN", util::format_time $rules->{interval}, $rules->{count};
506 }
507
508 $self->{text}->append_text ("<infoblock>$text</infoblock>");
509 }
510
511 sub inject_resign_game {
512 my ($self, $msg) = @_;
513
514 sound::play 3, "resign";
515
516 $self->{text}->append_text ("\n<infoblock><header>Resign</header>"
517 . "\n<user>"
518 . (util::toxml $self->{user}[$msg->{player}]->as_string)
519 . "</user> resigned.</infoblock>");
520 }
521
522 sub inject_final_result {
523 my ($self, $msg) = @_;
524
525 $self->{text}->append_text ("<infoblock>\n<header>Game Over</header>"
526 . "\nWhite Score " . (util::toxml $msg->{whitescore}->as_string)
527 . "\nBlack Score " . (util::toxml $msg->{blackscore}->as_string)
528 . "</infoblock>"
529 );
530 }
531
532 sub destroy {
533 my ($self) = @_;
534 $self->{userpanel}[$_] && (delete $self->{userpanel}[$_])->destroy
535 for BLACK, WHITE;
536 $self->SUPER::destroy;
537 delete $appwin::gamelist->{game}{$self->{channel}};
538 }
539
540 1;
541