abian/0ad
1
0
Fork 0
forked from 0ad/0ad
Code Pull Requests Activity

Uninteresting things that I've had hanging around for a while.

Browse Source 
This was SVN commit r2190.
This commit is contained in:
Ykkrosh 2005-04-28 20:50:19 +00:00
parent 780b6e266b
commit 0fc17f7305
10 changed files with 190 additions and 74 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

BIN
source/tools/entgraph/entgraph.exe
View File

Binary file not shown.

2
source/tools/i18n/DataFiles.pm
View File

@ -63,7 +63,7 @@ sub unescape {
}
sub escape {
my $t = $_[0];
return "\\" unless length $t;
return "\\" unless defined $t and length $t;
$t =~ s/\\/\\\\/g;
$t =~ s/\n/\\n/g;
$t;

1
source/tools/i18n/StringExtract/CCode.pm
View File

@ -14,7 +14,6 @@ our $data = {
],
file_roots_ignore => [
'source/workspaces',
'source/i18n/tests',
'source/tools',
],

19
source/tools/i18n/StringExtract/Utils.pm
View File

@ -4,6 +4,7 @@ use warnings;
package StringExtract::Utils;
use XML::Simple();
use Carp;
use Regexp::Common qw(comment);
@ -18,14 +19,24 @@ sub read_xml {
);
my $filedata = do { open my $f, '<', $filename or die $!; local $/; <$f> };
my ($dir) = ($filename =~ /(.*)[\\\/]/);
# Fix DTD paths
my ($dir) = ($filename =~ m~(.*)[\\/]~);
$filedata =~ s {SYSTEM "(?!/)} {SYSTEM "$dir/};
$filedata =~ s {SYSTEM "/} {SYSTEM "../../../binaries/data/mods/official/};
my $data = $xml->XMLin($filedata);
my $data = eval { $xml->XMLin($filedata) };
if ($@) {
warn "Error reading $filename: $@";
return;
}
recursive_process($data);
my ($filename_short) = ($filename =~ m~([^\\/]+)$~);
my $root = (keys %$data)[0];
return [ $root, @{$data->{$root}} ];
return [ $root, $filename_short, @{$data->{$root}} ];
}
sub recursive_process {
@ -53,7 +64,7 @@ sub recursive_process {
sub read_text {
my ($filename) = $_;
open my $file, '<', $filename or die "Error opening $filename: $!";
open my $file, '<', $filename or carp "Error opening $filename: $!";
my $data = do { local $/; <$file> };
return ({ filename => $filename }, $data);

21
source/tools/i18n/StringExtract/XML.pm
View File

@ -21,24 +21,29 @@ our $data = {
sub extract {
my ($xmldata) = @_;
my ($root, %elements) = ($xmldata->[0], %{$xmldata->[1]});
return unless $xmldata;
my ($root, $filename, %elements) = (@{$xmldata}[0, 1], %{$xmldata->[2]});
my @strings;
# Entities
if ($root eq 'entity') {
push @strings, map [ "noun:".$_->{content}, "Entity name" ], @{$elements{name}};
push @strings, map [ "noun:".$_->{content}, "Entity name ($filename)" ], @{$elements{name}};
# Actors
} elsif ($root eq 'object') {
push @strings, map [ "noun:".$_->{content}, "Actor name" ], @{$elements{name}};
push @strings, map [ "noun:".$_->{content}, "Actor name ($filename)" ], @{$elements{name}};
# Materials
} elsif ($root eq 'material') {
# GUI objects
} elsif ($root eq 'objects') {
recursive_extract_guiobject(\@strings, [\%elements]);
recursive_extract_guiobject($filename, \@strings, [\%elements]);
# GUI setup
} elsif ($root eq 'setup') {
@ -60,10 +65,10 @@ sub extract {
}
sub recursive_extract_guiobject {
my ($strings, $elements) = @_;
my ($filename, $strings, $elements) = @_;
for my $element (@$elements) {
push @$strings, [ "phrase:".$element->{tooltip}, "GUI tooltip" ] if defined $element->{tooltip};
push @$strings, [ "phrase:".$element->{content}, "GUI text" ] if defined $element->{content};
push @$strings, [ "phrase:".$element->{tooltip}, "GUI tooltip ($filename)" ] if defined $element->{tooltip};
push @$strings, [ "phrase:".$element->{content}, "GUI text ($filename)" ] if defined $element->{content};
if ($element->{script}) {
push @$strings, StringExtract::JSCode::extract($_->{content}) for @{$element->{script}};
@ -72,7 +77,7 @@ sub recursive_extract_guiobject {
push @$strings, StringExtract::JSCode::extract($_->{content}) for @{$element->{action}};
}
recursive_extract_guiobject($strings, $element->{object}) if $element->{object};
recursive_extract_guiobject($filename, $strings, $element->{object}) if $element->{object};
}
}

61
source/tools/i18n/Strings.pm Normal file
View File

@ -0,0 +1,61 @@
use strict;
use warnings;
package Strings;
use DataFiles;
sub merge {
my ($filename, %new_strings) = @_;
# Read the earlier string data
my $strings = DataFiles::read_file($filename, ignoremissing=>1);
for my $old (@$strings) {
my $stringid = $old->[STR_ID];
if (exists $new_strings{$stringid}) {
# String already exists; just update the content
if ($new_strings{$stringid}{context}) {
$old->[STR_CONTEXT] = $new_strings{$stringid}{context};
}
if ($new_strings{$stringid}{description}) {
$old->[STR_DESCRIPTION] = $new_strings{$stringid}{description};
}
# Make sure it's not obsolete now
flag_set(\$old->[STR_FLAGS], 'obsolete', 0);
# Remove it from this list, so the unprocessed ones can be found later
delete $new_strings{$stringid};
} else {
# String has been removed; set obsolete flag
flag_set(\$old->[STR_FLAGS], 'obsolete', 1);
}
}
for (keys %new_strings) {
# Newly added strings
push @$strings, [ $_, len_or($new_strings{$_}{context}, "?"), len_or($new_strings{$_}{description}, "?"), "" ];
}
DataFiles::write_file($filename, $strings);
}
sub len_or { (defined $_[0] and length $_[0]) ? $_[0] : $_[1] }
sub flag_set {
my ($str, $flagname, $value) = @_;
my @flags = split / /, $$str;
if ($value) {
push @flags, $flagname unless grep $_ eq $flagname, @flags;
} else {
@flags = grep $_ ne $flagname, @flags;
}
$$str = join ' ', @flags;
}
1;

40
source/tools/i18n/Translations.pm Normal file
View File

@ -0,0 +1,40 @@
use strict;
use warnings;
package Translations;
use DataFiles;
sub merge {
my ($filename, %new_translations) = @_;
# Read the earlier translation data
my $translations = DataFiles::read_file($filename, ignoremissing=>1);
for my $old (@$translations) {
my $stringid = $old->[0];
if (exists $new_translations{$stringid}) {
# Translation already exists; just update the content
$old->[1] = $new_translations{$stringid};
# Remove it from this list, so the unprocessed ones can be found later
delete $new_translations{$stringid};
} else {
# String has been removed; leave it for now
}
}
for (keys %new_translations) {
# Newly added translations
push @$translations, [ $_, len_or($new_translations{$_}, "") ];
}
DataFiles::write_file($filename, $translations);
}
sub len_or { (defined $_[0] and length $_[0]) ? $_[0] : $_[1] }
1;

28
source/tools/i18n/fromspreadsheet.pl
View File

@ -7,6 +7,8 @@ our %config;
do "config.pl";
use DataFiles;
use Strings;
use Translations;
use Spreadsheet::ParseExcel;
@ -14,32 +16,42 @@ fromspreadsheet($config{strings_filename}, $config{data_path}."/$language/transl
sub fromspreadsheet {
my ($strings_filename, $translations_filename, $spreadsheet_filename) = @_;
# Read data from spreadsheet:
my $strings = DataFiles::read_file($strings_filename);
my $translations = DataFiles::read_file($translations_filename, ignoremissing=>1);
my $workbook = Spreadsheet::ParseExcel::Workbook->Parse($spreadsheet_filename);
my @stringdata; # = ( [type:id, description], ...)
my @transdata; # = ( [type:id, translation], ...)
my %strings; # Data associated with each string. (type:id => { description => '...' }, ...)
my %translations; # Data associated with each translation. (type:id => translation, ...)
for my $worksheet (@{$workbook->{Worksheet}}) {
my $type = $worksheet->{Name};
my @rows;
for my $col ($worksheet->{MinCol} .. $worksheet->{MaxCol}) {
push @cells, [];
for my $row ($worksheet->{MinRow} .. $worksheet->{MaxRow}) {
for my $row ($worksheet->{MinRow} .. $worksheet->{MaxRow}) {
next if $row == 0;
push @rows, [];
for my $col ($worksheet->{MinCol} .. $worksheet->{MaxCol}) {
push @{$rows[-1]}, $worksheet->{Cells}[$row][$col]->{Val};
}
}
for (@rows) {
my $id = $type.':'.$_->[0];
push @transsdata, [$id, $_->[1]];
push @stringsdata, [$id, $_->[2]];
if ($strings{$id}) {
warn "Duplicated string $id!";
}
$strings{$id} = { description => $_->[2] };
$translations{$id} = $_->[1];
}
}
Strings::merge($strings_filename, %strings);
Translations::merge($translations_filename, %translations);
}

67
source/tools/i18n/stringextract.pl
View File

@ -19,14 +19,15 @@ use StringExtract::JSCode;
use StringExtract::CCode;
use DataFiles;
use Strings;
my %all_strings;
# Repeat for each data type that needs to be parsed
for my $type (
# $StringExtract::XML::data,
$StringExtract::XML::data,
# $StringExtract::JSCode::data,
$StringExtract::CCode::data,
# $StringExtract::CCode::data,
) {
# Get the list of files that the module wants to handle
@ -38,8 +39,10 @@ for my $type (
my @dirs = map $prefix.$_, @{$type->{file_roots}};
find({
preprocess => sub {
# Trim the ../../../ prefix
my $path = substr($File::Find::dir, length $prefix);
grep !contains($type->{file_roots_ignore}, $path.'/'.$_), @_;
# Ignore all directories that are called '.svn', or whose paths are any of file_roots_ignore
grep not ($_ eq '.svn' or contains($type->{file_roots_ignore}, $path.'/'.$_)), @_;
},
wanted => sub {
# Include files that match the file_types regexp
@ -64,52 +67,18 @@ for my $type (
}
}
# Transform into %all_strings = (stringid => { context => '...' })
for (keys %all_strings) {
$all_strings{$_} = { context => join "\n", uniq(sort @{$all_strings{$_}}) };
}
# Merge the string data with any existing information
merge_strings($config{strings_filename}, %all_strings);
Strings::merge($config{strings_filename}, %all_strings);
sub merge_strings {
my ($filename, %new_strings) = @_;
# Read the earlier string data
my $strings = DataFiles::read_file($filename, ignoremissing=>1);
for my $old (@$strings) {
my $stringid = $old->[STR_ID];
if ($new_strings{$stringid}) {
# String already exists; just update the context
$old->[STR_CONTEXT] = join "\n", @{ $new_strings{$stringid} };
sub contains { $_[1] eq $_ && return 1 for @{$_[0]}; 0 }
# Make sure it's not obsolete now
flag_set(\$old->[STR_FLAGS], 'obsolete', 0);
# Remove it from this list, so the unprocessed ones can be found later
delete $new_strings{$stringid};
} else {
# String has been removed; set obsolete flag
flag_set(\$old->[STR_FLAGS], 'obsolete', 1);
}
}
for (keys %new_strings) {
# Newly added strings
push @$strings, [ $_, join("\n", @{ $new_strings{$_} }), "?", "" ];
}
DataFiles::write_file($filename, $strings);
}
sub flag_set {
my ($str, $flagname, $value) = @_;
my @flags = split / /, $$str;
if ($value) {
push @flags, $flagname unless grep $_ eq $flagname, @flags;
} else {
@flags = grep $_ ne $flagname, @flags;
}
$$str = join ' ', @flags;
}
sub contains { $_[1] eq $_ && return 1 for @{$_[0]}; 0 }
sub uniq { # Uniquify sorted lists
my @r;
for (@_) { push @r, $_ unless @r and $r[-1] eq $_ };
@r;
}

25
source/tools/i18n/tospreadsheet.pl
View File

@ -16,14 +16,14 @@ sub tospreadsheet {
my ($strings_filename, $translations_filename, $spreadsheet_filename) = @_;
my $strings = DataFiles::read_file($strings_filename);
my $translations = DataFiles::read_file($translations_filename, ignoremissing=>1);
my %translations = map @$_, DataFiles::read_file($translations_filename, ignoremissing=>1);
my %data; # = ("phrase" => [ [id, translation, description, context, flags ], ... ], "noun" => ...)
for my $string (@$strings) {
my ($type, $id) = split /:/, $string->[STR_ID], 2;
my $translation = find_translation($translations, $string->[STR_ID]);
my $translation = $translations{$string->[STR_ID]};
push @{$data{$type}}, [ $id, $translation, @$string[STR_DESCRIPTION, STR_CONTEXT, STR_FLAGS] ];
}
@ -34,7 +34,26 @@ sub tospreadsheet {
my $worksheet = $workbook->add_worksheet($type);
my $row = 0;
my $headerformat = $workbook->add_format();
$headerformat->set_bold(1);
$worksheet->write(0,0, "String", $headerformat);
$worksheet->write(0,1, "Translation", $headerformat);
$worksheet->write(0,2, "Description", $headerformat);
$worksheet->write(0,3, "Used by", $headerformat);
$worksheet->freeze_panes(1, 0);
my $mainformat = $workbook->add_format();
$mainformat->set_align('top');
$mainformat->set_text_wrap();
$worksheet->set_column(0,0, 27, $mainformat);
$worksheet->set_column(1,1, 45, $mainformat);
$worksheet->set_column(2,2, 33, $mainformat);
$worksheet->set_column(3,3, 33, $mainformat);
my $row = 1;
for my $string (@{ $data{$type} }) {