X-Git-Url: https://git.sesse.net/?a=blobdiff_plain;f=remoteglot.pl;h=8b3a0b776f40678ae3c6e58244580a5fd6e32c60;hb=8733e976299634c8bce83bc8908a99ff669bc2fd;hp=66fb2ff7bb83f3cfce508f1c267a59f796988403;hpb=bdf7fb246fa3fcf64350d8edd3f3a9ea9c32f46f;p=remoteglot diff --git a/remoteglot.pl b/remoteglot.pl index 66fb2ff..8b3a0b7 100755 --- a/remoteglot.pl +++ b/remoteglot.pl @@ -35,7 +35,6 @@ my $output_timer = undef; 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; @@ -76,17 +75,20 @@ my $last_move; my $last_text = ''; my ($pos_calculating, $pos_calculating_second_engine); -uciprint($engine, "setoption name UCI_AnalyseMode value true"); -while (my ($key, $value) = each %remoteglotconf::engine_config) { - uciprint($engine, "setoption name $key value $value"); -} +# If not undef, we've started calculating this position but haven't ever given out +# any analysis for it, so we're on a forced timer to do so. +my $pos_calculating_started = undef; + +# If not undef, we've output this position, but without a main PV, so we're on +# _another_ forced timer to do so. +my $pos_pv_started = undef; +my $last_output_had_pv = 0; + +setoptions($engine, \%remoteglotconf::engine_config); uciprint($engine, "ucinewgame"); if (defined($engine2)) { - uciprint($engine2, "setoption name UCI_AnalyseMode value true"); - while (my ($key, $value) = each %remoteglotconf::engine2_config) { - uciprint($engine2, "setoption name $key value $value"); - } + setoptions($engine2, \%remoteglotconf::engine2_config); uciprint($engine2, "setoption name MultiPV value 500"); uciprint($engine2, "ucinewgame"); } @@ -124,7 +126,7 @@ if (defined($remoteglotconf::server)) { ); } if (defined($remoteglotconf::target)) { - if ($remoteglotconf::target =~ /^https?:/) { + if ($remoteglotconf::target =~ /^(?:\/|https?:)/) { fetch_pgn($remoteglotconf::target); } elsif (defined($t)) { $t->cmd("observe $remoteglotconf::target"); @@ -149,7 +151,7 @@ sub handle_uci { return if ($engine->{'stopping'} && $line !~ /^bestmove/); $engine->{'stopping'} = 0; - if ($line =~ /^info/) { + if ($line =~ /^info/ && $line !~ / cluster /) { my (@infos) = split / /, $line; shift @infos; @@ -248,9 +250,26 @@ sub handle_fics { # Starts periodic fetching of PGNs from the given URL. sub fetch_pgn { my ($url) = @_; - AnyEvent::HTTP::http_get($url, sub { - handle_pgn(@_, $url); - }); + if ($url =~ m#^/#) { # Local file. + eval { + local $/ = undef; + open my $fh, "<", $url + or die "$url: $!"; + my $pgn = <$fh>; + close $fh; + handle_pgn($pgn, '', $url); + }; + if ($@) { + warn "$url: $@"; + $http_timer = AnyEvent->timer(after => 1.0, cb => sub { + fetch_pgn($url); + }); + } + } else { + AnyEvent::HTTP::http_get($url, sub { + handle_pgn(@_, $url); + }); + } } my ($last_pgn_white, $last_pgn_black); @@ -290,6 +309,7 @@ sub handle_pgn { my $pos; if (exists($tags->{'FEN'})) { $pos = Position->from_fen($tags->{'FEN'}); + $pos->{'last_move'} = 'none'; $pos->{'player_w'} = $white; $pos->{'player_b'} = $black; $pos->{'start_fen'} = $tags->{'FEN'}; @@ -299,6 +319,8 @@ sub handle_pgn { if (exists($tags->{'Variant'}) && $tags->{'Variant'} =~ /960|fischer/i) { $pos->{'chess960'} = 1; + } else { + $pos->{'chess960'} = 0; } my $moves = $pgn->moves; my @uci_moves = (); @@ -316,9 +338,12 @@ sub handle_pgn { if ($pgn->result eq '1-0' || $pgn->result eq '1/2-1/2' || $pgn->result eq '0-1') { $pos->{'result'} = $pgn->result; } - $pos->{'history'} = \@repretty_moves; + my @extra_moves = (); + $pos = extend_from_manual_override($pos, \@repretty_moves, \@extra_moves); extract_clock($pgn, $pos); + $pos->{'history'} = \@repretty_moves; + $pos->{'extra_moves'} = \@extra_moves; # Sometimes, PGNs lose a move or two for a short while, # or people push out new ones non-atomically. @@ -374,12 +399,23 @@ sub handle_position { # the position.) # # Do not output anything new to the main analysis; that's - # going to be obsolete really soon. + # going to be obsolete really soon. (Exception: If we've never + # output anything for this move, ie., it didn't hit the 200ms + # limit, spit it out to the user anyway. It's probably a really + # fast blitz game or something, and it's good to show the moves + # as they come in even without great analysis.) $pos_calculating->{'white_clock'} = $pos->{'white_clock'}; $pos_calculating->{'black_clock'} = $pos->{'black_clock'}; delete $pos_calculating->{'white_clock_target'}; delete $pos_calculating->{'black_clock_target'}; - output_json(1); + + if (defined($pos_calculating_started)) { + output_json(0); + } else { + output_json(1); + } + $pos_calculating_started = [Time::HiRes::gettimeofday]; + $pos_pv_started = undef; # Ask the engine to stop; we will throw away its data until it # sends us "bestmove", signaling the end of it. @@ -390,22 +426,24 @@ sub handle_position { # It's wrong to just give the FEN (the move history is useful, # and per the UCI spec, we should really have sent "ucinewgame"), # but it's easier, and it works around a Stockfish repetition issue. - if ($engine->{'chess960'} != $pos->is_chess960()) { - uciprint($engine, "setoption UCI_Chess960 " . ($pos->is_chess960() ? 'true' : 'false')); - $engine->{'chess960'} = $pos->is_chess960(); + if ($engine->{'chess960'} != $pos->{'chess960'}) { + uciprint($engine, "setoption name UCI_Chess960 value " . ($pos->{'chess960'} ? 'true' : 'false')); + $engine->{'chess960'} = $pos->{'chess960'}; } uciprint($engine, "position fen " . $pos->fen()); uciprint($engine, "go infinite"); $pos_calculating = $pos; + $pos_calculating_started = [Time::HiRes::gettimeofday]; + $pos_pv_started = undef; if (defined($engine2)) { if (defined($pos_calculating_second_engine)) { $engine2->{'stopping'} = 1; uciprint($engine2, "stop"); } - if ($engine2->{'chess960'} != $pos->is_chess960()) { - uciprint($engine2, "setoption UCI_Chess960 " . ($pos->is_chess960() ? 'true' : 'false')); - $engine2->{'chess960'} = $pos->is_chess960(); + if ($engine2->{'chess960'} != $pos->{'chess960'}) { + uciprint($engine2, "setoption name UCI_Chess960 value " . ($pos->{'chess960'} ? 'true' : 'false')); + $engine2->{'chess960'} = $pos->{'chess960'}; } uciprint($engine2, "position fen " . $pos->fen()); uciprint($engine2, "go infinite"); @@ -416,8 +454,6 @@ sub handle_position { $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, @@ -470,6 +506,7 @@ sub parse_infos { 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') { @@ -521,10 +558,14 @@ sub prettyprint_pv_no_cache { return (); } - my $pv = shift @pvs; - my ($from_row, $from_col, $to_row, $to_col, $promo) = parse_uci_move($pv); - my ($pretty, $nb) = $board->prettyprint_move($from_row, $from_col, $to_row, $to_col, $promo); - return ( $pretty, prettyprint_pv_no_cache($nb, @pvs) ); + my @ret = (); + for my $pv (@pvs) { + my ($from_row, $from_col, $to_row, $to_col, $promo) = parse_uci_move($pv); + my ($pretty, $nb) = $board->prettyprint_move($from_row, $from_col, $to_row, $to_col, $promo); + push @ret, $pretty; + $board = $nb; + } + return @ret; } sub prettyprint_pv { @@ -561,8 +602,11 @@ sub complete_using_tbprobe { 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. @@ -571,30 +615,36 @@ sub complete_using_tbprobe { $pos = $pos->make_move(parse_uci_move($move)); } - while ($pos->num_pieces() > 6 && $#pv > -1) { + while ($pos->num_pieces() > 7 && $#pv > -1) { my $move = shift @pv; push @moves, $move; $pos = $pos->make_move(parse_uci_move($move)); } - return if ($pos->num_pieces() > 6); + return if ($pos->num_pieces() > 7); my $fen = $pos->fen(); - my $pgn_text = `fathom --path=/srv/syzygy "$fen"`; + my $pgn_text = `$remoteglotconf::fathom_cmdline "$fen"`; 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'; + last if $move eq '0-1'; + last if $move eq '1/2-1/2'; my $uci_move; ($pos, $uci_move) = $pos->make_pretty_move($move); push @moves, $uci_move; } - $tbprobe_cache{$key} = \@moves; + $tbprobe_cache{$key} = { + moves => \@moves, + splicepos => $splicepos + }; } $info->{'pv' . $mpv} = \@moves; @@ -605,6 +655,7 @@ sub complete_using_tbprobe { } else { $info->{'score_mate' . $mpv} = $matelen; } + $info->{'splicepos' . $mpv} = $splicepos; } sub output { @@ -612,55 +663,32 @@ sub output { return if (!defined($pos_calculating)); - # Don't update too often. - my $age = Time::HiRes::tv_interval($latest_update); - if ($age < $remoteglotconf::update_max_interval) { - my $wait = $remoteglotconf::update_max_interval + 0.01 - $age; - $output_timer = AnyEvent->timer(after => $wait, cb => \&output); - return; - } - my $info = $engine->{'info'}; - # - # 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; - } + # Don't update too often. + my $wait = $remoteglotconf::update_max_interval - Time::HiRes::tv_interval($latest_update); + if (defined($pos_calculating_started)) { + my $new_pos_wait = $remoteglotconf::update_force_after_move - Time::HiRes::tv_interval($pos_calculating_started); + $wait = $new_pos_wait if ($new_pos_wait < $wait); + } + if (!$last_output_had_pv && has_pv($info)) { + if (!defined($pos_pv_started)) { + $pos_pv_started = [Time::HiRes::gettimeofday]; } - $info->{'pv'} = $pv; - $info->{'tablebase'} = 1; - } else { - $info->{'tablebase'} = 0; + # We just got initial PV, and we're in a hurry since we gave out a blank one earlier, + # so give us just 200ms more to increase the quality and then force a display. + my $new_pos_wait = $remoteglotconf::update_force_after_move - Time::HiRes::tv_interval($pos_pv_started); + $wait = $new_pos_wait if ($new_pos_wait < $wait); } + if ($wait > 0.0) { + $output_timer = AnyEvent->timer(after => $wait + 0.01, cb => \&output); + return; + } + $pos_pv_started = undef; + + # We're outputting something for this position now, so the special handling + # for new positions is off. + undef $pos_calculating_started; # # Some programs _always_ report MultiPV, even with only one PV. @@ -668,7 +696,7 @@ sub output { # 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 { @@ -713,6 +741,14 @@ sub output { output_screen(); output_json(0); $latest_update = [Time::HiRes::gettimeofday]; + $last_output_had_pv = has_pv($info); +} + +sub has_pv { + my $info = shift; + return 1 if (exists($info->{'pv'}) && (scalar(@{$info->{'pv'}}) > 0)); + return 1 if (exists($info->{'pv1'}) && (scalar(@{$info->{'pv1'}}) > 0)); + return 0; } sub output_screen { @@ -738,6 +774,11 @@ sub output_screen { } return unless (exists($pos_calculating->{'board'})); + + my $extra_moves = $pos_calculating->{'extra_moves'}; + if (defined($extra_moves) && scalar @$extra_moves > 0) { + $text .= " Manual move extensions: " . join(' ', @$extra_moves) . "\n"; + } if (exists($info->{'pv1'}) && exists($info->{'pv2'})) { # multi-PV @@ -790,8 +831,6 @@ sub output_screen { $text .= "\n\n"; } - #$text .= book_info($pos_calculating->fen(), $pos_calculating->{'board'}, $pos_calculating->{'toplay'}); - my @refutation_lines = (); if (defined($engine2)) { for (my $mpv = 1; $mpv < 500; ++$mpv) { @@ -860,7 +899,6 @@ sub output_json { $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'}; @@ -890,6 +928,9 @@ sub output_json { move => $pretty_move, pv => \@pretty_pv, }; + if (exists($info->{'splicepos' . $mpv})) { + $refutation_lines{$pretty_move}->{'splicepos'} = $info->{'splicepos' . $mpv}; + } }; } } @@ -907,6 +948,7 @@ sub output_json { } else { $pos = Position->start_pos('white', 'black'); } + $pos->{'chess960'} = $pos_calculating->{'chess960'}; my $halfmove_num = 0; for my $move (@{$pos_calculating->{'history'}}) { my $id = id_for_pos($pos, $halfmove_num); @@ -994,7 +1036,7 @@ sub output_json { } 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"; @@ -1100,7 +1142,24 @@ sub score_digest { 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}; @@ -1126,10 +1185,19 @@ sub long_score { 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})) { @@ -1181,56 +1249,32 @@ sub plot_score { return undef; } -my %book_cache = (); -sub book_info { - my ($fen, $board, $toplay) = @_; - - if (exists($book_cache{$fen})) { - return $book_cache{$fen}; - } - - my $ret = `./booklook $fen`; - return "" if ($ret =~ /Not found/ || $ret eq ''); - - my @moves = (); - - for my $m (split /\n/, $ret) { - my ($move, $annotation, $win, $draw, $lose, $rating, $rating_div) = split /,/, $m; +sub extend_from_manual_override { + my ($pos, $moves, $extra_moves) = @_; - my $pmove; - if ($move eq '') { - $pmove = '(current)'; - } else { - ($pmove) = prettyprint_pv_no_cache($board, $move); - $pmove .= $annotation; + my $q = $dbh->prepare('SELECT next_move FROM game_extensions WHERE fen=? AND history=? AND player_w=? AND player_b=? AND (CURRENT_TIMESTAMP - ts) < INTERVAL \'1 hour\''); + while (1) { + my $player_w = $pos->{'player_w'}; + my $player_b = $pos->{'player_b'}; + if ($player_w =~ /^base64:(.*)$/) { + $player_w = MIME::Base64::decode_base64($1); } - - my $score; - if ($toplay eq 'W') { - $score = 1.0 * $win + 0.5 * $draw + 0.0 * $lose; - } else { - $score = 0.0 * $win + 0.5 * $draw + 1.0 * $lose; + if ($player_b =~ /^base64:(.*)$/) { + $player_b = MIME::Base64::decode_base64($1); } - my $n = $win + $draw + $lose; - - my $percent; - if ($n == 0) { - $percent = " "; + #use Data::Dumper; print Dumper([$pos->fen(), JSON::XS::encode_json($moves), $player_w, $player_b]); + $q->execute($pos->fen(), JSON::XS::encode_json($moves), $player_w, $player_b); + my $ref = $q->fetchrow_hashref; + if (defined($ref)) { + my $move = $ref->{'next_move'}; + ($pos) = $pos->make_pretty_move($move); + push @$moves, $move; + push @$extra_moves, $move; } else { - $percent = sprintf "%4u%%", int(100.0 * $score / $n + 0.5); + last; } - - push @moves, [ $pmove, $n, $percent, $rating ]; - } - - @moves[1..$#moves] = sort { $b->[2] cmp $a->[2] } @moves[1..$#moves]; - - my $text = "Book moves:\n\n Perf. N Rating\n\n"; - for my $m (@moves) { - $text .= sprintf " %-10s %s %6u %4s\n", $m->[0], $m->[2], $m->[1], $m->[3] } - - return $text; + return $pos; } sub extract_clock { @@ -1351,84 +1395,6 @@ sub find_clock_start { $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)); @@ -1452,3 +1418,16 @@ sub parse_uci_move { my $promo = substr($move, 4, 1); return ($from_row, $from_col, $to_row, $to_col, $promo); } + +sub setoptions { + my ($engine, $config) = @_; + uciprint($engine, "setoption name UCI_AnalyseMode value true"); + uciprint($engine, "setoption name Analysis Contempt value Off"); + if (exists($config->{'Threads'})) { # Threads first, because clearing hash can be multithreaded then. + uciprint($engine, "setoption name Threads value " . $config->{'Threads'}); + } + while (my ($key, $value) = each %$config) { + next if $key eq 'Threads'; + uciprint($engine, "setoption name $key value $value"); + } +}