ViewVC Help
View File | Revision Log | Show Annotations | Download File
/cvs/kgsueme/kgsueme/game.pl
Revision: 1.98
Committed: Sun May 30 02:22:24 2004 UTC (20 years ago) by pcg
Content type: text/plain
Branch: MAIN
Changes since 1.97: +86 -49 lines
Log Message:
*** empty log message ***

File Contents

# Content
1 use utf8;
2
3 use Scalar::Util ();
4
5 package game::goclock;
6
7 # Lo and Behold! I admit it! The rounding stuff etc.. in goclock
8 # is completely borked.
9
10 use Time::HiRes ();
11
12 use KGS::Constants;
13
14 use Glib::Object::Subclass
15 Gtk2::Label;
16
17 sub INIT_INSTANCE {
18 my $self = shift;
19
20 $self->signal_connect (destroy => sub { $_[0]->stop });
21
22 $self->{set} = sub { };
23 $self->{format} = sub { "???" };
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 $self->{moves} > 1
61 ? $time / $self->{moves}
62 : $interval;
63 }
64 };
65
66 } else {
67 # none, or unknown
68 $self->{set} = sub { };
69 $self->{format} = sub { "---" }
70 }
71 }
72
73 sub refresh {
74 my ($self, $timestamp) = @_;
75 my $timer = $self->{time} + $self->{start} - $timestamp;
76
77 # we round the timer value slightly... the protocol isn't exact anyways,
78 # and this gives smoother timers ;)
79 my @format = $self->{format}->(int ($timer + 0.4));
80 $self->set_text ($self->{format}->(int ($timer + 0.4)));
81
82 $timer - int $timer;
83 }
84
85 sub set_time {
86 my ($self, $time) = @_;
87
88 # we ignore requests to re-set the time of a running clock.
89 # this is the easiest way to ensure that commentary etc.
90 # doesn't re-set the clock. yes, this is frickle design,
91 # but I think the protocol is to blame here, which gives
92 # very little time information. (cgoban2 also has had quite
93 # a lot of small time update problems...)
94 unless ($self->{timeout}) {
95 $self->{set}->($time->[0], $time->[1]);
96 $self->refresh ($self->{start});
97 }
98 }
99
100 sub start {
101 my ($self, $when) = @_;
102
103 $self->stop;
104
105 $self->{start} = $when;
106
107 my $timeout; $timeout = sub {
108 my $next = $self->refresh (Time::HiRes::time) * 1000;
109 $next += 1000 if $next < 0;
110 $self->{timeout} = add Glib::Timeout $next, $timeout;
111 0;
112 };
113
114 $timeout->();
115 }
116
117 sub stop {
118 my ($self) = @_;
119
120 remove Glib::Source delete $self->{timeout} if $self->{timeout};
121 }
122
123 package game::userpanel;
124
125 use Glib::Object::Subclass
126 Gtk2::HBox,
127 properties => [
128 Glib::ParamSpec->IV ("colour", "colour", "User Colour", 0, 1, 0, [qw(construct-only writable)]),
129 ];
130
131 sub INIT_INSTANCE {
132 my ($self) = @_;
133
134 $self->add (my $vbox = new Gtk2::VBox);
135
136 $vbox->add ($self->{name} = new Gtk2::Label $self->{name});
137 $vbox->add ($self->{info} = new Gtk2::Label "");
138 $vbox->add ($self->{clock} = new game::goclock); Scalar::Util::weaken $self->{clock};
139
140 $vbox->add ($self->{imagebox} = new Gtk2::VBox);
141
142 $self;
143 }
144
145 sub configure {
146 my ($self, $app, $user, $rules) = @_;
147
148 if ($self->{name}->get_text ne $user->as_string) {
149 $self->{name}->set_text ($user->as_string);
150
151 $self->{imagebox}->remove ($_) for $self->{imagebox}->get_children;
152 $self->{imagebox}->add (gtk::image_from_data undef);
153 $self->{imagebox}->show_all;
154
155 if ($user->has_pic) {
156 # the big picture...
157 $app->userpic ($user->{name}, sub {
158 return unless $self->{imagebox};
159
160 if ($_[0]) {
161 $self->{imagebox}->remove ($_) for $self->{imagebox}->get_children;
162 $self->{imagebox}->add (gtk::image_from_data $_[0]);
163 $self->{imagebox}->show_all;
164 }
165 });
166 }
167 }
168
169 $self->{clock}->configure (@{$rules}{qw(timesys time interval count)});
170 }
171
172 sub set_state {
173 my ($self, $captures, $timer, $when) = @_;
174
175 $self->{clock}->stop unless $when;
176 $self->{clock}->set_time ($timer);
177 $self->{clock}->start ($when) if $when;
178
179 $self->{info}->set_text ("$captures pris.");
180 }
181
182 package game;
183
184 use Scalar::Util qw(weaken);
185
186 use KGS::Constants;
187 use KGS::Game::Board;
188
189 use Gtk2::GoBoard;
190 use Gtk2::GoBoard::Constants;
191
192 use Glib::Object::Subclass
193 Gtk2::Window;
194
195 use base KGS::Listener::Game;
196 use base KGS::Game;
197
198 use POSIX qw(ceil);
199
200 sub new {
201 my ($self, %arg) = @_;
202 $self = $self->Glib::Object::new;
203 $self->{$_} = delete $arg{$_} for keys %arg;
204
205 gtk::state $self, "game::window", undef, window_size => [600, 500];
206
207 $self->signal_connect (destroy => sub {
208 $self->unlisten;
209 delete $self->{app}{game}{$self->{channel}};
210 %{$_[0]} = ();
211 });#d#
212
213 $self->add (my $hpane = new Gtk2::HPaned);
214 gtk::state $hpane, "game::hpane", undef, position => 500;
215
216 # LEFT PANE
217
218 $hpane->pack1 (($self->{left} = new Gtk2::VBox), 1, 0);
219
220 $self->{boardbox} = new Gtk2::VBox;
221
222 $hpane->pack1((my $vbox = new Gtk2::VBox), 1, 1);
223
224 # board box (aspect/canvas)
225
226 #$self->{boardbox}->pack_start((my $frame = new Gtk2::Frame), 0, 1, 0);
227
228 # RIGHT PANE
229
230 $hpane->pack2 ((my $vbox = new Gtk2::VBox), 1, 1);
231 $hpane->set (position_set => 1);
232
233 $vbox->pack_start ((my $frame = new Gtk2::Frame), 0, 1, 0);
234
235 {
236 $frame->add (my $vbox = new Gtk2::VBox);
237 $vbox->add ($self->{title} = new Gtk2::Label $title);
238
239 $vbox->add (my $hbox = new Gtk2::HBox);
240
241 $hbox->pack_start (($self->{board_label} = new Gtk2::Label), 0, 1, 0);
242
243 $self->{moveadj} = new Gtk2::Adjustment 1, 1, 1, 1, 5, 0;
244
245 $hbox->pack_start ((my $scale = new Gtk2::HScale $self->{moveadj}), 1, 1, 0);
246 $scale->set_draw_value (0);
247 $scale->set_digits (0);
248
249 $self->{moveadj}->signal_connect (value_changed => sub { $self->update_board });
250 }
251
252 $vbox->pack_start ((my $hbox = new Gtk2::HBox 1), 0, 1, 0);
253
254 $hbox->add ($self->{userpanel}[$_] = new game::userpanel colour => $_)
255 for COLOUR_WHITE, COLOUR_BLACK;
256
257 $vbox->pack_start (($self->{chat} = new superchat), 1, 1, 0);
258
259 $self->set_channel ($self->{channel});
260
261 $self->show_all;
262
263 $self;
264 }
265
266 sub set_channel {
267 my ($self, $channel) = @_;
268
269 $self->{channel} = $channel;
270
271 if ($self->{channel} > 0) {
272 $self->listen ($self->{conn});
273
274 $self->{rules_inlay} = $self->{chat}->new_switchable_inlay ("Game Setup:", sub { $self->draw_setup (@_) }, 1);
275 $self->{users_inlay} = $self->{chat}->new_switchable_inlay ("Users:", sub { $self->draw_users (@_) }, 1);
276
277 $self->signal_connect (delete_event => sub { $self->part; 1 });
278 $self->{chat}->signal_connect (command => sub {
279 my ($chat, $cmd, $arg) = @_;
280 if ($cmd eq "rsave") {
281 Storable::nstore { tree => $self->{tree}, curnode => $self->{curnode}, move => $self->{move} }, $arg;#d#
282 } else {
283 $self->{app}->do_command ($chat, $cmd, $arg, userlist => $self->{userlist}, game => $self);
284 }
285 });
286 }
287 }
288
289 sub event_update_users {
290 my ($self, $add, $update, $remove) = @_;
291
292 # $self->{userlist}->update ($add, $update, $remove);
293
294 $self->{challenge}{$_->{name}} && (delete $self->{challenge}{$_->{name}})->{inlay}->destroy
295 for @$remove;
296
297 $self->{users_inlay}->refresh;
298
299 my %important;
300 $important{$self->{black}{name}}++;
301 $important{$self->{white}{name}}++;
302 $important{$self->{owner}{name}}++;
303
304 if (my @users = grep $important{$_->{name}}, @$add) {
305 $self->{chat}->append_text ("\n<header>Joins:</header>");
306 $self->{chat}->append_text (" <user>" . $_->as_string . "</user>") for @users;
307 }
308 if (my @users = grep $important{$_->{name}}, @$remove) {
309 $self->{chat}->append_text ("\n<header>Parts:</header>");
310 $self->{chat}->append_text (" <user>" . $_->as_string . "</user>") for @users;
311 }
312 }
313
314 sub join {
315 my ($self) = @_;
316 return if $self->{joined};
317
318 $self->SUPER::join;
319 }
320
321 sub update_cursor {
322 my ($self) = @_;
323
324 my $move = int $self->{moveadj}->get_value;
325 my $cb;
326
327 my $running = $move == @{$self->{path}}
328 && $self->is_active;
329
330 warn "plaiyng $self->{playing} running $running teach $self->{teacher}\n";
331 warn !($self->{playing} && $running);
332 warn $self->{teacher} ne $self->{app}{conn};
333 if (!($self->{playing} && $running) && $self->{teacher} ne $self->{app}{conn}) {
334 warn "A\n";
335 $self->{board}->set (cursor_mask => 0, cursor_value => 0);
336 } elsif ($self->{black}{name} eq $self->{conn}{name}) {
337 warn "B\n";
338 $self->{board}->set (cursor_mask => MARK_B | MARK_W, cursor_value => MARK_B | MARK_GRAYED);
339 $cb = sub {
340 $self->send (upd_tree =>
341 channel => $self->{channel},
342 tree => $self->gen_move_tree (COLOUR_BLACK, $_[0], $_[1]),
343 );
344 };
345 } elsif ($self->{white}{name} eq $self->{conn}{name}) {
346 warn "C\n";
347 $self->{board}->set (cursor_mask => MARK_B | MARK_W, cursor_value => MARK_W | MARK_GRAYED);
348 $cb = sub {
349 $self->send (upd_tree =>
350 channel => $self->{channel},
351 tree => $self->gen_move_tree (COLOUR_WHITE, $_[0], $_[1]),
352 );
353 };
354 }
355
356 $self->{board_click} = $cb;
357 }
358
359 sub update_board {
360 my ($self) = @_;
361 return unless $self->{path};
362
363 my $move = int $self->{moveadj}->get_value;
364
365 my $running = $move == @{$self->{path}}
366 && !$self->{teacher}
367 && $self->is_active;
368
369 $self->{board_label}->set_text ("Move " . ($move - 1));
370
371 $self->{cur_board} = new KGS::Game::Board $self->{size};
372 $self->{cur_board}->interpret_path ([@{$self->{path}}[0 .. $move - 1]]);
373
374 for my $colour (COLOUR_WHITE, COLOUR_BLACK) {
375 $self->{userpanel}[$colour]->set_state (
376 $self->{cur_board}{captures}[$colour],
377 $self->{cur_board}{timer}[$colour],
378 ($running && $self->{lastmove_colour} == !$colour)
379 ? $self->{lastmove_time} : 0
380 );
381 }
382
383 $self->{board}->set_board ($self->{cur_board});
384
385 $self->update_cursor;
386 }
387
388 sub event_update_tree {
389 my ($self) = @_;
390
391 $self->{path} = $self->get_path;
392
393 if ($self->{moveadj}) {
394 my $upper = $self->{moveadj}->upper;
395 my $pos = $self->{moveadj}->get_value;
396 my $move = scalar @{$self->{path}};
397
398 $self->{moveadj}->upper ($move);
399
400 $self->{moveadj}->changed;
401 if ($pos == $upper) {
402 $self->{moveadj}->value ($move);
403 $self->{moveadj}->value_changed;
404 }
405 }
406 }
407
408 sub event_update_comments {
409 my ($self, $node, $comment, $newnode) = @_;
410 $self->SUPER::event_update_comments($node, $comment, $newnode);
411
412 my $text;
413
414 $text .= "\n<header>Move <move>$node->{move}</move>, Node <node>$node->{id}</node></header>"
415 if $newnode;
416
417 for (split /\n/, $comment) {
418 $text .= "\n";
419 if (s/^([0-9a-zA-Z]+ \[[0-9dkp\?\-]+\])://) {
420 $text .= "<user>" . (util::toxml $1) . "</user>:";
421 }
422
423 # coords only for 19x19 so far
424 $_ = util::toxml $_;
425 s{
426 (
427 \b
428 (?:[bw])?
429 [, ]{0,2}
430 [a-hj-t] # valid for upto 19x19
431 \s?
432 [1-9]?[0-9]
433 \b
434 )
435 }{
436 "<coord>$1</coord>";
437 }sgexi;
438
439 $text .= $_;
440 }
441
442 $self->{chat}->append_text ($text);
443 }
444
445 sub event_join {
446 my ($self) = @_;
447
448 $self->SUPER::event_join (@_);
449 $self->init_tree;
450 $self->event_update_game;
451 }
452
453 sub event_part {
454 my ($self) = @_;
455
456 $self->SUPER::event_part;
457 $self->destroy;
458 }
459
460 sub event_move {
461 my ($self, $pass) = @_;
462 sound::play 1, $pass ? "pass" : "move";
463
464 if ($self->{undo_inlay}) {
465 (delete $self->{undo_inlay})->clear;
466 }
467 }
468
469 sub event_update_game {
470 my ($self) = @_;
471
472 $self->SUPER::event_update_game;
473
474 return unless $self->{joined};
475
476 $self->{playing} = $self->{teacher} eq $self->{conn}{name}
477 || $self->is_playing ($self->{conn}{name});
478
479 my $title = defined $self->{channel}
480 ? $self->owner->as_string . " " . $self->opponent_string
481 : "Game Window";
482 $self->set_title("KGS Game $title");
483 $self->{title}->set_text ($title);
484
485 $self->{user}[COLOUR_BLACK] = $self->{black};
486 $self->{user}[COLOUR_WHITE] = $self->{white};
487
488 # show board
489 if ($self->is_inprogress) {
490 if (!$self->{boardbox}->parent) {
491 $self->{boardbox}->add ($self->{board} = new Gtk2::GoBoard size => $self->{size});
492 $self->{left}->add ($self->{boardbox});
493 $self->{board}->signal_connect (button_release => sub {
494 warn "XXX @_\n";#d#
495 if ($_[1] == 1) {
496 $self->{board_click}->($_[2], $_[3]) if $self->{board_click};
497 }
498 });
499 }
500 if (my $ch = delete $self->{challenge}) {
501 $_->{inlay}->destroy for values %$ch;
502 }
503 $self->update_cursor;
504 }
505
506 $self->{left}->show_all;
507
508 $self->{rules_inlay}->refresh;
509
510 }
511
512 sub draw_setup {
513 my ($self, $inlay) = @_;
514
515 return unless $self->{joined};
516
517 my $rules = $self->{rules};
518
519 my $text = "";
520
521 $text .= "\nTeacher: <user>" . (util::toxml $self->{teacher}) . "</user>"
522 if $self->{teacher};
523
524 $text .= "\nOwner: <user>" . (util::toxml $self->{owner}->as_string) . "</user>"
525 if $self->{owner}->is_valid;
526
527 if ($self->is_inprogress) {
528 $text .= "\nPlayers: <user>" . (util::toxml $self->{white}->as_string) . "</user>"
529 . " vs. <user>" . (util::toxml $self->{black}->as_string) . "</user>";
530 }
531 $text .= "\nType: " . util::toxml $gametype{$self->type};
532
533 $text .= "\nRuleset: " . $ruleset{$rules->{ruleset}};
534
535 $text .= "\nTime: ";
536
537 if ($rules->{timesys} == TIMESYS_NONE) {
538 $text .= "UNLIMITED";
539 } elsif ($rules->{timesys} == TIMESYS_ABSOLUTE) {
540 $text .= util::format_time $rules->{time};
541 $text .= " ABS";
542 } elsif ($rules->{timesys} == TIMESYS_BYO_YOMI) {
543 $text .= util::format_time $rules->{time};
544 $text .= sprintf " + %s (%d) BY", util::format_time $rules->{interval}, $rules->{count};
545 } elsif ($rules->{timesys} == TIMESYS_CANADIAN) {
546 $text .= util::format_time $rules->{time};
547 $text .= sprintf " + %s/%d CAN", util::format_time $rules->{interval}, $rules->{count};
548 }
549
550 $text .= "\nFlags:";
551 $text .= " private" if $self->is_private;
552 $text .= " started" if $self->is_inprogress;
553 $text .= " adjourned" if $self->is_adjourned;
554 $text .= " scored" if $self->is_scored;
555 $text .= " saved" if $self->is_saved;
556
557 if ($self->is_inprogress) {
558 $text .= "\nHandicap: " . $self->{handicap};
559 $text .= "\nKomi: " . $self->{komi};
560 $text .= "\nSize: " . $self->size_string;
561 }
562
563 if ($self->is_scored) {
564 $text .= "\nResult: " . $self->score_string;
565 }
566
567 $inlay->append_text ("<infoblock>$text</infoblock>");
568
569 }
570
571 sub event_update_rules {
572 my ($self, $rules) = @_;
573
574 $self->{rules} = $rules;
575
576 if ($self->{user}) {
577 $self->{userpanel}[$_]->configure ($self->{app}, $self->{user}[$_], $rules)
578 for COLOUR_BLACK, COLOUR_WHITE;
579 }
580
581 sound::play 3, "gamestart";
582
583 $self->{rules_inlay}->refresh;
584 }
585
586 sub inject_resign_game {
587 my ($self, $msg) = @_;
588
589 sound::play 3, "resign";
590
591 $self->{chat}->append_text ("\n<infoblock><header>Resign</header>"
592 . "\n<user>"
593 . (util::toxml $self->{user}[$msg->{player}]->as_string)
594 . "</user> resigned.</infoblock>");
595 }
596
597 sub inject_final_result {
598 my ($self, $msg) = @_;
599
600 $self->{chat}->append_text ("<infoblock>\n<header>Game Over</header>"
601 . "\nWhite Score " . (util::toxml $msg->{whitescore}->as_string)
602 . "\nBlack Score " . (util::toxml $msg->{blackscore}->as_string)
603 . "</infoblock>"
604 );
605 }
606
607 sub inject_req_undo {
608 my ($self, $msg) = @_;
609
610 my $inlay = $self->{undo_inlay} ||= $self->{chat}->new_inlay;
611 return if $inlay->{ignore};
612
613 $inlay->{count}++;
614 $inlay->clear;
615 $inlay->append_text ("\n<undo>Undo requested ($inlay->{count} times)</undo>\n");
616 $inlay->append_button ("Grant", sub {
617 $inlay->clear;
618 $self->send (grant_undo => channel => $self->{channel});
619 });
620 $inlay->append_button ("Ignore", sub {
621 $inlay->clear;
622 $inlay->{ignore} = 1;
623 # but leave inlay, so further undo requests get counted
624 });
625
626 }
627
628 sub inject_new_game {
629 my ($self, $msg) = @_;
630
631 $self->{chat}->append_text ("\n<header>ACK from server ($msg->{cid} == $self->{cid})</header>");
632 delete $self->{cid};
633 }
634
635 sub draw_challenge {
636 my ($self, $id) = @_;
637
638 my $info = $self->{challenge}{$id};
639 my $inlay = $info->{inlay};
640 my $rules = $info->{rules};
641 warn "drawchal $id\n";#d#
642 # use PApp::Util; warn PApp::Util::dumpval $challenge;#d#
643
644 my $as_black = $info->{black}{name} eq $self->{conn}{name} ? 1 : 0;;
645 my $opponent = $as_black ? $info->{white} : $info->{black};
646
647 my ($size, $time, $interval, $count);
648
649 if (!$self->{channel}) {
650 $inlay->append_text ("\nNotes: ");
651 $inlay->append_entry (\$info->{notes}, 20, "");
652 $inlay->append_text ("\nGlobal Offer: ");
653 $inlay->append_optionmenu (\$info->{flags},
654 0 => "No",
655 2 => "Yes",
656 );
657 } else {
658 $inlay->append_text ("\nNotes: " . util::toxml $info->{notes});
659 }
660
661 $inlay->append_text ("\nType: ");
662 $inlay->append_optionmenu (
663 \$info->{gametype},
664 GAMETYPE_DEMONSTRATION , "Demonstration",
665 GAMETYPE_DEMONSTRATION | GAMETYPE_PRIVATE, "Demonstration (P)",
666 GAMETYPE_TEACHING , "Teaching",
667 GAMETYPE_TEACHING | GAMETYPE_PRIVATE, "Teaching (P)",
668 GAMETYPE_SIMUL , "Simul (not yet!)",
669 GAMETYPE_FREE , "Free",
670 GAMETYPE_RATED , "Rated",
671 sub {
672 $size->set_history (2) if $_[0] eq GAMETYPE_RATED;
673 },
674 );
675
676 if ($self->{channel}) {
677 $inlay->append_text ("\nMy Colour: ");
678 $inlay->append_optionmenu (
679 \$as_black,
680 0 => "White",
681 1 => "Black",
682 sub {
683 if ($info->{$_[0] ? "black" : "white"}{name} ne $self->{conn}{name}) {
684 ($info->{black}, $info->{white}) = ($info->{white}, $info->{black});
685 }
686 }
687 );
688 }
689
690 $inlay->append_text ("\nRuleset: ");
691 $inlay->append_optionmenu (
692 \$info->{rules}{ruleset},
693 RULESET_JAPANESE , "Japanese",
694 RULESET_CHINESE , "Chinese",
695 RULESET_AGA , "AGA",
696 RULESET_NEW_ZEALAND, "New Zealand",
697 );
698
699 $inlay->append_text ("\nSize: ");
700 $size = $inlay->append_optionmenu (
701 \$info->{rules}{size}, 9 => 9, 13 => 13, 19 => 19, map +($_, $_), 2..38
702 );
703
704 if ($self->{channel}) {
705 $inlay->append_text ("\nHandicap: ");
706 $inlay->append_optionmenu (\$info->{rules}{handicap}, map +($_, $_), 0..9);
707
708 $inlay->append_text ("\nKomi: ");
709 $inlay->append_entry (\$info->{rules}{komi}, 5);
710 }
711
712 $inlay->append_text ("\nTimesys: ");
713 $inlay->append_optionmenu (
714 \$info->{rules}{timesys},
715 &TIMESYS_NONE => "None",
716 &TIMESYS_ABSOLUTE => "Absolute",
717 &TIMESYS_BYO_YOMI => "Byo Yomi",
718 &TIMESYS_CANADIAN => "Canadian",
719 sub {
720 my ($new) = @_;
721
722 if ($new eq TIMESYS_NONE) {
723 $time->hide;
724 $interval->hide;
725 $count->hide;
726 } else {
727 $time->show;
728 $time->set_text ($self->{app}{defaults}{time});
729 if ($new eq TIMESYS_ABSOLUTE) {
730 $interval->hide;
731 $count->hide;
732 } else {
733 $interval->show;
734 $count->show;
735 if ($new eq TIMESYS_BYO_YOMI) {
736 $interval->set_text ($self->{app}{defaults}{byo_time});
737 $count->set_text ($self->{app}{defaults}{byo_period});
738 } elsif ($new eq TIMESYS_CANADIAN) {
739 $interval->set_text ($self->{app}{defaults}{can_time});
740 $count->set_text ($self->{app}{defaults}{can_period});
741 }
742 }
743 }
744 }
745 );
746
747 $inlay->append_text ("\nMain Time: ");
748 $time = $inlay->append_entry (\$info->{rules}{time}, 5);
749 $inlay->append_text ("\nInterval: ");
750 $interval = $inlay->append_entry (\$info->{rules}{interval}, 3);
751 $inlay->append_text ("\nPeriods/Stones: ");
752 $count = $inlay->append_entry (\$info->{rules}{count}, 2);
753
754 $inlay->append_text ("\n");
755
756 if (!$self->{channel}) {
757 $inlay->append_button ("Create Challenge", sub {
758 $inlay->clear;
759 $self->{cid} = $self->{conn}->alloc_clientid;
760 $self->send (new_game =>
761 channel => delete $self->{roomid},
762 gametype => $info->{gametype},
763 cid => $self->{cid},
764 flags => $info->{flags},
765 rules => $info->{rules},
766 notes => $info->{notes},
767 );
768 });
769 } else {
770 $inlay->append_button ("OK", sub {
771 $inlay->clear;
772 $self->send (challenge =>
773 channel => $self->{channel},
774 black => $info->{black},
775 white => $info->{white},
776 gametype => $info->{gametype},
777 cid => $info->{cid},
778 rules => $info->{rules},
779 );
780 });
781 if (exists $self->{challenge}{""}) {
782 $inlay->append_button ("Reject", sub {
783 $inlay->clear;
784 $self->send (reject_challenge =>
785 channel => $self->{channel},
786 name => $opponent->{name},
787 gametype => $info->{gametype},
788 cid => $info->{cid},
789 rules => $info->{rules},
790 );
791 });
792 }
793 }
794 }
795
796 sub draw_users {
797 my ($self, $inlay) = @_;
798
799 for (sort keys %{$self->{users}}) {
800 $inlay->append_text (" <user>" . $self->{users}{$_}->as_string . "</user>");
801 }
802 }
803
804 sub event_challenge {
805 my ($self, $info) = @_;
806
807 my $as_black = $info->{black}->{name} eq $self->{conn}{name};
808 my $opponent = $as_black ? $info->{white} : $info->{black};
809
810 my $id = $opponent->{name};
811
812 warn "challenge from $opponent->{name}\n";#d#
813
814 $self->{challenge}{$id} = $info;
815 $self->{challenge}{$id}{inlay} = $self->{chat}->new_switchable_inlay (
816 exists $self->{challenge}{""}
817 ? "Challenge from $opponent->{name}"
818 : "Challenge to $opponent->{name}",
819 sub {
820 $self->{challenge}{$id}{inlay} = $_[0];
821 $self->draw_challenge ($id);
822 },
823 1 || !exists $self->{challenge}{""} # only open when not offerer
824 );
825 }
826
827 1;
828