+
+sub uciprint {
+ my ($engine, $msg) = @_;
+ print { $engine->{'write'} } "$msg\n";
+ print UCILOG localtime() . " => $msg\n";
+}
+
+sub short_score {
+ my ($info, $pos, $mpv, $invert) = @_;
+
+ $invert //= 0;
+ if ($pos->{'toplay'} eq 'B') {
+ $invert = !$invert;
+ }
+
+ 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 {
+ if (exists($info->{'score_cp' . $mpv})) {
+ my $score = $info->{'score_cp' . $mpv} * 0.01;
+ if ($invert) {
+ $score = -$score;
+ }
+ return sprintf "%+5.2f", $score;
+ }
+ }
+
+ return undef;
+}
+
+sub score_sort_key {
+ my ($info, $pos, $mpv, $invert) = @_;
+
+ $invert //= 0;
+ if ($pos->{'toplay'} eq 'B') {
+ $invert = !$invert;
+ }
+
+ if (defined($info->{'score_mate' . $mpv})) {
+ if ($invert) {
+ return -(99999 - $info->{'score_mate' . $mpv});
+ } else {
+ return 99999 - $info->{'score_mate' . $mpv};
+ }
+ } else {
+ if (exists($info->{'score_cp' . $mpv})) {
+ my $score = $info->{'score_cp' . $mpv};
+ if ($invert) {
+ $score = -$score;
+ }
+ return $score;
+ }
+ }
+
+ return undef;
+}
+
+sub long_score {
+ my ($info, $pos, $mpv) = @_;
+
+ if (defined($info->{'score_mate' . $mpv})) {
+ my $mate = $info->{'score_mate' . $mpv};
+ if ($pos->{'toplay'} eq 'B') {
+ $mate = -$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})) {
+ my $score = $info->{'score_cp' . $mpv} * 0.01;
+ if ($pos->{'toplay'} eq 'B') {
+ $score = -$score;
+ }
+ return sprintf "Score: %+5.2f", $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;
+
+ my $pmove;
+ if ($move eq '') {
+ $pmove = '(current)';
+ } else {
+ ($pmove) = prettyprint_pv($board, $move);
+ $pmove .= $annotation;
+ }
+
+ 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;
+ }
+ my $n = $win + $draw + $lose;
+
+ my $percent;
+ if ($n == 0) {
+ $percent = " ";
+ } else {
+ $percent = sprintf "%4u%%", int(100.0 * $score / $n + 0.5);
+ }
+
+ 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;
+}
+
+sub open_engine {
+ my $cmdline = shift;
+ my ($uciread, $uciwrite);
+ my $pid = IPC::Open2::open2($uciread, $uciwrite, $cmdline);
+
+ my $engine = {
+ pid => $pid,
+ read => $uciread,
+ readbuf => '',
+ write => $uciwrite,
+ info => {},
+ ids => {},
+ };
+
+ uciprint($engine, "uci");
+
+ # gobble the options
+ while (<$uciread>) {
+ /uciok/ && last;
+ handle_uci($engine, $_);
+ }
+
+ return $engine;
+}
+
+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.
+ #
+ while ($engine->{'readbuf'} !~ /\n/) {
+ my $tmp;
+ my $ret = sysread $engine->{'read'}, $tmp, 4096;
+
+ if (!defined($ret)) {
+ next if ($!{EINTR});
+ die "error in reading from the UCI engine: $!";
+ } elsif ($ret == 0) {
+ die "EOF from UCI engine";
+ }
+
+ $engine->{'readbuf'} .= $tmp;
+ }
+
+ # 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.
+sub calculate_refutation_moves {
+ my $pos = shift;
+ my $board = $pos->{'board'};
+ my %refutation_moves = ();
+ for my $col (0..7) {
+ for my $row (0..7) {
+ my $piece = substr($board->[$row], $col, 1);
+
+ # Check that there's a piece of the right color on this square.
+ next if ($piece eq '-');
+ if ($pos->{'toplay'} eq 'W') {
+ next if ($piece ne uc($piece));
+ } else {
+ next if ($piece ne lc($piece));
+ }
+
+ for my $to_col (0..7) {
+ for my $to_row (0..7) {
+ next if ($col == $to_col && $row == $to_row);
+ next unless (can_reach($board, $piece, $row, $col, $to_row, $to_col));
+
+ my $promo = ""; # FIXME
+ my $nb = make_move($board, $row, $col, $to_row, $to_col, $promo);
+ my $check = in_check($nb);
+ next if ($check eq 'both');
+ if ($pos->{'toplay'} eq 'W') {
+ next if ($check eq 'white');
+ } else {
+ next if ($check eq 'black');
+ }
+ my $move = move_to_uci_notation($row, $col, $to_row, $to_col, $promo);
+ $refutation_moves{$move} = { depth => $second_engine_start_depth - 1, score_cp => 0, pv => '' };
+ }
+ }
+ }
+ }
+ return %refutation_moves;
+}
+
+sub give_new_move_to_second_engine {
+ my $pos = shift;
+
+ # Find the move that's been analyzed the shortest but is most promising.
+ # Tie-break on UCI move representation.
+ my $best_move = undef;
+ for my $move (sort keys %refutation_moves) {
+ if (!defined($best_move)) {
+ $best_move = $move;
+ next;
+ }
+ my $best = $refutation_moves{$best_move};
+ my $this = $refutation_moves{$move};
+
+ if ($this->{'depth'} < $best->{'depth'} ||
+ ($this->{'depth'} == $best->{'depth'} && $this->{'score_cp'} < $best->{'score_cp'})) {
+ $best_move = $move;
+ next;
+ }
+ }
+
+ my $m = $refutation_moves{$best_move};
+ ++$m->{'depth'};
+ uciprint($engine2, "position fen " . $pos->{'fen'} . " moves " . $best_move);
+ uciprint($engine2, "go depth " . $m->{'depth'});
+ $move_calculating_second_engine = $best_move;
+}
+
+sub col_letter_to_num {
+ return ord(shift) - ord('a');
+}
+
+sub row_letter_to_num {
+ return 7 - (ord(shift) - ord('1'));
+}
+
+sub move_to_uci_notation {
+ my ($from_row, $from_col, $to_row, $to_col, $promo) = @_;
+ $promo //= "";
+ return sprintf("%c%d%c%d%s", ord('a') + $from_col, 8 - $from_row, ord('a') + $to_col, 8 - $to_row, $promo);
+}