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:
parent
002e3f5606
commit
aaef1b0d74
@ -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 = [];
|
||||
};
|
||||
|
||||
/**
|
||||
|
@ -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))
|
||||
|
187
source/tools/cmpgraph/cmpgraph.pl
Normal file
187
source/tools/cmpgraph/cmpgraph.pl
Normal 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);
|
||||
}
|
Loading…
Reference in New Issue
Block a user