X-Git-Url: https://git.sesse.net/?p=remoteglot;a=blobdiff_plain;f=remoteglot.pl;h=16416ba07fb7a37c48c6e1c36e54c0c9cd69fe04;hp=eecad8f215d54efbac8d2a6e6aac4a63991566a0;hb=a8b3bf55a7bed6924b44c94931d0fc2c71f6aae2;hpb=517f9dd2dc682986409a7dfc1e492b7723d32dbb diff --git a/remoteglot.pl b/remoteglot.pl index eecad8f..16416ba 100755 --- a/remoteglot.pl +++ b/remoteglot.pl @@ -16,15 +16,30 @@ use Time::HiRes; use strict; use warnings; +# Configuration +my $server = "freechess.org"; +my $target = "GMCarlsen"; +# my $engine = "/usr/games/toga2"; +#my $engine = "wine Rybkav2.3.2a.mp.w32.exe"; +my $engine = "~/microwine-0.5/microwine Rybkav2.3.2a.mp.x64.exe"; +#my $engine = "ssh -t sesse\@84.48.204.209 ./microwine-0.5/microwine ./Rybkav2.3.2a.mp.x64.exe"; +#my $engine = "ssh -t sesse\@cirkus.samfundet.no nice -n 19 ./microwine-0.5/microwine ./microwine-0.5/Rybkav2.3.2a.mp.x64.exe"; +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 @masters = ( + 'Sesse', + 'Sessse', + 'Sesssse', + 'greatestguns', + 'beuki' +); + +# Program starts here $SIG{ALRM} = sub { output_screen(); }; $| = 1; -my $server = "freechess.org"; -my $target = "Sesse"; -# my $engine = "/usr/games/toga2"; -my $engine = "wine Rybkav2.3.2a.mp.w32.exe"; - open(FICSLOG, ">ficslog.txt") or die "ficslog.txt: $!"; print FICSLOG "Log starting.\n"; @@ -41,20 +56,26 @@ select(STDOUT); # open the chess engine my $pid = IPC::Open2::open2(*UCIREAD, *UCIWRITE, $engine); my %uciinfo = (); -my %ficsinfo = (); +my %uciid = (); +my ($last_move, $last_tell); +my $last_text = ''; +my $last_told_text = ''; +my ($pos_waiting, $pos_calculating); uciprint("uci"); # gobble the options while () { /uciok/ && last; + handle_uci($_); } uciprint("setoption name UCI_AnalyseMode value true"); -uciprint("setoption name NalimovPath value c:\\nalimov"); +# uciprint("setoption name Preserve Analysis value true"); +# uciprint("setoption name NalimovPath value /srv/tablebase"); uciprint("setoption name NalimovUsage value Rarely"); uciprint("setoption name Hash value 1024"); -# uciprint("setoption name MultiPV value 3"); +uciprint("setoption name MultiPV value 2"); # uciprint("setoption name Contempt value 1000"); # uciprint("setoption name Outlook value Ultra Optimistic"); uciprint("ucinewgame"); @@ -65,7 +86,7 @@ print "Chess engine ready.\n"; my $t = Net::Telnet->new(Timeout => 10, Prompt => '/fics% /'); $t->input_log(\*FICSLOG); $t->open($server); -$t->print("guest"); +$t->print("SesseBOT"); $t->waitfor('/Press return to enter the server/'); $t->cmd(""); @@ -93,10 +114,64 @@ while (1) { chomp $line; $line =~ tr/\r//d; if ($line =~ /^<12> /) { - my $fen = style12_to_fen($line); - uciprint("stop"); - uciprint("position fen $fen"); - uciprint("go infinite"); + my $pos = style12_to_fen($line); + + # if this is already in the queue, ignore it + next if (defined($pos_waiting) && $pos->{'fen'} eq $pos_waiting->{'fen'}); + + # if we're already chewing on this and there's nothing else in the queue, + # also ignore it + next if (!defined($pos_waiting) && defined($pos_calculating) && + $pos->{'fen'} eq $pos_calculating->{'fen'}); + + # if we're already thinking on something, stop and wait for the engine + # to approve + if (defined($pos_calculating)) { + if (!defined($pos_waiting)) { + uciprint("stop"); + } + if ($uci_assume_full_compliance) { + $pos_waiting = $pos; + } else { + uciprint("position fen " . $pos->{'fen'}); + uciprint("go infinite"); + $pos_calculating = $pos; + } + } else { + # it's wrong just to give the FEN (the move history is useful, + # and per the UCI spec, we should really have sent "ucinewgame"), + # but it's easier + uciprint("position fen " . $pos->{'fen'}); + uciprint("go infinite"); + $pos_calculating = $pos; + } + + %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"); + } + if ($line =~ /^([A-Za-z]+)(?:\([A-Z]+\))* tells you: (.*)$/) { + my ($who, $msg) = ($1, $2); + + next if (grep { $_ eq $who } (@masters) == 0); + + if ($msg =~ /^fics (.*?)$/) { + $t->cmd("tell $who Executing '$1' on FICS."); + $t->cmd($1); + } elsif ($msg =~ /^uci (.*?)$/) { + $t->cmd("tell $who Sending '$1' to the engine."); + print UCIWRITE "$1\n"; + } else { + $t->cmd("tell $who Couldn't understand '$msg', sorry."); + } } #print "FICS: [$line]\n"; $sleep = 0; @@ -104,16 +179,28 @@ while (1) { # any fun on the UCI channel? if ($nfound > 0 && vec($rout, fileno(UCIREAD), 1) == 1) { - my $line = ; - chomp $line; - $line =~ tr/\r//d; - print UCILOG "<= $line\n"; - if ($line =~ /^info/) { - my (@infos) = split / /, $line; - shift @infos; + # + # 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 UCIREAD, $tmp, 1; + + if (!defined($ret)) { + next if ($!{EINTR}); + die "error in reading from the UCI engine: $!"; + } elsif ($ret == 0) { + die "EOF from UCI engine"; + } - parse_infos(@infos); + $line .= $tmp; } + + $line =~ tr/\r\n//d; + handle_uci($line); $sleep = 0; # don't update too often @@ -123,6 +210,36 @@ while (1) { sleep $sleep; } +sub handle_uci { + my ($line) = @_; + + chomp $line; + $line =~ tr/\r//d; + $line =~ s/ / /g; # Sometimes needed for Zappa Mexico + print UCILOG localtime() . " <= $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); + } + if ($line =~ /^bestmove/ && $uci_assume_full_compliance) { + if (defined($pos_waiting)) { + uciprint("position fen " . $pos_waiting->{'fen'}); + uciprint("go infinite"); + + $pos_calculating = $pos_waiting; + $pos_waiting = undef; + } + } +} + sub parse_infos { my (@x) = @_; my $mpv = ''; @@ -179,12 +296,29 @@ 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 $str = shift; + my %pos = (); my (@x) = split / /, $str; - $ficsinfo{'board'} = [ @x[1..8] ]; - $ficsinfo{'toplay'} = $x[9]; + $pos{'board'} = [ @x[1..8] ]; + $pos{'toplay'} = $x[9]; # the board itself my (@board) = @x[1..8]; @@ -204,6 +338,7 @@ sub style12_to_fen { $castling .= "k" if ($x[13] == 1); $castling .= "q" if ($x[14] == 1); $castling = "-" if ($castling eq ""); + # $castling = "-"; # chess960 $fen .= " "; $fen .= $castling; @@ -218,7 +353,7 @@ sub style12_to_fen { } 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 @@ -227,11 +362,11 @@ sub style12_to_fen { # "right" thing as per the standard, though. # if ($x[9] eq 'B') { - $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'); + $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($board[3], $col-1, 1) eq 'P'); - $ep = $nep if ($col < 7 && substr($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 .= " "; @@ -245,15 +380,21 @@ sub style12_to_fen { $fen .= " "; $fen .= $x[26]; - return $fen; + $pos{'fen'} = $fen; + $pos{'move_num'} = $x[26]; + $pos{'last_move'} = $x[29]; + + return \%pos; } 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'); @@ -264,10 +405,12 @@ sub prettyprint_pv { my $pretty; 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') { - my @nb = @$board; - # king substr($nb[7], 4, 1, '-'); substr($nb[7], 6, 1, $piece); @@ -281,8 +424,6 @@ sub prettyprint_pv { # white long castling if ($pv eq 'e1c1' && $piece eq 'K') { - my @nb = @$board; - # king substr($nb[7], 4, 1, '-'); substr($nb[7], 2, 1, $piece); @@ -296,8 +437,6 @@ sub prettyprint_pv { # 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); @@ -311,8 +450,6 @@ sub prettyprint_pv { # black long castling if ($pv eq 'e8c8' && $piece eq 'k') { - my @nb = @$board; - # king substr($nb[0], 4, 1, '-'); substr($nb[0], 2, 1, $piece); @@ -327,8 +464,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); @@ -390,7 +536,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); @@ -405,75 +550,179 @@ sub prettyprint_pv { sub output_screen { #return; + + return if (!defined($pos_calculating)); + + # + # 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($pos_calculating->{'board'}, @{$uciinfo{'pv'}}); + } + + my $mpv = 1; + while (exists($uciinfo{'pv' . $mpv})) { + $dummy = prettyprint_pv($pos_calculating->{'board'}, @{$uciinfo{'pv' . $mpv}}); + ++$mpv; + } + }; + if ($@) { + %uciinfo = (); + return; + } + + my $text = 'Analysis'; + if ($pos_calculating->{'last_move'} ne 'none') { + if ($pos_calculating->{'toplay'} eq 'W') { + $text .= sprintf ' after %u. ... %s', ($pos_calculating->{'move_num'}-1), $pos_calculating->{'last_move'}; + } else { + $text .= sprintf ' after %u. %s', $pos_calculating->{'move_num'}, $pos_calculating->{'last_move'}; + } + if (exists($uciid{'name'})) { + $text .= ','; + } + } - print "cAnalysis:\n"; + if (exists($uciid{'name'})) { + $text .= " by $uciid{'name'}:\n\n"; + } else { + $text .= ":\n\n"; + } - return unless (exists($ficsinfo{'board'})); + 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($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($uciinfo{'pv1'})) { + if (exists($uciinfo{'pv1'}) && exists($uciinfo{'pv2'})) { # multi-PV my $mpv = 1; while (exists($uciinfo{'pv' . $mpv})) { - printf " PV%2u", $mpv; - - if (defined($uciinfo{'score_mate' . $mpv})) { - printf " (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; - } - printf " (%+5.2f)", $score; + $text .= sprintf " PV%2u", $mpv; + my $score = short_score(\%uciinfo, $pos_calculating, $mpv); + $text .= " ($score)" if (defined($score)); + + my $tbhits = ''; + if (exists($uciinfo{'tbhits' . $mpv}) && $uciinfo{'tbhits' . $mpv} > 0) { + if ($uciinfo{'tbhits' . $mpv} == 1) { + $tbhits = ", 1 tbhit"; + } else { + $tbhits = sprintf ", %u tbhits", $uciinfo{'tbhits' . $mpv}; } } - + if (exists($uciinfo{'nodes' . $mpv}) && exists($uciinfo{'nps' . $mpv}) && exists($uciinfo{'depth' . $mpv})) { - printf " (%5u kn, %3u kn/s, %2u ply)", + $text .= sprintf " (%5u kn, %3u kn/s, %2u ply$tbhits)", $uciinfo{'nodes' . $mpv} / 1000, $uciinfo{'nps' . $mpv} / 1000, $uciinfo{'depth' . $mpv}; } - print ":\n"; - print " ", join(', ', prettyprint_pv($ficsinfo{'board'}, @{$uciinfo{'pv' . $mpv}})), "\n"; - print "\n"; + $text .= ":\n"; + $text .= " " . join(', ', prettyprint_pv($pos_calculating->{'board'}, @{$uciinfo{'pv' . $mpv}})) . "\n"; + $text .= "\n"; ++$mpv; } } else { # single-PV - if (defined($uciinfo{'score_mate'})) { - my $mate = $uciinfo{'score_mate'}; - if ($ficsinfo{'toplay'} eq 'B') { - $mate = -$mate; - } - if ($mate > 0) { - printf " White mates in %u\n", $mate; + my $score = long_score(\%uciinfo, $pos_calculating, ''); + $text .= " $score\n" if defined($score); + $text .= " PV: " . join(', ', prettyprint_pv($pos_calculating->{'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'}) && $uciinfo{'tbhits'} > 0) { + if ($uciinfo{'tbhits'} == 1) { + $text .= ", one Nalimov hit"; } else { - printf " Black mates in %u\n", -$mate; - } - } else { - if (exists($uciinfo{'score_cp'})) { - my $score = $uciinfo{'score_cp'} * 0.01; - if ($ficsinfo{'toplay'} eq 'B') { - $score = -$score; - } - printf " Score: %+5.2f\n", $score; + $text .= sprintf ", %u Nalimov hits", $uciinfo{'tbhits'}; } } + if (exists($uciinfo{'seldepth'})) { + $text .= sprintf " (%u selective)", $uciinfo{'seldepth'}; + } + $text .= "\n\n"; + } - print " PV: ", join(', ', prettyprint_pv($ficsinfo{'board'}, @{$uciinfo{'pv'}})); - print "\n"; + #$text .= book_info($pos_calculating->{'fen'}, $pos_calculating->{'board'}, $pos_calculating->{'toplay'}); - if (exists($uciinfo{'nodes'}) && exists($uciinfo{'nps'}) && exists($uciinfo{'depth'})) { - printf " %u nodes, %7u nodes/sec, depth %u ply", - $uciinfo{'nodes'}, $uciinfo{'nps'}, $uciinfo{'depth'}; + 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, $pos_calculating, $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($pos_calculating->{'board'}, @{$uciinfo{'pv' . $mpv}})); + $tell_text .= "\n"; + ++$mpv; } - if (exists($uciinfo{'tbhits'})) { - printf ", %u Nalimov hits", $uciinfo{'tbhits'}; + } else { + # single-PV + my $score = long_score(\%uciinfo, $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'}; } - if (exists($uciinfo{'seldepth'})) { - printf " (%u selective)", $uciinfo{'seldepth'}; + $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"; } } @@ -667,5 +916,101 @@ sub can_reach { sub uciprint { my $msg = shift; print UCIWRITE "$msg\n"; - print UCILOG "=> $msg\n"; + print UCILOG localtime() . " => $msg\n"; +} + +sub short_score { + my ($uciinfo, $pos, $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 ($pos->{'toplay'} eq 'B') { + $score = -$score; + } + return sprintf "%+5.2f", $score; + } + } + + return undef; +} + +sub long_score { + my ($uciinfo, $pos, $mpv) = @_; + + if (defined($uciinfo{'score_mate' . $mpv})) { + my $mate = $uciinfo{'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($uciinfo{'score_cp' . $mpv})) { + my $score = $uciinfo{'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; }