Support defaulting to a PGN for fetching.

[remoteglot] / remoteglot.pl

diff --git a/remoteglot.pl b/remoteglot.pl
index 0729409e482d070138bb925b5e5b1cc30a680c42..d15a5282a41b52ef0e5d8237a335798c19def51d 100755 (executable)
--- a/remoteglot.pl
+++ b/remoteglot.pl
@@ -93,7 +93,13 @@ $t->cmd("");
 $t->cmd("set shout 0");
 $t->cmd("set seek 0");
 $t->cmd("set style 12");
-$t->cmd("observe $remoteglotconf::target");
+if (defined($remoteglotconf::target)) {
+       if ($remoteglotconf::target =~ /^http:/) {
+               fetch_pgn($remoteglotconf::target);
+       } else {
+               $t->cmd("observe $remoteglotconf::target");
+       }
+}
 print "FICS ready.\n";
 
 my $ev1 = AnyEvent->io(
@@ -172,9 +178,7 @@ sub handle_fics {
                } elsif ($msg =~ /^pgn (.*?)$/) {
                        my $url = $1;
                        $t->cmd("tell $who Starting to poll '$url'.");
-                       AnyEvent::HTTP::http_get($url, sub {
-                               handle_pgn(@_, $url);
-                       });
+                       fetch_pgn($url);
                } elsif ($msg =~ /^stoppgn$/) {
                        $t->cmd("tell $who Stopping poll.");
                        $http_timer = undef;
@@ -188,6 +192,14 @@ sub handle_fics {
        #print "FICS: [$line]\n";
 }
 
+# Starts periodic fetching of PGNs from the given URL.
+sub fetch_pgn {
+       my ($url) = @_;
+       AnyEvent::HTTP::http_get($url, sub {
+               handle_pgn(@_, $url);
+       });
+}
+
 sub handle_pgn {
        my ($body, $header, $url) = @_;
        my $pgn = Chess::PGN::Parse->new(undef, $body);
@@ -209,9 +221,7 @@ sub handle_pgn {
        }
        
        $http_timer = AnyEvent->timer(after => 1.0, cb => sub {
-               AnyEvent::HTTP::http_get($url, sub {
-                       handle_pgn(@_, $url);
-               });
+               fetch_pgn($url);
        });
 }
 
@@ -573,7 +583,7 @@ sub output_screen {
                                my $key = $pretty_move;
                                my $line = sprintf("  %-6s %6s %3s  %s",
                                        $pretty_move,
-                                       short_score($info, $pos_calculating_second_engine, $mpv, 0),
+                                       short_score($info, $pos_calculating_second_engine, $mpv),
                                        "d" . $info->{'depth' . $mpv},
                                        join(', ', @pretty_pv));
                                push @refutation_lines, [ $key, $line ];
@@ -603,6 +613,7 @@ sub output_json {
        $json->{'position'} = $pos_calculating->to_json_hash();
        $json->{'id'} = $engine->{'id'};
        $json->{'score'} = long_score($info, $pos_calculating, '');
+       $json->{'short_score'} = short_score($info, $pos_calculating, '');
 
        $json->{'nodes'} = $info->{'nodes'};
        $json->{'nps'} = $info->{'nps'};
@@ -632,7 +643,7 @@ sub output_json {
                                        sort_key => $pretty_move,
                                        depth => $info->{'depth' . $mpv},
                                        score_sort_key => score_sort_key($info, $pos_calculating, $mpv, 0),
-                                       pretty_score => short_score($info, $pos_calculating, $mpv, 0),
+                                       pretty_score => short_score($info, $pos_calculating, $mpv),
                                        pretty_move => $pretty_move,
                                        pv_pretty => \@pretty_pv,
                                };
@@ -656,13 +667,9 @@ sub uciprint {
 }
 
 sub short_score {
-       my ($info, $pos, $mpv, $invert) = @_;
-
-       $invert //= 0;
-       if ($pos->{'toplay'} eq 'B') {
-               $invert = !$invert;
-       }
+       my ($info, $pos, $mpv) = @_;
 
+       my $invert = ($pos->{'toplay'} eq 'B');
        if (defined($info->{'score_mate' . $mpv})) {
                if ($invert) {
                        return sprintf "M%3d", -$info->{'score_mate' . $mpv};
@@ -673,7 +680,11 @@ sub short_score {
                if (exists($info->{'score_cp' . $mpv})) {
                        my $score = $info->{'score_cp' . $mpv} * 0.01;
                        if ($score == 0) {
-                               return " 0.00";
+                               if ($info->{'tablebase'}) {
+                                       return "TB draw";
+                               } else {
+                                       return " 0.00";
+                               }
                        }
                        if ($invert) {
                                $score = -$score;
@@ -693,10 +704,10 @@ sub score_sort_key {
                my $score;
                if ($mate > 0) {
                        # Side to move mates
-                       $mate = 99999 - $mate;
+                       $score = 99999 - $mate;
                } else {
                        # Side to move is getting mated (note the double negative for $mate)
-                       $mate = -99999 - $mate;
+                       $score = -99999 - $mate;
                }
                if ($invert) {
                        $score = -$score;
@@ -860,7 +871,7 @@ sub handle_tb_lookup_return {
                        # position in the meantime, we might query a completely
                        # different position! But that's fine.
                } else {
-                       die "Unknown response state state " . $response->{'Response'}{'StateString'};
+                       die "Unknown response state " . $state;
                }
 
                # Wait a second before we schedule another one.