X-Git-Url: https://git.sesse.net/?p=remoteglot;a=blobdiff_plain;f=remoteglot.pl;h=d6ecbcb4e727dcad1c2aa88e217deeaf887dfa30;hp=b546589e5c03bfb56e9fd69caa3b6a13a996b075;hb=4f754b372829496a9f53eb52923446cc2a0398c1;hpb=ee7c89056c97c8b999034b5c7f2da0d7570b885f diff --git a/remoteglot.pl b/remoteglot.pl index b546589..d6ecbcb 100755 --- a/remoteglot.pl +++ b/remoteglot.pl @@ -20,6 +20,7 @@ use IPC::Open2; use Time::HiRes; use JSON::XS; use URI::Escape; +use Tie::Persistent; require 'Position.pm'; require 'Engine.pm'; require 'config.pm'; @@ -35,9 +36,14 @@ my $stop_pgn_fetch = 0; my $tb_retry_timer = undef; my %tb_cache = (); my $tb_lookup_running = 0; +my $last_written_json = undef; -# TODO: Persist (parts of) this so that we can restart. -my %clock_target_for_pos = (); +# Persisted so that we can restart. +tie my %clock_info_for_pos, 'Tie::Persistent', 'clock_info.db', 'rw'; +(tied %clock_info_for_pos)->autosync(1); + +tie my %json_for_pos, 'Tie::Persistent', 'analysis_info.db', 'rw'; +(tied %json_for_pos)->autosync(1); $| = 1; @@ -268,10 +274,16 @@ sub handle_pgn { } my $pgn = Chess::PGN::Parse->new(undef, $body); - if (!defined($pgn) || !$pgn->read_game()) { + if (!defined($pgn) || !$pgn->read_game() || $body !~ /^\[/) { warn "Error in parsing PGN from $url\n"; } else { eval { + # Skip to the right game. + while (defined($remoteglotconf::pgn_filter) && + !&$remoteglotconf::pgn_filter($pgn)) { + $pgn->read_game() or die "Out of games during filtering"; + } + $pgn->parse_game({ save_comments => 'yes' }); my $pos = Position->start_pos($pgn->white, $pgn->black); my $moves = $pgn->moves; @@ -308,7 +320,7 @@ sub handle_pgn { } }; if ($@) { - warn "Error in parsing moves from $url\n"; + warn "Error in parsing moves from $url: $@\n"; } } @@ -319,15 +331,21 @@ sub handle_pgn { sub handle_position { my ($pos) = @_; - find_clock_start($pos); + find_clock_start($pos, $pos_calculating); - # if this is already in the queue, ignore it - return if (defined($pos_waiting) && $pos->fen() eq $pos_waiting->fen()); + # if this is already in the queue, ignore it (just update the result) + if (defined($pos_waiting) && $pos->fen() eq $pos_waiting->fen()) { + $pos_waiting->{'result'} = $pos->{'result'}; + return; + } # if we're already chewing on this and there's nothing else in the queue, # also ignore it - return if (!defined($pos_waiting) && defined($pos_calculating) && - $pos->fen() eq $pos_calculating->fen()); + if (!defined($pos_waiting) && defined($pos_calculating) && + $pos->fen() eq $pos_calculating->fen()) { + $pos_calculating->{'result'} = $pos->{'result'}; + return; + } # if we're already thinking on something, stop and wait for the engine # to approve @@ -722,6 +740,7 @@ sub output_json { $json->{'id'} = $engine->{'id'}; $json->{'score'} = long_score($info, $pos_calculating, ''); $json->{'short_score'} = short_score($info, $pos_calculating, ''); + $json->{'plot_score'} = plot_score($info, $pos_calculating, ''); $json->{'nodes'} = $info->{'nodes'}; $json->{'nps'} = $info->{'nps'}; @@ -759,14 +778,59 @@ sub output_json { } $json->{'refutation_lines'} = \%refutation_lines; - my $encoded = JSON::XS::encode_json($json); - unless ($historic_json_only) { + # Piece together historic score information, to the degree we have it. + if (!$historic_json_only && exists($pos_calculating->{'pretty_history'})) { + my %score_history = (); + + my $pos = Position->start_pos('white', 'black'); + my $halfmove_num = 0; + for my $move (@{$pos_calculating->{'pretty_history'}}) { + my $id = id_for_pos($pos, $halfmove_num); + if (exists($json_for_pos{$id}) && defined($json_for_pos{$id}->{'plot_score'})) { + $score_history{$halfmove_num} = [ + $json_for_pos{$id}->{'plot_score'}, + $json_for_pos{$id}->{'short_score'} + ]; + } + ++$halfmove_num; + ($pos) = $pos->make_pretty_move($move); + } + + # If at any point we are missing 10 consecutive moves, + # truncate the history there. This is so we don't get into + # a situation where we e.g. start analyzing at move 45, + # but we have analysis for 1. e4 from some completely different game + # and thus show a huge hole. + my $consecutive_missing = 0; + my $truncate_until = 0; + for (my $i = $halfmove_num; $i --> 0; ) { + if ($consecutive_missing >= 10) { + delete $score_history{$i}; + next; + } + if (exists($score_history{$i})) { + $consecutive_missing = 0; + } else { + ++$consecutive_missing; + } + } + + $json->{'score_history'} = \%score_history; + } + + my $json_enc = JSON::XS->new; + $json_enc->canonical(1); + my $encoded = $json_enc->encode($json); + unless ($historic_json_only || !defined($remoteglotconf::json_output) || + (defined($last_written_json) && $last_written_json eq $encoded)) { atomic_set_contents($remoteglotconf::json_output, $encoded); + $last_written_json = $encoded; } if (exists($pos_calculating->{'pretty_history'}) && defined($remoteglotconf::json_history_dir)) { - my $filename = $remoteglotconf::json_history_dir . "/" . id_for_pos($pos_calculating) . ".json"; + my $id = id_for_pos($pos_calculating); + my $filename = $remoteglotconf::json_history_dir . "/" . $id . ".json"; # Overwrite old analysis (assuming it exists at all) if we're # using a different engine, or if we've calculated deeper. @@ -780,6 +844,7 @@ sub output_json { $new_depth > $old_depth || ($new_depth == $old_depth && $new_nodes >= $old_nodes)) { atomic_set_contents($filename, $encoded); + $json_for_pos{$id} = $json; } } } @@ -795,9 +860,9 @@ sub atomic_set_contents { } sub id_for_pos { - my $pos = shift; + my ($pos, $halfmove_num) = @_; - my $halfmove_num = scalar @{$pos->{'pretty_history'}}; + $halfmove_num //= scalar @{$pos->{'pretty_history'}}; (my $fen = $pos->fen()) =~ tr,/ ,-_,; return "move$halfmove_num-$fen"; } @@ -923,6 +988,36 @@ sub long_score { return undef; } +# For graphs; a single number in centipawns, capped at +/- 500. +sub plot_score { + my ($info, $pos, $mpv) = @_; + + my $invert = ($pos->{'toplay'} eq 'B'); + if (defined($info->{'score_mate' . $mpv})) { + my $mate = $info->{'score_mate' . $mpv}; + if ($invert) { + $mate = -$mate; + } + if ($mate > 0) { + return 500; + } else { + return -500; + } + } else { + if (exists($info->{'score_cp' . $mpv})) { + my $score = $info->{'score_cp' . $mpv}; + if ($invert) { + $score = -$score; + } + $score = 500 if ($score > 500); + $score = -500 if ($score < -500); + return int($score); + } + } + + return undef; +} + my %book_cache = (); sub book_info { my ($fen, $board, $toplay) = @_; @@ -981,8 +1076,8 @@ sub extract_clock { # Look for extended PGN clock tags. my $tags = $pgn->tags; if (exists($tags->{'WhiteClock'}) && exists($tags->{'BlackClock'})) { - $pos->{'white_clock'} = $tags->{'WhiteClock'}; - $pos->{'black_clock'} = $tags->{'BlackClock'}; + $pos->{'white_clock'} = hms_to_sec($tags->{'WhiteClock'}); + $pos->{'black_clock'} = hms_to_sec($tags->{'BlackClock'}); return; } @@ -997,56 +1092,98 @@ sub extract_clock { if (exists($comments->{$white_key}) && exists($comments->{$black_key}) && - $comments->{$white_key} =~ /tl=(\d+:\d+:\d+)/ && - $comments->{$black_key} =~ /tl=(\d+:\d+:\d+)/) { - $comments->{$white_key} =~ /tl=(\d+:\d+:\d+)/; - $pos->{'white_clock'} = $1; - $comments->{$black_key} =~ /tl=(\d+:\d+:\d+)/; - $pos->{'black_clock'} = $1; + $comments->{$white_key} =~ /(?:tl=|clk )(\d+:\d+:\d+)/ && + $comments->{$black_key} =~ /(?:tl=|clk )(\d+:\d+:\d+)/) { + $comments->{$white_key} =~ /(?:tl=|clk )(\d+:\d+:\d+)/; + $pos->{'white_clock'} = hms_to_sec($1); + $comments->{$black_key} =~ /(?:tl=|clk )(\d+:\d+:\d+)/; + $pos->{'black_clock'} = hms_to_sec($1); return; } + + delete $pos->{'white_clock'}; + delete $pos->{'black_clock'}; +} + +sub hms_to_sec { + my $hms = shift; + return undef if (!defined($hms)); + $hms =~ /(\d+):(\d+):(\d+)/; + return $1 * 3600 + $2 * 60 + $3; } sub find_clock_start { - my $pos = shift; + my ($pos, $prev_pos) = @_; # If the game is over, the clock is stopped. - if ($pos->{'result'} eq '1-0' || - $pos->{'result'} eq '1/2-1/2' || - $pos->{'result'} eq '0-1') { + if (exists($pos->{'result'}) && + ($pos->{'result'} eq '1-0' || + $pos->{'result'} eq '1/2-1/2' || + $pos->{'result'} eq '0-1')) { return; } # When we don't have any moves, we assume the clock hasn't started yet. if ($pos->{'move_num'} == 1 && $pos->{'toplay'} eq 'W') { + if (defined($remoteglotconf::adjust_clocks_before_move)) { + &$remoteglotconf::adjust_clocks_before_move(\$pos->{'white_clock'}, \$pos->{'black_clock'}, 1, 'W'); + } + return; + } + + # TODO(sesse): Maybe we can get the number of moves somehow else for FICS games. + # The history is needed for id_for_pos. + if (!exists($pos->{'pretty_history'})) { return; } my $id = id_for_pos($pos); - if (exists($clock_target_for_pos{$id})) { + if (exists($clock_info_for_pos{$id})) { + $pos->{'white_clock'} //= $clock_info_for_pos{$id}{'white_clock'}; + $pos->{'black_clock'} //= $clock_info_for_pos{$id}{'black_clock'}; if ($pos->{'toplay'} eq 'W') { - $pos->{'white_clock_target'} = $clock_target_for_pos{$id}; + $pos->{'white_clock_target'} = $clock_info_for_pos{$id}->{'white_clock_target'}; } else { - $pos->{'black_clock_target'} = $clock_target_for_pos{$id}; + $pos->{'black_clock_target'} = $clock_info_for_pos{$id}->{'black_clock_target'}; } return; } # OK, we haven't seen this position before, so we assume the move # happened right now. + + # See if we should do our own clock management (ie., clock information + # is spurious or non-existent). + if (defined($remoteglotconf::adjust_clocks_before_move)) { + my $wc = $pos->{'white_clock'} // $prev_pos->{'white_clock'}; + my $bc = $pos->{'black_clock'} // $prev_pos->{'black_clock'}; + if (defined($prev_pos->{'white_clock_target'})) { + $wc = $prev_pos->{'white_clock_target'} - time; + } + if (defined($prev_pos->{'black_clock_target'})) { + $bc = $prev_pos->{'black_clock_target'} - time; + } + &$remoteglotconf::adjust_clocks_before_move(\$wc, \$bc, $pos->{'move_num'}, $pos->{'toplay'}); + $pos->{'white_clock'} = $wc; + $pos->{'black_clock'} = $bc; + } + my $key = ($pos->{'toplay'} eq 'W') ? 'white_clock' : 'black_clock'; if (!exists($pos->{$key})) { # No clock information. return; } - $pos->{$key} =~ /(\d+):(\d+):(\d+)/; - my $time_left = $1 * 3600 + $2 * 60 + $3; - $clock_target_for_pos{$id} = time + $time_left; + my $time_left = $pos->{$key}; + my $clock_info = { + white_clock => $pos->{'white_clock'}, + black_clock => $pos->{'black_clock'} + }; if ($pos->{'toplay'} eq 'W') { - $pos->{'white_clock_target'} = $clock_target_for_pos{$id}; + $clock_info->{'white_clock_target'} = $pos->{'white_clock_target'} = time + $time_left; } else { - $pos->{'black_clock_target'} = $clock_target_for_pos{$id}; + $clock_info->{'black_clock_target'} = $pos->{'black_clock_target'} = time + $time_left; } + $clock_info_for_pos{$id} = $clock_info; } sub schedule_tb_lookup {