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
master
Harald Welte 11 years ago
parent f8441a6aaf
commit 5bad900708
  1. 301
      GD/Arrow.pm
  2. 12
      Makefile
  3. 217
      OsmoLadder.pm
  4. 123
      gen_ladder.pl

@ -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

@ -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();

@ -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…
Cancel
Save