X-Git-Url: https://git.sesse.net/?p=remoteglot;a=blobdiff_plain;f=remoteglot.pl;h=1caf19b14bddb389e955749831cb0607dab668e2;hp=d4a0d73183a2388c5f8930e922680cc3e80fedaf;hb=5a625112cf0e2c26da7b2cf9b7a2ba7062ce0338;hpb=243c535dd2efc9d8126aa6c153292d8253239dd9 diff --git a/remoteglot.pl b/remoteglot.pl index d4a0d73..1caf19b 100755 --- a/remoteglot.pl +++ b/remoteglot.pl @@ -5,7 +5,7 @@ # analysis, or for live analysis of relayed games. (Do not use for # cheating! Cheating is bad for your karma, and your abuser flag.) # -# Copyright 2007 Steinar H. Gunderson +# Copyright 2007 Steinar H. Gunderson # Licensed under the GNU General Public License, version 2. # @@ -67,6 +67,7 @@ select(TBLOG); $| = 1; select(STDOUT); +umask 0022; # open the chess engine my $engine = open_engine($remoteglotconf::engine_cmdline, 'E1', sub { handle_uci(@_, 1); }); @@ -275,8 +276,12 @@ sub handle_pgn { } my $pgn = Chess::PGN::Parse->new(undef, $body); - if (!defined($pgn) || !$pgn->read_game() || $body !~ /^\[/) { - warn "Error in parsing PGN from $url\n"; + if (!defined($pgn)) { + warn "Error in parsing PGN from $url [body='$body']\n"; + } elsif (!$pgn->read_game()) { + warn "Error in reading PGN game from $url [body='$body']\n"; + } elsif ($body !~ /^\[/) { + warn "Malformed PGN from $url [body='$body']\n"; } else { eval { # Skip to the right game. @@ -289,13 +294,19 @@ sub handle_pgn { my $pos = Position->start_pos($pgn->white, $pgn->black); my $moves = $pgn->moves; my @uci_moves = (); + my @repretty_moves = (); for my $move (@$moves) { - my $uci_move; - ($pos, $uci_move) = $pos->make_pretty_move($move); + my ($npos, $uci_move) = $pos->make_pretty_move($move); push @uci_moves, $uci_move; + + # Re-prettyprint the move. + my ($from_row, $from_col, $to_row, $to_col, $promo) = parse_uci_move($uci_move); + my ($pretty, undef) = $pos->{'board'}->prettyprint_move($from_row, $from_col, $to_row, $to_col, $promo); + push @repretty_moves, $pretty; + $pos = $npos; } $pos->{'result'} = $pgn->result; - $pos->{'pretty_history'} = $moves; + $pos->{'pretty_history'} = \@repretty_moves; extract_clock($pgn, $pos); @@ -501,7 +512,7 @@ sub prettyprint_pv_no_cache { } my $pv = shift @pvs; - my ($from_col, $from_row, $to_col, $to_row, $promo) = parse_uci_move($pv); + 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) ); } @@ -519,6 +530,61 @@ sub prettyprint_pv { } } +sub complete_using_tbprobe { + my ($pos, $info, $mpv) = @_; + + # We need Fathom installed to do standalone TB probes. + return if (!defined($remoteglotconf::fathom_cmdline)); + + # If we already have a mate, don't bother; in some cases, it would even be + # better than a tablebase score. + return if defined($info->{'score_mate' . $mpv}); + + # If we have a draw or near-draw score, there's also not much interesting + # we could add from a tablebase. We only really want mates. + return if ($info->{'score_cp' . $mpv} >= -12250 && $info->{'score_cp' . $mpv} <= 12250); + + # Run through the PV until we are at a 6-man position. + # TODO: We could in theory only have 5-man data. + my @pv = @{$info->{'pv' . $mpv}}; + my $key = join('', @pv); + my @moves = (); + if (exists($pos->{'tbprobe_cache'}{$key})) { + @moves = $pos->{'tbprobe_cache'}{$key}; + } else { + while ($pos->num_pieces() > 6 && $#pv > -1) { + my $move = shift @pv; + push @moves, $move; + $pos = $pos->make_move(parse_uci_move($move)); + } + + return if ($pos->num_pieces() > 6); + + my $fen = $pos->fen(); + my $pgn_text = `fathom --path=/srv/syzygy "$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. + for my $move (@{$pgn->moves}) { + my $uci_move; + ($pos, $uci_move) = $pos->make_pretty_move($move); + push @moves, $uci_move; + } + } + + $info->{'pv' . $mpv} = \@moves; + + my $matelen = int((1 + scalar @moves) / 2); + if ((scalar @moves) % 2 == 0) { + $info->{'score_mate' . $mpv} = -$matelen; + } else { + $info->{'score_mate' . $mpv} = $matelen; + } +} + sub output { #return; @@ -583,6 +649,8 @@ sub output { for my $key (qw(pv score_cp score_mate nodes nps depth seldepth tbhits)) { if (exists($info->{$key . '1'})) { $info->{$key} = $info->{$key . '1'}; + } else { + delete $info->{$key}; } } } @@ -609,6 +677,17 @@ sub output { return; } + # Now do our own Syzygy tablebase probes to convert scores like +123.45 to mate. + if (exists($info->{'pv'})) { + complete_using_tbprobe($pos_calculating, $info, ''); + } + + my $mpv = 1; + while (exists($info->{'pv' . $mpv})) { + complete_using_tbprobe($pos_calculating, $info, $mpv); + ++$mpv; + } + output_screen(); output_json(0); $latest_update = [Time::HiRes::gettimeofday]; @@ -697,8 +776,8 @@ sub output_screen { my $info = $engine2->{'info'}; last if (!exists($info->{'pv' . $mpv})); eval { + complete_using_tbprobe($pos_calculating_second_engine, $info, $mpv); my $pv = $info->{'pv' . $mpv}; - my $pretty_move = join('', prettyprint_pv($pos_calculating_second_engine, $pv->[0])); my @pretty_pv = prettyprint_pv($pos_calculating_second_engine, @$pv); if (scalar @pretty_pv > 5) { @@ -775,6 +854,7 @@ sub output_json { last if (!exists($info->{'pv' . $mpv})); eval { + complete_using_tbprobe($pos_calculating, $info, $mpv); my $pv = $info->{'pv' . $mpv}; my $pretty_move = join('', prettyprint_pv($pos_calculating, $pv->[0])); my @pretty_pv = prettyprint_pv($pos_calculating, @$pv); @@ -892,12 +972,16 @@ sub output_json { ($new_depth == $old_depth && $new_nodes >= $old_nodes)) { atomic_set_contents($filename, $encoded); if (defined($json->{'plot_score'})) { - local $dbh->{AutoCommit} = 0; - $dbh->do('DELETE FROM scores WHERE id=?', undef, $id); - $dbh->do('INSERT INTO scores (id, plot_score, short_score, engine, depth, nodes) VALUES (?,?,?,?,?,?)', undef, + $dbh->do('INSERT INTO scores (id, plot_score, short_score, engine, depth, nodes) VALUES (?,?,?,?,?,?) ' . + ' ON CONFLICT (id) DO UPDATE SET ' . + ' plot_score=EXCLUDED.plot_score, ' . + ' short_score=EXCLUDED.short_score, ' . + ' engine=EXCLUDED.engine, ' . + ' depth=EXCLUDED.depth, ' . + ' nodes=EXCLUDED.nodes', + undef, $id, $json->{'plot_score'}, $json->{'short_score'}, $json->{'engine'}{'name'}, $new_depth, $new_nodes); - $dbh->commit; } } } @@ -1329,5 +1413,5 @@ sub parse_uci_move { my $to_col = col_letter_to_num(substr($move, 2, 1)); my $to_row = row_letter_to_num(substr($move, 3, 1)); my $promo = substr($move, 4, 1); - return ($from_col, $from_row, $to_col, $to_row, $promo); + return ($from_row, $from_col, $to_row, $to_col, $promo); }