my $http_timer = undef;
my $stop_pgn_fetch = 0;
my $tb_retry_timer = undef;
-my %tb_cache = ();
my $tb_lookup_running = 0;
my $last_written_json = undef;
return if ($engine->{'stopping'} && $line !~ /^bestmove/);
$engine->{'stopping'} = 0;
- if ($line =~ /^info/) {
+ if ($line =~ /^info/ && $line !~ / cluster /) {
my (@infos) = split / /, $line;
shift @infos;
$engine->{'info'} = {};
$last_move = time;
- schedule_tb_lookup();
-
#
# Output a command every move to note that we're
# still paying attention -- this is a good tradeoff,
delete $info->{'score_cp' . $mpv};
delete $info->{'score_mate' . $mpv};
+ delete $info->{'splicepos' . $mpv};
while ($x[0] eq 'cp' || $x[0] eq 'mate') {
if ($x[0] eq 'cp') {
my @pv = @{$info->{'pv' . $mpv}};
my $key = $pos->fen() . " " . join('', @pv);
my @moves = ();
+ my $splicepos;
if (exists($tbprobe_cache{$key})) {
- @moves = @{$tbprobe_cache{$key}};
+ my $c = $tbprobe_cache{$key};
+ @moves = @{$c->{'moves'}};
+ $splicepos = $c->{'splicepos'};
} else {
if ($mpv ne '') {
# Force doing at least one move of the PV.
my $pgn = Chess::PGN::Parse->new(undef, $pgn_text);
return if (!defined($pgn) || !$pgn->read_game() || ($pgn->result ne '0-1' && $pgn->result ne '1-0'));
$pgn->quick_parse_game;
- $info->{'pv' . $mpv} = \@moves;
# Splice the PV from the tablebase onto what we have so far.
+ $splicepos = scalar @moves;
for my $move (@{$pgn->moves}) {
last if $move eq '#';
last if $move eq '1-0';
push @moves, $uci_move;
}
- $tbprobe_cache{$key} = \@moves;
+ $tbprobe_cache{$key} = {
+ moves => \@moves,
+ splicepos => $splicepos
+ };
}
$info->{'pv' . $mpv} = \@moves;
} else {
$info->{'score_mate' . $mpv} = $matelen;
}
+ $info->{'splicepos' . $mpv} = $splicepos;
}
sub output {
# for new positions is off.
undef $pos_calculating_started;
- #
- # If we have tablebase data from a previous lookup, replace the
- # engine data with the data from the tablebase.
- #
- my $fen = $pos_calculating->fen();
- if (exists($tb_cache{$fen})) {
- for my $key (qw(pv score_cp score_mate nodes nps depth seldepth tbhits)) {
- delete $info->{$key . '1'};
- delete $info->{$key};
- }
- $info->{'nodes'} = 0;
- $info->{'nps'} = 0;
- $info->{'depth'} = 0;
- $info->{'seldepth'} = 0;
- $info->{'tbhits'} = 0;
-
- my $t = $tb_cache{$fen};
- my $pv = $t->{'pv'};
- my $matelen = int((1 + $t->{'score'}) / 2);
- if ($t->{'result'} eq '1/2-1/2') {
- $info->{'score_cp'} = 0;
- } elsif ($t->{'result'} eq '1-0') {
- if ($pos_calculating->{'toplay'} eq 'B') {
- $info->{'score_mate'} = -$matelen;
- } else {
- $info->{'score_mate'} = $matelen;
- }
- } else {
- if ($pos_calculating->{'toplay'} eq 'B') {
- $info->{'score_mate'} = $matelen;
- } else {
- $info->{'score_mate'} = -$matelen;
- }
- }
- $info->{'pv'} = $pv;
- $info->{'tablebase'} = 1;
- } else {
- $info->{'tablebase'} = 0;
- }
-
#
# Some programs _always_ report MultiPV, even with only one PV.
# In this case, we simply use that data as if MultiPV was never
# specified.
#
if (exists($info->{'pv1'}) && !exists($info->{'pv2'})) {
- for my $key (qw(pv score_cp score_mate nodes nps depth seldepth tbhits)) {
+ for my $key (qw(pv score_cp score_mate nodes nps depth seldepth tbhits splicepos)) {
if (exists($info->{$key . '1'})) {
$info->{$key} = $info->{$key . '1'};
} else {
$json->{'move_source_url'} = $remoteglotconf::move_source_url;
}
$json->{'score'} = score_digest($info, $pos_calculating, '');
- $json->{'using_lomonosov'} = defined($remoteglotconf::tb_serial_key);
$json->{'nodes'} = $info->{'nodes'};
$json->{'nps'} = $info->{'nps'};
move => $pretty_move,
pv => \@pretty_pv,
};
+ if (exists($info->{'splicepos' . $mpv})) {
+ $refutation_lines{$pretty_move}->{'splicepos'} = $info->{'splicepos' . $mpv};
+ }
};
}
}
}
if (exists($pos_calculating->{'history'}) &&
- defined($remoteglotconf::json_history_dir)) {
+ defined($remoteglotconf::json_history_dir) && defined($json->{'engine'}{name})) {
my $id = id_for_pos($pos_calculating);
my $filename = $remoteglotconf::json_history_dir . "/" . $id . ".json";
if ($pos->{'toplay'} eq 'B') {
$mate = -$mate;
}
- return ['m', $mate];
+ if (exists($info->{'splicepos' . $mpv})) {
+ my $sp = $info->{'splicepos' . $mpv};
+ if ($mate > 0) {
+ return ['T', $sp];
+ } else {
+ return ['t', $sp];
+ }
+ } else {
+ if ($mate > 0) {
+ return ['M', $mate];
+ } elsif ($mate < 0) {
+ return ['m', -$mate];
+ } elsif ($pos->{'toplay'} eq 'B') {
+ return ['M', 0];
+ } else {
+ return ['m', 0];
+ }
+ }
} else {
if (exists($info->{'score_cp' . $mpv})) {
my $score = $info->{'score_cp' . $mpv};
if ($pos->{'toplay'} eq 'B') {
$mate = -$mate;
}
- if ($mate > 0) {
- return sprintf "White mates in %u", $mate;
+ if (exists($info->{'splicepos' . $mpv})) {
+ my $sp = $info->{'splicepos' . $mpv};
+ if ($mate > 0) {
+ return sprintf "White wins in %u", int(($sp + 1) * 0.5);
+ } else {
+ return sprintf "Black wins in %u", int(($sp + 1) * 0.5);
+ }
} else {
- return sprintf "Black mates in %u", -$mate;
+ if ($mate > 0) {
+ return sprintf "White mates in %u", $mate;
+ } else {
+ return sprintf "Black mates in %u", -$mate;
+ }
}
} else {
if (exists($info->{'score_cp' . $mpv})) {
$dbh->commit;
}
-sub schedule_tb_lookup {
- return if (!defined($remoteglotconf::tb_serial_key));
- my $pos = $pos_calculating;
- return if (exists($tb_cache{$pos->fen()}));
-
- # If there's more than seven pieces, there's not going to be an answer,
- # so don't bother.
- return if ($pos->num_pieces() > 7);
-
- # Max one at a time. If it's still relevant when it returns,
- # schedule_tb_lookup() will be called again.
- return if ($tb_lookup_running);
-
- $tb_lookup_running = 1;
- my $url = 'http://tb7-api.chessok.com:6904/tasks/addtask?auth.login=' .
- $remoteglotconf::tb_serial_key .
- '&auth.password=aquarium&type=0&fen=' .
- URI::Escape::uri_escape($pos->fen());
- print TBLOG "Downloading $url...\n";
- AnyEvent::HTTP::http_get($url, sub {
- handle_tb_lookup_return(@_, $pos, $pos->fen());
- });
-}
-
-sub handle_tb_lookup_return {
- my ($body, $header, $pos, $fen) = @_;
- print TBLOG "Response for [$fen]:\n";
- print TBLOG $header . "\n\n";
- print TBLOG $body . "\n\n";
- eval {
- my $response = JSON::XS::decode_json($body);
- if ($response->{'ErrorCode'} != 0) {
- die "Unknown tablebase server error: " . $response->{'ErrorDesc'};
- }
- my $state = $response->{'Response'}{'StateString'};
- if ($state eq 'COMPLETE') {
- my $pgn = Chess::PGN::Parse->new(undef, $response->{'Response'}{'Moves'});
- if (!defined($pgn) || !$pgn->read_game()) {
- warn "Error in parsing PGN\n";
- } else {
- $pgn->quick_parse_game;
- my $pvpos = $pos;
- my $moves = $pgn->moves;
- my @uci_moves = ();
- for my $move (@$moves) {
- my $uci_move;
- ($pvpos, $uci_move) = $pvpos->make_pretty_move($move);
- push @uci_moves, $uci_move;
- }
- $tb_cache{$fen} = {
- result => $pgn->result,
- pv => \@uci_moves,
- score => $response->{'Response'}{'Score'},
- };
- output();
- }
- } elsif ($state =~ /QUEUED/ || $state =~ /PROCESSING/) {
- # Try again in a second. Note that if we have changed
- # position in the meantime, we might query a completely
- # different position! But that's fine.
- } else {
- die "Unknown response state " . $state;
- }
-
- # Wait a second before we schedule another one.
- $tb_retry_timer = AnyEvent->timer(after => 1.0, cb => sub {
- $tb_lookup_running = 0;
- schedule_tb_lookup();
- });
- };
- if ($@) {
- warn "Error in tablebase lookup: $@";
-
- # Don't try this one again, but don't block new lookups either.
- $tb_lookup_running = 0;
- }
-}
-
sub open_engine {
my ($cmdline, $tag, $cb) = @_;
return undef if (!defined($cmdline));
projects / remoteglot / blobdiff