#!/usr/bin/perl -w

# Copyright Oscar Campbell, 2000. 2K-May-29th.
# Se PROJECT.txt för detaljerad onödig progress info...

use Fcntl;
use POSIX qw(tmpnam);


$VERSION = "0.6 (001010)";
	

if (scalar(@ARGV) == 0) {
	&printusage;
}

$tabwd = 8;
$run = 0;

$restisparams = 0;
$perlparams = "";

$warningflag = "";

#process arguments...
foreach $a (@ARGV) {
        if ($restisparams) {
                $perlparams .= $a . " ";
	
	} elsif ($a =~ /^-t(ab)?=(\d*)/) {
		$tabwd = $1;
	} elsif ($a =~ /^-w/) {
		$warningflag="-w";
	} elsif ($a =~ /^-p(retty)?/) {
		$prettyoutput = 1;
		$generate = 1;
	} elsif ($a =~ /^-g(enerate)?/) {
		$generate = 1;
	} elsif ($a =~ /^-r(un)?/) {
		$run = 1;
	} elsif ($a =~ /^-(-)?h(elp)?/) {
		&printusage();
                die "";
	} elsif ($a =~ /^-(-)?v(ersion)?/) {
                die "Pyrl version " . $VERSION . "\n\n";
	} else {
		$fname = $a;
                $restisparams = 1;
	}
}

if (!$run && !$prettyoutput && !$generate) {
	$run = 1;
}

&compilefile($fname);

print "\n";
# e-o-program.. nedan är bara sub routines..







########################################
# Det är här parsing actionen är... Själva translatorn..
########################################
sub compilefile  #arg 1 = file..
{
	my $fname = $_[0];
	my $outname = $_[0];
	$outname =~ s/(.*)\.ply$/$1\.pl/;

	if ($outname eq $fname) {
		print "   No need to process, not an pyrl .ply file.\n";
		return 1;
	}

	if ($fname) {
		open XF, "<$fname" or die "File $fname not found!\n\n\n";
	}
	
	my @lines = <XF>; #läser in prog..
	close XF;

	$lines[0] =~ s/pyrl/perl/;

	if ($lines[1] =~ s/^#tab[\t =]*([0-9])[ \t]*\n/\n/) { # TODO: supporta kommnt eol sen...
		$tabwd = $1;
	}

	# flyttats till "first pass":
	#	for ($n = 0; $n < @lines; $n++) {
	#		$lines[$n] =~ s/\\[ \t]*\n/\n/; # ta bort '\' i slut av rader men INTE \n efter det.. (!= join)
	#	}
# print "Tabwidth: $tabwd\n";
	
# detta kan verka o-optimerat.. Men vi måste ändå 'göra om' arrayn så de tomma raderna försvinner..
	my $lines = join("",@lines);
	$lines =~ s/ {$tabwd}/\t/gm; # ersätt tabwd spaces med en tab..
	@lines = split(/\n/, $lines);
	undef $lines;# = "";
	foreach $l (@lines) {
		$l .= "\n";
	}


	########################################
	# first pass, get indentvalues and expand some stuff
	########################################
# foreach är inte lämpligt här.. Vi behöver ändå $n...
#	$hangingjoin = 0;
	for ($n = 0; $n < @lines; $n++) {
		$_ = $lines[$n];
		
		$linesind[$n] = 0; #"de-warnifier"..
		
		#### Ta hand om \ joinsar		
#		if ($hangingjoin) {
#				$linesind[$n] = -3;
#			$hangingjoin = 0;
#		}
#		if ($lines[$n] =~ s/\\[ \t]*\n/\n/) {
#			$hangingjoin = 1;
#			if ($linesind[$n] != -3) {
#			$linesind[$n] = &getindent($lines[$n]);
#			}
#		}
#		if ($hangingjoin) {
#			next;
#		}
		########

######## Tillåt block med std perl..
		if ($lines[$n] =~ s/^\{$//) {
			while ($lines[$n] !~ s/^\}$//) {
				$linesind[$n] = -3;
				$n++;
			}
			$linesind[$n]=-3;
			
			next;
		}
###########

		
		if (/^[\t ]*#/) { # om '#' nånstans i 'början' på rad..
			$linesind[$n] = -3;
		} elsif (/^[\t ]*$/) {   # tom rad
			$linesind[$n] = -3;

		} elsif (/^\t*\w*.*:([ \t]+\w)?(#.*)?$/) { #TODO: det funkar inte med comment efter label: etc..
			$linesind[$n] = -2;

		} else {		# en 'vanlig' rad... No special case..
			$linesind[$n] = &getindent($lines[$n]);
		}
	}

	
	$lines[@lines] = "";            # extenda array'n så sista '}' läggs till...
	$linesind[@linesind] = "0";     #

########################################
# second pass, insert brackets and ;'s...
########################################
	my $lind = 0;
	my $ln = 0;
	my $lastwascomma = 0;
	for ($n = 0; $n < @lines; $n++) {
		my $ind = $linesind[$n];
		if ($ind < 0) {
			next;
		}
		
		###  hitta nästa indent värde som inte är < 0:
		my $nind = 0;
		for ($t = $n+1; $t < @linesind; $t++) {
			if ($linesind[$t] >= 0) {
				$nind = $linesind[$t];
				last;
			}
		}
		###
		if ($ind < $lind) {   #	|| $n == @lines) { # låser sig, varför?: || $n+1 == @lines SKIT SAMMA, lagt efter loopen...
			$t = $lind - $ind;
			if ($prettyoutput) {
				$tstr = "";
				while ($t--) {
					$tstr .= "\t" x ($ind+$t) . "}\n";
				}
				$lines[$ln] .= $tstr; # lägger efter förra raden som hade indent värde...
			} else {
###### Här har vi gjort om:
				$tstr = "}" x $t; # . "\n";
				chomp($lines[$ln]);
				if ($lines[$ln] !~ s/(( {2,}|\t)#.*)$/$tstr$1\n/) {    # sätt in { efter statements..
					$lines[$ln] .= $tstr . "\n";
				}
			}
		}
		if ($ind < $nind) {
			if (($nind - $ind) > 1) {
#				print "WARNING! " . ($intransl[$n]+1) . ": Indentation increased by " . ($nind - $ind) . " levels.\n";
				print "WARNING! " . ($n+1) . ": Indentation increased by " . ($nind - $ind) . " levels.\n";
			}

			if ($lines[$n] !~ s/(( {2,}|\t)#.*$)/\{$1/) {    # sätt in { efter statements..
				$lines[$n] =~ s/\n/ \{\n/;
			}
		} else { # if ($ind >= $nind) {
			if ($lines[$n] !~ s/(( {2,}|\t)#.*$)/;$1/) {    # sätt in ; efter statements..
				  $lines[$n] =~ s/\n/;\n/;
			}
		}
		
		$lind = $ind;
		$ln = $n;
	}

	undef @linesind;

	if ($generate) {
		open OUTF, ">$outname" or die "Couldn't open out file!\n\n\n";
		print OUTF @lines;
		close OUTF;

		if ($run) {
			system("perl $warningflag $outname $perlparams");
		}
	} else {

		do { $outname = tmpnam() }
			until sysopen(OUTF, $outname, O_RDWR|O_CREAT|O_EXCL);
#		END { unlink($outname) or die "Couldn't remove temp file $outname : $!" }

		print OUTF @lines;
		close OUTF;
		system("perl $warningflag $outname $perlparams");
		unlink "$outname" or die "Couldn't remove temp file $outname : $! \n\n\n";
	}


	
	print "\n";

	return 1;
} # sub compilefile

sub findbalancedparan
{
	my @tmp = split(//,$_[0]);
	my $foo = 0;
	my $got = 0;
	
	for ($i = 0; $i < @tmp; $i++) {
		if ($tmp[$i] eq "(") {
			$foo++;
			$got =1;
		} elsif ($tmp[$i] eq ")") {
			$foo--;
			$got =1;
		}
		if ($foo == 0 && $got) {
			last;
		}
	}
	# $i innehåller nu pos efter balancerad parantes...
	return ++$i;
}

sub getindent
{
	$_[0] =~ /^(\t*)/;
	return length $1;
}

sub printusage
{
        print "\nPyrl version " . $VERSION . " by Oscar Campbell.\n\n";
	print "  usage:\n";
	print "pyrl [tab=n] [-w] [-g[enerate]] [-p[retty]] [-r[un]] filename.ply\n";
	print "\n-g generates perl source. -p generates a bit nicer perl source.\n";
	print "-r tells pyrl to run the script even though -g or -p is passed. If\n";
	print "you pass -pretty and -run, warning messages from perl will tell the\n";
	print "wrong line. Use -pretty only when you want readable perl source for\n";
	print "some reason.";
	die "\n";
}

