X-Git-Url: https://git.sesse.net/?p=remoteglot;a=blobdiff_plain;f=remoteglot.pl;h=655a9ae00d8acdc57cea3f1d36036d3b11a16469;hp=28bebd25cfcf57de6e1685b83b202e9c03ebb70f;hb=96cd2398965d355262bae77bd270a0f5bbf8069c;hpb=9dd7122b75bf598f16a18a70bc8b2eb519d0796b diff --git a/remoteglot.pl b/remoteglot.pl index 28bebd2..655a9ae 100755 --- a/remoteglot.pl +++ b/remoteglot.pl @@ -18,12 +18,18 @@ use warnings; # Configuration my $server = "freechess.org"; -my $target = "22"; +my $target = "Sessse"; # my $engine = "/usr/games/toga2"; -my $engine = "wine Rybkav2.3.2a.mp.w32.exe"; +# my $engine = "wine Rybkav2.3.2a.mp.w32.exe"; +my $engine = "~/microwine-0.2/microwine 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 $uci_assume_full_compliance = 1; # dangerous :-) +my @masters = ( + 'Sesse', + 'Sessse', + 'Sesssse' +); # Program starts here $SIG{ALRM} = sub { output_screen(); }; @@ -62,10 +68,10 @@ while () { uciprint("setoption name UCI_AnalyseMode value true"); # uciprint("setoption name Preserve Analysis value true"); -uciprint("setoption name NalimovPath value c:\\nalimov"); +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"); @@ -148,13 +154,48 @@ while (1) { # $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; } # any fun on the UCI channel? if ($nfound > 0 && vec($rout, fileno(UCIREAD), 1) == 1) { - my $line = ; + # + # 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"; + } + + $line .= $tmp; + } + + $line =~ tr/\r\n//d; handle_uci($line); $sleep = 0; @@ -334,13 +375,15 @@ sub style12_to_fen { $fen .= $x[26]; $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 (); } @@ -526,12 +569,22 @@ sub output_screen { return; } - my $text = ''; + 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 .= ','; + } + } if (exists($uciid{'name'})) { - $text .= "Analysis by $uciid{'name'}:\n\n"; + $text .= " by $uciid{'name'}:\n\n"; } else { - $text .= "Analysis:\n\n"; + $text .= ":\n\n"; } return unless (exists($pos_calculating->{'board'})); @@ -558,8 +611,12 @@ sub output_screen { $text .= " ($score)" if (defined($score)); my $tbhits = ''; - if (exists($uciinfo{'tbhits' . $mpv})) { - $tbhits = sprintf ", %u tbhits", $uciinfo{'tbhits' . $mpv}; + 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})) { @@ -583,8 +640,12 @@ sub output_screen { $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{'tbhits'}) && $uciinfo{'tbhits'} > 0) { + if ($uciinfo{'tbhits'} == 1) { + $text .= ", one Nalimov hit"; + } else { + $text .= sprintf ", %u Nalimov hits", $uciinfo{'tbhits'}; + } } if (exists($uciinfo{'seldepth'})) { $text .= sprintf " (%u selective)", $uciinfo{'seldepth'}; @@ -592,6 +653,8 @@ sub output_screen { $text .= "\n\n"; } + $text .= book_info($pos_calculating->{'fen'}, $pos_calculating->{'board'}, $pos_calculating->{'toplay'}); + if ($last_text ne $text) { print ""; # clear the screen print $text; @@ -893,3 +956,55 @@ sub long_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 "[$fen]" 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; +}