|
|
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 | |
| 209 | $self->{hpane}->pack1(($self->{left} = new Gtk2::VBox), 1, 1); |
220 | $self->{hpane}->pack1(($self->{left} = new Gtk2::VBox), 1, 0); |
| 210 | |
221 | |
| 211 | $self->{boardbox} = new Gtk2::VBox; |
222 | $self->{boardbox} = new Gtk2::VBox; |
| 212 | |
223 | |
| 213 | $self->{hpane}->pack1((my $vbox = new Gtk2::VBox), 1, 1); |
224 | $self->{hpane}->pack1((my $vbox = new Gtk2::VBox), 1, 1); |
| 214 | |
225 | |
| … | |
… | |
| 243 | $self->{canvas}->signal_connect(configure_event => \&configure_event, $self); |
254 | $self->{canvas}->signal_connect(configure_event => \&configure_event, $self); |
| 244 | $self->{canvas}->signal_connect(expose_event => \&expose_event, $self); |
255 | $self->{canvas}->signal_connect(expose_event => \&expose_event, $self); |
| 245 | |
256 | |
| 246 | # RIGHT PANE |
257 | # RIGHT PANE |
| 247 | |
258 | |
| 248 | $self->{hpane}->pack2(($self->{vpane} = new Gtk2::VPaned), 0, 0); |
259 | $self->{hpane}->pack2(($self->{vpane} = new Gtk2::VPaned), 1, 1); |
| 249 | $self->{hpane}->set(position_set => 1); |
260 | $self->{hpane}->set(position_set => 1); |
| 250 | gtk::state $self->{vpane}, "game::vpane", $self->{name}, position => 80; |
261 | gtk::state $self->{vpane}, "game::vpane", $self->{name}, position => 80; |
| 251 | |
262 | |
| 252 | $self->{vpane}->add(my $sw = new Gtk2::ScrolledWindow); |
263 | $self->{vpane}->add(my $sw = new Gtk2::ScrolledWindow); |
| 253 | $sw->set_policy("automatic", "always"); |
264 | $sw->set_policy("automatic", "always"); |
| … | |
… | |
| 650 | $self->{board_label}->set_text ("Move $move"); |
661 | $self->{board_label}->set_text ("Move $move"); |
| 651 | |
662 | |
| 652 | $self->{board} = new KGS::Game::Board $self->{size}; |
663 | $self->{board} = new KGS::Game::Board $self->{size}; |
| 653 | $self->{board}->interpret_path ([@{$self->{path}}[0 .. $move - 1]]); |
664 | $self->{board}->interpret_path ([@{$self->{path}}[0 .. $move - 1]]); |
| 654 | |
665 | |
| 655 | $self->{userpanel}[WHITE]->set_state ($self->{board}{captures}[WHITE], |
666 | for my $colour (WHITE, BLACK) { |
| 656 | $self->{board}{timer}[WHITE], |
667 | $self->{userpanel}[$colour]->set_state ( |
| 657 | $running && $self->{board}{last} == BLACK); |
668 | $self->{board}{captures}[$colour], |
| 658 | $self->{userpanel}[BLACK]->set_state ($self->{board}{captures}[BLACK], |
669 | $self->{board}{timer}[$colour], |
| 659 | $self->{board}{timer}[BLACK], |
670 | ($running && $self->{lastmove_colour} == !$colour) |
| 660 | $running && $self->{board}{last} == WHITE); |
671 | ? $self->{lastmove_time} : 0 |
|
|
672 | ); |
|
|
673 | } |
| 661 | |
674 | |
| 662 | $self->redraw ($self->repaint_board); |
675 | $self->redraw ($self->repaint_board); |
| 663 | } |
676 | } |
| 664 | |
677 | |
| 665 | sub event_update_tree { |
678 | sub event_update_tree { |
| … | |
… | |
| 689 | my ($self, $node, $comment, $newnode) = @_; |
702 | my ($self, $node, $comment, $newnode) = @_; |
| 690 | $self->SUPER::event_update_comments($node, $comment, $newnode); |
703 | $self->SUPER::event_update_comments($node, $comment, $newnode); |
| 691 | |
704 | |
| 692 | my $text; |
705 | my $text; |
| 693 | |
706 | |
| 694 | $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>" |
| 695 | if $newnode; |
708 | if $newnode; |
| 696 | |
709 | |
| 697 | for (split /\n/, $comment) { |
710 | for (split /\n/, $comment) { |
| 698 | $text .= "\n"; |
711 | $text .= "\n"; |
| 699 | if ($_ =~ s/^([0-9a-zA-Z]+ \[[0-9dkp\?\-]+\])://) { |
712 | if ($_ =~ s/^([0-9a-zA-Z]+ \[[0-9dkp\?\-]+\])://) { |
| … | |
… | |
| 721 | } |
734 | } |
| 722 | |
735 | |
| 723 | sub event_update_game { |
736 | sub event_update_game { |
| 724 | my ($self) = @_; |
737 | my ($self) = @_; |
| 725 | $self->SUPER::event_update_game; |
738 | $self->SUPER::event_update_game; |
| 726 | warn "GAME UPDATE ".join (":", %$self); |
739 | |
| 727 | warn "SAVED ".$self->is_saved; |
740 | $text = "\n<header>Game Update</header>"; |
| 728 | warn "SCORED ".$self->is_scored; |
741 | |
| 729 | warn "ADJ ".$self->is_adjourned; |
742 | $text .= "\nType: " . (util::toxml $gametype{$self->type}) |
| 730 | warn "VALID ".$self->is_valid; |
743 | . " (" . (util::toxml $gameopt{$self->option}) . ")"; |
| 731 | warn "MOVES ".$self->moves; |
744 | $text .= "\nFlags:"; |
| 732 | warn "TYPE ".$self->type; |
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); |
| 733 | |
761 | |
| 734 | $self->{left}->remove ($_) for $self->{left}->get_children; |
762 | $self->{left}->remove ($_) for $self->{left}->get_children; |
| 735 | if ($self->is_valid) { |
763 | if ($self->is_valid) { |
| 736 | $self->{left}->add ($self->{boardbox}); |
764 | $self->{left}->add ($self->{boardbox}); |
| 737 | (delete $self->{challenge})->destroy if $self->{challenge}; |
765 | (delete $self->{challenge})->destroy if $self->{challenge}; |
| 738 | } else { |
766 | } else { |
| 739 | $self->{left}->add ($self->{challenge}); |
767 | $self->{left}->add ($self->{challenge}->widget); |
| 740 | } |
768 | } |
| 741 | $self->{left}->show_all; |
769 | $self->{left}->show_all; |
| 742 | } |
770 | } |
| 743 | |
771 | |
| 744 | sub destroy { |
772 | sub destroy { |
