new gen_ladder implementation, based on the GD perl module
This version generates PNG graphics based on the perl GD bindings and no longer uses dot craphics. This solves the long-standing problems that existed with dot and 'bent arrows' TODO: * re-add support for dashed arrows * re-add support for bi-directional arrows
This commit is contained in:
parent
f8441a6aaf
commit
5bad900708
|
|
@ -0,0 +1,301 @@
|
|||
package GD::Arrow;
|
||||
# $Id: Arrow.pm,v 1.7 2004/10/25 17:22:27 tcaine Exp $
|
||||
|
||||
use strict;
|
||||
use warnings;
|
||||
use vars qw( $VERSION @ISA );
|
||||
use GD;
|
||||
|
||||
$VERSION = '0.01';
|
||||
@ISA = qw( GD::Polygon );
|
||||
|
||||
sub x1 { shift->{X1} }
|
||||
sub y1 { shift->{Y1} }
|
||||
sub x2 { shift->{X2} }
|
||||
sub y2 { shift->{Y2} }
|
||||
sub width { shift->{WIDTH} }
|
||||
|
||||
package GD::Arrow::Full;
|
||||
|
||||
use strict;
|
||||
use warnings;
|
||||
use vars qw( $VERSION @ISA );
|
||||
use Carp;
|
||||
use GD;
|
||||
|
||||
$VERSION = '0.01';
|
||||
@ISA = qw( GD::Arrow );
|
||||
|
||||
sub new {
|
||||
my $class = shift;
|
||||
my %arg = @_;
|
||||
my ($x1, $y1, $x2, $y2, $width);
|
||||
my $self = $class->SUPER::new();
|
||||
|
||||
foreach ( keys %arg ) {
|
||||
if (/^-?X1$/i) { $self->{X1} = $x1 = $arg{$_} }
|
||||
elsif (/^-?Y1$/i) { $self->{Y1} = $y1 = $arg{$_} }
|
||||
elsif (/^-?X2$/i) { $self->{X2} = $x2 = $arg{$_} }
|
||||
elsif (/^-?Y2$/i) { $self->{Y2} = $y2 = $arg{$_} }
|
||||
elsif (/^-?WIDTH$/i) { $self->{WIDTH} = $width = $arg{$_} }
|
||||
}
|
||||
|
||||
$self->{WIDTH} = $width = 6 if !defined($self->{WIDTH});
|
||||
|
||||
croak "" . __PACKAGE__ . "->new() requires 4 named parameters"
|
||||
if !defined($self->{X1}) ||
|
||||
!defined($self->{Y1}) ||
|
||||
!defined($self->{X2}) ||
|
||||
!defined($self->{Y2});
|
||||
|
||||
my $double_width = $width * 2;
|
||||
my $theta = atan2($y1-$y2,$x1-$x2);
|
||||
|
||||
$self->addPt(
|
||||
sprintf('%.0f', $x2+$width*sin($theta)),
|
||||
sprintf('%.0f', $y2-$width*cos($theta))
|
||||
);
|
||||
$self->addPt(
|
||||
sprintf('%.0f', $x2-$width*sin($theta)),
|
||||
sprintf('%.0f', $y2+$width*cos($theta))
|
||||
);
|
||||
$self->addPt(
|
||||
sprintf('%.0f', $x1-$width*sin($theta)-$double_width*cos($theta)),
|
||||
sprintf('%.0f', $y1-$double_width*sin($theta)+$width*cos($theta))
|
||||
);
|
||||
$self->addPt(
|
||||
sprintf('%.0f', $x1-$double_width*sin($theta)-$double_width*cos($theta)),
|
||||
sprintf('%.0f', $y1-$double_width*sin($theta)+$double_width*cos($theta))
|
||||
);
|
||||
$self->addPt($x1,$y1);
|
||||
$self->addPt(
|
||||
sprintf('%.0f', $x1+$double_width*(sin($theta)-cos($theta))),
|
||||
sprintf('%.0f', $y1+$double_width*(-sin($theta)-cos($theta)))
|
||||
);
|
||||
$self->addPt(
|
||||
sprintf('%.0f', $x1+$width*sin($theta)-$double_width*cos($theta)),
|
||||
sprintf('%.0f', $y1-$double_width*sin($theta)-$width*cos($theta))
|
||||
);
|
||||
|
||||
return $self;
|
||||
}
|
||||
|
||||
package GD::Arrow::LeftHalf;
|
||||
|
||||
use strict;
|
||||
use warnings;
|
||||
use vars qw( $VERSION @ISA );
|
||||
use Carp;
|
||||
use GD;
|
||||
|
||||
$VERSION = '0.01';
|
||||
@ISA = qw( GD::Arrow );
|
||||
|
||||
sub new {
|
||||
my $class = shift;
|
||||
my %arg = @_;
|
||||
my ($x1, $y1, $x2, $y2, $width);
|
||||
my $self = $class->SUPER::new();
|
||||
|
||||
foreach ( keys %arg ) {
|
||||
if (/^-?X1$/i) { $self->{X1} = $x1 = $arg{$_} }
|
||||
elsif (/^-?Y1$/i) { $self->{Y1} = $y1 = $arg{$_} }
|
||||
elsif (/^-?X2$/i) { $self->{X2} = $x2 = $arg{$_} }
|
||||
elsif (/^-?Y2$/i) { $self->{Y2} = $y2 = $arg{$_} }
|
||||
elsif (/^-?WIDTH$/i) { $self->{WIDTH} = $width = $arg{$_} }
|
||||
}
|
||||
|
||||
$self->{WIDTH} = $width = 6 if !defined($self->{WIDTH});
|
||||
|
||||
croak "" . __PACKAGE__ . "->new() requires 4 named parameters"
|
||||
if !defined($self->{X1}) ||
|
||||
!defined($self->{Y1}) ||
|
||||
!defined($self->{X2}) ||
|
||||
!defined($self->{Y2});
|
||||
|
||||
my $double_width = $width * 2;
|
||||
my $theta = atan2($y1-$y2,$x1-$x2);
|
||||
|
||||
$self->addPt($x2, $y2);
|
||||
$self->addPt(
|
||||
sprintf('%.0f', $x2+$width*sin($theta)),
|
||||
sprintf('%.0f', $y2-$width*cos($theta))
|
||||
);
|
||||
$self->addPt(
|
||||
sprintf('%.0f', $x1+$width*sin($theta)-$double_width*cos($theta)),
|
||||
sprintf('%.0f', $y1-$double_width*sin($theta)-$width*cos($theta))
|
||||
);
|
||||
$self->addPt(
|
||||
sprintf('%.0f', $x1+$double_width*(sin($theta)-cos($theta))),
|
||||
sprintf('%.0f', $y1+$double_width*(-sin($theta)-cos($theta)))
|
||||
);
|
||||
$self->addPt($x1,$y1);
|
||||
|
||||
return $self;
|
||||
}
|
||||
|
||||
package GD::Arrow::RightHalf;
|
||||
|
||||
use strict;
|
||||
use warnings;
|
||||
use vars qw( $VERSION @ISA );
|
||||
use Carp;
|
||||
use GD;
|
||||
|
||||
$VERSION = '0.01';
|
||||
@ISA = qw( GD::Arrow );
|
||||
|
||||
sub new {
|
||||
my $class = shift;
|
||||
my %arg = @_;
|
||||
my ($x1, $y1, $x2, $y2, $width);
|
||||
my $self = $class->SUPER::new();
|
||||
|
||||
foreach ( keys %arg ) {
|
||||
if (/^-?X1$/i) { $self->{X1} = $x1 = $arg{$_} }
|
||||
elsif (/^-?Y1$/i) { $self->{Y1} = $y1 = $arg{$_} }
|
||||
elsif (/^-?X2$/i) { $self->{X2} = $x2 = $arg{$_} }
|
||||
elsif (/^-?Y2$/i) { $self->{Y2} = $y2 = $arg{$_} }
|
||||
elsif (/^-?WIDTH$/i) { $self->{WIDTH} = $width = $arg{$_} }
|
||||
}
|
||||
|
||||
$self->{WIDTH} = $width = 6 if !defined($self->{WIDTH});
|
||||
|
||||
croak "" . __PACKAGE__ . "->new() requires 4 named parameters"
|
||||
if !defined($self->{X1}) ||
|
||||
!defined($self->{Y1}) ||
|
||||
!defined($self->{X2}) ||
|
||||
!defined($self->{Y2});
|
||||
|
||||
my $double_width = $width * 2;
|
||||
my $theta = atan2($y1-$y2,$x1-$x2);
|
||||
|
||||
$self->addPt($x2, $y2);
|
||||
$self->addPt(
|
||||
sprintf('%.0f', $x2-$width*sin($theta)),
|
||||
sprintf('%.0f', $y2+$width*cos($theta))
|
||||
);
|
||||
$self->addPt(
|
||||
sprintf('%.0f', $x1-$width*sin($theta)-$double_width*cos($theta)),
|
||||
sprintf('%.0f', $y1-$double_width*sin($theta)+$width*cos($theta))
|
||||
);
|
||||
$self->addPt(
|
||||
sprintf('%.0f', $x1-$double_width*sin($theta)-$double_width*cos($theta)),
|
||||
sprintf('%.0f', $y1-$double_width*sin($theta)+$double_width*cos($theta))
|
||||
);
|
||||
$self->addPt($x1,$y1);
|
||||
|
||||
return $self;
|
||||
}
|
||||
|
||||
|
||||
1;
|
||||
__END__
|
||||
|
||||
=head1 NAME
|
||||
|
||||
GD::Arrow - draw arrows using GD
|
||||
|
||||
=head1 SYNOPSIS
|
||||
|
||||
use GD;
|
||||
use GD::Arrow;
|
||||
|
||||
my $width = 8;
|
||||
my ($x1, $y1) = (100, 10);
|
||||
my ($x2, $y2) = (100, 190);
|
||||
my ($x3, $y3) = (10, 30);
|
||||
my ($x4, $y4) = (190, 75);
|
||||
|
||||
my $arrow = GD::Arrow::Full->new(
|
||||
-X1 => $x1,
|
||||
-Y1 => $y1,
|
||||
-X2 => $x2,
|
||||
-Y2 => $y2,
|
||||
-WIDTH => $width,
|
||||
);
|
||||
|
||||
my $image = GD::Image->new(200, 200);
|
||||
my $white = $image->colorAllocate(255, 255, 255);
|
||||
my $black = $image->colorAllocate(0, 0, 0);
|
||||
my $blue = $image->colorAllocate(0, 0, 255);
|
||||
my $yellow = $image->colorAllocate(255, 255, 0);
|
||||
$image->transparent($white);
|
||||
|
||||
$image->filledPolygon($arrow,$blue);
|
||||
$image->polygon($arrow,$black);
|
||||
|
||||
my $half_arrow_1 = GD::Arrow::LeftHalf->new(
|
||||
-X1 => $x3,
|
||||
-Y1 => $y3,
|
||||
-X2 => $x4,
|
||||
-Y2 => $y4,
|
||||
-WIDTH => $width,
|
||||
);
|
||||
|
||||
my $half_arrow_2 = GD::Arrow::LeftHalf->new(
|
||||
-X1 => $x4,
|
||||
-Y1 => $y4,
|
||||
-X2 => $x3,
|
||||
-Y2 => $y3,
|
||||
-WIDTH => $width
|
||||
);
|
||||
|
||||
$image->filledPolygon($half_arrow_1,$blue);
|
||||
$image->polygon($half_arrow_1,$black);
|
||||
|
||||
$image->filledPolygon($half_arrow_2,$yellow);
|
||||
$image->polygon($half_arrow_2,$black);
|
||||
|
||||
open IMAGE, "> image.png" or die $!;
|
||||
binmode(IMAGE, ":raw");
|
||||
print IMAGE $image->png;
|
||||
close IMAGE;
|
||||
|
||||
exit(0);
|
||||
|
||||
=head1 DESCRIPTION
|
||||
|
||||
This is a subclass of GD::Polygon used to draw an arrow between two vertices.
|
||||
|
||||
GD::Arrow::Full draws a full arrow between two verticies.
|
||||
|
||||
|\
|
||||
+----------------------+ \
|
||||
(X2, Y2) * * (X1, Y1)
|
||||
+----------------------+ /
|
||||
|/
|
||||
|
||||
GD::Arrow::RightHalf draws a half arrow between two verticies.
|
||||
|
||||
(X2, Y2) *-------------------------* (X1, Y1)
|
||||
+----------------------+ /
|
||||
|/
|
||||
|
||||
GD::Arrow::LeftHalf draws a half arrow between two verticies.
|
||||
|
||||
|\
|
||||
+----------------------+ \
|
||||
(X2, Y2) *-------------------------* (X1, Y1)
|
||||
|
||||
=head1 SEE ALSO
|
||||
|
||||
GD::Polygon
|
||||
|
||||
=head1 CREDITS
|
||||
|
||||
The equations used to determine the critical verticies to represent a GD::Arrow was based on Hideki Ono's makefeedmap software. Makefeedmap can be found at http://www.ono.org/software/makefeedmap/.
|
||||
|
||||
=head1 AUTHOR
|
||||
|
||||
Todd Caine, E<lt>todd@pobox.comE<gt>
|
||||
|
||||
=head1 COPYRIGHT AND LICENSE
|
||||
|
||||
Copyright 2004 by Todd Caine
|
||||
|
||||
This library is free software; you can redistribute it and/or modify
|
||||
it under the same terms as Perl itself.
|
||||
|
||||
=cut
|
||||
|
||||
12
Makefile
12
Makefile
|
|
@ -3,14 +3,8 @@ DOT=dot
|
|||
|
||||
default:
|
||||
|
||||
%.dot: %.lad $(GL)
|
||||
$(GL) $< > $@
|
||||
|
||||
%.ps: %.dot
|
||||
$(DOT) -Tps < $^ > $@
|
||||
|
||||
%.svg: %.dot
|
||||
$(DOT) -Tsvg < $^ > $@
|
||||
%.png: %.lad $(GL)
|
||||
$(GL) $< $@
|
||||
|
||||
clean:
|
||||
rm *.dot *.ps *.svg
|
||||
rm *.dot *.ps *.svg *.png
|
||||
|
|
|
|||
|
|
@ -0,0 +1,217 @@
|
|||
package OsmoLadder;
|
||||
|
||||
# Perl Module to generate ladder diagrams for network protocols
|
||||
#
|
||||
# (C) 2010-2011 by Harald Welte <laforge@gnumonks.org>
|
||||
#
|
||||
# This program is free software; you can redistribute it and/or modify
|
||||
# it under the terms of the GNU General Public License as published by
|
||||
# the Free Software Foundation; either version 2 of the License, or
|
||||
# (at your option) any later version.
|
||||
#
|
||||
# This program is distributed in the hope that it will be useful,
|
||||
# but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||
# GNU General Public License for more details.
|
||||
#
|
||||
# You should have received a copy of the GNU General Public License along
|
||||
# with this program; if not, write to the Free Software Foundation, Inc.,
|
||||
# 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
|
||||
|
||||
|
||||
use GD;
|
||||
use GD::Arrow;
|
||||
|
||||
my $ROW_SIZE = 50;
|
||||
my $HEAD_SIZE = 70;
|
||||
my $FOOT_SIZE = 50;
|
||||
my $COL_SIZE_MIN = 200;
|
||||
my $MARGIN_LR = 50;
|
||||
my $NODELINE_OVERLAP = 30;
|
||||
|
||||
my $FONT = "/usr/share/fonts/truetype/freefont/FreeSansBold.ttf";
|
||||
|
||||
sub compute_img_size($$)
|
||||
{
|
||||
my ($num_nodes, $num_msgs) = @_;
|
||||
|
||||
my $height = (($num_msgs-1) * $ROW_SIZE) + $HEAD_SIZE + $FOOT_SIZE;
|
||||
my $width = 2*$MARGIN_LR + ($num_nodes-1)*$COL_SIZE_MIN;
|
||||
|
||||
return ($width, $height);
|
||||
}
|
||||
|
||||
sub compute_node_x($)
|
||||
{
|
||||
my $node_num = shift;
|
||||
|
||||
return $MARGIN_LR + $node_num * $COL_SIZE_MIN;
|
||||
}
|
||||
|
||||
sub compute_msg_y($)
|
||||
{
|
||||
my $msg_num = shift;
|
||||
|
||||
return $HEAD_SIZE + $msg_num * $ROW_SIZE;
|
||||
}
|
||||
|
||||
my %nodes;
|
||||
my $next_node_number = 0;
|
||||
my @msgs;
|
||||
|
||||
sub new_node($$)
|
||||
{
|
||||
my ($name, $label) = @_;
|
||||
my %nn;
|
||||
|
||||
$nn{'name'} = $name;
|
||||
$nn{'label'} = $label;
|
||||
|
||||
$nn{'num'} = $next_node_number++;
|
||||
$nn{'x_pos'} = compute_node_x($nn{'num'});
|
||||
|
||||
$nodes{$name} = \%nn;
|
||||
}
|
||||
|
||||
sub new_msg($$$$)
|
||||
{
|
||||
my ($src, $dst, $label, $flags) = @_;
|
||||
my %nm;
|
||||
|
||||
$nm{'src'} = $src;
|
||||
$nm{'dst'} = $dst;
|
||||
$nm{'label'} = $label;
|
||||
$nm{'flags'} = $flags;
|
||||
|
||||
push(@msgs, \%nm);
|
||||
}
|
||||
|
||||
sub try_fontsize($$$)
|
||||
{
|
||||
my ($font, $text, $size) = @_;
|
||||
|
||||
my @arr = GD::Image->stringFT(0, $font, $size, 0, 0, 0, $text);
|
||||
|
||||
return ($arr[4] - $arr[0]);
|
||||
}
|
||||
|
||||
sub get_fontsize($$$)
|
||||
{
|
||||
my ($font, $text, $x_avail) = @_;
|
||||
my $fontsize;
|
||||
|
||||
for ($fontsize = 12; $fontsize >= 6; $fontsize--) {
|
||||
my $width = try_fontsize($font, $text, $fontsize);
|
||||
if ($width < $x_avail) {
|
||||
return ($fontsize, $width);
|
||||
}
|
||||
}
|
||||
return (6,0);
|
||||
}
|
||||
|
||||
sub draw_scaled_label($$$$$)
|
||||
{
|
||||
my ($im, $text, $line_y, $start_x, $end_x) = @_;
|
||||
my $black = $im->colorAllocate(0, 0, 0);
|
||||
|
||||
if ($start_x > $end_x) {
|
||||
my $tmp = $end_x;
|
||||
$end_x = $start_x;
|
||||
$start_x = $tmp;
|
||||
}
|
||||
my $delta_x = $end_x - $start_x;
|
||||
|
||||
my ($fontsize, $x_pixels) = get_fontsize($FONT, $text, $delta_x);
|
||||
my $x_offset = ($delta_x - $x_pixels)/2;
|
||||
|
||||
my @a = $im->stringFT($black, $FONT, $fontsize, 0,
|
||||
$start_x+$x_offset, $line_y-5, $text);
|
||||
}
|
||||
|
||||
|
||||
sub draw_msg_label($$$$$)
|
||||
{
|
||||
my ($im, $m, $line_y, $start_x, $end_x) = @_;
|
||||
my $text = $$m{'label'};
|
||||
draw_scaled_label($im, $text, $line_y, $start_x, $end_x);
|
||||
}
|
||||
|
||||
sub draw_graph($)
|
||||
{
|
||||
my $outfile_name = shift;
|
||||
my $num_nodes = keys %nodes;
|
||||
my $num_msgs = @msgs;
|
||||
my ($x, $y) = compute_img_size($num_nodes, $num_msgs);
|
||||
my $im = new GD::Image($x, $y);
|
||||
|
||||
my $white = $im->colorAllocate(255, 255, 255);
|
||||
$im->transparent($white);
|
||||
my $black = $im->colorAllocate(0, 0, 0);
|
||||
|
||||
# vertical lines for each of the nodes in the graph
|
||||
foreach my $n (values %nodes) {
|
||||
printf("node %s (%s)\n", $$n{'name'}, $$n{'label'});
|
||||
my $line_x = $$n{'x_pos'};
|
||||
my $start_y = compute_msg_y(0)-$NODELINE_OVERLAP;
|
||||
my $end_y = compute_msg_y($num_msgs-1)+$NODELINE_OVERLAP;
|
||||
$im->line($line_x, $start_y, $line_x, $end_y, $black);
|
||||
|
||||
my $space_oneside = ($COL_SIZE_MIN/2) * 0.8;
|
||||
draw_scaled_label($im, $$n{'label'}, $start_y-10,
|
||||
$line_x-$space_oneside,
|
||||
$line_x+$space_oneside);
|
||||
}
|
||||
|
||||
# draw per-message arrows
|
||||
$im->setThickness(2);
|
||||
my $msg_n = 0;
|
||||
foreach my $m (@msgs) {
|
||||
my $line_y = compute_msg_y($msg_n++);
|
||||
my $start_node = $nodes{$$m{'src'}};
|
||||
my $end_node = $nodes{$$m{'dst'}};
|
||||
my $start_x = $$start_node{'x_pos'};
|
||||
my $end_x = $$end_node{'x_pos'};
|
||||
|
||||
if ($$m{'flags'} =~ /\W+both\W*/) {
|
||||
# FIXME
|
||||
}
|
||||
if ($$m{'flags'} =~ /\W+dashed\W*/) {
|
||||
print("setting dahsed style\n");
|
||||
$im->setStyle($black, $black, gdTransparent,
|
||||
gdTransparent);
|
||||
}
|
||||
|
||||
#$im->line($start_x, $line_y, $end_x, $line_y, $black);
|
||||
my $arrow = GD::Arrow::Full->new(-X1 => $end_x,
|
||||
-Y1 => $line_y,
|
||||
-X2 => $start_x,
|
||||
-Y2 => $line_y,
|
||||
-WIDTH => 3);
|
||||
$im->polygon($arrow, $black);
|
||||
|
||||
draw_msg_label($im, $m, $line_y-5, $start_x, $end_x)
|
||||
}
|
||||
|
||||
open(OUTFILE, ">$outfile_name");
|
||||
print(OUTFILE $im->png);
|
||||
close(OUTFILE);
|
||||
}
|
||||
|
||||
1;
|
||||
__END__
|
||||
|
||||
sub test()
|
||||
{
|
||||
new_node('ms', 'MS');
|
||||
new_node('bts', 'BTS');
|
||||
new_node('bsc', 'BSC');
|
||||
|
||||
new_msg('ms', 'bts', 'RACH REQ', undef);
|
||||
new_msg('bts', 'bsc', 'RSL CHAN RQD', undef);
|
||||
new_msg('bsc', 'bts', 'RSL CHAN ACT', undef);
|
||||
new_msg('bts', 'bsc', 'RSL CHAN ACT ACK', undef);
|
||||
|
||||
draw_graph();
|
||||
}
|
||||
|
||||
test();
|
||||
123
gen_ladder.pl
123
gen_ladder.pl
|
|
@ -1,6 +1,8 @@
|
|||
#!/usr/bin/perl -w
|
||||
use strict;
|
||||
|
||||
use OsmoLadder;
|
||||
|
||||
# Script to generate Graphviz (.dot) based ladder diagrams for network
|
||||
# protocols
|
||||
#
|
||||
|
|
@ -24,11 +26,6 @@ use strict;
|
|||
my $cfg_parse_state;
|
||||
my $cfg_parse_section;
|
||||
|
||||
my %cfg_entities;
|
||||
my @cfg_entity_arr;
|
||||
my $cfg_nr_entities = 0;
|
||||
my @cfg_messages;
|
||||
|
||||
# parse a line of the config file
|
||||
sub parse_cfg_line($)
|
||||
{
|
||||
|
|
@ -45,21 +42,17 @@ sub parse_cfg_line($)
|
|||
return;
|
||||
}
|
||||
if ($cfg_parse_section eq 'entities') {
|
||||
my ($entity) = $line =~ /^(\S+)/;
|
||||
$cfg_entities{$entity} = $cfg_nr_entities++;
|
||||
push(@cfg_entity_arr, $entity);
|
||||
if (my ($entity, $label) = $line =~ /^(\S+)\s+"(.+)"/) {
|
||||
OsmoLadder::new_node($entity, $label);
|
||||
} else {
|
||||
my ($entity) = $line =~ /^(\S+)/;
|
||||
OsmoLadder::new_node($entity, $entity);
|
||||
}
|
||||
} elsif ($cfg_parse_section eq 'messages') {
|
||||
my ($src, $dst, $label, $flags) =
|
||||
$line =~ /(\S+)\s+(\S+)\s+"(.*)"(.*)/;
|
||||
my %msg;
|
||||
$msg{'src'} = $src;
|
||||
$msg{'dst'} = $dst;
|
||||
$msg{'label'} = $label;
|
||||
$msg{'flags'} = $flags;
|
||||
# store a reference to the new hash on the global pile of
|
||||
# message hash references
|
||||
#print("$src $dst $label $flags\n");
|
||||
push(@cfg_messages, \%msg);
|
||||
OsmoLadder::new_msg($src, $dst, $label, $flags);
|
||||
}
|
||||
}
|
||||
|
||||
|
|
@ -76,102 +69,6 @@ sub parse_cfg_file($)
|
|||
close(INFILE);
|
||||
}
|
||||
|
||||
# generate the nodes between which we will transfer messages
|
||||
sub gen_nodes()
|
||||
{
|
||||
my $num_msgs = @cfg_messages;
|
||||
|
||||
foreach my $m (@cfg_entity_arr) {
|
||||
printf(" %s [shape=none]\n", $m);
|
||||
}
|
||||
print("\n");
|
||||
|
||||
foreach my $m (@cfg_entity_arr) {
|
||||
my $first = 0;
|
||||
my $count;
|
||||
|
||||
# initial edge between header entity and the chain
|
||||
printf(" %s -> %s0 [style=invis]\n", $m, $m);
|
||||
|
||||
# chain of edges between the individual nodes of one entity
|
||||
for ($count = 0; $count < $num_msgs+1; $count++) {
|
||||
my $name = sprintf("%s%u", $m, $count);
|
||||
if ($first == 0) {
|
||||
printf(" %s ", $name);
|
||||
} else {
|
||||
printf("-> %s ", $name);
|
||||
}
|
||||
$first = 1;
|
||||
}
|
||||
print(" [weight=1000]\n");
|
||||
}
|
||||
print("\n");
|
||||
|
||||
# invisible chain of edges between all entities
|
||||
my $first = 1;
|
||||
print(" { rank=same;\n edge[style=invis]\n");
|
||||
foreach my $e (@cfg_entity_arr) {
|
||||
if ($first) {
|
||||
printf(" %s0 ", $e);
|
||||
$first = 0;
|
||||
} else {
|
||||
printf("-> %s0 ", $e);
|
||||
}
|
||||
}
|
||||
print("\n }\n");
|
||||
print("\n");
|
||||
}
|
||||
|
||||
sub entity_left_of($$)
|
||||
{
|
||||
my $l = shift;
|
||||
my $r = shift;
|
||||
if ($cfg_entities{$l} < $cfg_entities{$r}) {
|
||||
return 1;
|
||||
} else {
|
||||
return 0;
|
||||
}
|
||||
}
|
||||
|
||||
# generate edges for the individual messages
|
||||
sub gen_edges()
|
||||
{
|
||||
my $count = 1;
|
||||
|
||||
foreach my $m (@cfg_messages) {
|
||||
my $l; my $r; my $dir; my $attr = "";
|
||||
if (entity_left_of($$m{'src'}, $$m{'dst'})) {
|
||||
$l = $$m{'src'};
|
||||
$r = $$m{'dst'};
|
||||
$dir = 'forward';
|
||||
} else {
|
||||
$l = $$m{'dst'};
|
||||
$r = $$m{'src'};
|
||||
$dir = 'back';
|
||||
}
|
||||
if ($$m{'flags'} =~ /\W+both\W*/) {
|
||||
$dir = 'both';
|
||||
}
|
||||
if ($$m{'flags'} =~ /\W+dashed\W*/) {
|
||||
$attr .= ' style=dashed';
|
||||
}
|
||||
print(" { rank=same;\n");
|
||||
printf(" %s%u -> %s%u [dir=%s label=\"%s\"%s]\n }\n",
|
||||
$l, $count, $r, $count, $dir, $$m{'label'}, $attr);
|
||||
$count++;
|
||||
}
|
||||
}
|
||||
|
||||
parse_cfg_file($ARGV[0]);
|
||||
|
||||
# print static header
|
||||
print("digraph ladder {\n");
|
||||
print(" node [shape=point]\n");
|
||||
print(" edge [dir=none]\n");
|
||||
|
||||
# generate and print dynamic content
|
||||
gen_nodes();
|
||||
gen_edges();
|
||||
|
||||
# print footer
|
||||
print("}\n");
|
||||
OsmoLadder::draw_graph($ARGV[1]);
|
||||
|
|
|
|||
Loading…
Reference in New Issue