aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorHarald Welte <laforge@gnumonks.org>2011-10-07 20:36:29 +0200
committerHarald Welte <laforge@gnumonks.org>2011-10-07 20:36:29 +0200
commit5bad9007084a954a6ec025cef70bf24be7eaf75b (patch)
tree2d340d72c81af9253c1d88d0ec7a9b1c9bc547b3
parentf8441a6aaf0550998fded98d01934036d0d2e0f4 (diff)
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
-rw-r--r--GD/Arrow.pm301
-rw-r--r--Makefile12
-rwxr-xr-xOsmoLadder.pm217
-rwxr-xr-xgen_ladder.pl123
4 files changed, 531 insertions, 122 deletions
diff --git a/GD/Arrow.pm b/GD/Arrow.pm
new file mode 100644
index 0000000..1030eb8
--- /dev/null
+++ b/GD/Arrow.pm
@@ -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
+
diff --git a/Makefile b/Makefile
index bb51b88..a293261 100644
--- a/Makefile
+++ b/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
diff --git a/OsmoLadder.pm b/OsmoLadder.pm
new file mode 100755
index 0000000..13be608
--- /dev/null
+++ b/OsmoLadder.pm
@@ -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();
diff --git a/gen_ladder.pl b/gen_ladder.pl
index f58c7e4..924e254 100755
--- a/gen_ladder.pl
+++ b/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]);