#!/usr/bin/env perl

$prog_name = $0;

sub  usage()
{
	print STDERR "Usage: ${prog_name} [-o objdir] file.act\n";
}

$have_srcfile = 0;
$i = 0;
while( $i <= $#ARGV )
{
	if ( $ARGV[$i] eq '-o' )
	{
		$i ++;

		if ( $i > $#ARGV )
		{
			usage();
			exit 1;
		}

		$objdir = $ARGV[$i];
	}
	elsif( $ARGV[$i] =~ /^-/ )
	{
		usage();
		exit 1;
	}
	else
	{
		if ( $have_srcfile )
		{
			usage();
			exit 1;
		}

		$have_srcfile = 1;

		$srcfile = $ARGV[$i];
	}

	$i ++;
}

if ( ! $have_srcfile )
{
	usage();
	exit 1;
}

$line_number_trans = 1;


$srcfile =~ /^(.*)\.act$/;
$actname = $1;

$Act_Name = "\u${actname}";
$Act_Name =~ s/-/_/g;
$Act_Name =~ s/_([a-z])/_\u$1/g;

$FR_Interface = 'const Field_Recog_Interface &';

open( SRCFILE ,"< ${srcfile}" ) || die "${prog_name}: Can't open ${srcfile}\n";


#$comment_out_mode = 0;
%evolutional_variable_set = ();

sub  get_line()
{
	my $line;

	$line = <SRCFILE>;

	$line =~ s/\@Act_Name\@/${Act_Name}/go;

	while ( $line =~ s/\@<([^>]+)>\@/INTERNAL_EVOLUTIONAL_VARIABLE_${1}/o )
	{
		$evolutional_variable_set{$1} = 1;
	}

	$line;
}

sub  evolutional_variable_trans($)
{
	my ($var_name) = @_;

	$var_name =~ s/_/-/g;

#	"Act_${Act_Name}/\L${var_name}\E";
	"\L${var_name}\E";
}


@cc_act_include = ();
@cc_include = ();
@h_include = ();
$parent_class = "";
$parent_name = "";
@private = ();
@protected = ();
@public = ();
@action = ();
@finalize = ();
@finished = ();
@filter = ();
@other_code = ();
$has_finished = 0;
$has_filter = 0;
@evaluate = ();
$has_evaluate = 0;
$has_other_code = 0;
$filter_arg = "";
%constructor_definition_line = ();
%constructor_definition = ();
%constructor_code = ();
%single_command_definition = ();
%single_command_definition_line = ();
%single_command_code = ();
@cc_pre_code = ();



sub  error($$)
{
	my( $line_number , $error_message ) = @_;

	print STDERR "Srcgen: ${srcfile}:${line_number}: ${error_message}\n";
	exit 1;
}

sub  syntax_error($)
{
	my( $line_number ) = @_;

	error( $line_number , "syntax error" );
}

sub  get_block()
{
	$_ = get_line() || syntax_error($.);
	chomp;

	syntax_error($.) if ( $_ ne "{" );

	get_until_next_close_bracket();
}

sub  get_until_next_close_bracket()
{
	my $src_line_number = $. + 1;

	my @block;

	my $remain = 1;

	for(;;)
	{
		$_ = get_line() || syntax_error($.);

		chomp;

		if ( /\@Parent_Name\@/ )
		{
			if ( $parent_name eq "" )
			{
				error( $. , "no %parent found." );
			}
			else
			{
				s/\@Parent_Name\@/${parent_name}/go;
			}
		}

		if ( $_ =~ /^{/ )
		{
			$remain ++;
		}
		elsif ( $_ =~ /^}/ )
		{
			$remain --;
			if ( $remain == 0 )
			{
				last;
			}
		}

		push( @block , $_ );
	}

	if ( $line_number_trans )
	{
		("#line ${src_line_number} \"${srcfile}\"" , @block);
	}
	else
	{
		@block;
	}
}

sub  get_h_include(@)
{
	my( @list ) = @_;
	my @h_include;

	foreach $line ( @list )
	{
		if ( $line =~ /^\s*#\s*INCLUDE\s+([-\w]+)$/o )
		{
			my $a_name = $1;

			push( @h_include ,
			      "#include  \"autogen_act_${a_name}.h\"" );
		}
		elsif ( $line =~ /^\s*(#\s*include\s+[^\s].*)$/o )
		{
			push( @h_include , $1 );
		}
	}

	@h_include;
}


sub  get_declaration(@)
{
	my( @list ) = @_;
	my @declaration;

	foreach $line ( @list )
	{
		if ( $line !~ /^\s*#\s*INCLUDE\s+([-\w]+)$/o
		  && $line !~ /^\s*#\s*include\s+[^\s]/o )
		{
			push( @declaration , $line );
		}
	}

	@declaration;
}


for(;;)
{
	$_ = get_line() || last;

	chomp;

	if ( /\@Parent_Name\@/ )
	{
		if ( $parent_name eq "" )
		{
			error( $. , "no %parent found." );
		}
		else
		{
			s/\@Parent_Name\@/${parent_name}/go;
		}
	}


	if ( $_ =~ m|^\s*//|o )
	{
		# comment out
	}
	elsif ( $_ =~ /^\s*#\s*INCLUDE\s+([-\w]+)$/o )
	{
		push( @cc_act_include , $1 );
	}
	elsif ( $_ =~ /^\s*#\s*include\s+[^\s]$/o )
	{
		if ( $line_number_trans )
		{
			push( @cc_include , "#line ${.} ${srcfile}" );
		}

		push( @cc_include , $_ );
	}
	elsif ( $_ =~ /^\s*private\s*:$/o )
	{
		my @block = get_block();
		my( @declaration , @h_inc );

		@h_inc = get_h_include( @block );
		@declaration = get_declaration( @block );

		push( @private , @declaration );
		push( @h_include , @h_inc );
	}
	elsif ( $_ =~ /^\s*protected\s*:$/o )
	{
		my @block = get_block();
		my( @declaration , @h_inc );

		@h_inc = get_h_include( @block );
		@declaration = get_declaration( @block );

		push( @protected , @declaration );
		push( @h_include , @h_inc );
	}
	elsif( $_ =~ /^\s*public\s*:$/o )
	{
		my @block = get_block();
		my( @declaration , @h_inc );

		@h_inc = get_h_include( @block );
		@declaration = get_declaration( @block );

		push( @public , @declaration );
		push( @h_include , @h_inc );
	}
	elsif( $_ =~ /^\s*finished\s*\(\s*\)$/o )
	{
		$has_finished = 1;
		@finished = get_block();
	}
	elsif( $_ =~ /^\s*action\s*\(\s*\)$/o )
	{
		if ( $#action != -1 )
		{
			print STDERR "${srcfile}:${.}:"
					. "action() multiple defined.\n";
			exit 1;
		}

		@action = get_block();
	}
	elsif( $_ =~ /^\s*finalize\s*\(\s*\)$/o )
	{
		if ( $#finalize != -1 )
		{
			print STDERR "${srcfile}:${.}:"
					. "finalize() multiple defined.\n";
		}

		@finalize = get_block();
	}
	elsif( $_ =~ /^\s*filter\s*\(\s*(\w+)?\s*\)$/o )
	{
		$filter_arg = $1;
		$has_filter = 1;
		@filter = get_block();
	}
	elsif( $_ =~ /^\s*evaluate\s*\(\s*\)$/o )
	{
		$has_evaluate = 1;
		@evaluate = get_block();
	}
	elsif( $_ =~ /code:/o )
	{
		$has_other_code = 1;
		push( @other_code , get_block() );
	}
	elsif( $_ =~ /^\s*initialize\s*\(/o )
	{
		my $src_line_number = $.;
		my $definition = $_;

		for(;;)
		{
			my $ln = get_line() || syntax_error($.);
			last if ( $ln eq "{\n" );

			$definition .= $ln;
		}

		# XXX
		$definition =~ s/[\n\t]/ /go;
		$definition =~ s/\s+$//o;
		$definition =~ s/^\s+//o;

		# XXX
		if ( ! ($definition
			=~ /^\s*initialize\s*\(\s*((?:[^\)]|\([^\)]*\))*)\)\s*(throw\([^\)]*\)\s*)?(?::(.*))?\s*$/o ) )
		{
			syntax_error($.);
		}

		my $arg_and_exception = $1;
		my $exceptions = $2;
		my $initializer = $3;

		if ( $exceptions ne '' )
		{
			syntax_error($.);
		}

		$constructor_definition{$arg_and_exception} = $initializer;

		$constructor_definition_line{$arg_and_exception}
							    = $src_line_number;

		$constructor_code{$arg_and_exception}
			= join( "\n" , get_until_next_close_bracket() );
	}
	elsif( $_ =~ /^\s*single_command\s*\(/o )
	{
		my $src_line_number = $.;

		my $definition = $_;

		for(;;)
		{
			my $ln = get_line() || syntax_error($.);
			last if ( $ln eq "{\n" );

			$definition .= $ln;
		}

		# XXX
		$definition =~ s/[\n\t]/ /go;
		$definition =~ s/\s+$//o;
		$definition =~ s/^\s+//o;

		# XXX
		if ( ! ($definition
			=~ /^\s*single_command\s*\(\s*((?:[^\)]|\([^\)]*\))*)\)\s*(throw\([^\)]*\))?\s*$/o ) )
		{
			syntax_error($.);
		}

		my $arg_and_exception = $1;
		my $exceptions = $2;

		if ( $exceptions ne '' )
		{
			syntax_error($.);
		}

		$single_command_definition{$arg_and_exception}
							= $arg_and_exception;

		$single_command_definition_line{$arg_and_exception}
							= $src_line_number;

		$single_command_code{$arg_and_exception}
			= join( "\n" , get_until_next_close_bracket() );

	}
	elsif( $_ =~ /^\s*\%parent\s+(:?)\s*(\w+)\s*$/o )
	{
		if ( $parent_class ne "" )
		{
			error( $. , "\%parent multiply defined" );
		}

		if ( $1 eq ":" )
		{
			$parent_class = $2;
			$parent_name = $parent_class;
		}
		else
		{
			$parent_class = $2;

			$parent_name = $parent_class;
			$parent_name =~ s/^(.)/\u$1/;
			$parent_name =~ s/_([a-z])/_\u$1/g;

			push( @h_include ,
			     "#include \"autogen_act_${parent_class}.h\"\n");
			$parent_class = "Act_${parent_class}";
			$parent_class =~ s/_([a-z])/_\u$1/g;
		}
	}
	else
	{
		push( @cc_pre_code , $_ );
	}
}

close(SRCFILE);


#
# autogen_act_*.h
#
$hfile = '';
$hfile .= "//\n";
$hfile .= "// This file is automatically generated from ${srcfile}\n";
$hfile .= "//\n";
$hfile .= "\n";

$hfile .= "#ifndef	   ACT_\U${Act_Name}\E_H_INCLUDED\n";
$hfile .= "#define	   ACT_\U${Act_Name}\E_H_INCLUDED\n";
$hfile .= "\n";
$hfile .= "#include  \"action_basic.h\"\n";
$hfile .= join( "\n" , @h_include );
$hfile .= "\n";
$hfile .= "\n";

if ( ${parent_class} eq "" )
{
	$hfile .= "class  Act_${Act_Name} : public Soccer_Action\n";
}
else
{
	$hfile .= "class  Act_${Act_Name} : public ${parent_class}\n";
}
$hfile .= "{\n";
$hfile .= "private:\n";
$hfile .= "	virtual	Soccer_Composite_Command  INTERNAL_real_action();\n";
$hfile .= "\n";
$hfile .= "\n";


if ( $#public >= 0 )
{
	$hfile .= "public:\n";
	$hfile .= join( "\n" , @public ) . "\n";
	$hfile .= "\n";
}

if ( $#protected >= 0 )
{
	$hfile .= "protected:\n";
	$hfile .= join( "\n" , @protected ) . "\n";
	$hfile .= "\n";
}

if ( $#private >= 0 )
{
	$hfile .= "private:\n";
	$hfile .= join( "\n" , @private ) . "\n";
	$hfile .= "\n";
}

$hfile .= "\n";

$hfile .= "public:\n";

if ( scalar( keys %constructor_definition ) == 0 )
{
	$hfile .= "		 Act_${Act_Name}"
		  . "( ${FR_Interface}  f );\n";
}
else
{
	foreach( keys %constructor_definition )
	{
		$hfile .= "		 Act_${Act_Name}"
			  . "( ${FR_Interface}  f ";

		if ( $_ !~ /^\s*$/ )
		{
			$hfile .= ",\n"
				  . "			      ${_}";
		}
		$hfile .= ");\n";
	}
}


$hfile .= "	virtual	~Act_${Act_Name}();\n";
$hfile .= "\n";
$hfile .= "	virtual	Soccer_Composite_Command	action();\n";
$hfile .= "	virtual	ref_count_ptr<Soccer_Action>	clone() const;\n";
if ( $has_finished )
{
	$hfile .= "	virtual	bool				finished()"
								. " const;\n";
}

if ( $has_filter )
{
	$hfile .= "	virtual	Soccer_Composite_Command"
		  . "	INTERNAL_filter\n"
		  . "			( const Soccer_Composite_Command & ";

	if ( $filter_arg ne "" )
	{
		$hfile .= " ${filter_arg} ";
	}

	$hfile .= ");\n";
}

if ( $has_evaluate )
{
	$hfile .= "	virtual	bool				evaluate();\n";
}

if ( scalar( keys %single_command_definition ) != 0 )
{
	$hfile .= "\n";

	foreach( keys %single_command_definition )
	{
		$hfile .= "	static	Soccer_Composite_Command\n"
			  . "			single_command"
			  . "( ${FR_Interface} ";

		if ( $_ !~ /^\s*$/ )
		{
			$hfile .= ",\n					${_}";
		}
		$hfile .= ");\n";
	}
}

if ( scalar( %evolutional_variable_set ) )
{
	$hfile .= "\n";
	$hfile .= "\n";
	$hfile .= "protected:\n";

	foreach( keys %evolutional_variable_set )
	{
		$hfile .= "	Evolutional_Double"
				. "	INTERNAL_EVOLUTIONAL_VARIABLE_${_};\n";
	}
}

$hfile .= "};\n";
$hfile .= "\n";
$hfile .= "\n";

$hfile .= "#endif	/* ACT_\U${Act_Name}\E_H_INCLUDED */\n";


#
# autogen_act_*.cc
#
$ccfile='';
$ccfile .= "//\n";
$ccfile .= "// This file is automatically generated from ${srcfile}\n";
$ccfile .= "//\n";
$ccfile .= "\n";

$ccfile .= "#include  \"autogen_act_${actname}.h\"\n";
foreach( @cc_act_include )
{
	$ccfile .= "#include  \"autogen_act_${_}.h\"\n";
}
$ccfile .= join( "\n" , @cc_include ) . "\n";
$ccfile .= "\n";

foreach( @cc_pre_code )
{
	$ccfile .= $_ . "\n";
}

if ( scalar( keys %constructor_definition ) == 0 )
{
	$ccfile .= "Act_${Act_Name}::Act_${Act_Name}"
			. "( ${FR_Interface}  f )\n";
	if ( $parent_class eq "" )
	{
		$ccfile .= "\t: Soccer_Action( f )";
	}
	else
	{
		$ccfile .= "\t: ${parent_class}( f )";
	}

	if ( scalar( %evolutional_variable_set ) )
	{
		foreach( keys %evolutional_variable_set )
		{
			$ccfile .= " ,\n";
			$ccfile .= "\t  "
				   . "INTERNAL_EVOLUTIONAL_VARIABLE_${_}\n"
				   . "\t\t( f.evs() ,"
					   . " \""
					   . evolutional_variable_trans( ${_} )
					   . "\" )";
		}
	}

	$ccfile .= "\n";

	$ccfile .= "{\n";
	$ccfile .= "}\n";
	$ccfile .= "\n";
}
else
{
	foreach( keys %constructor_definition )
	{
		my $key = $_;

		$args = $key;

		$args =~ s/\([^\)]*\)//go;

		$args =~ s/=[^,\)]+//go;

		$line_directive = "";
		if ( $line_number_trans )
		{
			$line_directive
				= "#line "
				  . $constructor_definition_line{$key}
				  . " \"" . ${srcfile} . "\"\n";
		}

		$ccfile .= $line_directive;

		$ccfile .= "Act_${Act_Name}::Act_${Act_Name}"
			   . "( ${FR_Interface}  f ";
		if ( $args !~ /^\s*$/o )
		{
			$ccfile .= ", ${args}";
		}
		$ccfile .= ")\n";

		my $parameter_initialize_added = 0;

		if ( $parent_class eq "" )
		{
			$ccfile .= "\t: Soccer_Action( f )";
			$parameter_initialize_added = 1;

			if ( $constructor_definition{$_} )
			{
				$ccfile .= " ," . $constructor_definition{$_};
			}
		}
		else
		{
			if ( $constructor_definition{$_} )
			{
				$parameter_initialize_added = 1;
				$ccfile .= "\t: "
					   . $constructor_definition{$_};
			}
		}

		if ( scalar( %evolutional_variable_set ) )
		{
			foreach( keys %evolutional_variable_set )
			{
				if ( $parameter_initialize_added )
				{
					$ccfile .= " ,\n";
					$ccfile .= "\t  ";
				}
				else
				{
					$ccfile .= "\t: ";
					$parameter_initialize_added = 1;
				}

				$ccfile
				  .= "INTERNAL_EVOLUTIONAL_VARIABLE_${_}\n"
				  . "\t\t( f.evs() ,"
					   . " \""
					   . evolutional_variable_trans( ${_} )
					   . "\" )";
			}
		}

		$ccfile .= "\n";
		$ccfile .= "{\n";
		$ccfile .= $constructor_code{$_} . "\n";
		$ccfile .= "}\n";
		$ccfile .= "\n";
	}
}

$ccfile .= "Act_${Act_Name}::~Act_${Act_Name}()\n";
$ccfile .= "{\n";
$ccfile .= join( "\n" , @finalize ) . "\n";
$ccfile .= "}\n";
$ccfile .= "\n";

if ( $has_finished )
{
	$ccfile .= "bool   Act_${Act_Name}::finished() const\n";
	$ccfile .= "{\n";
	$ccfile .= join( "\n" , @finished ) . "\n";
	$ccfile .= "}\n";
	$ccfile .= "\n";
}

if ( $has_filter )
{
	$ccfile .= "Soccer_Composite_Command  Act_${Act_Name}"
		    . "::INTERNAL_filter\n"
		    . "    ( const Soccer_Composite_Command & ";

	if ( ${filter_arg} ne "" )
	{
		$ccfile .= " ${filter_arg} ";
	}
	$ccfile .= ")\n";

	$ccfile .= "{\n";
	$ccfile .= join( "\n" , @filter ) . "\n";
	$ccfile .= "}\n";
	$ccfile .= "\n";
}

$ccfile .= "Soccer_Composite_Command  Act_${Act_Name}::action()\n";
$ccfile .= "{\n";
$ccfile .= "\t" . "if ( Debug_Stream::dbg )\n";
$ccfile .= "\t" . "{\n";
$ccfile .= "\t" . "\t" . "Debug_Stream::dbg "
			. "<< \"Act_${Act_Name}::action()\" << std::endl;\n";
$ccfile .= "\t" . "}\n";


$ccfile .= "\n";
if ( $has_filter )
{
	$ccfile .= "	return( this -> INTERNAL_filter"
				. "( this -> INTERNAL_real_action() ) );\n";
}
else
{
	$ccfile .= "	return( this -> INTERNAL_real_action() );\n";
}
$ccfile .= "}\n";
$ccfile .= "\n";

$ccfile .= "Soccer_Composite_Command  Act_${Act_Name}"
		. "::INTERNAL_real_action()\n";
$ccfile .= "{\n";
$ccfile .= join( "\n" , @action ) . "\n";
$ccfile .= "}\n";


$ccfile .= "\n";
$ccfile .= "ref_count_ptr<Soccer_Action>  Act_${Act_Name}::clone() const\n";
$ccfile .= "{\n";
$ccfile .= "	return( new Act_${Act_Name}( *this ) );\n";
$ccfile .= "}\n";


if ( scalar( keys %single_command_definition ) != 0 )
{
	$ccfile .= "\n";

	foreach( keys %single_command_definition )
	{
		my $key = $_;

		$args = $key;

		$args =~ s/\([^\)]*\)//go;

		$args =~ s/=[^,\)]+//go;
		$args =~ s/\s+$//go;

		$ccfile .= "Soccer_Composite_Command  "
			   . "Act_${Act_Name}::single_command\n"
			   . "			    ( ${FR_Interface}  f";

		$line_directive = "";
		if ( $line_number_trans )
		{
			$line_directive
				= "#line "
				  . $single_command_definition_line{$key}
				  . " \"" . ${srcfile} . "\"\n";
		}

		if ( $args =~ /^\s*$/o )
		{
			$ccfile .= "\n";
			$ccfile .= $line_directive;
		}
		else
		{
			$ccfile .= " ,\n";
			$ccfile .= $line_directive;
			$ccfile .= "			      ${args} ";
		}

		$ccfile .= ")\n";
		$ccfile .= "{\n";
		$ccfile .= $single_command_code{$key} . "\n";
		$ccfile .= "}\n";
		$ccfile .= "\n";
	}
}

if ( $has_evaluate )
{
	$ccfile .= "\n";
	$ccfile .= "bool   Act_${Act_Name}::evaluate()\n";
	$ccfile .= "{\n";
	$ccfile .= join( "\n" , @evaluate ) . "\n";
	$ccfile .= "}\n";
}

if ( $has_other_code )
{
	$ccfile .= "\n";

	$ccfile .= join( "\n" , @other_code ) . "\n";
}


if ( $objdir eq '' )
{
	$ccfilename = "autogen_act_${actname}.cc";
	$hfilename  = "autogen_act_${actname}.h";
}
else
{
	$ccfilename = "${objdir}/autogen_act_${actname}.cc";
	$hfilename  = "${objdir}/autogen_act_${actname}.h";
}

undef $/;

$new_ccfile = 0;
$new_hfile  = 0;

if ( ! open( OLD_CCFILE , "<${ccfilename}" ) )
{
	$new_ccfile = 1;
}

if ( ! open( OLD_HFILE , "<${hfilename}" ) )
{
	$new_hfile = 1;
}

if ( ! $new_ccfile )
{
	$old_ccfile = <OLD_CCFILE>;

	if ( $old_ccfile ne $ccfile )
	{
		$new_ccfile = 1;
	}

	close( OLD_CCFILE );
}

if ( ! $new_hfile )
{
	$old_hfile = <OLD_HFILE>;

	if ( $old_hfile ne $hfile )
	{
		$new_hfile = 1;
	}

	close( OLD_HFILE );
}


#if ( $new_hfile )
{
	unlink( $hfilename );

	open( HFILE , "> ${hfilename}" )
		|| die "${prog_name}: Can't open ${hfilename}\n";

	print HFILE $hfile;

	close( HFILE );

	chmod( 0444 , $hfilename );
}

#if ( $new_ccfile )
{
	unlink( $ccfilename );

	open( CCFILE , "> ${ccfilename}" )
		|| die "${prog_name}: Can't open ${ccfilename}\n";

	print CCFILE $ccfile;

	close( CCFILE );

	chmod( 0444 , $ccfilename );
}
