v50 Steam/Premium information for editors
- v50 information can now be added to pages in the main namespace. v0.47 information can still be found in the DF2014 namespace. See here for more details on the new versioning policy.
- Use this page to report any issues related to the migration.
This notice may be cached—the current version can be found here.
Editing User:Mortal
Jump to navigation
Jump to search
Warning: You are not logged in.
Your IP address will be recorded in this page's edit history.
The edit can be undone. Please check the comparison below to verify that this is what you want to do, and then save the changes below to finish undoing the edit.
Latest revision | Your text | ||
Line 9: | Line 9: | ||
use strict; | use strict; | ||
− | |||
− | |||
sub parsefile; | sub parsefile; | ||
+ | sub parsefile_; | ||
sub gettoken; | sub gettoken; | ||
− | sub | + | sub fetchtemplates (_); |
− | sub | + | sub fixstatenames (_); |
− | |||
sub usage { | sub usage { | ||
print STDERR <<USAGE; | print STDERR <<USAGE; | ||
− | $0 | + | $0 Display boolean keys |
− | $0 | + | $0 key1 [key2 [...]] Display items grouped by key |
− | $0 -h|-v|-V|--help|--version | + | $0 -h|-v|-V|--help|--version Display usage |
− | |||
− | |||
− | |||
rawparse.pl written by Mathias Rav, October 2010 | rawparse.pl written by Mathias Rav, October 2010 | ||
Line 30: | Line 25: | ||
Run the script from the df/raw/objects/ directory | Run the script from the df/raw/objects/ directory | ||
USAGE | USAGE | ||
− | |||
− | |||
− | |||
− | |||
− | |||
− | |||
− | |||
− | |||
− | |||
− | |||
− | |||
− | |||
− | |||
− | |||
− | |||
− | |||
− | |||
− | |||
− | |||
− | |||
− | |||
− | |||
− | |||
− | |||
− | |||
− | |||
− | |||
− | |||
− | |||
− | |||
− | |||
− | |||
− | |||
− | |||
− | |||
− | |||
− | |||
− | |||
− | |||
− | |||
− | |||
− | |||
− | |||
− | |||
− | |||
− | |||
− | |||
− | |||
− | |||
− | |||
− | |||
− | |||
− | |||
− | |||
− | |||
− | |||
− | |||
− | |||
− | |||
− | |||
− | |||
− | |||
− | |||
− | |||
− | |||
− | |||
− | |||
− | |||
− | |||
− | |||
− | |||
− | |||
− | |||
− | |||
− | |||
− | |||
− | |||
− | |||
− | |||
− | |||
− | |||
− | |||
− | |||
− | |||
− | |||
− | |||
− | |||
− | |||
− | |||
− | |||
− | |||
− | |||
− | |||
− | |||
− | |||
− | |||
− | |||
− | |||
− | |||
− | |||
− | |||
− | |||
− | |||
− | |||
− | |||
− | |||
− | |||
− | |||
− | |||
− | |||
− | |||
− | |||
− | |||
− | |||
− | |||
− | |||
− | |||
− | |||
− | |||
− | |||
− | |||
− | |||
− | |||
− | |||
− | |||
− | |||
− | |||
− | |||
− | |||
− | |||
− | |||
− | |||
− | |||
− | |||
− | |||
− | |||
− | |||
− | |||
− | |||
− | |||
− | |||
− | |||
− | |||
− | |||
− | |||
− | |||
− | |||
− | |||
− | |||
− | |||
− | |||
− | |||
− | |||
− | |||
− | |||
− | |||
− | |||
− | |||
− | |||
− | |||
− | |||
− | |||
− | |||
− | |||
− | |||
− | |||
− | |||
− | |||
− | |||
− | |||
− | |||
− | |||
− | |||
− | |||
− | |||
− | |||
− | |||
− | |||
− | |||
− | |||
− | |||
− | |||
− | |||
− | |||
− | |||
− | |||
− | |||
− | |||
− | |||
− | |||
− | |||
− | |||
− | |||
− | |||
− | |||
− | |||
− | |||
− | |||
− | |||
− | |||
− | |||
− | |||
− | |||
− | |||
− | |||
− | |||
− | |||
− | |||
− | |||
− | |||
− | |||
− | |||
− | |||
− | |||
− | |||
− | |||
− | |||
− | |||
− | |||
− | |||
− | |||
− | |||
− | |||
− | |||
− | |||
− | |||
− | |||
− | |||
− | |||
− | |||
− | |||
− | |||
− | |||
− | |||
− | |||
− | |||
− | |||
− | |||
− | |||
− | |||
− | |||
− | |||
− | |||
− | |||
− | |||
− | |||
− | |||
− | |||
− | |||
− | |||
− | |||
− | |||
− | |||
− | |||
− | |||
} | } | ||
Line 291: | Line 31: | ||
my $fp; | my $fp; | ||
unless (open $fp, '<', $filename) { | unless (open $fp, '<', $filename) { | ||
− | + | die "Couldn't open $filename for reading"; | |
− | |||
} | } | ||
+ | my $res = parsefile_ $fp, $filename; | ||
+ | close $fp; | ||
+ | $res; | ||
+ | } | ||
+ | |||
+ | sub parsefile_ { | ||
+ | my ($fp, $filename) = @_; | ||
my $expectfilename = $filename; | my $expectfilename = $filename; | ||
$expectfilename =~ s/^.*\/|\.txt$//g; | $expectfilename =~ s/^.*\/|\.txt$//g; | ||
Line 299: | Line 45: | ||
$gotfilename =~ s/\r?\n?$//s; | $gotfilename =~ s/\r?\n?$//s; | ||
if ($expectfilename ne $gotfilename) { | if ($expectfilename ne $gotfilename) { | ||
− | print STDERR "Expected filename '$expectfilename' in $filename, got '$gotfilename' | + | print STDERR "Expected filename '$expectfilename' in $filename, got '$gotfilename'\n"; |
} | } | ||
local $/ = ']'; | local $/ = ']'; | ||
my $firsttok = gettoken $fp, 1; | my $firsttok = gettoken $fp, 1; | ||
− | + | if ($firsttok->[0] ne 'OBJECT') { | |
print STDERR "Expected first token to be an OBJECT-token, got $firsttok->[0]\n"; | print STDERR "Expected first token to be an OBJECT-token, got $firsttok->[0]\n"; | ||
} | } | ||
− | my $objecttype = $1; | + | if (!defined $firsttok->[1]) { |
+ | print STDERR "In OBJECT-token, 1st arg is undef\n"; | ||
+ | return; | ||
+ | } | ||
+ | my $objecttype = $firsttok->[1]; | ||
my $objects = []; | my $objects = []; | ||
my $objectsbyid = {}; | my $objectsbyid = {}; | ||
+ | my $object = {}; | ||
my $res = {object => $objecttype, objects => $objects, objectsbyid => $objectsbyid}; | my $res = {object => $objecttype, objects => $objects, objectsbyid => $objectsbyid}; | ||
− | |||
− | |||
my $pushobject = sub { | my $pushobject = sub { | ||
− | + | push @$objects, $object if keys %$object; | |
− | + | $objectsbyid->{$object->{id}} = $object if exists $object->{id}; | |
− | + | $object = {}; | |
− | |||
− | |||
− | |||
− | $ | ||
}; | }; | ||
my $token; | my $token; | ||
while ($token = gettoken $fp and keys %$token) { | while ($token = gettoken $fp and keys %$token) { | ||
last unless keys %$token; | last unless keys %$token; | ||
− | next unless defined $token->{ | + | next unless defined $token->{key}; |
− | + | if ($token->{key} eq $objecttype) { | |
− | |||
$pushobject->(); | $pushobject->(); | ||
− | $ | + | $object->{'id'} = $token->{value}; |
− | |||
} else { | } else { | ||
− | + | $object->{$token->{key}} = $token->{value}; | |
} | } | ||
} | } | ||
$pushobject->(); | $pushobject->(); | ||
− | |||
$res; | $res; | ||
} | } | ||
Line 360: | Line 102: | ||
$comment =~ s/^\s+|\s+$//g; | $comment =~ s/^\s+|\s+$//g; | ||
$comment = undef unless length $comment; | $comment = undef unless length $comment; | ||
− | return $ | + | my ($key, $value) = ($token); |
− | return {comment => $comment, | + | if ($token =~ /^(STATE_[^:]+:[^:]+|[^:]+)(?::(.*))/) { |
+ | ($key, $value) = ($1, $2); | ||
+ | } | ||
+ | return [$key, $value] if $asserttoken; | ||
+ | return {comment => $comment, key => $key, value => $value}; | ||
} | } | ||
Line 369: | Line 115: | ||
} | } | ||
− | + | my $type = 'INORGANIC'; | |
− | + | my $templatetype = 'MATERIAL_TEMPLATE'; | |
− | + | my $templateincludekey = "USE_$templatetype"; | |
− | |||
my $templates = parsefile 'material_template_default.txt'; | my $templates = parsefile 'material_template_default.txt'; | ||
if ($templates->{object} ne $templatetype) { | if ($templates->{object} ne $templatetype) { | ||
die "Template file contains objects of type $templates->{object}, expected $templatetype"; | die "Template file contains objects of type $templates->{object}, expected $templatetype"; | ||
} | } | ||
− | + | my %templates = %{$templates->{objectsbyid}}; | |
− | my $ | + | my @objects; |
− | + | for my $filename (<inorganic_*.txt>) { | |
− | + | my $parsed = parsefile $filename; | |
− | + | if ($parsed->{object} ne $type) { | |
− | + | die "Expected objects of type $type in $filename, got $parsed->{object}"; | |
+ | } | ||
+ | push @objects, @{$parsed->{objects}}; | ||
+ | } | ||
+ | fetchtemplates for @objects; | ||
+ | sub fetchtemplates (_) { | ||
+ | my ($obj) = @_; | ||
+ | my $id = $obj->{id}; | ||
+ | return unless defined $obj->{$templateincludekey}; | ||
+ | my $templatename = $obj->{$templateincludekey}; | ||
+ | my $template = $templates{$templatename}; | ||
+ | unless (defined $template) { | ||
+ | print STDERR "Object $id references a template called $templatename, but it doesn't exist!\n"; | ||
+ | return; | ||
+ | } | ||
+ | delete $obj->{$templateincludekey}; | ||
+ | for my $key (keys %$template) { | ||
+ | $obj->{$key} //= $template->{$key}; | ||
+ | } | ||
+ | } | ||
+ | fixstatenames for @objects; | ||
+ | sub fixstatenames (_) { | ||
+ | my ($obj) = @_; | ||
+ | if (($obj->{IS_GEM} // '') =~ /^([^:]+):[^:]+:OVERWRITE_SOLID/) { | ||
+ | my $name = $1; | ||
+ | $obj->{'STATE_NAME_ADJ:ALL_SOLID'} = $name; | ||
+ | } | ||
+ | for my $key (keys %$obj) { | ||
+ | next unless $key =~ /^STATE_([^:]+_[^:]+):(.*)/; | ||
+ | my $states = $1; | ||
+ | my $subkey = $2; | ||
+ | my $value = $obj->{$key}; | ||
+ | while ($states =~ /([^_]+)/g) { | ||
+ | $obj->{"STATE_${1}:$subkey"} = $value; | ||
+ | } | ||
+ | } | ||
+ | for my $key (keys %$obj) { | ||
+ | next unless $key =~ /^(STATE_[^:]+:)ALL_SOLID/; | ||
+ | my $prefix = $1; | ||
+ | my $value = $obj->{$key}; | ||
+ | $obj->{$prefix.'SOLID'} = $value; | ||
+ | $obj->{$prefix.'SOLID_POWDER'} = $value; | ||
+ | } | ||
+ | } | ||
+ | my %objectsbytype; | ||
+ | for my $obj (@objects) { | ||
+ | my @keys = grep {/^IS_/ or !defined $obj->{$_}} keys %$obj; | ||
+ | for my $key (@keys) { | ||
+ | $objectsbytype{$key} //= []; | ||
+ | push @{$objectsbytype{$key}}, $obj; | ||
+ | } | ||
+ | } | ||
sub tabstops { | sub tabstops { | ||
my ($line) = @_; | my ($line) = @_; | ||
Line 393: | Line 189: | ||
$line.$suffix; | $line.$suffix; | ||
} | } | ||
− | + | if (@ARGV == 0) { | |
− | my ( | + | for my $key (sort {@{$objectsbytype{$b}}-@{$objectsbytype{$a}}} keys %objectsbytype) { |
− | + | print tabstops(sprintf "%-30s %3d\n", $key, scalar @{$objectsbytype{$key}}); | |
− | |||
− | |||
− | |||
− | |||
− | |||
− | |||
− | |||
− | |||
− | |||
− | |||
} | } | ||
− | + | } else { | |
− | } | + | for my $key (@ARGV) { |
− | |||
− | |||
− | |||
− | |||
− | |||
− | |||
− | |||
− | |||
− | |||
− | |||
− | |||
− | |||
− | |||
− | |||
print "$key\n"; | print "$key\n"; | ||
my @rows; | my @rows; | ||
− | |||
− | |||
for my $obj (@{$objectsbytype{$key}}) { | for my $obj (@{$objectsbytype{$key}}) { | ||
− | my @row = ($obj-> | + | my @row = ($obj->{'STATE_NAME:SOLID'} // $obj->{'id'}); |
for (qw(MATERIAL_VALUE MOLAR_MASS)) { | for (qw(MATERIAL_VALUE MOLAR_MASS)) { | ||
− | push @row, | + | push @row, $obj->{$_} // 0; |
− | |||
− | |||
− | |||
− | |||
− | |||
− | |||
− | |||
− | |||
} | } | ||
push @rows, \@row; | push @rows, \@row; | ||
} | } | ||
− | + | for my $row (sort {$a->[0] cmp $b->[0]} @rows) { | |
− | + | print tabstops(sprintf " %-26s %6d %10d\n", @$row); | |
− | |||
− | |||
− | |||
− | |||
− | |||
− | |||
− | print tabstops(sprintf " %-26s %6d %10d | ||
− | |||
− | |||
− | |||
− | |||
− | |||
− | |||
− | |||
− | |||
− | |||
− | |||
− | |||
− | |||
} | } | ||
} | } | ||
− | |||
− | |||
− | |||
− | |||
− | |||
− | |||
− | |||
− | |||
− | |||
− | |||
− | |||
− | |||
− | |||
− | |||
− | |||
− | |||
− | |||
− | |||
− | |||
− | |||
− | |||
− | |||
− | |||
− | |||
− | |||
− | |||
− | |||
− | |||
− | |||
} | } |