X-Git-Url: https://git.sesse.net/?a=blobdiff_plain;f=remoteglot.pl;h=24ce2e75106a10ce53c539cdc650b115efa7bb4e;hb=2f411b34fe1fc367713f437b8b75a41ae8b805a3;hp=f6a94028ef2d4ac1d65705f20ed08261bd86b46d;hpb=a60af160df125d0e0e5ef03e52f473f1df7af030;p=remoteglot

diff --git a/remoteglot.pl b/remoteglot.pl
index f6a9402..24ce2e7 100755
--- a/remoteglot.pl
+++ b/remoteglot.pl
@@ -41,6 +41,7 @@ select(STDOUT);
 # open the chess engine
 my $pid = IPC::Open2::open2(*UCIREAD, *UCIWRITE, $engine);
 my %uciinfo = ();
+my %uciid = ();
 my %ficsinfo = ();
 
 uciprint("uci");
@@ -48,6 +49,7 @@ uciprint("uci");
 # gobble the options
 while (<UCIREAD>) {
 	/uciok/ && last;
+	handle_uci($_);
 }
 
 uciprint("setoption name UCI_AnalyseMode value true");
@@ -105,15 +107,7 @@ while (1) {
 	# any fun on the UCI channel?
 	if ($nfound > 0 && vec($rout, fileno(UCIREAD), 1) == 1) {
 		my $line = <UCIREAD>;
-		chomp $line;
-		$line =~ tr/\r//d;
-		print UCILOG "<= $line\n";
-		if ($line =~ /^info/) {
-			my (@infos) = split / /, $line;
-			shift @infos;
-
-			parse_infos(@infos);
-		}
+		handle_uci($line);
 		$sleep = 0;
 
 		# don't update too often
@@ -123,6 +117,26 @@ while (1) {
 	sleep $sleep;
 }
 
+sub handle_uci {
+	my ($line) = @_;
+
+	chomp $line;
+	$line =~ tr/\r//d;
+	print UCILOG "<= $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);
+	}
+}
+
 sub parse_infos {
 	my (@x) = @_;
 	my $mpv = '';
@@ -179,6 +193,22 @@ 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 (@x) = split / /, $str;
@@ -254,6 +284,8 @@ sub prettyprint_pv {
 	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 +296,12 @@ sub prettyprint_pv {
 	my $pretty;
 	my $piece = substr($board->[$from_row], $from_col, 1);
 
+	if ($piece eq '-') {
+		die "Invalid move";
+	}
+
 	# 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 +315,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 +328,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 +341,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 +355,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 +427,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);
 
@@ -406,11 +442,37 @@ sub prettyprint_pv {
 sub output_screen {
 	#return;
 
-	print  "cAnalysis:\n";
+	#
+	# 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($ficsinfo{'board'}, @{$uciinfo{'pv'}});
+		}
+	
+		my $mpv = 1;
+		while (exists($uciinfo{'pv' . $mpv})) {
+			$dummy = prettyprint_pv($ficsinfo{'board'}, @{$uciinfo{'pv' . $mpv}});
+			++$mpv;
+		}
+	};
+	if ($@) {
+		return;
+	}
+
+	print ""; # clear the screen
+	if (exists($uciid{'name'})) {
+		print "Analysis by $uciid{'name'}:\n\n";
+	} else {
+		print "Analysis:\n\n";
+	}
 
 	return unless (exists($ficsinfo{'board'}));
 
-	if (exists($uciinfo{'pv1'})) {
+	if (exists($uciinfo{'pv1'}) && exists($uciinfo{'pv2'})) {
 		# multi-PV
 		my $mpv = 1;
 		while (exists($uciinfo{'pv' . $mpv})) {
@@ -439,6 +501,19 @@ sub output_screen {
 			++$mpv;
 		}
 	} else {
+		#
+		# 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'})) {
+			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'};
+				}
+			}
+		}
+
 		# single-PV
 		if (defined($uciinfo{'score_mate'})) {
 			my $mate = $uciinfo{'score_mate'};
@@ -542,7 +617,7 @@ sub in_check {
 	for my $row (0..7) {
 		for my $col (0..7) {
 			my $piece = substr($board->[$row], $col, 1);
-			next if ($piece eq '-' || lc($piece) eq 'k');
+			next if ($piece eq '-');
 		
 			if (uc($piece) eq $piece) {
 				# white piece