#!/usr/bin/perl
# Script by Pierce Wetter for translating Thomas Wolf's problems
#use warnings;
#use strict;
#use diagnostics;
my $gnugo=1;
my $manyfaces=0;
$main::oneproblemperfile=0;
$main::solutions=1;
my $makegtp=0;
if ($gnugo)
{
	print "GNUGO\n";
	$makegtp=1;
}
if ($manyfaces )
{
	print "Many Faces\n";
	$main::oneproblemperfile=0;
	$main::solutions=1;
	$makegtp=0;

}
if ($makegtp )
{
	$main::oneproblemperfile=1;
	$main::solutions=0;
}

my $row=19;
foreach(A..S)
{
	$main::sgfconvertrow{$_}= $row--;
}

%main::sgfconvertcol=sort {$a cmp $b} (A..S, A..H, J..T);

$main::sgfboilerfront=q{(;GM[1]FF[3]RU[Japanese]SZ[19]HA[0]
PW[White]
PB[Black]
};
$main::sgfboilerback=")\n";

sub interesting($\@\@);
sub generatesgf($$$\@\@);
sub generategtp($$\@\@);
sub doit();

	doit();

sub doit()
{
	my $problem="";
	my ($dooutput,@moves,$board);
	while (<>)
	{
		chomp;
		while (s/\\$//)		#deal with continuation
		{
			$_ .= <>;
			chomp;
		}
		if (m/\$ P(\d+)/i)
		{
			$problem=$1;
			#print "Problem :", $problem,"\n" ;
			#print $cleanboard;			#output board
			#print $sgfsetup;
			$dooutput=0;
			@moves=();
			$board="";
			
		}
		elsif ($problem && !$board)
		{
			$board=$_; #next line after problem label is board
		}
		elsif ($problem)
		{
	#?+l2d#50 3 1 54.00 10 ??:GCFCFDFCEBHAFDFC:
	#?-d#8 3 1 37.50 12 ??:CAFCGCHAFDDA@@CAFCEB@@DB:
			
			my ($solcolor, $result, $nleaves,$heuristic,$interest,$overhead,$nmoves,$kocycles,$stuff,$movelist);
			
			$solcolor="";

			($solcolor, $result, $nleaves,$heuristic,$interest,$overhead,$nmoves,$kocycles,$stuff,$movelist)
				=m/^([\?A])([\+-][ld]\d?[ld]?)#(\d)+ (\d)+ (\d)+ ([\d.])+ (\d)+ ([+-?]*)( 0 255 ){0,1}:([A-Z@]+):/;
			
			if ($solcolor)
			{
				$solcolor =~ tr/\?A/WB/;
				push (@moves,{
					color => $solcolor,
					moves =>$movelist, 
					result => $result,
					nleaves => $nleaves,
					heuristic=> $heuristic,
					interest=> $interest,
					overhead=> $overhead,
					nmoves=> $nmoves,
					kocycles=> $kocycles
				});	
			}
			else #end of problem, output
			{
				print $_;
				$dooutput=1;
			}
			if (eof()) 
			{
				$dooutput=1; # files may end abruptly
			}
			if ($dooutput)
			{
				my @whitemoves= grep { $_->{color} eq "W"} @moves;
				my @blackmoves= grep { $_->{color} eq "B"} @moves;
	
				my $rating=interesting($board,@blackmoves,@whitemoves);
				#if ( $rating)
				{
					print "Generating SGF file for problem $problem rating:$rating $blackmoves[0]->{result} $whitemoves[0]->{result}\n";
					generategtp($problem,$board,@blackmoves,@whitemoves) if ($makegtp);
					generatesgf($problem,$rating,$board,@blackmoves,@whitemoves) if ($rating);
					$main::simplecount++;
				}
				$main::totalcount++;
	
				$problem="";
			}
		}
	}
	print "Total: $main::totalcount Count: $main::simplecount\n";
}

sub interesting ($\@\@)
{
	my ($board,$bmoves,$wmoves)=@_;
		
	my @setup_moves="";	
	push(@setup_moves,$+) while $board =~ m/((?:\?|A)\w\w)/gx;
	my @white_setup= grep /^\?/, @setup_moves;
	
	my $cleanboard= $board;
	$cleanboard =~ s/\[\w\w\]//g;

	my $nstones=$#white_setup+1;
	
	my $firstblack="";
	my $firstwhite="";
	$firstblack=$bmoves->[0] if ($bmoves->[0]->{result} =~ m/d/);
	
	$firstwhite=$wmoves->[0] if ($wmoves->[0]->{result} =~ m/l/);
	
	#print "interest $nstones, $firstwhite->{result},  $firstblack->{result}\n";
	
	my $result="";
	if ($firstwhite || $firstblack)	# are there answers for both sides
	{
		my $whiteresult=$firstwhite->{result};
		$whiteresult =~ tr/ld/dl/; # reverse answer
		my $blackresult=$firstblack->{result};
		#print "result $whiteresult $blackresult\n";
		#if ($whiteresult eq $blackresult) #are the answers symettric
		{
			$result= $nstones*100 + 
				$firstblack->{nmoves}+
				$firstblack->{nleaves}+
				$firstwhite->{nmoves}+
				$firstwhite->{nleaves};
		}
	}
	$result;

}

sub generatesgf ($$$\@\@)
{	
	my ($problem,$rating,$board,$blackmoves,$whitemoves)=@_;
	
	if ($main::oneproblemperfile)
	{
		my $filename= $problem . ".sgf";
		open SGF, "> $filename" or die $!;
	}
	else
	{
		my $filename= $ARGV;
		$filename =~ s/\./_/g;
		 $filename= $filename . ".prb";
		open SGF, ">> $filename" or die $!;
	}
	print SGF $main::sgfboilerfront;
	printf SGF "GN[Problem: $problem]\n";

	my $sgfsetup=setup2sgf($board);
	print SGF $sgfsetup;
	my @strings = ();
	push(@strings,$+) while $board =~ m/\[(\w\w)\]/gx;
	map { $_=lc($_);} @strings;
	
	print SGF "TR[", join("][",@strings),"]\n" unless ($#strings == 0);
	print SGF "C[Rating: $rating]" if ($rating);

	if ($main::solutions)
	{
		if ( $blackmoves->[0]->{result} =~ m/d/ )
		{
			my $sgfmoves=sgfmovelist($blackmoves->[0]->{moves},"B");
			print SGF "(;GB[1]TE[2]C[",resultcomment($blackmoves->[0]->{result}),"]",$sgfmoves,")";
		}
		my @goodblack = grep { $_->{result} =~ m/^\+/} @$blackmoves;
		shift @goodblack;
	
		if ($whitemoves->[0]->{result} =~ m/l/)
		{
			my $sgfmoves=sgfmovelist($whitemoves->[0]->{moves},"W");
			print SGF "(;GW[1]TE[2]C[",resultcomment($whitemoves->[0]->{result}),"]",$sgfmoves,")";
		}
		my @goodwhite = grep { $_->{result} =~ m/^\+/} @$whitemoves;
		shift @goodwhite;
	
		foreach(@goodwhite,@goodblack)
		{
			my $sgfmoves=sgfmovelist($_->{moves},$_->{color});
			print SGF "(;C[",resultcomment($_->{result}),"];",$sgfmoves,")";
		}
	}
	print SGF $main::sgfboilerback;
	close SGF;

}

sub sgftogtp
{
	my $move=shift;
	
	$move =~ s/^(\w)(\w).*$/$main::sgfconvertcol{$1} . $main::sgfconvertrow{$2}/e;
	$move;
}

sub generategtp ($$\@\@)
{	
	my ($problem,$board,$blackmoves,$whitemoves)=@_;
	
	if ($main::lastfile cmp $ARGV)
	{
		$main::testnum=0;
		$main::lastfile=$ARGV;
	}
	
	my $filename= $ARGV . ".gtp";
	open GTP, ">> $filename" or die $!;
	
	print GTP "# Problem $problem\n";
	print GTP "loadsgf $problem.sgf 1\n";

	my @strings = ();
	push(@strings,sgftogtp($+)) while $board =~ m/\[(\w\w)\]/gx;
	$board =~ m/\?(\w\w)/;
	my $whitestone = $1;
	$whitestone=sgftogtp($whitestone);
	
	my @whitesolved = grep {$_->{result} =~ m/l/} @$whitemoves;
	my @whiteanswers= map { $_->{moves}; } @whitesolved;
	
	if (@whiteanswers)
	{
		my $answer=sgftogtp($whiteanswers[0]); # only use first result
		print "$whitesolved[0]->{result} has pass\n" if ($whiteanswers[0] =~ m/@@/) ;
		my $koness=1;
		$koness=2 if ($whitesolved[0]->{result} =~ m/d/);   # defender has to win one or mo kos
		$koness=3 if ($whitesolved[0]->{result} =~ m/-/);  # defender has a ko threat which must be answered
		foreach(@strings)
		{
			$main::testnum++;
			print GTP "$main::testnum owl_defend $_\n";
			print GTP "#? [$koness $answer]\n";	
			print GTP "#? [$koness $answer]\n";	
			print GTP "\n10000 get_reading_node_counter\n";
			print GTP "\n10001 reset_reading_node_counter\n";
		}
		if ($strings == 0)
		{
			$main::testnum++;
			print GTP "$main::testnum owl_defend $whitestone\n";
			print GTP "#? [$answer]\n";	
			print GTP "\n10000 get_reading_node_counter\n";
			print GTP "\n10001 reset_reading_node_counter\n";
		}
	
	}

	my @blacksolved = grep {$_->{result} =~ m/d/} @$blackmoves;
	my @blackanswers= map { $_->{moves}; } @blacksolved;
	
	if (@blackanswers)
	{
		my $answer=sgftogtp($blackanswers[0]); # only use first result
		print "$blacksolved[0]->{result} has pass\n" if ($blackanswers[0] =~ m/@@/) ;
		my $koness=1;
		$koness=2 if ($blacksolved[0]->{result} =~ m/l/);   # defender has to win one or mo kos
		$koness=3 if ($blacksolved[0]->{result} =~ m/-/);  # attacker has a ko threat which must be answered
		foreach(@strings)
		{
			$testnum++;
			print GTP "$main::testnum owl_attack $_\n";
			print GTP "#? [$koness $answer]\n";	
			print GTP "\n10000 get_reading_node_counter\n";
			print GTP "\n10001 reset_reading_node_counter\n";
		}
		if ($strings == 0)
		{
			$main::testnum++;
			print GTP "$main::testnum owl_attack $whitestone\n";
			print GTP "#? [$answer]\n";	
			print GTP "\n10000 get_reading_node_counter\n";
			print GTP "\n10001 reset_reading_node_counter\n";
		}
	
	}
	print GTP "\n";
	close GTP;

}


sub setup2sgf
{
	my $setup=shift;
	my $cleansetup= $setup;
	$cleansetup =~ s/\[\w\w\]//g;
	my @setup_moves=();
	push(@setup_moves,$+) while $cleansetup =~ m/((?:\?|A)\w\w)/gx;
	map { $_=lc($_);} @setup_moves;
	my @black_setup= grep {/^a/} @setup_moves;
	my @white_setup= grep /^\?/, @setup_moves;
	map { s/^a(\w\w)/$1/;} @black_setup;
	map { s/^\?(\w\w)/$1/;} @white_setup;
	my $wresult= join "][", @white_setup;
	$wresult= "AW[" . $wresult . "]\n";
	my $bresult= join "][",@black_setup;
	$bresult="AB[".$bresult."]\n";
	my $result= $wresult . $bresult;
}

sub sgfmovelist
{
	my $moves=shift;
	my $startcolor=shift;
	my @setup_moves=();
	push(@setup_moves,$+) while $moves =~ m/(\w\w)/gx;
	map { $_=lc($_);} @setup_moves;
	map { s/@@//g;} @setup_moves;
	my @result=();
	my $color = $startcolor;
	foreach(@setup_moves)
	{
		push(@result, $color . "[" . $_ . "]");
		if ($color eq "W") 
		{
			$color="B";
		}
		else
		{
		    $color="W";
		}
	}
	my $movelist = join ";", @result;
}

sub resultcomment
{
	my $result=shift;
	my ($success,$lives,$extra,$lives2) = $result =~ m/^([+-])([ld])(\d)?([ld])?/;
	my $comment=$result;
	if ($success eq "+")
	{
		$comment.=":Succeed! ";
	}
	else
	{
		$comment.=":Fail! ";
	}
	if ($lives eq "l")
	{
		$comment .="White Lives";
	}
	else
	{
		$comment .="Black Kills";
	}
	if ($extra)
	{
		$comment .=" with $extra moves ";
		if ($lives2 eq "l")
		{
			$comment .="White Lives";
		}
		else
		{
			$comment .="Black Kills";
		}
	}
	$comment;
}