|
|
1 | use utf8; |
|
|
2 | |
1 | package game::goclock; |
3 | package game::goclock; |
2 | |
4 | |
3 | use Time::HiRes (); |
5 | use Time::HiRes (); |
4 | |
6 | |
5 | use KGS::Constants; |
7 | use KGS::Constants; |
… | |
… | |
16 | $self->{format} = sub { "ERROR" }; |
18 | $self->{format} = sub { "ERROR" }; |
17 | |
19 | |
18 | $self; |
20 | $self; |
19 | } |
21 | } |
20 | |
22 | |
21 | sub append_text { |
|
|
22 | my ($self, $text) = @_; |
|
|
23 | |
|
|
24 | $self->{buffer}->insert ($self->{buffer}->get_end_iter, $text); |
|
|
25 | } |
|
|
26 | |
|
|
27 | sub format_time { |
23 | sub format_time($) { |
28 | my ($time) = @_; |
24 | my ($time) = @_; |
29 | |
25 | |
30 | $time > 60*60 |
26 | $time > 60*60 |
31 | ? sprintf "%d:%02d:%02d", $time / (60 * 60), $time / 60 % 60, $time % 60 |
27 | ? sprintf "%d:%02d:%02d", $time / (60 * 60), $time / 60 % 60, $time % 60 |
32 | : sprintf "%d:%02d", $time / 60 % 60, $time % 60; |
28 | : sprintf "%d:%02d", $time / 60 % 60, $time % 60; |
… | |
… | |
46 | |
42 | |
47 | $self->{format} = sub { |
43 | $self->{format} = sub { |
48 | if ($_[0] > $low) { |
44 | if ($_[0] > $low) { |
49 | format_time $_[0] - $low; |
45 | format_time $_[0] - $low; |
50 | } else { |
46 | } else { |
51 | sprintf "%s (%d)", (format_time int ($_[0] % $interval) || $interval), $_[0] / $interval; |
47 | sprintf "%s (%d)", |
|
|
48 | format_time int ($_[0] % $interval) || $interval, |
|
|
49 | $_[0] / $interval; |
52 | } |
50 | } |
53 | }; |
51 | }; |
54 | |
52 | |
55 | } elsif ($timesys == TIMESYS_CANADIAN) { |
53 | } elsif ($timesys == TIMESYS_CANADIAN) { |
56 | my $low = $interval; |
|
|
57 | |
|
|
58 | $self->{set} = sub { $self->{time} = $_[0]; $self->{moves} = $_[1] }; |
54 | $self->{set} = sub { $self->{time} = $_[0]; $self->{moves} = $_[1] }; |
59 | |
55 | |
60 | $self->{format} = sub { |
56 | $self->{format} = sub { |
61 | if ($_[0] > $low) { |
57 | if (!$self->{moves}) { |
62 | format_time $_[0] - $low; |
58 | format_time $_[0] - $low; |
63 | } else { |
59 | } else { |
64 | sprintf "%s / %d", (format_time int($_[0] % $interval) || $interval), $self->{moves}; |
60 | my $time = int($_[0] % $interval) || $interval; |
|
|
61 | sprintf "%s/%d {%d}", |
|
|
62 | format_time $time, |
|
|
63 | $self->{moves}, |
|
|
64 | int ($time / ($self->{moves} || 1)); |
|
|
65 | |
65 | } |
66 | } |
66 | }; |
67 | }; |
67 | |
68 | |
68 | } else { |
69 | } else { |
69 | # none, or unknown |
70 | # none, or unknown |
… | |
… | |
72 | } |
73 | } |
73 | } |
74 | } |
74 | |
75 | |
75 | sub refresh { |
76 | sub refresh { |
76 | my ($self, $timestamp) = @_; |
77 | my ($self, $timestamp) = @_; |
77 | my $timer = $self->{time} + $self->{start} - $timestamp; |
78 | my $timer = $self->{time} + $self->{start} - $timestamp + 0.5; |
|
|
79 | |
|
|
80 | # we round the timer value slightly... the protocol isn't exact anyways, |
|
|
81 | # and this gives smoother timers ;) |
78 | $self->{widget}->set_text ($self->{format}->($timer)); |
82 | $self->{widget}->set_text ($self->{format}->(int ($timer + 0.4))); |
79 | |
83 | |
80 | $timer - int $timer; |
84 | $timer - int $timer; |
81 | } |
85 | } |
82 | |
86 | |
83 | sub set_time { |
87 | sub set_time { |
84 | my ($self, $time) = @_; |
88 | my ($self, $time) = @_; |
85 | |
89 | |
86 | # we ignore requests to re-set the time of a running clock. |
90 | # we ignore requests to re-set the time of a running clock. |
87 | # this is the easiest way to ensure that commentary etc. |
91 | # this is the easiest way to ensure that commentary etc. |
88 | # doesn't re-set the clock. yes, this is frickle design, |
92 | # doesn't re-set the clock. yes, this is frickle design, |
89 | # but I think the protoocl is to blame here, which gives |
93 | # but I think the protocol is to blame here, which gives |
90 | # very little time information. (cgoban2 also has had quite |
94 | # very little time information. (cgoban2 also has had quite |
91 | # a lot of small time update problems...) |
95 | # a lot of small time update problems...) |
92 | unless ($self->{timeout}) { |
96 | unless ($self->{timeout}) { |
93 | $self->{set}->($time->[0], $time->[1]); |
97 | $self->{set}->($time->[0], $time->[1]); |
94 | $self->refresh ($self->{start}); |
98 | $self->refresh ($self->{start}); |
95 | } |
99 | } |
96 | } |
100 | } |
97 | |
101 | |
98 | sub start { |
102 | sub start { |
99 | my ($self) = @_; |
103 | my ($self, $when) = @_; |
100 | |
104 | |
101 | return if $self->{timeout}; |
105 | $self->stop; |
102 | |
106 | |
103 | # this is correct, since we assume the last message triggered a start |
107 | $self->{start} = $when; |
104 | $self->{start} = $KGS::Protocol::NOW; |
|
|
105 | |
108 | |
106 | my $timeout; $timeout = sub { |
109 | my $timeout; $timeout = sub { |
107 | # -100 means we run the timer a bit earlier to avoid 10.99 => 10s roundings. |
|
|
108 | # we "could" cheat by precalculating the time, but I feel uneasy about both |
|
|
109 | # ways to cheat. |
|
|
110 | my $next = int ($self->refresh (Time::HiRes::time) * 1000) - 100; |
110 | my $next = $self->refresh (Time::HiRes::time) * 1000; |
111 | $next += 1000 if $next < 0; |
111 | $next += 1000 if $next < 0; |
112 | $self->{timeout} = add Glib::Timeout $next, $timeout; |
112 | $self->{timeout} = add Glib::Timeout $next, $timeout; |
113 | 0; |
113 | 0; |
114 | }; |
114 | }; |
115 | |
115 | |
… | |
… | |
142 | |
142 | |
143 | $vbox->add ($self->{name} = new Gtk2::Label $self->{name}); |
143 | $vbox->add ($self->{name} = new Gtk2::Label $self->{name}); |
144 | $vbox->add ($self->{info} = new Gtk2::Label ""); |
144 | $vbox->add ($self->{info} = new Gtk2::Label ""); |
145 | $vbox->add (($self->{clock} = new game::goclock)->widget); |
145 | $vbox->add (($self->{clock} = new game::goclock)->widget); |
146 | |
146 | |
|
|
147 | $vbox->add ($self->{imagebox} = new Gtk2::VBox); |
|
|
148 | |
147 | $self; |
149 | $self; |
148 | } |
150 | } |
149 | |
151 | |
150 | sub set_rules { |
152 | sub set_rules { |
151 | my ($self, $rules) = @_; |
153 | my ($self, $rules) = @_; |
152 | |
154 | |
153 | if ($self->{name}->get_text ne $rules->{player}[$self->{colour}]) { |
155 | if ($self->{name}->get_text ne $rules->{player}[$self->{colour}]) { |
154 | $self->{name}->set_text ($rules->{player}[$self->{colour}]); |
156 | $self->{name}->set_text ($rules->{player}[$self->{colour}]); |
155 | |
157 | |
|
|
158 | $self->{imagebox}->remove ($_) for $self->{imagebox}->get_children; |
|
|
159 | $self->{imagebox}->add (gtk::image_from_data undef); |
|
|
160 | $self->{imagebox}->show_all; |
|
|
161 | |
156 | # the big picture... |
162 | # the big picture... |
157 | appwin::userpic ($rules->{player}[$self->{colour}], sub { |
163 | appwin::userpic ($rules->{player}[$self->{colour}], sub { |
|
|
164 | return unless $self->{imagebox}; |
|
|
165 | if ($_[0]) { |
|
|
166 | $self->{imagebox}->remove ($_) for $self->{imagebox}->get_children; |
158 | $self->{widget}->add (gtk::image_from_data $_[0]) if $_[0]; |
167 | $self->{imagebox}->add (gtk::image_from_data $_[0]); |
159 | $self->{widget}->show_all; |
168 | $self->{imagebox}->show_all; |
160 | # undef => show sth. funny |
169 | } |
161 | }); |
170 | }); |
162 | } |
171 | } |
163 | |
172 | |
164 | $self->{clock}->set_rules (@{$rules->{rules}}{qw(timesys time interval count)}); |
173 | $self->{clock}->set_rules (@{$rules->{rules}}{qw(timesys time interval count)}); |
165 | } |
174 | } |
166 | |
175 | |
167 | sub set_state { |
176 | sub set_state { |
168 | my ($self, $captures, $timer, $running) = @_; |
177 | my ($self, $captures, $timer, $when) = @_; |
169 | |
178 | |
170 | $self->{clock}->stop unless $running; |
179 | $self->{clock}->stop unless $when; |
171 | $self->{clock}->set_time ($timer); |
180 | $self->{clock}->set_time ($timer); |
172 | $self->{clock}->start if $running; |
181 | $self->{clock}->start ($when) if $when; |
173 | |
182 | |
174 | $self->{info}->set_text ("$captures pris."); |
183 | $self->{info}->set_text ("$captures pris."); |
175 | } |
184 | } |
176 | |
185 | |
177 | package game; |
186 | package game; |
… | |
… | |
204 | }); |
213 | }); |
205 | |
214 | |
206 | $self->{window}->add($self->{hpane} = new Gtk2::HPaned); |
215 | $self->{window}->add($self->{hpane} = new Gtk2::HPaned); |
207 | gtk::state $self->{hpane}, "game::hpane", undef, position => 500; |
216 | gtk::state $self->{hpane}, "game::hpane", undef, position => 500; |
208 | |
217 | |
|
|
218 | # LEFT PANE |
|
|
219 | |
|
|
220 | $self->{hpane}->pack1(($self->{left} = new Gtk2::VBox), 1, 0); |
|
|
221 | |
|
|
222 | $self->{boardbox} = new Gtk2::VBox; |
|
|
223 | |
209 | $self->{hpane}->pack1((my $vbox = new Gtk2::VBox), 1, 1); |
224 | $self->{hpane}->pack1((my $vbox = new Gtk2::VBox), 1, 1); |
210 | |
225 | |
|
|
226 | # challenge |
|
|
227 | |
|
|
228 | $self->{challenge} = new challenge channel => $self->{channel}; |
|
|
229 | |
|
|
230 | # board box (aspect/canvas) |
|
|
231 | |
211 | $vbox->pack_start((my $frame = new Gtk2::Frame), 0, 1, 0); |
232 | $self->{boardbox}->pack_start((my $frame = new Gtk2::Frame), 0, 1, 0); |
212 | |
233 | |
213 | { |
234 | { |
214 | $frame->add(my $vbox = new Gtk2::VBox); |
235 | $frame->add(my $vbox = new Gtk2::VBox); |
215 | $vbox->add($self->{title} = new Gtk2::Label $title); |
236 | $vbox->add($self->{title} = new Gtk2::Label $title); |
216 | |
237 | |
… | |
… | |
220 | $scale->set_draw_value (0); |
241 | $scale->set_draw_value (0); |
221 | $scale->set_digits (0); |
242 | $scale->set_digits (0); |
222 | |
243 | |
223 | $self->{moveadj}->signal_connect (value_changed => sub { $self->update_board }); |
244 | $self->{moveadj}->signal_connect (value_changed => sub { $self->update_board }); |
224 | } |
245 | } |
225 | |
246 | |
226 | $vbox->pack_start((my $aspect_frame = new Gtk2::AspectFrame "", 0.5, 0.5, 1, 0), 1, 1, 0); |
247 | $self->{boardbox}->pack_start((my $aspect_frame = new Gtk2::AspectFrame "", 0.5, 0.5, 1, 0), 1, 1, 0); |
227 | $aspect_frame->set (border_width => 0, shadow_type => 'none', label_xalign => 0.5); |
248 | $aspect_frame->set (border_width => 0, shadow_type => 'none', label_xalign => 0.5); |
228 | $self->{board_label} = $aspect_frame->get_label_widget; |
249 | $self->{board_label} = $aspect_frame->get_label_widget; |
229 | |
250 | |
230 | $aspect_frame->add($self->{canvas} = new Gtk2::DrawingArea); |
251 | $aspect_frame->add($self->{canvas} = new Gtk2::DrawingArea); |
231 | $self->{canvas}->double_buffered (0) if $::config->{conserve_memory}; |
252 | $self->{canvas}->double_buffered (0) if $::config->{conserve_memory}; |
… | |
… | |
233 | $self->{canvas}->signal_connect(configure_event => \&configure_event, $self); |
254 | $self->{canvas}->signal_connect(configure_event => \&configure_event, $self); |
234 | $self->{canvas}->signal_connect(expose_event => \&expose_event, $self); |
255 | $self->{canvas}->signal_connect(expose_event => \&expose_event, $self); |
235 | |
256 | |
236 | # RIGHT PANE |
257 | # RIGHT PANE |
237 | |
258 | |
238 | $self->{hpane}->pack2(($self->{vpane} = new Gtk2::VPaned), 0, 0); |
259 | $self->{hpane}->pack2(($self->{vpane} = new Gtk2::VPaned), 1, 1); |
239 | $self->{hpane}->set(position_set => 1); |
260 | $self->{hpane}->set(position_set => 1); |
240 | gtk::state $self->{vpane}, "game::vpane", $self->{name}, position => 80; |
261 | gtk::state $self->{vpane}, "game::vpane", $self->{name}, position => 80; |
241 | |
262 | |
242 | $self->{vpane}->add(my $sw = new Gtk2::ScrolledWindow); |
263 | $self->{vpane}->add(my $sw = new Gtk2::ScrolledWindow); |
243 | $sw->set_policy("automatic", "always"); |
264 | $sw->set_policy("automatic", "always"); |
… | |
… | |
257 | my $text = $self->{entry}->get_text; |
278 | my $text = $self->{entry}->get_text; |
258 | $self->say($text) if $text =~ /\S/; |
279 | $self->say($text) if $text =~ /\S/; |
259 | $self->{entry}->set_text(""); |
280 | $self->{entry}->set_text(""); |
260 | }); |
281 | }); |
261 | |
282 | |
|
|
283 | $self->event_update_game; |
262 | $self; |
284 | $self; |
263 | } |
285 | } |
264 | |
286 | |
265 | sub event_update_users { |
287 | sub event_update_users { |
266 | my ($self, $add, $update, $remove) = @_; |
288 | my ($self, $add, $update, $remove) = @_; |
… | |
… | |
639 | $self->{board_label}->set_text ("Move $move"); |
661 | $self->{board_label}->set_text ("Move $move"); |
640 | |
662 | |
641 | $self->{board} = new KGS::Game::Board $self->{size}; |
663 | $self->{board} = new KGS::Game::Board $self->{size}; |
642 | $self->{board}->interpret_path ([@{$self->{path}}[0 .. $move - 1]]); |
664 | $self->{board}->interpret_path ([@{$self->{path}}[0 .. $move - 1]]); |
643 | |
665 | |
644 | $self->{userpanel}[WHITE]->set_state ($self->{board}{captures}[WHITE], |
666 | for my $colour (WHITE, BLACK) { |
645 | $self->{board}{timer}[WHITE], |
667 | $self->{userpanel}[$colour]->set_state ( |
646 | $running && $self->{board}{last} == BLACK); |
668 | $self->{board}{captures}[$colour], |
647 | $self->{userpanel}[BLACK]->set_state ($self->{board}{captures}[BLACK], |
669 | $self->{board}{timer}[$colour], |
648 | $self->{board}{timer}[BLACK], |
670 | ($running && $self->{lastmove_colour} == !$colour) |
649 | $running && $self->{board}{last} == WHITE); |
671 | ? $self->{lastmove_time} : 0 |
|
|
672 | ); |
|
|
673 | } |
650 | |
674 | |
651 | $self->redraw ($self->repaint_board); |
675 | $self->redraw ($self->repaint_board); |
652 | } |
676 | } |
653 | |
677 | |
654 | sub event_update_tree { |
678 | sub event_update_tree { |
… | |
… | |
678 | my ($self, $node, $comment, $newnode) = @_; |
702 | my ($self, $node, $comment, $newnode) = @_; |
679 | $self->SUPER::event_update_comments($node, $comment, $newnode); |
703 | $self->SUPER::event_update_comments($node, $comment, $newnode); |
680 | |
704 | |
681 | my $text; |
705 | my $text; |
682 | |
706 | |
683 | $text .= "\n<header>Move <move>$node->{move}</move>, <header>Node <node>$node->{id}</node></header>" |
707 | $text .= "\n<header>Move <move>$node->{move}</move>, Node <node>$node->{id}</node></header>" |
684 | if $newnode; |
708 | if $newnode; |
685 | |
709 | |
686 | for (split /\n/, $comment) { |
710 | for (split /\n/, $comment) { |
687 | $text .= "\n"; |
711 | $text .= "\n"; |
688 | if ($_ =~ s/^([0-9a-zA-Z]+ \[[0-9dkp\?\-]+\])://) { |
712 | if ($_ =~ s/^([0-9a-zA-Z]+ \[[0-9dkp\?\-]+\])://) { |
… | |
… | |
692 | } |
716 | } |
693 | |
717 | |
694 | $self->{text}->append_text ($text); |
718 | $self->{text}->append_text ($text); |
695 | } |
719 | } |
696 | |
720 | |
|
|
721 | sub event_join { |
|
|
722 | my ($self) = @_; |
|
|
723 | $self->SUPER::event_join; |
|
|
724 | } |
|
|
725 | |
697 | sub event_part { |
726 | sub event_part { |
698 | my ($self) = @_; |
727 | my ($self) = @_; |
699 | $self->SUPER::event_part; |
728 | $self->SUPER::event_part; |
700 | } |
729 | } |
701 | |
730 | |
… | |
… | |
705 | } |
734 | } |
706 | |
735 | |
707 | sub event_update_game { |
736 | sub event_update_game { |
708 | my ($self) = @_; |
737 | my ($self) = @_; |
709 | $self->SUPER::event_update_game; |
738 | $self->SUPER::event_update_game; |
710 | warn "UPDATE GAME";#d# |
739 | |
|
|
740 | $text = "\n<header>Game Update</header>"; |
|
|
741 | |
|
|
742 | $text .= "\nType: " . (util::toxml $gametype{$self->type}) |
|
|
743 | . " (" . (util::toxml $gameopt{$self->option}) . ")"; |
|
|
744 | $text .= "\nFlags:"; |
|
|
745 | $text .= " valid" if $self->is_valid; |
|
|
746 | $text .= " adjourned" if $self->is_adjourned; |
|
|
747 | $text .= " scored" if $self->is_scored; |
|
|
748 | $text .= " saved" if $self->is_saved; |
|
|
749 | |
|
|
750 | $text .= "\nWhite: <user>" . (util::toxml $self->{user1}->as_string) . "</user>"; |
|
|
751 | $text .= "\nBlack: <user>" . (util::toxml $self->{user2}->as_string) . "</user>"; |
|
|
752 | $text .= "\nOwner: <user>" . (util::toxml $self->{user3}->as_string) . "</user>" if $self->{user3}->is_valid; |
|
|
753 | |
|
|
754 | if ($self->is_valid) { |
|
|
755 | $text .= "\nHandicap: " . $self->{handicap}; |
|
|
756 | $text .= "\nKomi: " . $self->{komi}; |
|
|
757 | $text .= "\nSize: " . $self->size_string; |
|
|
758 | } |
|
|
759 | |
|
|
760 | $self->{text}->append_text ($text); |
|
|
761 | |
|
|
762 | $self->{left}->remove ($_) for $self->{left}->get_children; |
|
|
763 | if ($self->is_valid) { |
|
|
764 | $self->{left}->add ($self->{boardbox}); |
|
|
765 | (delete $self->{challenge})->destroy if $self->{challenge}; |
|
|
766 | } else { |
|
|
767 | $self->{left}->add ($self->{challenge}->widget); |
|
|
768 | } |
|
|
769 | $self->{left}->show_all; |
711 | } |
770 | } |
712 | |
771 | |
713 | sub destroy { |
772 | sub destroy { |
714 | my ($self) = @_; |
773 | my ($self) = @_; |
715 | (delete $self->{userpanel}[WHITE])->destroy if $self->{userpanel}[WHITE]; |
774 | (delete $self->{userpanel}[WHITE])->destroy if $self->{userpanel}[WHITE]; |