X-Git-Url: https://git.sesse.net/?p=remoteglot;a=blobdiff_plain;f=remoteglot.pl;h=baed79ae476cb47cadbd7a9973d6998d9dc4974c;hp=bd10cd020475f50a4b3ca0db6e08108e3babead6;hb=faf19b0ff0a5cbc2e814bd095c95d64730e18d27;hpb=9e923c34a6788eb9780a151316b196d4a18c3bbd diff --git a/remoteglot.pl b/remoteglot.pl index bd10cd0..baed79a 100755 --- a/remoteglot.pl +++ b/remoteglot.pl @@ -99,7 +99,7 @@ while (1) { chomp $line; $line =~ tr/\r//d; if ($line =~ /^<12> /) { - my $pos = style12_to_fen($line); + my $pos = style12_to_pos($line); # if this is already in the queue, ignore it next if (defined($pos_waiting) && $pos->{'fen'} eq $pos_waiting->{'fen'}); @@ -132,6 +132,7 @@ while (1) { } %uciinfo = (); + $engine->{'info'} = {}; $last_move = time; # @@ -164,28 +165,8 @@ while (1) { # any fun on the UCI channel? if ($nfound > 0 && vec($rout, fileno($engine->{'read'}), 1) == 1) { - # - # 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/) { - my $tmp; - my $ret = sysread $engine->{'read'}, $tmp, 1; - - if (!defined($ret)) { - next if ($!{EINTR}); - die "error in reading from the UCI engine: $!"; - } elsif ($ret == 0) { - die "EOF from UCI engine"; - } - - $line .= $tmp; - } - - $line =~ tr/\r\n//d; - handle_uci($line); + my $line = read_line($engine->{'read'}); + handle_uci($engine, $line); $sleep = 0; # don't update too often @@ -196,7 +177,7 @@ while (1) { } sub handle_uci { - my ($line) = @_; + my ($engine, $line) = @_; chomp $line; $line =~ tr/\r//d; @@ -206,13 +187,13 @@ sub handle_uci { my (@infos) = split / /, $line; shift @infos; - parse_infos(@infos); + parse_infos($engine, @infos); } if ($line =~ /^id/) { my (@ids) = split / /, $line; shift @ids; - parse_ids(@ids); + parse_ids($engine, @ids); } if ($line =~ /^bestmove/ && $uci_assume_full_compliance) { if (defined($pos_waiting)) { @@ -226,9 +207,11 @@ sub handle_uci { } sub parse_infos { - my (@x) = @_; + my ($engine, @x) = @_; my $mpv = ''; + my $info = $engine->{'info'}; + while (scalar @x > 0) { if ($x[0] =~ 'multipv') { shift @x; @@ -238,28 +221,28 @@ sub parse_infos { if ($x[0] =~ /^(currmove|currmovenumber|cpuload)$/) { my $key = shift @x; my $value = shift @x; - $uciinfo{$key} = $value; + $info->{$key} = $value; next; } if ($x[0] =~ /^(depth|seldepth|hashfull|time|nodes|nps|tbhits)$/) { my $key = shift @x; my $value = shift @x; - $uciinfo{$key . $mpv} = $value; + $info->{$key . $mpv} = $value; next; } if ($x[0] eq 'score') { shift @x; - delete $uciinfo{'score_cp' . $mpv}; - delete $uciinfo{'score_mate' . $mpv}; + delete $info->{'score_cp' . $mpv}; + delete $info->{'score_mate' . $mpv}; while ($x[0] =~ /^(cp|mate|lowerbound|upperbound)$/) { if ($x[0] eq 'cp') { shift @x; - $uciinfo{'score_cp' . $mpv} = shift @x; + $info->{'score_cp' . $mpv} = shift @x; } elsif ($x[0] eq 'mate') { shift @x; - $uciinfo{'score_mate' . $mpv} = shift @x; + $info->{'score_mate' . $mpv} = shift @x; } else { shift @x; } @@ -267,7 +250,7 @@ sub parse_infos { next; } if ($x[0] eq 'pv') { - $uciinfo{'pv' . $mpv} = [ @x[1..$#x] ]; + $info->{'pv' . $mpv} = [ @x[1..$#x] ]; last; } if ($x[0] eq 'string' || $x[0] eq 'UCI_AnalyseMode' || $x[0] eq 'setting' || $x[0] eq 'contempt') { @@ -282,13 +265,13 @@ sub parse_infos { } sub parse_ids { - my (@x) = @_; + my ($engine, @x) = @_; while (scalar @x > 0) { if ($x[0] =~ /^(name|author)$/) { my $key = shift @x; my $value = join(' ', @x); - $uciid{$key} = $value; + $engine->{'info'}{'id'}{$key} = $value; last; } @@ -297,16 +280,31 @@ sub parse_ids { } } -sub style12_to_fen { +sub style12_to_pos { my $str = shift; my %pos = (); my (@x) = split / /, $str; $pos{'board'} = [ @x[1..8] ]; $pos{'toplay'} = $x[9]; - + $pos{'ep_file_num'} = $x[10]; + $pos{'white_castle_k'} = $x[11]; + $pos{'white_castle_q'} = $x[12]; + $pos{'black_castle_k'} = $x[13]; + $pos{'black_castle_q'} = $x[14]; + $pos{'time_to_100move_rule'} = $x[15]; + $pos{'move_num'} = $x[26]; + $pos{'last_move'} = $x[29]; + $pos{'fen'} = make_fen(\%pos); + + return \%pos; +} + +sub make_fen { + my $pos = shift; + # the board itself - my (@board) = @x[1..8]; + my (@board) = @{$pos->{'board'}}; for my $rank (0..7) { $board[$rank] =~ s/(-+)/length($1)/ge; } @@ -314,14 +312,14 @@ sub style12_to_fen { # white/black to move $fen .= " "; - $fen .= lc($x[9]); + $fen .= lc($pos->{'toplay'}); # castling my $castling = ""; - $castling .= "K" if ($x[11] == 1); - $castling .= "Q" if ($x[12] == 1); - $castling .= "k" if ($x[13] == 1); - $castling .= "q" if ($x[14] == 1); + $castling .= "K" if ($pos->{'white_castle_k'} == 1); + $castling .= "Q" if ($pos->{'white_castle_q'} == 1); + $castling .= "k" if ($pos->{'black_castle_k'} == 1); + $castling .= "q" if ($pos->{'black_castle_q'} == 1); $castling = "-" if ($castling eq ""); # $castling = "-"; # chess960 $fen .= " "; @@ -329,11 +327,11 @@ sub style12_to_fen { # en passant my $ep = "-"; - if ($x[10] != -1) { - my $col = $x[10]; + if ($pos->{'ep_file_num'} != -1) { + my $col = $pos->{'ep_file_num'}; my $nep = (qw(a b c d e f g h))[$col]; - if ($x[9] eq 'B') { + if ($pos->{'toplay'} eq 'B') { $nep .= "3"; } else { $nep .= "6"; @@ -346,12 +344,12 @@ sub style12_to_fen { # not, just lie -- it doesn't matter anyway. I'm unsure what's the # "right" thing as per the standard, though. # - if ($x[9] eq 'B') { - $ep = $nep if ($col > 0 && substr($pos{'board'}[4], $col-1, 1) eq 'p'); - $ep = $nep if ($col < 7 && substr($pos{'board'}[4], $col+1, 1) eq 'p'); + if ($pos->{'toplay'} eq 'B') { + $ep = $nep if ($col > 0 && substr($pos->{'board'}[4], $col-1, 1) eq 'p'); + $ep = $nep if ($col < 7 && substr($pos->{'board'}[4], $col+1, 1) eq 'p'); } else { - $ep = $nep if ($col > 0 && substr($pos{'board'}[3], $col-1, 1) eq 'P'); - $ep = $nep if ($col < 7 && substr($pos{'board'}[3], $col+1, 1) eq 'P'); + $ep = $nep if ($col > 0 && substr($pos->{'board'}[3], $col-1, 1) eq 'P'); + $ep = $nep if ($col < 7 && substr($pos->{'board'}[3], $col+1, 1) eq 'P'); } } $fen .= " "; @@ -359,43 +357,27 @@ sub style12_to_fen { # half-move clock $fen .= " "; - $fen .= $x[15]; + $fen .= $pos->{'time_to_100move_rule'}; # full-move clock $fen .= " "; - $fen .= $x[26]; - - $pos{'fen'} = $fen; - $pos{'move_num'} = $x[26]; - $pos{'last_move'} = $x[29]; + $fen .= $pos->{'move_num'}; - return \%pos; + return $fen; } -sub prettyprint_pv { - my ($board, @pvs) = @_; - - if (scalar @pvs == 0 || !defined($pvs[0])) { - return (); - } - - my @nb = @$board; - - my $pv = shift @pvs; - my $from_col = ord(substr($pv, 0, 1)) - ord('a'); - my $from_row = 7 - (ord(substr($pv, 1, 1)) - ord('1')); - my $to_col = ord(substr($pv, 2, 1)) - ord('a'); - my $to_row = 7 - (ord(substr($pv, 3, 1)) - ord('1')); - - my $pretty; +sub make_move { + my ($board, $from_row, $from_col, $to_row, $to_col, $promo) = @_; + my $move = move_to_uci_notation($from_row, $from_col, $to_row, $to_col, $promo); my $piece = substr($board->[$from_row], $from_col, 1); + my @nb = @$board; if ($piece eq '-') { - die "Invalid move $pv"; + die "Invalid move $move"; } # white short castling - if ($pv eq 'e1g1' && $piece eq 'K') { + if ($move eq 'e1g1' && $piece eq 'K') { # king substr($nb[7], 4, 1, '-'); substr($nb[7], 6, 1, $piece); @@ -404,11 +386,11 @@ sub prettyprint_pv { substr($nb[7], 7, 1, '-'); substr($nb[7], 5, 1, 'R'); - return ('0-0', prettyprint_pv(\@nb, @pvs)); + return \@nb; } # white long castling - if ($pv eq 'e1c1' && $piece eq 'K') { + if ($move eq 'e1c1' && $piece eq 'K') { # king substr($nb[7], 4, 1, '-'); substr($nb[7], 2, 1, $piece); @@ -417,11 +399,11 @@ sub prettyprint_pv { substr($nb[7], 0, 1, '-'); substr($nb[7], 3, 1, 'R'); - return ('0-0-0', prettyprint_pv(\@nb, @pvs)); + return \@nb; } # black short castling - if ($pv eq 'e8g8' && $piece eq 'k') { + if ($move eq 'e8g8' && $piece eq 'k') { # king substr($nb[0], 4, 1, '-'); substr($nb[0], 6, 1, $piece); @@ -430,11 +412,11 @@ sub prettyprint_pv { substr($nb[0], 7, 1, '-'); substr($nb[0], 5, 1, 'r'); - return ('0-0', prettyprint_pv(\@nb, @pvs)); + return \@nb; } # black long castling - if ($pv eq 'e8c8' && $piece eq 'k') { + if ($move eq 'e8c8' && $piece eq 'k') { # king substr($nb[0], 4, 1, '-'); substr($nb[0], 2, 1, $piece); @@ -443,15 +425,13 @@ sub prettyprint_pv { substr($nb[0], 0, 1, '-'); substr($nb[0], 3, 1, 'r'); - return ('0-0-0', prettyprint_pv(\@nb, @pvs)); + return \@nb; } # check if the from-piece is a pawn if (lc($piece) eq 'p') { # attack? if ($from_col != $to_col) { - $pretty = substr($pv, 0, 1) . 'x' . substr($pv, 2, 2); - # en passant? if (substr($board->[$to_row], $to_col, 1) eq '-') { if ($piece eq 'p') { @@ -460,6 +440,72 @@ sub prettyprint_pv { substr($nb[$to_row - 1], $to_col, 1, '-'); } } + } else { + if ($promo ne '') { + if ($piece eq 'p') { + $piece = $promo; + } else { + $piece = uc($promo); + } + } + } + } + + # update the board + substr($nb[$from_row], $from_col, 1, '-'); + substr($nb[$to_row], $to_col, 1, $piece); + + return \@nb; +} + +sub prettyprint_pv { + my ($board, @pvs) = @_; + + if (scalar @pvs == 0 || !defined($pvs[0])) { + return (); + } + + my $pv = shift @pvs; + my $from_col = col_letter_to_num(substr($pv, 0, 1)); + my $from_row = row_letter_to_num(substr($pv, 1, 1)); + my $to_col = col_letter_to_num(substr($pv, 2, 1)); + my $to_row = row_letter_to_num(substr($pv, 3, 1)); + my $promo = substr($pv, 4, 1); + + my $nb = make_move($board, $from_row, $from_col, $to_row, $to_col, $promo); + my $piece = substr($board->[$from_row], $from_col, 1); + + if ($piece eq '-') { + die "Invalid move $pv"; + } + + # white short castling + if ($pv eq 'e1g1' && $piece eq 'K') { + return ('0-0', prettyprint_pv($nb, @pvs)); + } + + # white long castling + if ($pv eq 'e1c1' && $piece eq 'K') { + return ('0-0-0', prettyprint_pv($nb, @pvs)); + } + + # black short castling + if ($pv eq 'e8g8' && $piece eq 'k') { + return ('0-0', prettyprint_pv($nb, @pvs)); + } + + # black long castling + if ($pv eq 'e8c8' && $piece eq 'k') { + return ('0-0-0', prettyprint_pv($nb, @pvs)); + } + + my $pretty; + + # check if the from-piece is a pawn + if (lc($piece) eq 'p') { + # attack? + if ($from_col != $to_col) { + $pretty = substr($pv, 0, 1) . 'x' . substr($pv, 2, 2); } else { $pretty = substr($pv, 2, 2); @@ -520,17 +566,12 @@ sub prettyprint_pv { $pretty .= substr($pv, 2, 2); } - # update the board - substr($nb[$from_row], $from_col, 1, '-'); - substr($nb[$to_row], $to_col, 1, $piece); - - if (in_mate(\@nb)) { + if (in_mate($nb)) { $pretty .= '#'; - } elsif (in_check(\@nb) ne 'none') { + } elsif (in_check($nb) ne 'none') { $pretty .= '+'; } - - return ($pretty, prettyprint_pv(\@nb, @pvs)); + return ($pretty, prettyprint_pv($nb, @pvs)); } sub output_screen { @@ -538,6 +579,9 @@ sub output_screen { return if (!defined($pos_calculating)); + my $info = $engine->{'info'}; + my $id = $engine->{'id'}; + # # 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 @@ -545,18 +589,18 @@ sub output_screen { # eval { my $dummy; - if (exists($uciinfo{'pv'})) { - $dummy = prettyprint_pv($pos_calculating->{'board'}, @{$uciinfo{'pv'}}); + if (exists($info->{'pv'})) { + $dummy = prettyprint_pv($pos_calculating->{'board'}, @{$info->{'pv'}}); } my $mpv = 1; - while (exists($uciinfo{'pv' . $mpv})) { - $dummy = prettyprint_pv($pos_calculating->{'board'}, @{$uciinfo{'pv' . $mpv}}); + while (exists($info->{'pv' . $mpv})) { + $dummy = prettyprint_pv($pos_calculating->{'board'}, @{$info->{'pv' . $mpv}}); ++$mpv; } }; if ($@) { - %uciinfo = (); + $engine->{'info'} = {}; return; } @@ -567,13 +611,13 @@ sub output_screen { } else { $text .= sprintf ' after %u. %s', $pos_calculating->{'move_num'}, $pos_calculating->{'last_move'}; } - if (exists($uciid{'name'})) { + if (exists($id->{'name'})) { $text .= ','; } } - if (exists($uciid{'name'})) { - $text .= " by $uciid{'name'}:\n\n"; + if (exists($id->{'name'})) { + $text .= " by $id->{'name'}:\n\n"; } else { $text .= ":\n\n"; } @@ -585,61 +629,61 @@ sub output_screen { # In this case, we simply use that data as if MultiPV was never # specified. # - if (exists($uciinfo{'pv1'}) && !exists($uciinfo{'pv2'})) { - for my $key qw(pv score_cp score_mate nodes nps depth seldepth tbhits) { - if (exists($uciinfo{$key . '1'}) && !exists($uciinfo{$key})) { - $uciinfo{$key} = $uciinfo{$key . '1'}; + 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($uciinfo{'pv1'}) && exists($uciinfo{'pv2'})) { + if (exists($info->{'pv1'}) && exists($info->{'pv2'})) { # multi-PV my $mpv = 1; - while (exists($uciinfo{'pv' . $mpv})) { + while (exists($info->{'pv' . $mpv})) { $text .= sprintf " PV%2u", $mpv; - my $score = short_score(\%uciinfo, $pos_calculating, $mpv); + my $score = short_score($info, $pos_calculating, $mpv); $text .= " ($score)" if (defined($score)); my $tbhits = ''; - if (exists($uciinfo{'tbhits' . $mpv}) && $uciinfo{'tbhits' . $mpv} > 0) { - if ($uciinfo{'tbhits' . $mpv} == 1) { + if (exists($info->{'tbhits' . $mpv}) && $info->{'tbhits' . $mpv} > 0) { + if ($info->{'tbhits' . $mpv} == 1) { $tbhits = ", 1 tbhit"; } else { - $tbhits = sprintf ", %u tbhits", $uciinfo{'tbhits' . $mpv}; + $tbhits = sprintf ", %u tbhits", $info->{'tbhits' . $mpv}; } } - if (exists($uciinfo{'nodes' . $mpv}) && exists($uciinfo{'nps' . $mpv}) && exists($uciinfo{'depth' . $mpv})) { + if (exists($info->{'nodes' . $mpv}) && exists($info->{'nps' . $mpv}) && exists($info->{'depth' . $mpv})) { $text .= sprintf " (%5u kn, %3u kn/s, %2u ply$tbhits)", - $uciinfo{'nodes' . $mpv} / 1000, $uciinfo{'nps' . $mpv} / 1000, $uciinfo{'depth' . $mpv}; + $info->{'nodes' . $mpv} / 1000, $info->{'nps' . $mpv} / 1000, $info->{'depth' . $mpv}; } $text .= ":\n"; - $text .= " " . join(', ', prettyprint_pv($pos_calculating->{'board'}, @{$uciinfo{'pv' . $mpv}})) . "\n"; + $text .= " " . join(', ', prettyprint_pv($pos_calculating->{'board'}, @{$info->{'pv' . $mpv}})) . "\n"; $text .= "\n"; ++$mpv; } } else { # single-PV - my $score = long_score(\%uciinfo, $pos_calculating, ''); + my $score = long_score($info, $pos_calculating, ''); $text .= " $score\n" if defined($score); - $text .= " PV: " . join(', ', prettyprint_pv($pos_calculating->{'board'}, @{$uciinfo{'pv'}})); + $text .= " PV: " . join(', ', prettyprint_pv($pos_calculating->{'board'}, @{$info->{'pv'}})); $text .= "\n"; - if (exists($uciinfo{'nodes'}) && exists($uciinfo{'nps'}) && exists($uciinfo{'depth'})) { + if (exists($info->{'nodes'}) && exists($info->{'nps'}) && exists($info->{'depth'})) { $text .= sprintf " %u nodes, %7u nodes/sec, depth %u ply", - $uciinfo{'nodes'}, $uciinfo{'nps'}, $uciinfo{'depth'}; + $info->{'nodes'}, $info->{'nps'}, $info->{'depth'}; } - if (exists($uciinfo{'tbhits'}) && $uciinfo{'tbhits'} > 0) { - if ($uciinfo{'tbhits'} == 1) { + if (exists($info->{'tbhits'}) && $info->{'tbhits'} > 0) { + if ($info->{'tbhits'} == 1) { $text .= ", one Nalimov hit"; } else { - $text .= sprintf ", %u Nalimov hits", $uciinfo{'tbhits'}; + $text .= sprintf ", %u Nalimov hits", $info->{'tbhits'}; } } - if (exists($uciinfo{'seldepth'})) { - $text .= sprintf " (%u selective)", $uciinfo{'seldepth'}; + if (exists($info->{'seldepth'})) { + $text .= sprintf " (%u selective)", $info->{'seldepth'}; } $text .= "\n\n"; } @@ -657,36 +701,36 @@ sub output_screen { my $tell_text = ''; - if (exists($uciid{'name'})) { - $tell_text .= "Analysis by $uciid{'name'} -- see http://analysis.sesse.net/ for more information\n"; + if (exists($id->{'name'})) { + $tell_text .= "Analysis by $id->{'name'} -- see http://analysis.sesse.net/ for more information\n"; } else { $tell_text .= "Computer analysis -- http://analysis.sesse.net/ for more information\n"; } - if (exists($uciinfo{'pv1'}) && exists($uciinfo{'pv2'})) { + if (exists($info->{'pv1'}) && exists($info->{'pv2'})) { # multi-PV my $mpv = 1; - while (exists($uciinfo{'pv' . $mpv})) { + while (exists($info->{'pv' . $mpv})) { $tell_text .= sprintf " PV%2u", $mpv; - my $score = short_score(\%uciinfo, $pos_calculating, $mpv); + my $score = short_score($info, $pos_calculating, $mpv); $tell_text .= " ($score)" if (defined($score)); - if (exists($uciinfo{'depth' . $mpv})) { - $tell_text .= sprintf " (%2u ply)", $uciinfo{'depth' . $mpv}; + if (exists($info->{'depth' . $mpv})) { + $tell_text .= sprintf " (%2u ply)", $info->{'depth' . $mpv}; } $tell_text .= ": "; - $tell_text .= join(', ', prettyprint_pv($pos_calculating->{'board'}, @{$uciinfo{'pv' . $mpv}})); + $tell_text .= join(', ', prettyprint_pv($pos_calculating->{'board'}, @{$info->{'pv' . $mpv}})); $tell_text .= "\n"; ++$mpv; } } else { # single-PV - my $score = long_score(\%uciinfo, $pos_calculating, ''); + my $score = long_score($info, $pos_calculating, ''); $tell_text .= " $score\n" if defined($score); - $tell_text .= " PV: " . join(', ', prettyprint_pv($pos_calculating->{'board'}, @{$uciinfo{'pv'}})); - if (exists($uciinfo{'depth'})) { - $tell_text .= sprintf " (depth %u ply)", $uciinfo{'depth'}; + $tell_text .= " PV: " . join(', ', prettyprint_pv($pos_calculating->{'board'}, @{$info->{'pv'}})); + if (exists($info->{'depth'})) { + $tell_text .= sprintf " (depth %u ply)", $info->{'depth'}; } $tell_text .= "\n"; } @@ -873,11 +917,17 @@ sub can_reach { return (can_reach($board, 'R', $from_row, $from_col, $to_row, $to_col) || can_reach($board, 'B', $from_row, $from_col, $to_row, $to_col)); } + + # TODO: en passant if ($piece eq 'p') { # black pawn if ($to_col == $from_col && $to_row == $from_row + 1) { return ($dest_piece eq '-'); } + if ($to_col == $from_col && $from_row == 1 && $to_row == 3) { + my $middle_piece = substr($board->[2], $to_col, 1); + return ($dest_piece eq '-' && $middle_piece eq '-'); + } if (abs($to_col - $from_col) == 1 && $to_row == $from_row + 1) { return ($dest_piece ne '-'); } @@ -888,6 +938,10 @@ sub can_reach { if ($to_col == $from_col && $to_row == $from_row - 1) { return ($dest_piece eq '-'); } + if ($to_col == $from_col && $from_row == 6 && $to_row == 4) { + my $middle_piece = substr($board->[5], $to_col, 1); + return ($dest_piece eq '-' && $middle_piece eq '-'); + } if (abs($to_col - $from_col) == 1 && $to_row == $from_row - 1) { return ($dest_piece ne '-'); } @@ -905,13 +959,13 @@ sub uciprint { } sub short_score { - my ($uciinfo, $pos, $mpv) = @_; + my ($info, $pos, $mpv) = @_; - if (defined($uciinfo{'score_mate' . $mpv})) { - return sprintf "M%3d", $uciinfo{'score_mate' . $mpv}; + if (defined($info->{'score_mate' . $mpv})) { + return sprintf "M%3d", $info->{'score_mate' . $mpv}; } else { - if (exists($uciinfo{'score_cp' . $mpv})) { - my $score = $uciinfo{'score_cp' . $mpv} * 0.01; + if (exists($info->{'score_cp' . $mpv})) { + my $score = $info->{'score_cp' . $mpv} * 0.01; if ($pos->{'toplay'} eq 'B') { $score = -$score; } @@ -923,10 +977,10 @@ sub short_score { } sub long_score { - my ($uciinfo, $pos, $mpv) = @_; + my ($info, $pos, $mpv) = @_; - if (defined($uciinfo{'score_mate' . $mpv})) { - my $mate = $uciinfo{'score_mate' . $mpv}; + if (defined($info->{'score_mate' . $mpv})) { + my $mate = $info->{'score_mate' . $mpv}; if ($pos->{'toplay'} eq 'B') { $mate = -$mate; } @@ -936,8 +990,8 @@ sub long_score { return sprintf "Black mates in %u", -$mate; } } else { - if (exists($uciinfo{'score_cp' . $mpv})) { - my $score = $uciinfo{'score_cp' . $mpv} * 0.01; + if (exists($info->{'score_cp' . $mpv})) { + my $score = $info->{'score_cp' . $mpv} * 0.01; if ($pos->{'toplay'} eq 'B') { $score = -$score; } @@ -1008,7 +1062,9 @@ sub open_engine { my $engine = { pid => $pid, read => $uciread, - write => $uciwrite + write => $uciwrite, + info => {}, + ids => {} }; uciprint($engine, "uci"); @@ -1016,8 +1072,49 @@ sub open_engine { # gobble the options while (<$uciread>) { /uciok/ && last; - handle_uci($_); + handle_uci($engine, $_); } return $engine; } + +sub read_line { + my $fh = 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/) { + my $tmp; + my $ret = sysread $engine->{'read'}, $tmp, 1; + + if (!defined($ret)) { + next if ($!{EINTR}); + die "error in reading from the UCI engine: $!"; + } elsif ($ret == 0) { + die "EOF from UCI engine"; + } + + $line .= $tmp; + } + + $line =~ tr/\r\n//d; + return $line; +} + +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); +}