#!/usr/bin/perl -w

## Initialize status variable
BEGIN
{
  $curr_polygon = "";
}

## Declare function prototypes
sub get_curr_polygon ();
sub merge_polygon (\@);
sub write_polygon ();

LINE_OF_FILE: while (<>)
{
  if (/^\s*<polygon /)
  {
    ## New polygon.  Store it and keep parsing.
    if (! $curr_polygon)
    {
      get_curr_polygon ();
      next LINE_OF_FILE;
    }

    my $color;
    ($color) = m/fill="([^"]*)"/;
    if ($color ne $curr_color)
    {
      ## Polygon is different.  Write old polygon and make this one current.
      write_polygon ();
      get_curr_polygon ();
      next LINE_OF_FILE;
    }

    ## Decide if polygon can be merged by checking for a point in common.
    my ($points, @points);
    ($points) = m/points="([^"]*)"/;
    @points = split (" ", $points);
    my $found_edge = 0;
    foreach my $pt (@points)
    {
      if ($db{$pt})
      {
        $found_edge++;
        if ($found_edge == 2)
        {
          merge_polygon (@points);
          next LINE_OF_FILE;
        }
      }
    }

    ## Different polygons.  Write out first one and store next one.
    write_polygon ();
    get_curr_polygon ();
    next LINE_OF_FILE;

  }
  else  # Current line of file is not a polygon
  {
    # Write out any current polygon before writing this line 
    if ($curr_polygon)
    {
      write_polygon ();
      $curr_polygon = "";
    }
    print $_;
  }
}

## Store current_polygon in global variables
sub get_curr_polygon ()
{
  $curr_polygon = $_; 

  ($curr_color) = m/fill="([^"]*)"/;

  my $points;
  ($points) = m/points="([^"]*)"/;
  @curr_points = split (" ", $points);

  undef (%db);
  foreach my $pt (@curr_points)
  {
    $db{$pt} = 1;
  }
}

## Merge unique vertices into current points list
sub merge_polygon (\@)
{
  my @poly1 = @curr_points;
  my @poly2 = @{$_[0]};
  my @union;

  ## Algorithm: Traverse current polygon until an intersection is found and
  ## then switch to second polygon.  Traverse second polygon until intersection
  ## is found and switch back again.  Repeat until all points exhausted.
  my $ref1 = \@poly1;
  my $ref2 = \@poly2;
  while (@{$ref1})
  {
    ## Add point to merged polygon
    my $pt1 = shift (@{$ref1});
    push (@union, $pt1);
    $db{$pt1} = 1;

    ## Check for intersection with second polygon
    my $i = 0;
    my $found = 0;
    foreach $pt2 (@{$ref2})
    {
      if ($pt1 eq $pt2)
      {  $found = 1;  last; }
      else
      { $i++; }
    }
    if ($found)
    {
      ## Remove point from second polygon and re-order polygon2.
      @{$ref2} = (@{$ref2}[$i+1..$#$ref2], @{$ref2}[0..$i-1]);
      ## switch polygons
      my $tmp_ref = $ref1;
      $ref1 = $ref2;
      $ref2 = $tmp_ref;
    }
  }
  push (@union, @{$ref2});  # Add any remaining points to merged polygon

  @curr_points = @union;
}

## Write polygon out 
sub write_polygon ()
{
  my $curr_points = join (" ", @curr_points); 

  $curr_polygon =~ s/points="[^"]*"/points="$curr_points"/;

  print $curr_polygon;
}

