#!/usr/bin/perl -w

@ARGV==1 or die "usage: lgm2gnu <geometry>\n";
my $real='[+-]?\d+\.?\d*[eE]?[+-]?\d+|[+-]?\d*\.?\d+[eE]?[+-]?\d+|[+-]?\d+';
$debug=0;

# admin
if (-e "gnu") {system("rm -r gnu");}
system("mkdir gnu");

# functions
sub min
{
	$min_min=1000000;
	for ($min_i=0; $min_i<@_; $min_i++) {if ($min_min>$_[$min_i]) {$min_min=$_[$min_i];}}
	return ($min_min);
}
sub max 
{
	$max_max=-100000000;
	for ($max_i=0; $max_i<@_; $max_i++) {if ($max_max<$_[$max_i]) {$max_max=$_[$max_i];}}
	return ($max_max);
}

# check dimension
print "detect dimension ";
$dim=2;
open(IN,$ARGV[0]);
while($line=<IN>)
{
	if ($line=~/surface/)
	{
		$dim=3;
		last;
	}
}
close(IN);
print ".................................................... found $dim, run ".$dim."d-check\n";

if ($dim==2)
{
	# admin
	open(IN,$ARGV[0]);
	$sd_min=1000000; $sd_max=-1;

	# get lines
	$l=0;
	while($line=<IN>)
	{
		if ($line=~/points:/)
		{
			$n[$l]=0;
			if (!($line=~/left=(\d+);\s*right=(\d+)/)) {die "ERROR: cannot read left/right info\n";}
			$left[$l]=$1; $right[$l]=$2;
			if ($left[$l]==$right[$l]) {die "ERROR: line $l references subdomain $right[$l] on both sides\n";}
			$sd_max=max($sd_max,$1,$2);
			$sd_min=min($sd_min,$1,$2);
			$line=~s/line\s*\d+:\s*left=\d+;\s*right=\d+;\s*points:\s*//g;
			while(1)
			{
				if ($line=~/(\d+)\s*/)
				{
					$lp[$l][$n[$l]++]=$1;			
					$line=~s/\d+\s*//;
				}
				else
				{
					last;
				}
			}
			$l++;
		}
		if ($line=~/Point-Info/) {last;}
	}

	# get points
	$m=0;
	while($line=<IN>)
	{
		if ($line=~/\s*($real)\s+($real)/)
		{
			$p[$m][0]=$1; $p[$m][1]=$2; $p_ref[$m]=0;
			$m++;
		}
	}
	close(IN);
	if ($m<3) {print "ERROR: $m points detected\n";}
	else {print "$m points detected\n";}

	# check point references
	for ($i=0; $i<$l; $i++)
	{
		for ($j=0; $j<$n[$i]; $j++)
		{
			$p_ref[$lp[$i][$j]]=1;
		}
	}
	$err=0; 
	for ($i=0; $i<$m; $i++) 
	{
		if ($p_ref[$i]==0)
		{
			$err=1;
			print "ERROR: point $i not referenced\n";
		}
	}
	if (!$err) {$i=$m-1; print "point 0 ... $i referenced correctly\n";}

	# check subdomains
	$err=0; for ($i=0; $i<=$sd_max; $i++) {$sd_ref[$i]=0;}
	for ($i=0; $i<$l; $i++) {$sd_ref[$left[$i]]=1; $sd_ref[$right[$i]]=1;}
	for ($i=0; $i<=$sd_max; $i++) 
	{
		if (!$sd_ref[$i]) {print "ERROR: subdomain $i not referenced\n";$err=1;}
		else
		{
			$nl=0;
			for ($j=0; $j<$l; $j++) 
			{
				if ($left[$j]==$i)
				{
					$start[$nl]=$lp[$j][0];
					$end[$nl]=$lp[$j][$n[$j]-1];
					$nl++;
				}
				if ($right[$j]==$i)
				{
					$end[$nl]=$lp[$j][0];
					$start[$nl]=$lp[$j][$n[$j]-1];
					$nl++;
				}
			}
			for ($j=0; $j<$nl; $j++)
			{
				$sum=0;
				for ($k=0; $k<$nl; $k++) 
				{
					if( $start[$j]==$end[$k] )
					{
						$sum++;
					}
				}
				if ($sum!=1) {print "ERROR: subdomain $i not surrounded correctly\n"; $err=1; last;}
			}
		}
	}
	if (!$err) {print "subdomain 0 ... $sd_max: ok\n";}

	# output 
	open(FULL,">gnu/full");
	for ($i=0; $i<$l; $i++)
	{
		for ($j=0; $j<$n[$i]; $j++)
		{
			$idx=$lp[$i][$j];
			print FULL "$p[$idx][0] $p[$idx][1];\n";
		}
		print FULL "\n";
	}
	close(FULL);
	for ($i=0; $i<=$sd_max; $i++)
	{
		open(OUT,">gnu/sd$i");
		for ($j=0; $j<$l; $j++)
		{
			if ($left[$j]!=$i && $right[$j]!=$i) {next;}
			for ($k=0; $k<$n[$j]; $k++)
			{
				$idx=$lp[$j][$k];
				print OUT "$p[$idx][0] $p[$idx][1];\n";
			}
			print OUT "\n";
		}
		close(OUT);
	}
}

if ($dim==3)
{
    # admin
    open(IN,$ARGV[0]);
    $sd_min=1000000; $sd_max=-1;

    # get lines
    $l=0;
    while($line=<IN>)
    {
        if ($line=~/points:/)
        {
            $n[$l]=0;
            $line=~s/line\s*\d+:\s*points:\s*//g;
            while(1)
            {
                if ($line=~/(\d+)\s*/)
                {
                    $lp[$l][$n[$l]++]=$1;
                    $line=~s/\d+\s*//;
                }
                else
                {
                    last;
                }
            }
            $l++;
        }
        if ($line=~/Surface-Info/) {last;}
    }

	# get surfaces
	print "looking for surfaces ";
	$s=0;
	while($line=<IN>)
	{
		if ($line=~/surface/)		
		{
            $nsl[$s]=$nst[$s]=0;
            if (!($line=~/left=(\d+);\s*right=(\d+)/)) {die "ERROR: cannot read left/right info\n";}
            $left[$s]=$1; $right[$s]=$2;
            if ($left[$s]==$right[$s]) {die "ERROR: surface $s references subdomain $right[$s] on both sides\n";}
            $sd_max=max($sd_max,$1,$2);
            $sd_min=min($sd_min,$1,$2);
            $line=~s/.*lines:\s*//g;
			if ($debug) {print $line;}
            while(1)
            {
                if ($line=~/^(\d+)\s*/)
                {
                    $sl[$s][$nsl[$s]++]=$1;
                    $line=~s/\d+\s*//;
                }
                else
                {
                    last;
                }
            }
			$line=~s/.*triangles:\s*//g;
			while(1)
            {
                if ($line=~/^(\d+)\s+(\d+)\s+(\d+)\s*;\s*/)
                {
                    $st[$s][$nst[$s]][0]=$1;
                    $st[$s][$nst[$s]][1]=$2;
                    $st[$s][$nst[$s]++][2]=$3;
                    $line=~s/^\d+\s+\d+\s+\d+\s*;\s*//;
                }
                else
                {
                    last;
                }
            }

			if ($debug) {print "surface $s: lines: ";
			for ($i=0; $i<$nsl[$s]; $i++) {print "$sl[$s][$i] ";}
			print "triangles: ";
			for ($i=0; $i<$nst[$s]; $i++) {print "$st[$s][$i][0] $st[$s][$i][1] $st[$s][$i][2], ";}
			print "\n";}

            $s++;
		}

		if ($line=~/Point-Info/) { last;}
	}
	print "................................................ found $s\n";

    # get points
	print "looking for points ";
    $m=0;
    while($line=<IN>)
    {
        if ($line=~/\s*($real)\s+($real)\s+($real)/)
        {
            $p[$m][0]=$1; $p[$m][1]=$2; $p[$m][2]=$3; $p_ref[$m]=0;
            $m++;
        }
    }
    close(IN);
    if ($m<3) {print "ERROR: $m points detected\n";}
    else {print ".................................................. found $m\n";}

    # check point references
	print "checking point references ";
    for ($i=0; $i<$s; $i++)
    {
        for ($j=0; $j<$nst[$i]; $j++)
        {
            $p_ref[$st[$i][$j][0]]=1;
            $p_ref[$st[$i][$j][1]]=1;
            $p_ref[$st[$i][$j][2]]=1;
        }
    }
    $err=0;
    for ($i=0; $i<$m; $i++)
    {
        if ($p_ref[$i]==0)
        {
            $err=1;
            print "\nERROR: point $i not referenced\n";
        }
    }
    if (!$err) {$i=$m-1; print "........................................... ok\n";}

    # check subdomains
    $err=0; for ($i=0; $i<=$sd_max; $i++) {$sd_ref[$i]=0;}
    for ($i=0; $i<$s; $i++) {$sd_ref[$left[$i]]=1; $sd_ref[$right[$i]]=1;}
	print "checking subdomain references fron surfaces ";
	for ($i=0; $i<=$sd_max; $i++)
    {
        if (!$sd_ref[$i]) {print "ERROR: subdomain $i not referenced\n";$err=1;}
	}
	print "......................... ok\n";
	print "checking line-references from surfaces of the subdomains ";
	for ($i=0; $i<=$sd_max; $i++)
	{
		for ($j=0; $j<$s; $j++)
		{
			if ($left[$j]!=$i && $right[$j]!=$i) {next;}
			for ($k=0; $k<$nsl[$j]; $k++)
			{
				$line=$sl[$j][$k];
				$surf_ref=0;
				for ($j2=0; $j2<$s; $j2++)
				{
					if ($left[$j2]!=$i && $right[$j2]!=$i) {next;}
					for ($k2=0; $k2<$nsl[$j2]; $k2++)
					{
						if ($sl[$j2][$k2]==$line)
						{
							$surf_ref_id[$surf_ref]=$j2;
							$surf_ref++;
						}
					}
				}
				if ($surf_ref!=2) 
				{
					print "\nERROR: surface $j, line $line is referenced from $surf_ref surfaces of subdomain $i: (";
					for ($j2=0; $j2<$surf_ref-1; $j2++)
					{
						print "$surf_ref_id[$j2], ";
					}
					print "$surf_ref_id[$surf_ref-1])"; $err=1;
				}
			}
		}
	}
    if (!$err) {print "............ ok\n";}

    # output
    open(FULL,">gnu/full");
	print FULL "0 0 0\n\n";
    for ($i=0; $i<$l; $i++)
    {
        for ($j=0; $j<$n[$i]; $j++)
        {
            $idx=$lp[$i][$j];
            print FULL "$p[$idx][0] $p[$idx][1] $p[$idx][2];\n";
        }
        print FULL "\n\n";
    }
    close(FULL);
    for ($i=0; $i<=$sd_max; $i++)
    {
		$name=sprintf("gnu/sd%.2d",$i);
        open(OUT,">$name");
        for ($j=0; $j<$s; $j++)
        {
           	if ($left[$j]!=$i && $right[$j]!=$i) {next;}
           	for ($k=0; $k<$nsl[$j]; $k++)
			{
				$line=$sl[$j][$k];
            	for ($kk=0; $kk<$n[$line]; $kk++)
            	{
            	    $idx=$lp[$line][$kk];
            	    print OUT "$p[$idx][0] $p[$idx][1] $p[$idx][2];\n";
            	}
            	print OUT "\n\n";
			}
        }
        close(OUT);
    }
	for ($i=0; $i<$s; $i++)
	{
		$name=sprintf("gnu/sf%.2d",$i);
        open(OUT,">$name");
		print OUT "# left=$left[$i], right=$right[$i]\n";
		for ($j=0; $j<$nst[$i]; $j++)
		{
			$id=$st[$i][$j][0]; print OUT "$p[$id][0] $p[$id][1] $p[$id][2]\n";
			$id=$st[$i][$j][1]; print OUT "$p[$id][0] $p[$id][1] $p[$id][2]\n";
			$id=$st[$i][$j][2]; print OUT "$p[$id][0] $p[$id][1] $p[$id][2]\n";
			$id=$st[$i][$j][0]; print OUT "$p[$id][0] $p[$id][1] $p[$id][2]\n\n\n";
			#$id=$st[$i][$j][0]; print OUT "$id ";
			#$id=$st[$i][$j][1]; print OUT "$id ";
			#$id=$st[$i][$j][2]; print OUT "$id\n";
		}
        close(OUT);
	}

	# write README
	open(README,">gnu/README");
	print README '# to print output-file with gnuplot:'."\n";
	print README '#'."\n";
	print README '# gnuplot'."\n";
	print README '# load "README"'."\n";
	print README '# splot "full" w l'."\n";
	print README '#'."\n";
	print README '#'."\n";
	print README 'set parametric;'."\n";
	close(README);
}














