1
0
forked from 0ad/0ad

Add script for generating mostly-useless component interaction graphs.

Fix some components to use more standard syntax.

This was SVN commit r8857.
This commit is contained in:
Ykkrosh 2011-01-07 20:31:48 +00:00
parent 002e3f5606
commit aaef1b0d74
3 changed files with 190 additions and 5 deletions

View File

@ -1,7 +1,4 @@
function GuiInterface()
{
this.notifications = [];
}
function GuiInterface() {}
GuiInterface.prototype.Schema =
"<a:component type='system'/><empty/>";
@ -15,6 +12,7 @@ GuiInterface.prototype.Init = function()
{
this.placementEntity = undefined; // = undefined or [templateName, entityID]
this.rallyPoints = undefined;
this.notifications = [];
};
/**

View File

@ -20,7 +20,7 @@
#include "simulation2/system/Component.h"
#include "ICmpVision.h"
class CCmpVision: public ICmpVision
class CCmpVision : public ICmpVision
{
public:
static void ClassInit(CComponentManager& UNUSED(componentManager))

View File

@ -0,0 +1,187 @@
#!/usr/bin/perl
# Generates a graph of the interdependencies between simulation components
use strict;
use warnings;
use File::Find;
use Data::Dumper;
my %implements;
my %implementedby;
my %subscribes;
my %queries;
my %posts;
my %native;
for (<../../simulation2/components/CCmp*>)
{
next if /CCmpTest/;
parse_ctype_cpp($_);
}
for (<../../../binaries/data/mods/public/simulation/components/*.js>)
{
parse_ctype_js($_);
}
parse_helper_js("CommandQueue", "../../../binaries/data/mods/public/simulation/helpers/Commands.js");
#parse_ctype_design("components.txt");
# Add one that the parser misses
$posts{RangeManager}{RangeUpdate} = 1;
dump_stats();
use Data::Dumper; print Dumper \%queries;
dump_graph();
system("dot -Tpng -o components.png components.dot");
sub parse_ctype_cpp
{
my ($fn) = @_;
print "$fn ...\n";
open my $f, $fn or die "can't open $fn: $!";
my $cmp;
if ($fn =~ /CCmpPathfinder/) { $cmp = 'Pathfinder'; } # because it's split into multiple .cpp files
while (<$f>) {
if (/class CCmp(\S+) : public ICmp(\S+)/) {
$implements{$1} = $2;
$implementedby{$2}{$1} = 1;
$native{$1} = 1;
$cmp = $1;
} elsif (/Subscribe(Globally)?ToMessageType\(MT_(\S+)\)/) {
$subscribes{$2}{$cmp} = 1;
} elsif (/CmpPtr<ICmp(\S+)>/) {
$queries{$cmp}{$1} = 1;
} elsif (/^\s*CMessage(\S+)/) {
$posts{$cmp}{$1} = 1;
}
}
}
sub parse_ctype_js
{
my ($fn) = @_;
print "$fn ...\n";
open my $f, $fn or die "can't open $fn: $!";
my $cmp;
while (<$f>) {
if (/^\s*function (\S+)\s*\(\)\s*\{\s*\}\s*$/) {
$cmp = $1;
} elsif ($cmp and /\s*$cmp\.prototype\.On(?:Global)?(\S+)\s*=/) {
$subscribes{$1}{$cmp} = 1;
} elsif (/Engine\.QueryInterface\(.*?,\s*IID_(\S+?)\)/) {
$queries{$cmp}{$1} = 1;
} elsif (/Engine\.RegisterComponentType\(IID_(\S+), "(\S+)", (\S+)\);/) {
die unless $2 eq $cmp;
die unless $3 eq $cmp;
$implements{$cmp} = $1;
$implementedby{$1}{$cmp} = 1;
} elsif (/Engine\.(?:Post|Broadcast)Message\(\S+, MT_(\S+),/) {
$posts{$cmp}{$1} = 1;
}
}
}
sub parse_helper_js
{
my ($cmp, $fn) = @_;
open my $f, $fn or die "can't open $fn: $!";
while (<$f>) {
if (/Engine\.QueryInterface\(.*?,\s*IID_(\S+)\)/) {
$queries{$cmp}{$1} = 1;
}
# TODO: check for message sending
}
}
sub parse_ctype_design
{
my ($fn) = @_;
open my $f, $fn or die "can't open $fn: $!";
my $cmp;
while (<$f>) {
s/\s*#.*//;
next unless /\S/;
if (/^component (\S+)(?: : (\S+))?$/) {
$implements{$1} = ($2 || $1);
$implementedby{$2 || $1}{$1} = 1;
$cmp = $1;
} elsif (/^native$/) {
$native{$cmp} = 1;
} elsif (/^subscribe (\S+)$/) {
$subscribes{$1}{$cmp} = 1;
} elsif (/^query (\S+)$/) {
$queries{$cmp}{$1} = 1;
} elsif (/^post (\S+)$/) {
$posts{$cmp}{$1} = 1;
} else {
die "Invalid input line: $_ in $fn.";
}
}
}
sub dump_graph
{
open my $f, '>', 'components.dot' or die $!;
print $f <<EOF;
digraph g {
graph [ranksep=1 nodesep=0.1 fontsize=10 compound=true];
node [fontsize=10];
edge [fontsize=8];
EOF
# for my $c (sort keys %implements) {
# print $f "$c;\n";
# }
for my $i (sort keys %implementedby) {
print $f "subgraph cluster_ifc_$i {\n";
print $f "label=\"$i\";\n";
for my $c (sort keys %{$implementedby{$i}}) {
my $col = ($native{$c} ? "green" : "black");
print $f "$c [color=$col];\n";
}
print $f "}\n";
}
print $f qq{node [color=gray fontcolor=gray];\n};
print $f qq{edge [color=blue fontcolor=blue];\n};
for my $c (sort keys %queries) {
next if $c eq 'GuiInterface' or $c eq 'CommandQueue'; # these make the graph messy
for my $t (sort keys %{$queries{$c}}) {
my $tc = (sort keys %{$implementedby{$t}})[0];
print $f qq{$c -> $tc [lhead=cluster_ifc_$t];\n};
}
}
print $f qq{edge [color=red fontcolor=red weight=0.9];\n};
for my $c (sort keys %posts) {
for my $m (sort keys %{$posts{$c}}) {
for my $t (sort keys %{$subscribes{$m}}) {
print $f qq{$c -> $t [label="$m"];\n};
}
}
}
print $f <<EOF;
}
EOF
}
sub dump_stats
{
my ($native, $scripted) = (0, 0);
for my $c (keys %implements) {
if ($native{$c}) { ++$native; } else { ++$scripted; }
}
printf "Native components: %d\nScripted components: %d\nTotal components: %d\n", $native, $scripted, $native+$scripted;
printf "Interfaces: %d\n", (scalar keys %implementedby);
}