# Copyright (c) 1999-2009 Nokia Corporation and/or its subsidiary(-ies).

# All rights reserved.

# This component and the accompanying materials are made available

# under the terms of "Eclipse Public License v1.0"

# which accompanies this distribution, and is available

# at the URL "http://www.eclipse.org/legal/epl-v10.html".

#

# Initial Contributors:

# Nokia Corporation - initial contribution.

#

# Contributors:

#

# Description:

# use strict;

# 

#

use Math::Complex;

use Math::Trig;

require 'getopts.pl';

my $version = "0.2 VRML (28/12/07)";

my $animate = 0;

#

# Notes for future merging with parseseq.pl:

# - usage of %symtab with "oc" and "od"

#

# Abstract principles:

#

# Objects are conceptually placed within a variable sized rectangular "super" grid.  Each position of this

# grid represents a particular "type" of object (e.g. IP SubConnection Provider).  More than one object

# (of the same type) can occupy the same position on this grid.  Consequently, each grid position has

# within it a variable sized rectangular "sub-grid" that is used to define the placement of each of the

# individual objects that occupy the same super grid position.  The object placement within the sub-grid

# is calculated to avoid connecting lines to neighbouring objects from passing through other objects

# (this is, in fact, the raison d'etre for the sub-grid concept).  Note that the sub-grid can have

# larger dimensions than the number of objects within it - i.e. it can have "empty" spaces.  This

# is a consequence of the simple placement algorithm:

#

# Each sub-grid in the super grid has a (subRow,subCol) variable that starts with the value (0,0).  The

# first object is placed at (0,0).  For every subsequent object needs to be placed, if there are has

# any horizontal connections ("west" or "east") to neighbouring objects, then (subRow) variable is

# incremented.  if there are any vertical connections, then (subCol) variable is incremented.  The object

# is then placed at the final (subRow,subCol) position within the sub-grid, and process repeats.

#

# Each set of inter-related objects forms a "group".  The relationship is based around the exchange of

# messages.  There may be several such distinct and seperate groups.  By definition, no object in one

# group has any message exchange with an object in another group.

#

# Example of two groups:

#

#	group 1:

#

#	A -- B -- C

#		 |

#		 D

#

#	group 2:

#

#	E -- F -- G

#	|

#	H

#

# Two groups are merged into one if, whilst reading the message sequence file, a message is found to flow from

# an object in one group is sent to an object in another group.  For example, if object D sends a message to

# object E, then a larger group is formed:

#

#

#	group 1:

#

#	A -- B -- C

#		 |

#		 D

#		 |

#		 E -- F -- G

#		 |

#		 H

#

# Each object is a hash:

#	n => array of object references to objects that are "north" of this object

#	s => array of object references to objects that are "south" of this object

#	w => array of object references to objects that are "west" of this object

#	e => array of object references to objects that are "east" of this object

#	group => group number.  Each group is a set of interconnected objects.

#	col => column number of object within super grid

#	row => row number of object within super grid

#	subCol => column number of object within sub-grid (within supergrid col,row position)

#	subRow => row number of objects within sub-grid (within supergrid col,row position)

#

# subGridPlacement[<col>][<row>] is a hash containing the (subRow,subCol) variable pair for a sub-grid at

# a particular <col> and <row> in the overall grid:

#	subCol => <subCol>

#	subRow => <subRow>

#

# colToSubColIndex[<col>] and rowToSubRowIndex[<row>] are arrays containing the cumulative total number of sub-grid

# columns and rows, respectively, at a particular <col> and <row> position in the super grid.

# For example, if the first, second and third columns of the super grid contain sub-grids of

# 2, 1 and 3 columns respectively, then colToSubColIndex[] contains 0, 2, 3, 6, ...).

#

# colToSubGridWidth[<col>] and rowToSubGridHeight[<row>] are arrays containing the width and height respectively

# of the sub-grid at a particular <col> and <row> position in the super grid, respectively.

#

# gridVerticalLineCount[<col>] and gridHorizontalLineCount[<row>] are arrays containing the number

# of "long" lines that run vertically and horizontally at certain <col> and <row> positions in the

# grid for connecting objects that are not neighbours.  Objects connected to immediate neighbours

# do not have "long" lines and are not counted here.

#

# groupRanges{<group>} is a hash which contains

#	minCol => minimum column number of any object within the group

#	maxCol => maximum column number of any object within the group

#	minRow => minimum row number of any object within the group

#	maxRow => maximum row number of any object within the group

#	row => row number that the group starts at within the super grid

#

# VRML line array elements

use constant X => 0;

use constant Y => 1;

use constant Z => 2;

# fonts

use constant FONT_FAMILY => "SANS";

use constant Z_POSITION => 0;

#

# Flags

my $displayObjectAddressFlag = 0;		# display object hex address alongside name

my $group = 1;							# next free group number (monotonically incremented after allocation)

my $groupVerticalSeperation = 3;

my %directionTranslate = ( n => { x =>  0, y => -1 },

						   s => { x =>  0, y => +1 },

						   w => { x => -1, y =>  0 },

						   e => { x => +1, y =>  0 } );

my %initRange = ( minCol => 9999, minRow => 9999, maxCol => -9999, maxRow => -9999 );

my %overallRange = %initRange;

# tabLabel is a monotonically increasing value used to derive a unique Tab Label.  It is incremented

# everytime a new Tab is drawn.

my $tabLabel = "a";

my @colToSubColIndex;

my @rowToSubRowIndex;

my @rowToSubGridHeight;

my @colToSubGridWidth;

my %relationships;

my %groupRanges;

my @objects;

my @subGridPlacement;

Getopts("x:vV");

readRelationshipFile();

print "Reading sequences\n" if ($opt_V);

readSequences();

#printGroupRanges();

#printRelationships();

print "Normalising coordinates\n" if ($opt_V);

normaliseCoords();

print "Seperating groups\n" if ($opt_V);

seperateGroups();

print "Seperating overlaps\n" if ($opt_V);

seperateOverlaps();

# print2DArray("subGridPlacement", \@subGridPlacement);

print "Calculating grid positions\n" if ($opt_V);

calculateGridPositions();

if ($opt_v) {

	printArray("colToSubColIndex", \@colToSubColIndex);

	printArray("rowToSubRowIndex", \@rowToSubRowIndex);

	printArray("rowToSubGridHeight", \@rowToSubGridHeight);

	printArray("colToSubGridWidth", \@colToSubGridWidth);

	printLoners();

	printRelationships();

	printGroupRanges();

}

#my $outputFormat = "svg";

my $outputFormat = "vrml";

my $adjustFactor;

if ($outputFormat eq "vrml") {

	$adjustFactor = 0.1;

} else {

	$adjustFactor = 1;

}

#VRML specific

my $vrmlCycleInterval = 0.2;

my $boxDepth = 20 * $adjustFactor;

my $lineThickness = 2 * $adjustFactor;

my $lineExtensionFactor = 1.01;			# *** REMOVE THIS ***

my $initialTransparency = $animate ? 1 : 0;

my $boxDepthMargin = 120 * $adjustFactor;

my $boxDepthWithMargin = $boxDepth + $boxDepthMargin;

my $boxInternalTextColour = colourString(0,100,100);

my $tabSpacing = 10 * $adjustFactor;

# minor aesthetic adjustments to the spacing between the end of a Tab line and its Labels

my $tabToFontAdjustTopY = 2 * $adjustFactor;

my $tabToFontAdjustBottomY = 1 * $adjustFactor;

my $tabLineLengthY = 5 * $adjustFactor;

my $fontHeight = 9 * $adjustFactor;				# assumed font height

my $boxInternalFontHeight = $fontHeight / 3;

my $groupHighlightFill = colourString(235,235,235);

my $groupHighlightMargin = 5 * $adjustFactor;			# margin of the group background rectangle

my $horizMargin = 20 * $adjustFactor;

my $rectangleMargin = 15 * $adjustFactor;

#Sphere

#my $rectangleWidth = 50 * $adjustFactor;

#my $rectangleHeight = 50 * $adjustFactor;

my $rectangleWidth = 110 * $adjustFactor;

my $rectangleHeight = 27 * $adjustFactor;

my $rectangleWidthWithMargin = $rectangleWidth + $rectangleMargin;

my $rectangleHeightWithMargin = $rectangleHeight + $rectangleMargin;

my $vertMargin = $horizMargin;

my $gridXSpacing = $horizMargin;

my $gridYSpacing = $gridXSpacing;

my $rectangleOpacity = 0.80;

my $rectangleColour1 = colourString(144,238,144);		# "lightgreen"

my $rectangleColour2 = colourString(135,206,250);		# "lightskyblue"

my $rectHighlightColour = colourString(250,128,114);		# "salmon"

# X position of last grid column + size of last grid column + horizontal margin

my $width = gridX($#colToSubColIndex) + $colToSubGridWidth[$#colToSubColIndex] * $rectangleWidthWithMargin + $horizMargin;

my $height = gridY($#rowToSubRowIndex) + $rowToSubGridHeight[$#subGridRow] * $rectangleHeightWithMargin + $vertMargin;

createOutputFile();

outputDocHeader($width,$height);

# Not for VRML (yet)

#outputGroupHighlight();

print "Generating links\n" if ($opt_V);

outputLinks();

print "Generating nodes\n" if ($opt_V);

outputNodes();

outputDocFooter();

if ($animate) {

	print "Generating animation\n" if ($opt_V);

	AnimateDo();

}

closeOutputFile();

if ($outputFormat eq "svg")

	{

	outputRelationsHTMLEmbedder($width, $height);

	}

sub colourString($$$)

	{

	my ($r,$g,$b) = @_;

	if ($outputFormat eq "svg") {

		return "rgb($r,$g,$b)";

		}

	else {

		my $str = sprintf("%.3f %.3f %.3f", $r/255, $g/255, $b/255);

		return $str;

		}

	}

sub createOutputFile()

	{

        if ($outputFormat eq "svg")

        	{

		open SVG, ">relations.svg" || die "Cannot open relations.svg for writing\n";

		}

	else

	    	{

	    	open WRL, ">relations.wrl" || die "Cannot open relations.wrl for writing\n";

		}

	}

sub closeOutputFile()

	{

	if ($outputFormat eq "svg")

		{

		close SVG;

		}

	else

		{

		close WRL;

		}

	}

sub readSequences()

	{

	while (<>) {

		die unless s/^(\w+)\s+//;

		my $action = $1;

		if ($action eq "p" || $action eq "r" || $action eq "sc")

			{

			# Post/Receive

			# [P|R] <message> <source object> <destination object>

			my $msg;

			if (/^"/)

				{

				s/^"([^"]+)"\s+//;

				$msg = $1;

				}

			else

				{

				s/^(\S+)\s+//;

				$msg = $1;

				}

			$msg =~ s/ \(.*\)//;		# remove message arguments in parentheses: "<message>(<arguments>)" => "<message>"

			split;

			my $srcRef = findOrCreateObject(shift @_);

			my $destRef = findOrCreateObject(shift @_);

			my $direction = $relationships{$msg};

			if ($direction) {

				if (isDirection($direction)) {

					AddRelation($srcRef, $destRef, $direction);

				}

				}

			elsif ($srcRef != $destRef) {

#				print "Unknown relationship: $srcRef->{Name} -- $msg --> $destRef->{Name}\n";

				}

			AnimateObjectMessage($srcRef, $destRef, $direction) if $animate;

			}

		elsif ($action eq "oc")

			{

			# Object Create

			# oc <object name> <order> <addr>

			split;

			my $objRef = findOrCreateObject(shift @_);

			shift @_;							# order - can we use this to define object column placement ?

			$objRef->{Addr} = shift @_;

			AnimateObjectCreate($objRef) if $animate;

			}

		elsif ($action eq "od")

			{

			# Object Destroy

			# od <object name> <addr>

			split;

			my $objRef = findObject(shift @_);

			if ($objRef != 0) {

				AnimateObjectDestroy($objRef) if $animate;

				}

			}

		}

	}

sub AddRelation($$$)

	{

	my ($srcRef,$destRef,$dir) = @_;

	my $rdir = reverseDirection($dir);

	if ($srcRef != $destRef && ! RelationExists($srcRef->{$dir}, $destRef))

		{

		push @{$srcRef->{$dir}}, $destRef;

		push @{$destRef->{$rdir}}, $srcRef;

		# my %range = %initRange;

		# we are about to merge groups, so delete the group about to be assimilated from the group ranges hash

		delete $groupRanges{$destRef->{group}};

		my $rangeRef = \%{$groupRanges{$srcRef->{group}}};

		MergeGroups($destRef->{group}, $srcRef->{group},

					$srcRef->{col} + $directionTranslate{$dir}{x} - $destRef->{col},

					$srcRef->{row} + $directionTranslate{$dir}{y} - $destRef->{row}, $rangeRef );

		# MergeGroups() above will automatically adjust the min/max range values in range for all the "incoming"

		# objects.  However, we still have to take into account the effect that the original src object has on

		# the min/max range values, so call updateRange() specially here for it.

		updateRange($rangeRef, $srcRef->{col}, $srcRef->{row});

		# Ultimately we need to place objects on the super grid according to what type they are - for example,

		# flows in col 0, SCPRs in col 1 etc.  At the moment, they are mixed up in the same super grid, as

		# some groups may have flow, some may not, but all groups are left aligned.  This explains why

		# the display is messed up with MCPRs and CPRs occupying the same column in different groups.

		updateRange(\%overallRange, $rangeRef->{minCol}, $rangeRef->{minRow});

		updateRange(\%overallRange, $rangeRef->{maxCol}, $rangeRef->{maxRow});

		}

	}

#

# Indicate whether the string passed is a (compass) direction.

#

sub isDirection($)

{

	my $dir = $_[0];

	return $dir eq "n" || $dir eq "s" || $dir eq "w" || $dir eq "e";

}

sub MergeGroups($$$$)

	{

	my ($targetGroup, $newGroup, $adjustCol, $adjustRow, $rangeRef) = @_;

	foreach my $obj (@objects) {

		if ($obj->{group} == $targetGroup) {

#			print "Merge $obj->{Name}, group $obj->{group} => $newGroup, ($obj->{col},$obj->{row}) => ";

			$obj->{group} = $newGroup;

			$obj->{col} += $adjustCol;

			$obj->{row} += $adjustRow;

#			print "($obj->{col},$obj->{row})\n";

			# determine minimum and maximum row,col extent of group

			updateRange($rangeRef, $obj->{col}, $obj->{row});

			}

		}

	}

sub updateRange($range, $col, $row)

	{

	my ($range, $col, $row) = @_;

	if (!defined($range->{maxCol}) || $col > $range->{maxCol}) {

		$range->{maxCol} = $col;

		}

	if (!defined($range->{maxRow}) || $row > $range->{maxRow}) {

		$range->{maxRow} = $row;

		}

	if (!defined($range->{minCol}) || $col < $range->{minCol}) {

		$range->{minCol} = $col;

		}

	if (!defined($range->{minRow}) || $row < $range->{minRow}) {

		$range->{minRow} = $row;

		}

	}

sub RelationExists($$)

	{

	my ($relationArrayRef, $objRef) = @_;

	if (defined ($relationArrayRef))

		{

		foreach my $obj (@{$relationArrayRef})

			{

			if ($obj == $objRef)

				{

				return 1;

				}

			}

		}

	else

		{

		return 0;

		}

	}

sub reverseDirection($)

	{

	my ($dir) = @_;

	my %reverseMap = ( "n" => "s", "s" => "n", "w" => "e", "e" => "w" );

	return $reverseMap{$dir};

	}

#

# Print objects that exchange no messages with anyone else.

#

sub printLoners()

	{

	my $wrapCount = 8;

	my $wrapIndex = 1;

	print "Loners:\t";

	my $commaRequired = 0;

	for (my $i = 0 ; $i <= $#objects ; ++$i)

		{

		my $obj = $objects[$i];

		if (!defined($obj->{subCol}) && !defined($obj->{subRow}))

			{

			if ($commaRequired != 0)

				{

				print ", ";

				}

			$commaRequired = 1;

			print $obj->{Name};

			if (($wrapIndex++ % $wrapCount) == 0)

				{

				$commaRequired = 0;

				print "\n\t";

				}

			}

		}

	print "\n\n";

	}

sub printRelationships()

	{

	print "Relationships - overallRange: ($overallRange{minCol}, $overallRange{minRow}) to ($overallRange{maxCol}, $overallRange{maxRow}):\n";

	my $i;

	for ($i = 0 ; $i < scalar(@objects) ; ++$i)

		{

		printObjectRelationships($objects[$i]);

		}

	print "\n";

	}

sub printObjectRelationships($)

	{

	my ($obj) = @_;

	# Object

	print $obj->{Name}, ": group $obj->{group}, ($obj->{col},$obj->{row}), sub ($obj->{subCol},$obj->{subRow})\n";

	# North

	if (defined($obj->{n}))

		{

		print "\tN: ";

		printObjects($obj->{n});

		print "\n";

		}

	# West

	if (defined($obj->{w}))

		{

		print "\tW: ";

		printObjects($obj->{w});

		print "\n";