#! perl -w
use strict;

# --- The contents of these is the compiled data/code
my %state;
my %locals;
my %stringtables;
my @rules;
my @display;
my @RepeatedActions;

# --- This is runtime state
my %allowed;

use URI::Escape;
use Data::Dumper;
use Slang;	# generated from slang.grammar using perl -MParse::RecDescent - slang.grammar Slang

my $verbosity = 0;
my $version = 3;

$::RD_HINT = 1;
# $::RD_TRACE = 1;

my @reserved = ( );
my %reserved = map { push @reserved, $_; $_ => $#reserved }
(
	'==',
	'!=',
	'*',
	'+',
	'-',
	'/',
	'%',
	'|',
	'&',
	'^',
	'<=',
	'>=',
	'<',
	'>',
	'and',
	'or',
	'int',
	'array',
	'for',
	'when',
	'allow',
	'=int',
	'=array',
	'stringtable',
	'label',
	'end',
	'if',
	'box',
	'newline',
	'width',
	'height',
	'border',
	'background',
	'content',
	'bind_action',
	'while_active',
	'true',
	'false',
	'position',
	'repeatedly',
	'sprite'
);

# generate opcode table checksum
my $opcodesum = 0;
map { $opcodesum += ord($_); 1 } split('', join('', @reserved) );

sub Opcode
{
	my($text) = @_;
	defined($reserved{$text}) or die("Unknown operator: $text.\n");
	return \$reserved{$text};
};

sub OpSymbol
{
	my($opcode) = @_;
	defined($reserved[$$opcode]) or die("Unknown opcode: $$opcode.\n");
	return $reserved[$$opcode];
};

sub IsReserved
{
	my( $symbol ) = @_;
	return defined($reserved{ $symbol });
};

sub Eval
{
  my( $expression, $state ) = @_;

  $Data::Dumper::Indent = 0;
  $Data::Dumper::Terse = 1;
  Trace('Eval' . ":(" . Dumper($expression) . ")\n" . "State: " . Dumper($state) . "\n" );
  $Data::Dumper::Terse =0;
  $Data::Dumper::Indent = 2;
  defined($state) or $state = \%state;

	if( ref($expression) ne 'ARRAY' )
	{
		Trace('literal', $expression);
		return ($expression); # can't eval. Assume it's a constant.
	}

  # take local copies of expression and state
  $expression = [@$expression];
  $state = {(%$state)};

	# expression is reverse polish
	my @stack = ( );

	while( $#$expression > -1 )
	{
		my( $op ) = shift @$expression;

		if( ref($op) eq 'SCALAR' )
		{
			$op = $$op;
			defined($reserved[$op]) and $op = $reserved[$op];

			Trace( $op, \@stack );

			if( $op eq '==' )
			{
				my $b = pop @stack;
				my $a = pop @stack;
				push @stack, ($a == $b);
			}
			elsif( $op eq	'!=' )
			{
				my $b = pop @stack;
				my $a = pop @stack;
				push @stack, ($a != $b);
			}
			elsif( $op eq	'*' )
			{
				my $b = pop @stack;
				my $a = pop @stack;
				push @stack, ($a * $b);
			}
			elsif( $op eq	'+' )
			{
				my $b = pop @stack;
				my $a = pop @stack;
				push @stack, ($a + $b);
			}
			elsif( $op eq	'-' )
			{
				my $b = pop @stack;
				my $a = pop @stack;
				push @stack, ($a - $b);
			}
			elsif( $op eq	'/' )
			{
				my $b = pop @stack;
				my $a = pop @stack;
				push @stack, int($a / $b);
			}
			elsif( $op eq	'%' )
			{
				my $b = pop @stack;
				my $a = pop @stack;
				push @stack, ($a % $b);
			}
			elsif( $op eq	'|' )
			{
				my $b = pop @stack;
				my $a = pop @stack;
				push @stack, ($a | $b);
			}
			elsif( $op eq	'&' )
			{
				my $b = pop @stack;
				my $a = pop @stack;
				push @stack, ($a & $b);
			}
			elsif( $op eq	'^' )
			{
				my $b = pop @stack;
				my $a = pop @stack;
				push @stack, ($a ^ $b);
			}
			elsif( $op eq	'<=' )
			{
				my $b = pop @stack;
				my $a = pop @stack;
				push @stack, ($a <= $b);
			}
			elsif( $op eq	'>=' )
			{
				my $b = pop @stack;
				my $a = pop @stack;
				push @stack, ($a >= $b);
			}
			elsif( $op eq	'<' )
			{
				my $b = pop @stack;
				my $a = pop @stack;
				push @stack, ($a < $b);
			}
			elsif( $op eq	'>' )
			{
				my $b = pop @stack;
				my $a = pop @stack;
				push @stack, ($a > $b);
			}
			elsif( $op eq	'and' )
			{
				my $b = pop @stack;
				my $a = pop @stack;
				push @stack, ((Eval($a, $state))[0] && (Eval($b, $state))[0]);
			}
			elsif( $op eq	'or' )
			{
				my $b = pop @stack;
				my $a = pop @stack;
				push @stack, ((Eval($a, $state))[0] || (Eval($b, $state))[0]);
			}
			elsif( $op eq	'int' )
			{
				my $a = pop @stack;
				if(!defined($state->{$a}))
				{
					print STDERR " ** $a was not defined.\n";
					return undef;
				}
				push @stack, $state->{$a};
			}
			elsif( $op eq	'array' )
			{
				my $index = pop @stack;
				my $name = pop @stack;
				if(!defined($state->{$name}))
				{
					print STDERR " ** Array $name was not defined.\n";
					return undef;
				}
				if(($index < 0) || ($index > $#{$state->{$name}}))
				{
					print STDERR " ** Array index $index is out of bounds for $name".'[0..'.$#{$state->{$name}}."].\n";
					return undef;
				}
				push @stack, $state->{$name}->[$index];
			}
			elsif( $op eq	'for' )
			{
				my $code = pop @stack;
				my $to = pop @stack;
				my $from = pop @stack;
				my $varname = pop @stack;
				my $localstate = { ( %$state ) };
				foreach my $var( $from .. $to )
				{
				 $localstate->{$varname} = $var;
					Eval( $code, $localstate );
				}
			}
			elsif( $op eq	'when' )
			{
				my $code = pop @stack;
				my $condition = pop @stack;
				if( $condition )
				{
					Eval( $code, $state );
				}
			}
			elsif( $op eq	'allow' )
			{
				my $label = pop @stack;
				my $code = pop @stack;
				($label) = join('', map( { $_ =~ s/^\"(.*)\"$/$1/; $_ } Eval( $label, $state ) ) );
				length($label) or ($label = '(unlabelled)');
				$allowed{$label} = [$code, {(%$state)}];
			}
			elsif( $op eq	'=int' )
			{
				my ($data) = pop @stack;
				my ($target) = pop @stack;
				# NB. This is *not* what the javascript does: scope is respected in the JS version.
				$state->{$target->[0]} = $data;
				$state{$target->[0]} = $data;
				Log("Assign: $target->[0] <- $data.\n");
			}
			elsif( $op eq	'=array' )
			{
				my ($data) = pop @stack;
				my ($target) = pop @stack;
				$target = [ Eval( $target, $state ) ];
				my( $index ) = pop @$target;
				my( $name ) = pop @$target;
				# NB. This is *not* what the javascript does: scope is respected in the JS version.
				$state->{$name}->[$index] = $data;
				$state{$name}->[$index] = $data;
				Log("Assign: ".$name."[$index] <- $data.\n");
			}
			elsif( $op eq	'label' )
			{
				my ($label) = pop @stack;
				push @stack, '"' . $label . '"';
			}
			else
			{
				die( "Unknown opcode: $op\n");
			}
		}
	  else
    {
			Trace('data('.$op.')');
      push @stack, $op;
    }
	}

  $Data::Dumper::Indent = 0;
  $Data::Dumper::Terse = 1;
  Trace( 'return' . " (" . Dumper(\@stack) . ")\n" );
  $Data::Dumper::Terse =0;
  $Data::Dumper::Indent = 2;

	return @stack;
};

sub Trace
{
	my ($text, $stack) = @_;
	
	if( defined($stack) && ($#$stack > -1) )
	{
		$text .= ' -- ' . $stack->[$#$stack];
	}

	if( $verbosity > 1 )
	{
		Log('-- ' . $text . "\n");
	}
};

sub Log
{
	my($text) = @_;
	if( $verbosity > 0 )
	{
		print STDERR $text;
	}
};

sub AddRepeatedAction
{
	my($rule) = @_;
	push @RepeatedActions, $rule;
}

sub AddRule
{
	my($rule) = @_;
	push @rules, @{$rule};
};

sub AddDisplayCode
{
	my($rule) = @_;
	push @display, @{$rule};
};

sub GetStringtableString
{
	my($key) = @_;
	return $stringtables{$key};
};

sub SetState
{
	my($l, $s) = @_;
	$state{$s->[0]} = $s->[1];
	$locals{$s->[0]} = $l;
};

sub AddStringTable
{
	my($key, $value) = @_;
	$stringtables{$key} = $value;
};

sub UpdatePermissibleActions
{
	%allowed = ( );
	Eval(\@rules);
};

sub PerformAction
{
  my( $label ) = @_;
	Log( "------------------ ACTION: $label\n" );
  defined( $allowed{$label} ) or return 0;
  Eval( @{$allowed{$label}} );
	Log( "------------------ Updating permissible actions.\n" );
  UpdatePermissibleActions();
  return 1;
};

sub Compile
{
	my( $code, $indent ) = @_;
	my @code = @$code;
	defined( $indent ) or $indent = 0;

	my $dataindent = ' ' x ($indent + 2);

	return 
		' ' x ($indent) . "new Array\n"	
		. ' ' x ($indent) . "(\n"
		. join (",\n",
	map
	{
		my $item = $_;
		if( ref($item) eq 'ARRAY' )
		{
			$dataindent . "block\n" . $dataindent . "(\n" . Compile( $item, $indent + 4 ) . $dataindent . ")";
		}
		elsif( ref($item) eq 'REF' )
		{
      $dataindent . "lambda(" . $$$item . ")";
    }
		elsif( ref($item) eq 'SCALAR' )
		{
 			$dataindent . "opcode(" . $$item . ") /* " . $reserved[$$item] . ' */';
		}
		elsif( ref($item) )
		{
			die( "Unhandled reference while compiling Javascript: " . ref($item) . " - ". Dumper($item) . "\n" );
		}
		else
		{
 			$dataindent . dataitem( $item );
		}
	}
	@code)	
	. "\n" . ' ' x ($indent) . ")\n";
}

sub dataitem
{
	my($item) = @_;
	if( $item =~ /^[+-]?[0-9]+$/ )
	{
  	return 'dataitem(' . $item . ')';
	}
	else
	{
  	return 'dataitem(unescape("' . uri_escape( $item ) . '"))';
	}
}

# ----------------------------------------------------------------------------------

sub RetainNewlines
{
  my($text) = @_;
  $text =~ s/[^\n]//sg;
  return $text;
}

my $text = join('', <> );

$text =~ s/\/\*(.*?)\*\//RetainNewlines($1)/sge;
$text =~ s/\/\/.*$/\n/mg;

my $parser = Slang->new;
my $result = $parser->game_definition($text);
$result or die("Parse failed.\n");

# ----------------------------------------

# $Data::Dumper::Deepcopy = 1;
# print Dumper( \%state );
# print Dumper( \@rules );

print <<'_JS_'
<HTML>
  <HEAD>
  <style type="text/css">
  <!--
   .menu { line-height: 2em; text-align: center; }
   .menu span { padding: 2px; spacing: 4px; border: 1px solid black; cursor: pointer; cursor: hand; }
   table { padding: 0px; border: none; margin: 0px; text-align: center; border-spacing: 0; }   
   td { cursor: pointer; cursor: hand; }   
   -->
  </style>
  <script language="javascript" src="types.js"></script>
  <script language="javascript" src="slang.js"></script>
  <script language="JavaScript"><!--
// Javascript generated by game description compiler
// http://www.toothycat.net for more details

_JS_
;

print 'var compiler_opcodesum = ' . ($opcodesum + $version) . ";\n";

print 'var rules = ';
print Compile ( \@rules );
print ";\n\n";

if( $#RepeatedActions > -1 )
{
	print 's_repeatedActions = new Array (';
	print	join (',', map { 'unescape("' . uri_escape( $_ ) . '")' } @RepeatedActions);
	print ");\n\n";
}

print 'var display = ';
print Compile ( \@display );
print ";\n\n";

print 'var state = new Array();' . "\n";
foreach my $key( keys %state )
{
	if( uri_escape( $key ) ne $key )
	{
		die ("Identifier $key cannot be represented as an unescaped Javascript string.\n");
	}

	print 'state["' . $key . '"] = ';
	if( ref( $state{$key} ) )
	{
		ref( $state{$key} ) eq 'ARRAY' or die("Unhandled state reference for $key.\n" );
		print "new Array (";
		print join
		( ",\n", map
			{
				dataitem($_)
			}
			@{$state{$key}}
		);
		print ");\n";
	}
	else
	{
		print dataitem( $state{$key} ) . ';';
	}
	print "\n";
}

print 'var LocalsList = new Array();' . "\n";
foreach my $key( keys %locals )
{
	if( uri_escape( $key ) ne $key )
	{
		die ("Identifier $key cannot be represented as an unescaped Javascript string.\n");
	}

	print 'LocalsList["' . $key . '"] = ';
	if( $locals{$key} )
	{
		print "1;\n";
	}
	else
	{
		print "0;\n";
	}
}


print 'var stringtables = new Array();' . "\n";

foreach my $key( keys %stringtables )
{
	if( uri_escape( $key ) ne $key )
	{
		die ("Identifier $key cannot be represented as an unescaped Javascript string.\n");
	}

	print 'stringtables["' . $key . '"] = ';
	{
		ref( $stringtables{$key} ) eq 'ARRAY' or die("Unhandled stringtable entry for $key.\n" );
		print "new Array (";
		print join
		( ",\n", map
			{
				'unescape("' . uri_escape($_) . '")'
			}
			@{$stringtables{$key}}
		);
		print ");\n";
	}
	print "\n";
}


print <<'__JS__'
  //--></script>
  </HEAD>
  <BODY onLoad="doOnce()">
  <DIV ID="mainDiv"></DIV>
	<DIV ID="sprites"></DIV>
  <DIV ID="playmenu" CLASS="menu"></DIV>
  <HR>
  <DIV ID="debugmenu" CLASS="menu"></DIV>
  <HR>
  <DIV ID="state"></DIV>
  <DIV ID="trace"></DIV>
  <DIV ID="log"></DIV>
  <script language="JavaScript"><!--
  function doOnce()
  {
	if( compiler_opcodesum != opcodesum )
	{
		alert("Version mismatch! " + compiler_opcodesum + "," + opcodesum 
    +"\nThe engine has been upgraded since this page was last recompiled, and is no longer compatible with this code.\nPlease recompile this page." );
		return;
	}

	s_current_state.push( state );
	Initialise();
  };
  
  //-->
  </SCRIPT>

  </BODY>
</HTML>
__JS__
;

exit(0);