Hopefully fix sorting in the cases where the side to move is getting mated.

[remoteglot] / remoteglot.pl

diff --git a/remoteglot.pl b/remoteglot.pl
index 7f1a6687e72aa597827212a95a673b429e1b2bd2..dd913f6a6855b45263c043691a380da6514a2920 100755 (executable)
--- a/remoteglot.pl
+++ b/remoteglot.pl
@@ -21,23 +21,10 @@ use Time::HiRes;
 use JSON::XS;
 require 'Position.pm';
 require 'Engine.pm';
+require 'config.pm';
 use strict;
 use warnings;
-
-# Configuration
-my $server = "freechess.org";
-my $target = "GMCarlsen";
-my $engine_cmdline = "'./Deep Rybka 4 SSE42 x64'";
-my $engine2_cmdline = "./stockfish_13111119_x64_modern_sse42";  # undef for none
-my $uci_assume_full_compliance = 0;                    # dangerous :-)
-my $update_max_interval = 1.0;
-my @masters = (
-       'Sesse',
-       'Sessse',
-       'Sesssse',
-       'greatestguns',
-       'beuki'
-);
+no warnings qw(once);
 
 # Program starts here
 $SIG{ALRM} = sub { output(); };
@@ -60,25 +47,23 @@ $| = 1;
 select(STDOUT);
 
 # open the chess engine
-my $engine = open_engine($engine_cmdline, 'E1', sub { handle_uci(@_, 1); });
-my $engine2 = open_engine($engine2_cmdline, 'E2', sub { handle_uci(@_, 0); });
+my $engine = open_engine($remoteglotconf::engine_cmdline, 'E1', sub { handle_uci(@_, 1); });
+my $engine2 = open_engine($remoteglotconf::engine2_cmdline, 'E2', sub { handle_uci(@_, 0); });
 my $last_move;
 my $last_text = '';
 my ($pos_waiting, $pos_calculating, $pos_calculating_second_engine);
 
 uciprint($engine, "setoption name UCI_AnalyseMode value true");
-# uciprint($engine, "setoption name NalimovPath value /srv/tablebase");
-uciprint($engine, "setoption name NalimovUsage value Rarely");
-uciprint($engine, "setoption name Hash value 1024");
-# uciprint($engine, "setoption name MultiPV value 2");
+while (my ($key, $value) = each %remoteglotconf::engine_config) {
+       uciprint($engine, "setoption name $key value $value");
+}
 uciprint($engine, "ucinewgame");
 
 if (defined($engine2)) {
        uciprint($engine2, "setoption name UCI_AnalyseMode value true");
-       # uciprint($engine2, "setoption name NalimovPath value /srv/tablebase");
-       uciprint($engine2, "setoption name NalimovUsage value Rarely");
-       uciprint($engine2, "setoption name Hash value 1024");
-       uciprint($engine2, "setoption name Threads value 8");
+       while (my ($key, $value) = each %remoteglotconf::engine2_config) {
+               uciprint($engine2, "setoption name $key value $value");
+       }
        uciprint($engine2, "setoption name MultiPV value 500");
        uciprint($engine2, "ucinewgame");
 }
@@ -88,8 +73,8 @@ print "Chess engine ready.\n";
 # now talk to FICS
 my $t = Net::Telnet->new(Timeout => 10, Prompt => '/fics% /');
 $t->input_log(\*FICSLOG);
-$t->open($server);
-$t->print("SesseBOT");
+$t->open($remoteglotconf::server);
+$t->print($remoteglotconf::nick);
 $t->waitfor('/Press return to enter the server/');
 $t->cmd("");
 
@@ -97,7 +82,7 @@ $t->cmd("");
 $t->cmd("set shout 0");
 $t->cmd("set seek 0");
 $t->cmd("set style 12");
-$t->cmd("observe $target");
+$t->cmd("observe $remoteglotconf::target");
 print "FICS ready.\n";
 
 my $ev1 = AnyEvent->io(
@@ -120,6 +105,8 @@ EV::run;
 sub handle_uci {
        my ($engine, $line, $primary) = @_;
 
+       return if $line =~ /(upper|lower)bound/;
+
        $line =~ s/  / /g;  # Sometimes needed for Zappa Mexico
        print UCILOG localtime() . " $engine->{'tag'} <= $line\n";
        if ($line =~ /^info/) {
@@ -136,7 +123,7 @@ sub handle_uci {
        }
        if ($line =~ /^bestmove/) {
                if ($primary) {
-                       return if (!$uci_assume_full_compliance);
+                       return if (!$remoteglotconf::uci_assume_full_compliance);
                        if (defined($pos_waiting)) {
                                uciprint($engine, "position fen " . $pos_waiting->fen());
                                uciprint($engine, "go infinite");
@@ -163,7 +150,7 @@ sub handle_fics {
        if ($line =~ /^([A-Za-z]+)(?:\([A-Z]+\))* tells you: (.*)$/) {
                my ($who, $msg) = ($1, $2);
 
-               next if (grep { $_ eq $who } (@masters) == 0);
+               next if (grep { $_ eq $who } (@remoteglotconf::masters) == 0);
 
                if ($msg =~ /^fics (.*?)$/) {
                        $t->cmd("tell $who Executing '$1' on FICS.");
@@ -199,10 +186,14 @@ sub handle_pgn {
                $pgn->quick_parse_game;
                my $pos = Position->start_pos($pgn->white, $pgn->black);
                my $moves = $pgn->moves;
+               my @uci_moves = ();
                for my $move (@$moves) {
                        my ($from_row, $from_col, $to_row, $to_col, $promo) = $pos->parse_pretty_move($move);
+                       push @uci_moves, Board::move_to_uci_notation($from_row, $from_col, $to_row, $to_col, $promo);
                        $pos = $pos->make_move($from_row, $from_col, $to_row, $to_col, $promo);
                }
+               $pos->{'history'} = \@uci_moves;
+               $pos->{'pretty_history'} = $moves;
                handle_position($pos);
        }
        
@@ -230,7 +221,7 @@ sub handle_position {
                if (!defined($pos_waiting)) {
                        uciprint($engine, "stop");
                }
-               if ($uci_assume_full_compliance) {
+               if ($remoteglotconf::uci_assume_full_compliance) {
                        $pos_waiting = $pos;
                } else {
                        uciprint($engine, "position fen " . $pos->fen());
@@ -311,7 +302,7 @@ sub parse_infos {
                        delete $info->{'score_cp' . $mpv};
                        delete $info->{'score_mate' . $mpv};
 
-                       while ($x[0] eq 'cp' || $x[0] eq 'mate' || $x[0] eq 'lowerbound' || $x[0] eq 'upperbound') {
+                       while ($x[0] eq 'cp' || $x[0] eq 'mate') {
                                if ($x[0] eq 'cp') {
                                        shift @x;
                                        $info->{'score_cp' . $mpv} = shift @x;
@@ -388,8 +379,8 @@ sub output {
 
        # Don't update too often.
        my $age = Time::HiRes::tv_interval($latest_update);
-       if ($age < $update_max_interval) {
-               Time::HiRes::alarm($update_max_interval + 0.01 - $age);
+       if ($age < $remoteglotconf::update_max_interval) {
+               Time::HiRes::alarm($remoteglotconf::update_max_interval + 0.01 - $age);
                return;
        }
        
@@ -644,11 +635,19 @@ sub score_sort_key {
        my ($info, $pos, $mpv, $invert) = @_;
 
        if (defined($info->{'score_mate' . $mpv})) {
-               if ($invert) {
-                       return 99999 - $info->{'score_mate' . $mpv};
+               my $mate = $info->{'score_mate' . $mpv};
+               my $score;
+               if ($mate > 0) {
+                       # Side to move mates
+                       $mate = 99999 - $mate;
                } else {
-                       return -(99999 - $info->{'score_mate' . $mpv});
+                       # Side to move is getting mated (note the double negative for $mate)
+                       $mate = -99999 - $mate;
+               }
+               if ($invert) {
+                       $score = -$score;
                }
+               return $score;
        } else {
                if (exists($info->{'score_cp' . $mpv})) {
                        my $score = $info->{'score_cp' . $mpv};