| 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 |
|
