X-Git-Url: https://git.sesse.net/?p=remoteglot;a=blobdiff_plain;f=remoteglot.pl;h=f42b7244aab08a810b5a0c0981ed22c04c10b2d8;hp=2e0f2206bba780b5a2fd8c81674adc7168dd35fa;hb=bf26f1b3ef29a518e1ee9f71c42c9cf344d2e987;hpb=cf9785772b5dcb8de2376b4b1ab5951d868b3140 diff --git a/remoteglot.pl b/remoteglot.pl index 2e0f220..f42b724 100755 --- a/remoteglot.pl +++ b/remoteglot.pl @@ -13,6 +13,7 @@ use Net::Telnet; use FileHandle; use IPC::Open2; use Time::HiRes; +use JSON::XS; use strict; use warnings; @@ -24,6 +25,7 @@ my $engine2_cmdline = "./stockfish_13111119_x64_modern_sse42"; my $telltarget = undef; # undef to be silent my @tell_intervals = (5, 20, 60, 120, 240, 480, 960); # after each move my $uci_assume_full_compliance = 0; # dangerous :-) +my $update_max_interval = 2.0; my $second_engine_start_depth = 8; my @masters = ( 'Sesse', @@ -34,7 +36,8 @@ my @masters = ( ); # Program starts here -$SIG{ALRM} = sub { output_screen(); }; +$SIG{ALRM} = sub { output(); }; +my $latest_update = undef; $| = 1; @@ -52,8 +55,8 @@ $| = 1; select(STDOUT); # open the chess engine -my $engine = open_engine($engine_cmdline); -my $engine2 = open_engine($engine2_cmdline); +my $engine = open_engine($engine_cmdline, 'E1'); +my $engine2 = open_engine($engine2_cmdline, 'E2'); my ($last_move, $last_tell); my $last_text = ''; my $last_told_text = ''; @@ -184,20 +187,24 @@ while (1) { # any fun on the UCI channel? if ($nfound > 0 && vec($rout, fileno($engine->{'read'}), 1) == 1) { - my $line = read_line($engine->{'read'}); - handle_uci($engine, $line, 1); + my @lines = read_lines($engine); + for my $line (@lines) { + next if $line =~ /(upper|lower)bound/; + handle_uci($engine, $line, 1); + } $sleep = 0; - # don't update too often - Time::HiRes::alarm(0.2); + output(); } if ($nfound > 0 && vec($rout, fileno($engine2->{'read'}), 1) == 1) { - my $line = read_line($engine2->{'read'}); - handle_uci($engine2, $line, 0); + my @lines = read_lines($engine2); + for my $line (@lines) { + next if $line =~ /(upper|lower)bound/; + handle_uci($engine2, $line, 0); + } $sleep = 0; - # don't update too often - Time::HiRes::alarm(0.2); + output(); } sleep $sleep; @@ -209,7 +216,7 @@ sub handle_uci { chomp $line; $line =~ tr/\r//d; $line =~ s/ / /g; # Sometimes needed for Zappa Mexico - print UCILOG localtime() . " <= $line\n"; + print UCILOG localtime() . " $engine->{'tag'} <= $line\n"; if ($line =~ /^info/) { my (@infos) = split / /, $line; shift @infos; @@ -235,7 +242,7 @@ sub handle_uci { } else { if (defined($move_calculating_second_engine)) { my $move = $refutation_moves{$move_calculating_second_engine}; - $move->{'pv'} = $engine->{'info'}{'pv'}; + $move->{'pv'} = $engine->{'info'}{'pv'} // $engine->{'info'}{'pv1'}; $move->{'score_cp'} = $engine->{'info'}{'score_cp'} // $engine->{'info'}{'score_cp1'} // 0; $move->{'score_mate'} = $engine->{'info'}{'score_mate'} // $engine->{'info'}{'score_mate1'}; $move->{'toplay'} = $pos_calculating->{'toplay'}; @@ -613,14 +620,33 @@ sub prettyprint_pv { return ($pretty, prettyprint_pv($nb, @pvs)); } -sub output_screen { +sub output { #return; - + return if (!defined($pos_calculating)); + # Don't update too often. + my $age = Time::HiRes::tv_interval($latest_update); + if ($age < $update_max_interval) { + Time::HiRes::alarm($update_max_interval + 0.01 - $age); + return; + } + my $info = $engine->{'info'}; - my $id = $engine->{'id'}; - + + # + # 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)) { + if (exists($info->{$key . '1'})) { + $info->{$key} = $info->{$key . '1'}; + } + } + } + # # Check the PVs first. if they're invalid, just wait, as our data # is most likely out of sync. This isn't a very good solution, as @@ -643,6 +669,15 @@ sub output_screen { return; } + output_screen(); + output_json(); + $latest_update = [Time::HiRes::gettimeofday]; +} + +sub output_screen { + my $info = $engine->{'info'}; + my $id = $engine->{'id'}; + my $text = 'Analysis'; if ($pos_calculating->{'last_move'} ne 'none') { if ($pos_calculating->{'toplay'} eq 'W') { @@ -663,19 +698,6 @@ sub output_screen { return unless (exists($pos_calculating->{'board'})); - # - # 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)) { - if (exists($info->{$key . '1'}) && !exists($info->{$key})) { - $info->{$key} = $info->{$key . '1'}; - } - } - } - if (exists($info->{'pv1'}) && exists($info->{'pv2'})) { # multi-PV my $mpv = 1; @@ -714,6 +736,9 @@ sub output_screen { $text .= sprintf " %u nodes, %7u nodes/sec, depth %u ply", $info->{'nodes'}, $info->{'nps'}, $info->{'depth'}; } + if (exists($info->{'seldepth'})) { + $text .= sprintf " (%u selective)", $info->{'seldepth'}; + } if (exists($info->{'tbhits'}) && $info->{'tbhits'} > 0) { if ($info->{'tbhits'} == 1) { $text .= ", one Nalimov hit"; @@ -721,9 +746,6 @@ sub output_screen { $text .= sprintf ", %u Nalimov hits", $info->{'tbhits'}; } } - if (exists($info->{'seldepth'})) { - $text .= sprintf " (%u selective)", $info->{'seldepth'}; - } $text .= "\n\n"; } @@ -733,7 +755,7 @@ sub output_screen { for my $move (keys %refutation_moves) { eval { my $m = $refutation_moves{$move}; - next if ($m->{'depth'} < $second_engine_start_depth); + die if ($m->{'depth'} < $second_engine_start_depth); my $pretty_move = join('', prettyprint_pv($pos_calculating->{'board'}, $move)); my @pretty_pv = prettyprint_pv($pos_calculating->{'board'}, $move, @{$m->{'pv'}}); if (scalar @pretty_pv > 5) { @@ -824,6 +846,54 @@ sub output_screen { } } +sub output_json { + my $info = $engine->{'info'}; + + my $json = {}; + $json->{'position'} = $pos_calculating; + $json->{'id'} = $engine->{'id'}; + $json->{'score'} = long_score($info, $pos_calculating, ''); + + $json->{'nodes'} = $info->{'nodes'}; + $json->{'nps'} = $info->{'nps'}; + $json->{'depth'} = $info->{'depth'}; + $json->{'tbhits'} = $info->{'tbhits'}; + $json->{'seldepth'} = $info->{'seldepth'}; + + # single-PV only for now + $json->{'pv_uci'} = $info->{'pv'}; + $json->{'pv_pretty'} = [ prettyprint_pv($pos_calculating->{'board'}, @{$info->{'pv'}}) ]; + + my %refutation_lines = (); + for my $move (keys %refutation_moves) { + my $m = $refutation_moves{$move}; + my $pretty_move = ""; + my @pretty_pv = (); + eval { + $pretty_move = join('', prettyprint_pv($pos_calculating->{'board'}, $move)); + @pretty_pv = prettyprint_pv($pos_calculating->{'board'}, $move, @{$m->{'pv'}}); + }; + $refutation_lines{$move} = { + sort_key => $pretty_move, + depth => $m->{'depth'}, + score_sort_key => score_sort_key($refutation_moves{$move}, $pos_calculating, '', 1), + pretty_score => short_score($refutation_moves{$move}, $pos_calculating, '', 1), + pretty_move => $pretty_move, + pv_pretty => \@pretty_pv, + }; + eval { + $refutation_lines{$move}->{'pv_uci'} = [ $move, @{$m->{'pv'}} ]; + }; + } + $json->{'refutation_lines'} = \%refutation_lines; + + open my $fh, ">analysis.json.tmp" + or return; + print $fh JSON::XS::encode_json($json); + close $fh; + rename("analysis.json.tmp", "analysis.json"); +} + sub find_kings { my $board = shift; my ($wkr, $wkc, $bkr, $bkc); @@ -1024,7 +1094,7 @@ sub can_reach { sub uciprint { my ($engine, $msg) = @_; print { $engine->{'write'} } "$msg\n"; - print UCILOG localtime() . " => $msg\n"; + print UCILOG localtime() . " $engine->{'tag'} => $msg\n"; } sub short_score { @@ -1037,13 +1107,16 @@ sub short_score { if (defined($info->{'score_mate' . $mpv})) { if ($invert) { - return sprintf "M%3d", $info->{'score_mate' . $mpv}; - } else { return sprintf "M%3d", -$info->{'score_mate' . $mpv}; + } else { + return sprintf "M%3d", $info->{'score_mate' . $mpv}; } } else { if (exists($info->{'score_cp' . $mpv})) { my $score = $info->{'score_cp' . $mpv} * 0.01; + if ($score == 0) { + return " 0.00"; + } if ($invert) { $score = -$score; } @@ -1071,6 +1144,9 @@ sub score_sort_key { } else { if (exists($info->{'score_cp' . $mpv})) { my $score = $info->{'score_cp' . $mpv}; + if ($score == 0) { + return " 0.00"; + } if ($invert) { $score = -$score; } @@ -1160,16 +1236,18 @@ sub book_info { } sub open_engine { - my $cmdline = shift; + my ($cmdline, $tag) = @_; my ($uciread, $uciwrite); my $pid = IPC::Open2::open2($uciread, $uciwrite, $cmdline); my $engine = { pid => $pid, read => $uciread, + readbuf => '', write => $uciwrite, info => {}, - ids => {} + ids => {}, + tag => $tag, }; uciprint($engine, "uci"); @@ -1183,18 +1261,17 @@ sub open_engine { return $engine; } -sub read_line { - my $fh = shift; +sub read_lines { + my $engine = shift; # # Read until we've got a full line -- if the engine sends part of # a line and then stops we're pretty much hosed, but that should # never happen. # - my $line = ''; - while ($line !~ /\n/) { + while ($engine->{'readbuf'} !~ /\n/) { my $tmp; - my $ret = sysread $fh, $tmp, 1; + my $ret = sysread $engine->{'read'}, $tmp, 4096; if (!defined($ret)) { next if ($!{EINTR}); @@ -1203,11 +1280,17 @@ sub read_line { die "EOF from UCI engine"; } - $line .= $tmp; + $engine->{'readbuf'} .= $tmp; } - $line =~ tr/\r\n//d; - return $line; + # Blah. + my @lines = (); + while ($engine->{'readbuf'} =~ s/^([^\n]*)\n//) { + my $line = $1; + $line =~ tr/\r\n//d; + push @lines, $line; + } + return @lines; } # Find all possible legal moves.