diff options
| -rw-r--r-- | GD/Arrow.pm | 301 | ||||
| -rw-r--r-- | Makefile | 12 | ||||
| -rwxr-xr-x | OsmoLadder.pm | 217 | ||||
| -rwxr-xr-x | gen_ladder.pl | 123 |
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 + @@ -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]); |