X-Git-Url: https://git.sesse.net/?p=remoteglot;a=blobdiff_plain;f=remoteglot.pl;h=4abbe70f994a17757b29eb133c7fdfd777a1be4a;hp=4911b2cc43dac72b7e7a4a03b20b83c669c6e906;hb=f2f5a9191ecefbe9964f52e6ad6fac9f696053ee;hpb=f1ce090bd12cb4478c9226eded7e8ecf0917e377 diff --git a/remoteglot.pl b/remoteglot.pl old mode 100644 new mode 100755 index 4911b2c..4abbe70 --- a/remoteglot.pl +++ b/remoteglot.pl @@ -23,31 +23,47 @@ $| = 1; my $server = "freechess.org"; my $target = "Sesse"; # my $engine = "/usr/games/toga2"; -my $engine = "wine rybka22-mpw32.exe"; +my $engine = "wine Rybkav2.3.2a.mp.w32.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 %ficsinfo = (); -print UCIWRITE "uci\n"; + +uciprint("uci"); # gobble the options while () { /uciok/ && last; } -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/'); @@ -78,12 +94,9 @@ 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"); } #print "FICS: [$line]\n"; $sleep = 0; @@ -94,7 +107,7 @@ while (1) { my $line = ; chomp $line; $line =~ tr/\r//d; - #print "UCI: $line\n"; + print UCILOG "<= $line\n"; if ($line =~ /^info/) { my (@infos) = split / /, $line; shift @infos; @@ -112,27 +125,39 @@ while (1) { 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; } @@ -140,10 +165,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; } @@ -185,11 +210,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 .= " "; @@ -238,7 +280,7 @@ sub prettyprint_pv { } # white long castling - if ($pv eq 'e1b1' && $piece eq 'K') { + if ($pv eq 'e1c1' && $piece eq 'K') { my @nb = @$board; # king @@ -247,7 +289,7 @@ sub prettyprint_pv { # 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)); } @@ -268,7 +310,7 @@ sub prettyprint_pv { } # black long castling - if ($pv eq 'e8b8' && $piece eq 'k') { + if ($pv eq 'e8c8' && $piece eq 'k') { my @nb = @$board; # king @@ -277,7 +319,7 @@ sub prettyprint_pv { # 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)); } @@ -365,26 +407,66 @@ sub output_screen { #return; print "cAnalysis:\n"; - if (defined($uciinfo{'score_mate'})) { - printf " Mate in %d\n", $uciinfo{'score_mate'}; + + return unless (exists($ficsinfo{'board'})); + + if (exists($uciinfo{'pv1'})) { + # 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; + } + } + + if (exists($uciinfo{'nodes' . $mpv}) && exists($uciinfo{'nps' . $mpv}) && exists($uciinfo{'depth' . $mpv})) { + printf " (%5u kn, %3u kn/s, %2u ply)", + $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"; + ++$mpv; + } } else { - my $score = $uciinfo{'score_cp'} * 0.01; - if ($ficsinfo{'toplay'} eq 'B') { - $score = -$score; + # single-PV + if (defined($uciinfo{'score_mate'})) { + printf " Mate in %d\n", $uciinfo{'score_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; + } } - 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{'seldepth'})) { - printf " (%u selective)", $uciinfo{'seldepth'}; + + print " PV: ", join(', ', prettyprint_pv($ficsinfo{'board'}, @{$uciinfo{'pv'}})); + print "\n"; + + 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 (exists($uciinfo{'tbhits'})) { + printf ", %u Nalimov hits", $uciinfo{'tbhits'}; + } + if (exists($uciinfo{'seldepth'})) { + printf " (%u selective)", $uciinfo{'seldepth'}; + } + print "\n\n"; } - print "\n\n"; } sub find_kings { @@ -573,3 +655,9 @@ sub can_reach { # unknown piece return 0; } + +sub uciprint { + my $msg = shift; + print UCIWRITE "$msg\n"; + print UCILOG "=> $msg\n"; +}