1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
|
use strict;
use warnings;
use File::Find;
my $dir = '../../../binaries/data/mods/official/entities';
my @xml;
find({wanted=>sub{
push @xml, $_ if /\.xml$/;
}, no_chdir=>1}, $dir);
s~\Q$dir/~~ for @xml;
my %nodes;
for my $f (@xml) {
$f =~ m~(?:.*/|^)(.*)\.xml~ or die "invalid filename $f";
my $name = $1;
open I, "$dir/$f" or die "error opening $dir/$f: $!";
my $data = do { local $/; <I> };
close I;
my $parent;
$parent = $1 if $data =~ /Parent="(.*?)"/;
my ($upgrade, $rank);
$upgrade = $1 if $data =~ /<Entity>\s*(.*?)\s*</s;
$rank = $1 if $data =~ /Up.*rank="(.*?)"/s;
my $actor;
$actor = $1 if $data =~ /<Actor>\s*(.*?)\s*</;
undef $upgrade unless defined $upgrade and length $upgrade;
$nodes{$parent} ||= {} if defined $parent;
$nodes{$upgrade} ||= {} if defined $upgrade;
$nodes{$name} = { def=>1, parent=>$parent, upgrade=>[$upgrade, $rank], actor=>$actor };
}
open O, ">", "entities.dot" or die $!;
print O <<EOF;
digraph g
{
graph [nodesep=.1];
edge [fontname=ArialN fontsize=8];
EOF
print O " /* entities without actors */
node [fontname=ArialN fontsize=10 shape=ellipse];
";
for (sort keys %nodes) {
print O qq{ "$_";\n} if keys %{$nodes{$_}} and not defined $nodes{$_}{actor};
}
print O " /* entities with actors */
node [shape=box];
";
for (sort keys %nodes) {
print O qq{ "$_";\n} if keys %{$nodes{$_}} and defined $nodes{$_}{actor};
}
print O " /* undefined entities */
node [color=red];
";
for (sort keys %nodes) {
print O qq{ "$_";\n} if not keys %{$nodes{$_}};
}
print O "\n /* inheritance edges */\n";
for (sort keys %nodes) {
print O qq{ "$nodes{$_}{parent}" -> "$_";\n} if defined $nodes{$_}{parent};
}
print O "\n /* upgrade edges */\n";
print O " edge [color=red fontcolor=red]\n";
for (sort keys %nodes) {
if (defined $nodes{$_}{upgrade}[0]) {
print O qq{ "$_" -> "$nodes{$_}{upgrade}[0]"};
print O qq{ [label="from rank $nodes{$_}{upgrade}[1]"]} if defined $nodes{$_}{upgrade}[1];
print O qq{;\n};
}
}
print O "}\n";
close O;
system("dot.exe", "-Tpng", "entities.dot", "-o", "entities.png");
|
