1 |
#!/opt/bin/perl |
2 |
package util; |
3 |
|
4 |
sub format_time($) { |
5 |
my ($time) = @_; |
6 |
|
7 |
$time > 60*60 |
8 |
? sprintf "%d:%02d:%02d", $time / (60 * 60), $time / 60 % 60, $time % 60 |
9 |
: sprintf "%d:%02d", $time / 60 % 60, $time % 60; |
10 |
} |
11 |
|
12 |
|
13 |
package goclock; |
14 |
|
15 |
use Time::HiRes (); |
16 |
|
17 |
use Gtk2; |
18 |
use Glib::Object::Subclass Gtk2::Label; |
19 |
|
20 |
sub INIT_INSTANCE { |
21 |
my $self = shift; |
22 |
|
23 |
$self->signal_connect (destroy => sub { $_[0]->stop }); |
24 |
|
25 |
$self->{format} = sub { |
26 |
|
27 |
if ($_[0] < 0 || $self->{interval} < 0 || $self->{moves} < 0) { |
28 |
util::format_time $_[0]; |
29 |
|
30 |
} else { |
31 |
my $time = int $_[0]; |
32 |
|
33 |
if ($self->{interval} != 0) { |
34 |
$time = int (($_[0] - 1) % $self->{interval} + 1); |
35 |
} |
36 |
|
37 |
sprintf "%s/%d = %d [s/mv]", |
38 |
util::format_time $time, |
39 |
$self->{moves}, |
40 |
$self->{moves} >= 1 ? $time / $self->{moves} : $self->{interval}; |
41 |
} |
42 |
} |
43 |
|
44 |
} |
45 |
|
46 |
sub FINALIZE_INSTANCE { |
47 |
my $self = shift; |
48 |
|
49 |
$self->stop; |
50 |
} |
51 |
|
52 |
sub refresh { |
53 |
my ($self) = @_; |
54 |
|
55 |
my $timer = $self->{time}; |
56 |
print "TIM: $self->{time} $self->{moves} $self->{interval}\n"; |
57 |
|
58 |
$self->set_text ($self->{format}->($timer)); |
59 |
} |
60 |
|
61 |
sub set_time { |
62 |
my ($self, $start, $time, $moves, $interval) = @_; |
63 |
|
64 |
$self->{interval} = $interval; |
65 |
$self->{time} = $time; |
66 |
$self->{moves} = $moves; |
67 |
|
68 |
$self->refresh; |
69 |
if ($start) { |
70 |
$self->start; |
71 |
} else { |
72 |
$self->stop; |
73 |
} |
74 |
} |
75 |
|
76 |
sub start { |
77 |
my ($self, $interval) = @_; |
78 |
|
79 |
$self->stop; |
80 |
|
81 |
my $timeout; $timeout = sub { |
82 |
$self->{timeout} = add Glib::Timeout 1000, $timeout; |
83 |
$self->{time}--; |
84 |
$self->refresh; |
85 |
0; |
86 |
}; |
87 |
|
88 |
$self->{time}++; |
89 |
$timeout->(); |
90 |
} |
91 |
|
92 |
sub stop { |
93 |
my ($self) = @_; |
94 |
|
95 |
remove Glib::Source delete $self->{timeout} if $self->{timeout}; |
96 |
} |
97 |
|
98 |
|
99 |
package main; |
100 |
|
101 |
use Glib; |
102 |
use Gtk2 -init; |
103 |
use Gtk2::Helper; |
104 |
use Gtk2::SimpleList; |
105 |
use Gtk2::GoBoard; |
106 |
use Games::Go::SimpleBoard; |
107 |
use IO::Socket::INET; |
108 |
use Net::IGS; |
109 |
use strict; |
110 |
|
111 |
require Data::Dumper; |
112 |
|
113 |
my %games; |
114 |
|
115 |
my @timers; |
116 |
|
117 |
my %alphmap = ( |
118 |
A => 1, B => 2, C => 3, D => 4, |
119 |
E => 5, F => 6, G => 7, H => 8, |
120 |
|
121 |
J => 9, K => 10, L => 11, M => 12, |
122 |
N => 13, O => 14, P => 15, Q => 16, |
123 |
R => 17, S => 18, T => 19, U => 20, |
124 |
V => 21, W => 22, |
125 |
); |
126 |
|
127 |
sub dump($) { |
128 |
print Data::Dumper::Dumper ([$_[0]]); |
129 |
} |
130 |
|
131 |
sub con { |
132 |
my ($host, $port) = @_; |
133 |
|
134 |
my $socket = new IO::Socket::INET PeerAddr => $host, PeerPort => $port |
135 |
or die "cannot connect to $host:$port: $!"; |
136 |
|
137 |
$socket->autoflush (1); |
138 |
return $socket; |
139 |
} |
140 |
|
141 |
sub spawn_game_view { |
142 |
my ($igs, $gamenr) = @_; |
143 |
|
144 |
my $game = $games{$gamenr}; |
145 |
my $size = $game->{size}; |
146 |
|
147 |
return if not defined $game; |
148 |
|
149 |
my $w = Gtk2::Window->new; |
150 |
$w->set_default_size (600, 700); |
151 |
|
152 |
$w->add (my $v = new Gtk2::VBox); |
153 |
$v->pack_start ((new Gtk2::Label |
154 |
"Game $gamenr: White: $game->{white} [$game->{white_rank}] vs. Black: $game->{black} [$game->{black_rank}]"), 0, 1, 0); |
155 |
$v->pack_start ((new Gtk2::Label |
156 |
"Size: $game->{size} Handicap: $game->{handicap}"), 0, 1, 0); |
157 |
$v->pack_start ((my $clock1 = new goclock), 0, 1, 0); |
158 |
$v->pack_start ((my $clock2 = new goclock), 0, 1, 0); |
159 |
$v->pack_start ((my $msg = new Gtk2::Label), 0, 1, 0); |
160 |
$v->pack_start ((my $mv_lbl = new Gtk2::Label), 0, 1, 0); |
161 |
|
162 |
$v->pack_start ((my $board = new Gtk2::GoBoard size => $size), 1, 1, 0); |
163 |
|
164 |
|
165 |
$msg->set_text ($game->{title}); |
166 |
|
167 |
my $p3 = $igs->set_ev_cb ('game_title' => sub { |
168 |
my ($s, $gnr, $t) = @_; |
169 |
$gnr == $gamenr or return; |
170 |
$msg->set_text ($t); |
171 |
$game->{title} = $t; |
172 |
}); |
173 |
|
174 |
my $pos = $igs->set_ev_cb ('game_over' => sub { |
175 |
my ($self, $gnr, $result) = @_; |
176 |
$gnr == $gamenr or return; |
177 |
$clock1->stop; |
178 |
$clock2->stop; |
179 |
$msg->set_text ($game->{title} . ": Game Over: $result"); |
180 |
}); |
181 |
|
182 |
my $pos2 = $igs->set_ev_cb ('game_move' => sub { |
183 |
my $self = shift; |
184 |
my $gnr = shift; |
185 |
|
186 |
$gnr == $gamenr or return; |
187 |
|
188 |
my $move = shift; |
189 |
|
190 |
my $mnr = $move->{number}; |
191 |
$move->{coords} =~ m/^(.)(\d+)/; |
192 |
my $x = $alphmap{$1} - 1; |
193 |
my $y = $size - $2; |
194 |
|
195 |
my $white_mv = $move->{color} eq 'white'; |
196 |
|
197 |
$game->{moves}->[$mnr] = $move; |
198 |
my $mv = $game->{moves_struct}->[$mnr] |
199 |
= [ $x, $y, ~MARK_CIRCLE, MARK_CIRCLE | MARK_MOVE | ($white_mv ? MARK_W : MARK_B), '' ]; |
200 |
|
201 |
print "MOVE $gamenr | $mnr | $gnr : $x, $y $move->{color} = $move->{white_time} <=> $move->{black_time} | $move->{white_stones} <-> $move->{black_stones} | $game->{byo}\n"; |
202 |
|
203 |
$mv_lbl->set_text ("Move " . ($mnr + 1)); |
204 |
$clock1->set_time ((not $white_mv), $move->{white_time}, $move->{white_stones}, $game->{byo} * 60); |
205 |
$clock2->set_time ($white_mv, $move->{black_time}, $move->{black_stones}, $game->{byo} * 60); |
206 |
if ($move->{white_time} == 0 && $move->{white_stones} == -1 && $move->{black_time} == 0 && $move->{black_stones} == -1) { |
207 |
$clock1->stop (); |
208 |
$clock2->stop (); |
209 |
} |
210 |
|
211 |
my $board_state = new Games::Go::SimpleBoard $size; |
212 |
$board_state->update ($game->{moves_struct}); |
213 |
$board->set_board ($board_state); |
214 |
}); |
215 |
|
216 |
$w->signal_connect (destroy => sub { |
217 |
$igs->unset_ev_cb ('game_over', $pos); |
218 |
$igs->unset_ev_cb ('game_move', $pos2); |
219 |
$igs->unset_ev_cb ('game_title', $p3); |
220 |
$igs->feed_event ('req_unobserve', $gamenr); |
221 |
}); |
222 |
|
223 |
$w->show_all; |
224 |
} |
225 |
|
226 |
sub build_ui { |
227 |
my $igs = shift; |
228 |
|
229 |
my $win = Gtk2::Window->new; |
230 |
$win->set_default_size (600, 800); |
231 |
|
232 |
my $slist = Gtk2::SimpleList->new ( |
233 |
'N' => 'int', # game number |
234 |
'White' => 'text', |
235 |
'W Rank' => 'text', |
236 |
'Black' => 'text', |
237 |
'B Rank' => 'text', |
238 |
'Move' => 'int', |
239 |
'Size' => 'int', |
240 |
'Hand' => 'int', |
241 |
'Komi' => 'double', |
242 |
'Byo' => 'int', |
243 |
'F' => 'text', |
244 |
'R' => 'text', |
245 |
); |
246 |
|
247 |
my $plist = Gtk2::SimpleList->new ( |
248 |
'Name' => 'text', |
249 |
'Rank' => 'text', |
250 |
'Obs' => 'int', |
251 |
'Pla' => 'int', |
252 |
'Idle' => 'text', |
253 |
'Flags' => 'text', |
254 |
); |
255 |
|
256 |
$win->add (my $p = Gtk2::VPaned->new); |
257 |
$p->add1 (my $sw = Gtk2::ScrolledWindow->new); |
258 |
$sw->add ($slist); |
259 |
$p->add2 (my $hp = Gtk2::HPaned->new); |
260 |
$hp->add1 (my $sw = Gtk2::ScrolledWindow->new); |
261 |
$sw->add_with_viewport (my $v = Gtk2::VBox->new); |
262 |
$v->pack_start (my $txt = Gtk2::TextView->new, 1, 1, 0); |
263 |
$v->pack_start (my $b1 = Gtk2::Button->new ('sort'), 0, 1, 0); |
264 |
$hp->add2 (my $sw = Gtk2::ScrolledWindow->new); |
265 |
$sw->add ($plist); |
266 |
|
267 |
$b1->signal_connect (clicked => sub { |
268 |
@{$slist->{data}} = |
269 |
map { my %g = %{$games{$_}}; print "$g{number}\n"; [ @g{qw/number white white_rank black black_rank move size handicap komi byo Fflag Rflag/} ] } |
270 |
sort { $a <=> $b } keys %games; |
271 |
}); |
272 |
$slist->signal_connect (row_activated => sub { |
273 |
my ($sl, $path, $column) = @_; |
274 |
my $row_ref = $sl->get_row_data_from_path ($path); |
275 |
|
276 |
spawn_game_view ($igs, $row_ref->[0]); |
277 |
|
278 |
$igs->feed_event ("req_observe", $row_ref->[0]); |
279 |
$igs->feed_event ("req_moves", $row_ref->[0]); |
280 |
}); |
281 |
|
282 |
$p->set_position (400); |
283 |
$hp->set_position (300); |
284 |
|
285 |
$igs->set_ev_cb ('game_list' => sub { |
286 |
my %game = %{$_[1]}; |
287 |
$games{$game{number}} = { %game }; |
288 |
push @{$slist->{data}}, [ @game{qw/number white white_rank black black_rank move size handicap komi byo Fflag Rflag/} ]; |
289 |
}); |
290 |
|
291 |
$igs->set_ev_cb ('player_list' => sub { |
292 |
my %player = %{$_[1]}; |
293 |
push @{$plist->{data}}, [ @player{qw/name rank obs playing idle flags/} ]; |
294 |
# @{$plist->{data}} = sort { $a->[0] cmp $b->[0] } @{$plist->{data}}; |
295 |
}); |
296 |
|
297 |
$win->show_all (); |
298 |
} |
299 |
|
300 |
################################################################################# |
301 |
################################################################################# |
302 |
################################################################################# |
303 |
|
304 |
my $igs = new Net::IGS; |
305 |
|
306 |
$igs->init ("elmex", "lolfe123"); |
307 |
|
308 |
my $sck = con ("igs.joyjoy.net", 6969); |
309 |
|
310 |
$igs->set_writer (sub { $sck->syswrite ($_[0]) }); |
311 |
|
312 |
$igs->set_ev_cb ('recv_file' => sub { |
313 |
print "FILE [ $_[1] ]\n"; |
314 |
}); |
315 |
|
316 |
$igs->sendline ('games'); |
317 |
$igs->sendline ('players'); |
318 |
my $buffer; |
319 |
|
320 |
my $pos = $igs->set_ev_cb ('game_over' => sub { |
321 |
my ($self, $gnr, $result) = @_; |
322 |
delete $games{$gnr}; |
323 |
}); |
324 |
|
325 |
Gtk2::Helper->add_watch (fileno($sck), 'in', sub { |
326 |
my $data; |
327 |
|
328 |
my $r = $sck->sysread (my $data, 4096); |
329 |
|
330 |
if (not $r) { |
331 |
# check $r == 0 or undef # FIXME |
332 |
die "eof from server"; |
333 |
} |
334 |
|
335 |
$igs->feed_data ($data); |
336 |
|
337 |
1; |
338 |
}); |
339 |
|
340 |
build_ui ($igs); |
341 |
|
342 |
Gtk2->main; |
343 |
|