langgrouping.pl

M3355的源代码

#!/usr/bin/perl
use BuildRscCFile;

my $LAN_GROUPS = "LangGroups";
my $group_index;

if (@ARGV == 0)
{
	die ("Language Grouping Error: Please choise a Language Grouping Number !\n");
}
elsif (@ARGV == 1)
{
	open (H_SCRIPT,"$LAN_GROUPS") || die ("Can not open file \"$LAN_GROUPS\"\n");
	$group_index = $ARGV[0];
}
elsif(@ARGV == 2)
{
	open (H_SCRIPT, "$ARGV[0]") || die ("Can not open file \"$ARGV[0]\"\n");
	$group_index = $ARGV[1];
}
else
{
	die ("Language Grouping Error: Too many parameters !\n");
}



#const
my $PARSE_LANG_GROUP = "lang_group";
my $PARSE_LANG_RSC = "lang_resource";


# ver
my $line;
my $linenum = 0;
my $parse_type;
my %h_Groups;
my %h_LangRsc;
my @a_basic;
my $rsc_line;
my $temp;
my @a_temp;


foreach $line(<H_SCRIPT>)
{
	$linenum ++;
		
	$line =~ s/(\;.*)//; #remove lines marked by ;
	$line =~ s/(\s*)//g; #remove all space for all of them can be ignord in format
	$line =~ tr/A-Z/a-z/; #lower case only;

	if ($line =~ /^\[(.+)\]$/)	# [] line
	{
		if (($1 eq $PARSE_LANG_GROUP) || ($1 eq $PARSE_LANG_RSC))
		{
			$parse_type = $1;
#			print "\nOK: find section [$parse_type] at line $linenum.\n";
		}
		else
		{
#			print "Warning: unknown section \"$1\" at line $linenum.\n"; 
			$parse_type = $PARSE_ERR_SECTION;
		}
		next;		
	}
	elsif ($line =~ /^$/)	#empty line
	{
#		print "OK: find an empty line at line $linenum.\n"; 		
		next;
	}
	
	if ($parse_type eq $PARSE_LANG_GROUP)
	{
		if ($line =~ /^(\d+)=(.+)$/)
		{
			$h_Groups{$1} = $2;
		}
		else
		{
			print "Warning: format mismatch for [$PARSE_LANG_GROUP] section, line $linenum has been ignored.\n";
		}
	}
	elsif($parse_type eq $PARSE_LANG_RSC)
	{
		if ($line =~ /^([_0-9a-zA-Z]+)=(.+)$/)
		{
			$h_LangRsc{$1} = $2;
			$rsc_line = $2;
			if ($1 =~ /^__basic_font$/)
			{
				@a_basic = split(/,/,$rsc_line);
				for($i=0;$i<@a_basic;$i++)
				{
					if ($a_basic[$i] !~ /^[_0-9a-zA-Z][_0-9a-zA-Z.]*\(([_a-zA-Z][a-zA-Z]\d)\)$/)
					{
						die "Error: font resource format error at line $linenum !\n";
					}
					else 
					{
						$a_basic[$i] = $1;
					}
				}
				#print "@a_basic\n";

			}
			elsif ($rsc_line =~ /^[_0-9a-zA-Z][_0-9a-zA-Z.]*\([_a-zA-Z][a-zA-Z]\),[_0-9a-zA-Z][_0-9a-zA-Z.]*\([_a-zA-Z][a-zA-Z]\d\),[_0-9a-zA-Z][_0-9a-zA-Z.]*\([_a-zA-Z][a-zA-Z]\d\),[_0-9a-zA-Z][_0-9a-zA-Z.]*\([_a-zA-Z][a-zA-Z]\d\)$/)
			{
				
			}
			else
			{
				print "Error: Language related Resource format mismatch!\n";
				die " ==> $temp\n";
			}
		}
		else
		{
			print "Warning: format mismatch for [$PARSE_LANG_GROUP] section, line $linenum has been ignored.\n";
		}
	}
	elsif ($parse_type eq $PARSE_ERR_SECTION)
	{
		print "Line $linenum be ignored for in unknown section \n";
		#do nothing for $PARSE_ERR_SECTION and just ignore this section.
	}
	else
	{
		die("Error: how can I run to here !!!\n");
	}
}


###### check the cfg and generate output
my @a_LangsInGroup;
my %h_fonts;
my %h_strings;

my $lang_rsc;


@a_temp = split(/,/,$h_LangRsc{"__basic_font"});
foreach $lang_rsc (@a_temp)
{
	if($lang_rsc =~ /([_0-9a-zA-Z]+\.fnt)\((.+)\)/)
	{
		$h_fonts{$1} = $2;
	}
}
if ($h_Groups{$group_index} eq "")
{
	die("Error: there is no such a group number = $group_index\n");
}
else
{
	@a_LangsInGroup = split(/,/,$h_Groups{$group_index});
}

#### remove old output files
my $SF_MAP = "sf_map";
my @proglist = ("rm","-f","$SF_MAP");
system(@proglist);
#####total 32 bytes(4*8) for basic font infomation
open (H_SF_MAP,">$SF_MAP");
binmode (H_SF_MAP);
$temp = @a_basic;
syswrite H_SF_MAP, pack("$BuildRscCFile::ui32",$temp);
for($i=0;$i<@a_basic&&$i<7;$i++)
{
	$temp = syswrite (H_SF_MAP, $a_basic[$i],4,0); #4 bytes for one font name
	for (;$temp<4;$temp++)
	{
		syswrite H_SF_MAP, pack ("C",0);
	}					
}
for(;$i<7;$i++)
{
	syswrite H_SF_MAP, pack("L",0);
}

foreach $Language (@a_LangsInGroup)
{
	@a_temp = split(/,/,$h_LangRsc{$Language});
	
	
#	print "$Language needs @a_temp\n";
	foreach $lang_rsc (@a_temp)
	{
		if($lang_rsc =~ /([_0-9a-zA-Z]+\.fnt)\((.+)\)/)
		{
			$h_fonts{$1} = $2;
			$temp = syswrite(H_SF_MAP,$2,4,0);
			for (;$temp<4;$temp++)
			{
				syswrite H_SF_MAP, pack ("C",0);
			}			
		}
		elsif ($lang_rsc =~ /([_0-9a-zA-Z]+\.str)\((.+)\)/)
		{
			$h_strings{$1} = $2;
			$temp = syswrite(H_SF_MAP,$2,4,0);
			for (;$temp<4;$temp++)
			{
				syswrite H_SF_MAP, pack ("C",0);
			}			
		}
		else
		{
			print("Warning: unknown resource type \"$lang_rsc\", ignored !\n");
		}
	}
}
close (H_SF_MAP);


##### output to RscScript
#my @proglist = ("cp","-f","RscScript","RscScript.wrk");
#system(@proglist);
#chmod (6,"RscScript.wrk"); # remove the "READ ONLY" attribute

open (H_RSCSCRIPT,">>RscScript.wrk") || die"Error: can not open \"RscScript.wrk\"\n";
print H_RSCSCRIPT "\n\n";
print H_RSCSCRIPT "[general] ; pub info for following resource\n";
print H_RSCSCRIPT "resource_path = ..\\..\\..\\source\\res_data\\\n";
print H_RSCSCRIPT "\n";
print H_RSCSCRIPT "[font] ; ==> \\font\\??????	?????? is idstr\n";
while (($font_name, $save_name) = each(%h_fonts)) 
{
	print H_RSCSCRIPT "file=$font_name,	idstr=$save_name,	iszip=1\n";
} 

print H_RSCSCRIPT "\n";
print H_RSCSCRIPT "[string] ; ==> \\string\\??????		?????? is idstr\n";
print H_RSCSCRIPT "stringidfile= StringID.def\n";
while (($string_name, $save_name) = each(%h_strings)) 
{
	print H_RSCSCRIPT "file=$string_name,	idstr=$save_name,	iszip=1\n";
}
print H_RSCSCRIPT "\n";

print H_RSCSCRIPT "[general] ; pub info for following resource\n"; 
print H_RSCSCRIPT "resource_path = .\\\n"; 
print H_RSCSCRIPT "\n"; 
print H_RSCSCRIPT "[rsccfg] ; ==> \\rsccfg\\??????		?????? is idstr\n";
print H_RSCSCRIPT "file=$SF_MAP,	idstr=$SF_MAP,	iszip=0\n";
print H_RSCSCRIPT "\n";

close (H_RSCSCRIPT);