X-Git-Url: https://git.sesse.net/?p=remoteglot;a=blobdiff_plain;f=remoteglot.pl;h=2c4bb9e8247be699bbd11cc21a5fd326a6389232;hp=c64fb41ceb1eea3b5e215afa2f3c676c253fc343;hb=07fe77d2f39c91fee4545236ef1134f9000b749c;hpb=3991b81c05e25f13cc6ec9e4cc18896d9247fc0e diff --git a/remoteglot.pl b/remoteglot.pl old mode 100644 new mode 100755 index c64fb41..2c4bb9e --- a/remoteglot.pl +++ b/remoteglot.pl @@ -16,38 +16,63 @@ use Time::HiRes; use strict; use warnings; +# Configuration +my $server = "freechess.org"; +my $target = "Sesse"; +# my $engine = "/usr/games/toga2"; +my $engine = "wine Rybkav2.3.2a.mp.w32.exe"; +my $telltarget = undef; # undef to be silent +my @tell_intervals = (5, 20, 60, 120, 240, 480, 960); # after each move + +# Program starts here $SIG{ALRM} = sub { output_screen(); }; $| = 1; -my $server = "freechess.org"; -my $target = "Sesse"; -# my $engine = "/usr/games/toga2"; -my $engine = "wine rybka22-mpw32.exe"; +open(FICSLOG, ">ficslog.txt") + or die "ficslog.txt: $!"; +print FICSLOG "Log starting.\n"; +select(FICSLOG); +$| = 1; + +open(UCILOG, ">ucilog.txt") + or die "ucilog.txt: $!"; +print UCILOG "Log starting.\n"; +select(UCILOG); +$| = 1; +select(STDOUT); # open the chess engine my $pid = IPC::Open2::open2(*UCIREAD, *UCIWRITE, $engine); my %uciinfo = (); +my %uciid = (); my %ficsinfo = (); -print UCIWRITE "uci\n"; +my ($last_move, $last_tell); +my $last_text = ''; +my $last_told_text = ''; + +uciprint("uci"); # gobble the options while () { /uciok/ && last; + handle_uci($_); } -print UCIWRITE "setoption name UCI_AnalyseMode value true\n"; -print UCIWRITE "setoption name NalimovPath value c:\\nalimov\n"; -print UCIWRITE "setoption name NalimovUsage value Normally\n"; -# print UCIWRITE "setoption name Contempt value 1000\n"; -# print UCIWRITE "setoption name Outlook value Ultra Optimistic\n"; -print UCIWRITE "ucinewgame\n"; +uciprint("setoption name UCI_AnalyseMode value true"); +uciprint("setoption name NalimovPath value c:\\nalimov"); +uciprint("setoption name NalimovUsage value Rarely"); +uciprint("setoption name Hash value 1024"); +uciprint("setoption name MultiPV value 3"); +# uciprint("setoption name Contempt value 1000"); +# uciprint("setoption name Outlook value Ultra Optimistic"); +uciprint("ucinewgame"); print "Chess engine ready.\n"; # now talk to FICS my $t = Net::Telnet->new(Timeout => 10, Prompt => '/fics% /'); -#$t->input_log(\*STDOUT); +$t->input_log(\*FICSLOG); $t->open($server); $t->print("guest"); $t->waitfor('/Press return to enter the server/'); @@ -63,10 +88,11 @@ $t->cmd("observe $target"); print "FICS ready.\n"; while (1) { my $rin = ''; + my $rout; vec($rin, fileno(UCIREAD), 1) = 1; vec($rin, fileno($t), 1) = 1; - my ($nfound, $timeleft) = select($rin, undef, undef, 5.0); + my ($nfound, $timeleft) = select($rout=$rin, undef, undef, 5.0); my $sleep = 1.0; while (1) { @@ -77,29 +103,30 @@ while (1) { $line =~ tr/\r//d; if ($line =~ /^<12> /) { my $fen = style12_to_fen($line); - print UCIWRITE "stop\n"; - print UCIWRITE "position fen $fen\n"; - print UCIWRITE "go infinite\n"; - #print "stop\n"; - #print "position fen $fen\n"; - #print "go infinite\n"; + uciprint("stop"); + uciprint("position fen $fen"); + uciprint("go infinite"); + + %uciinfo = (); + $last_move = time; + + # + # Output a command every move to note that we're + # still paying attention -- this is a good tradeoff, + # since if no move has happened in the last half + # hour, the analysis/relay has most likely stopped + # and we should stop hogging server resources. + # + $t->cmd("date"); } #print "FICS: [$line]\n"; $sleep = 0; } # any fun on the UCI channel? - if (vec($rin, fileno(UCIREAD), 1)) { + if ($nfound > 0 && vec($rout, fileno(UCIREAD), 1) == 1) { my $line = ; - chomp $line; - $line =~ tr/\r//d; - #print "UCI: $line\n"; - if ($line =~ /^info/) { - my (@infos) = split / /, $line; - shift @infos; - - parse_infos(@infos); - } + handle_uci($line); $sleep = 0; # don't update too often @@ -109,29 +136,61 @@ while (1) { sleep $sleep; } +sub handle_uci { + my ($line) = @_; + + chomp $line; + $line =~ tr/\r//d; + print UCILOG "<= $line\n"; + if ($line =~ /^info/) { + my (@infos) = split / /, $line; + shift @infos; + + parse_infos(@infos); + } + if ($line =~ /^id/) { + my (@ids) = split / /, $line; + shift @ids; + + parse_ids(@ids); + } +} + sub parse_infos { my (@x) = @_; + my $mpv = ''; while (scalar @x > 0) { - if ($x[0] =~ /^(currmove|currmovenumber|time|nodes|nps|cpuload|hashfull|depth|seldepth|multipv|time|tbhits)$/) { + if ($x[0] =~ 'multipv') { + shift @x; + $mpv = shift @x; + next; + } + if ($x[0] =~ /^(currmove|currmovenumber|cpuload)$/) { my $key = shift @x; my $value = shift @x; $uciinfo{$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; + next; + } if ($x[0] eq 'score') { shift @x; - delete $uciinfo{'score_cp'}; - delete $uciinfo{'score_mate'}; + delete $uciinfo{'score_cp' . $mpv}; + delete $uciinfo{'score_mate' . $mpv}; while ($x[0] =~ /^(cp|mate|lowerbound|upperbound)$/) { if ($x[0] eq 'cp') { shift @x; - $uciinfo{'score_cp'} = shift @x; + $uciinfo{'score_cp' . $mpv} = shift @x; } elsif ($x[0] eq 'mate') { shift @x; - $uciinfo{'score_mate'} = shift @x; + $uciinfo{'score_mate' . $mpv} = shift @x; } else { shift @x; } @@ -139,10 +198,10 @@ sub parse_infos { next; } if ($x[0] eq 'pv') { - $uciinfo{'pv'} = [ @x[1..$#x] ]; + $uciinfo{'pv' . $mpv} = [ @x[1..$#x] ]; last; } - if ($x[0] eq 'UCI_AnalyseMode' || $x[0] eq 'setting' || $x[0] eq 'contempt') { + if ($x[0] eq 'string' || $x[0] eq 'UCI_AnalyseMode' || $x[0] eq 'setting' || $x[0] eq 'contempt') { last; } @@ -153,6 +212,22 @@ sub parse_infos { } } +sub parse_ids { + my (@x) = @_; + + while (scalar @x > 0) { + if ($x[0] =~ /^(name|author)$/) { + my $key = shift @x; + my $value = join(' ', @x); + $uciid{$key} = $value; + last; + } + + # unknown + shift @x; + } +} + sub style12_to_fen { my $str = shift; my (@x) = split / /, $str; @@ -184,11 +259,28 @@ sub style12_to_fen { # en passant my $ep = "-"; if ($x[10] != -1) { - $ep = (qw(a b c d e f g h))[$x[10]]; + my $col = $x[10]; + my $nep = (qw(a b c d e f g h))[$col]; + + if ($x[9] eq 'B') { + $nep .= "3"; + } else { + $nep .= "6"; + } + + # + # Showing the en passant square when actually no capture can be made + # seems to confuse at least Rybka. Thus, check if there's actually + # a pawn of the opposite side that can do the en passant move, and if + # 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 .= "3"; + $ep = $nep if ($col > 0 && substr($board[4], $col-1, 1) eq 'p'); + $ep = $nep if ($col < 7 && substr($board[4], $col+1, 1) eq 'p'); } else { - $ep .= "6"; + $ep = $nep if ($col > 0 && substr($board[3], $col-1, 1) eq 'P'); + $ep = $nep if ($col < 7 && substr($board[3], $col+1, 1) eq 'P'); } } $fen .= " "; @@ -211,6 +303,8 @@ sub prettyprint_pv { 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'); @@ -221,10 +315,12 @@ sub prettyprint_pv { my $pretty; my $piece = substr($board->[$from_row], $from_col, 1); + if ($piece eq '-') { + die "Invalid move"; + } + # white short castling if ($pv eq 'e1g1' && $piece eq 'K') { - my @nb = @$board; - # king substr($nb[7], 4, 1, '-'); substr($nb[7], 6, 1, $piece); @@ -237,46 +333,40 @@ sub prettyprint_pv { } # white long castling - if ($pv eq 'e1b1' && $piece eq 'K') { - my @nb = @$board; - + if ($pv eq 'e1c1' && $piece eq 'K') { # king substr($nb[7], 4, 1, '-'); substr($nb[7], 2, 1, $piece); # rook substr($nb[7], 0, 1, '-'); - substr($nb[7], 2, 1, 'R'); + substr($nb[7], 3, 1, 'R'); return ('0-0-0', prettyprint_pv(\@nb, @pvs)); } # black short castling if ($pv eq 'e8g8' && $piece eq 'k') { - my @nb = @$board; - # king substr($nb[0], 4, 1, '-'); substr($nb[0], 6, 1, $piece); # rook substr($nb[0], 7, 1, '-'); - substr($nb[0], 5, 1, 'R'); + substr($nb[0], 5, 1, 'r'); return ('0-0', prettyprint_pv(\@nb, @pvs)); } # black long castling - if ($pv eq 'e8b8' && $piece eq 'k') { - my @nb = @$board; - + if ($pv eq 'e8c8' && $piece eq 'k') { # king substr($nb[0], 4, 1, '-'); substr($nb[0], 2, 1, $piece); # rook substr($nb[0], 0, 1, '-'); - substr($nb[0], 2, 1, 'R'); + substr($nb[0], 3, 1, 'r'); return ('0-0-0', prettyprint_pv(\@nb, @pvs)); } @@ -284,8 +374,17 @@ sub prettyprint_pv { # check if the from-piece is a pawn if (lc($piece) eq 'p') { # attack? - if (substr($board->[$to_row], $to_col, 1) ne '-') { + 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') { + substr($nb[$to_row + 1], $to_col, 1, '-'); + } else { + substr($nb[$to_row - 1], $to_col, 1, '-'); + } + } } else { $pretty = substr($pv, 2, 2); @@ -347,7 +446,6 @@ sub prettyprint_pv { } # update the board - my @nb = @$board; substr($nb[$from_row], $from_col, 1, '-'); substr($nb[$to_row], $to_col, 1, $piece); @@ -363,27 +461,152 @@ sub prettyprint_pv { sub output_screen { #return; - print "cAnalysis:\n"; - if (defined($uciinfo{'score_mate'})) { - printf " Mate in %d\n", $uciinfo{'score_mate'}; + # + # 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 + # it can frequently miss stuff, but it's good enough for most users. + # + eval { + my $dummy; + if (exists($uciinfo{'pv'})) { + $dummy = prettyprint_pv($ficsinfo{'board'}, @{$uciinfo{'pv'}}); + } + + my $mpv = 1; + while (exists($uciinfo{'pv' . $mpv})) { + $dummy = prettyprint_pv($ficsinfo{'board'}, @{$uciinfo{'pv' . $mpv}}); + ++$mpv; + } + }; + if ($@) { + %uciinfo = (); + return; + } + + my $text = ''; + + if (exists($uciid{'name'})) { + $text .= "Analysis by $uciid{'name'}:\n\n"; } else { - my $score = $uciinfo{'score_cp'} * 0.01; - if ($ficsinfo{'toplay'} eq 'B') { - $score = -$score; + $text .= "Analysis:\n\n"; + } + + return unless (exists($ficsinfo{'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($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'}; + } } - printf " Score: %+5.2f\n", $score; } - print " PV: ", join(', ', prettyprint_pv($ficsinfo{'board'}, @{$uciinfo{'pv'}})); - print "\n"; - printf " %u nodes, %7u nodes/sec, depth %u ply", - $uciinfo{'nodes'}, $uciinfo{'nps'}, $uciinfo{'depth'}; - if (exists($uciinfo{'tbhits'})) { - printf ", %u Nalimov hits", $uciinfo{'tbhits'}; + + if (exists($uciinfo{'pv1'}) && exists($uciinfo{'pv2'})) { + # multi-PV + my $mpv = 1; + while (exists($uciinfo{'pv' . $mpv})) { + $text .= sprintf " PV%2u", $mpv; + my $score = short_score(\%uciinfo, \%ficsinfo, $mpv); + $text .= " ($score)" if (defined($score)); + + if (exists($uciinfo{'nodes' . $mpv}) && exists($uciinfo{'nps' . $mpv}) && exists($uciinfo{'depth' . $mpv})) { + $text .= sprintf " (%5u kn, %3u kn/s, %2u ply)", + $uciinfo{'nodes' . $mpv} / 1000, $uciinfo{'nps' . $mpv} / 1000, $uciinfo{'depth' . $mpv}; + } + + $text .= ":\n"; + $text .= " " . join(', ', prettyprint_pv($ficsinfo{'board'}, @{$uciinfo{'pv' . $mpv}})) . "\n"; + $text .= "\n"; + ++$mpv; + } + } else { + # single-PV + my $score = long_score(\%uciinfo, \%ficsinfo, ''); + $text .= " $score\n" if defined($score); + $text .= " PV: " . join(', ', prettyprint_pv($ficsinfo{'board'}, @{$uciinfo{'pv'}})); + $text .= "\n"; + + if (exists($uciinfo{'nodes'}) && exists($uciinfo{'nps'}) && exists($uciinfo{'depth'})) { + $text .= sprintf " %u nodes, %7u nodes/sec, depth %u ply", + $uciinfo{'nodes'}, $uciinfo{'nps'}, $uciinfo{'depth'}; + } + if (exists($uciinfo{'tbhits'})) { + $text .= sprintf ", %u Nalimov hits", $uciinfo{'tbhits'}; + } + if (exists($uciinfo{'seldepth'})) { + $text .= sprintf " (%u selective)", $uciinfo{'seldepth'}; + } + $text .= "\n\n"; } - if (exists($uciinfo{'seldepth'})) { - printf " (%u selective)", $uciinfo{'seldepth'}; + + if ($last_text ne $text) { + print ""; # clear the screen + print $text; + $last_text = $text; + } + + # Now construct the tell text, if any + return if (!defined($telltarget)); + + my $tell_text = ''; + + if (exists($uciid{'name'})) { + $tell_text .= "Analysis by $uciid{'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'})) { + # multi-PV + my $mpv = 1; + while (exists($uciinfo{'pv' . $mpv})) { + $tell_text .= sprintf " PV%2u", $mpv; + my $score = short_score(\%uciinfo, \%ficsinfo, $mpv); + $tell_text .= " ($score)" if (defined($score)); + + if (exists($uciinfo{'depth' . $mpv})) { + $tell_text .= sprintf " (%2u ply)", $uciinfo{'depth' . $mpv}; + } + + $tell_text .= ": "; + $tell_text .= join(', ', prettyprint_pv($ficsinfo{'board'}, @{$uciinfo{'pv' . $mpv}})); + $tell_text .= "\n"; + ++$mpv; + } + } else { + # single-PV + my $score = long_score(\%uciinfo, \%ficsinfo, ''); + $tell_text .= " $score\n" if defined($score); + $tell_text .= " PV: " . join(', ', prettyprint_pv($ficsinfo{'board'}, @{$uciinfo{'pv'}})); + if (exists($uciinfo{'depth'})) { + $tell_text .= sprintf " (depth %u ply)", $uciinfo{'depth'}; + } + $tell_text .= "\n"; + } + + # see if a new tell is called for -- it is if the delay has expired _and_ + # this is not simply a repetition of the last one + if ($last_told_text ne $tell_text) { + my $now = time; + for my $iv (@tell_intervals) { + last if ($now - $last_move < $iv); + next if ($last_tell - $last_move >= $iv); + + for my $line (split /\n/, $tell_text) { + $t->print("tell $telltarget [$target] $line"); + } + + $last_told_text = $text; + $last_tell = $now; + + last; + } } - print "\n\n"; } sub find_kings { @@ -451,7 +674,7 @@ sub in_check { for my $row (0..7) { for my $col (0..7) { my $piece = substr($board->[$row], $col, 1); - next if ($piece eq '-' || lc($piece) eq 'k'); + next if ($piece eq '-'); if (uc($piece) eq $piece) { # white piece @@ -572,3 +795,53 @@ sub can_reach { # unknown piece return 0; } + +sub uciprint { + my $msg = shift; + print UCIWRITE "$msg\n"; + print UCILOG "=> $msg\n"; +} + +sub short_score { + my ($uciinfo, $ficsinfo, $mpv) = @_; + + if (defined($uciinfo{'score_mate' . $mpv})) { + return sprintf "M%3d", $uciinfo{'score_mate' . $mpv}; + } else { + if (exists($uciinfo{'score_cp' . $mpv})) { + my $score = $uciinfo{'score_cp' . $mpv} * 0.01; + if ($ficsinfo{'toplay'} eq 'B') { + $score = -$score; + } + return sprintf "%+5.2f", $score; + } + } + + return undef; +} + +sub long_score { + my ($uciinfo, $ficsinfo, $mpv) = @_; + + if (defined($uciinfo{'score_mate' . $mpv})) { + my $mate = $uciinfo{'score_mate' . $mpv}; + if ($ficsinfo{'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($uciinfo{'score_cp' . $mpv})) { + my $score = $uciinfo{'score_cp' . $mpv} * 0.01; + if ($ficsinfo{'toplay'} eq 'B') { + $score = -$score; + } + return sprintf "Score: %+5.2f", $score; + } + } + + return undef; +}