view release on metacpan or  search on metacpan

devel/lib/MyPlanar.pm  view on Meta::CPAN

# Return true if segment $p1,$p2 contains point $p3.
sub segment_contains_point {
  my ($points) = @_;
  my ($p1,$p2, $p3) = @$points;
  return abs(Math::Geometry::Planar::DistanceToSegment([$p1,$p2,$p3])) < $delta;
}
sub segments_are_colinear {
  my ($points) = @_;
  my ($p1,$p2, $p3,$p4) = @$points;
  return Math::Geometry::Planar::Colinear([$p1,$p2,$p3])
    && Math::Geometry::Planar::Colinear([$p1,$p2,$p4]);
}

# segment_intersection_segment([$p1,$p2, $p3,$p4])
# Return a segment [$ps,$pe] which is the intersection of segments $p1,$p2
# and $p3,$p4.  If they do not intersect then return 0;
# If they are colinear and overlapping then return the portion where they
# overlap.
# If they touch or cross at a single point then return [$p,$p] which is that
# point (like SegmentIntersection() does).
#
sub segment_intersection_segment {
  my ($points) = @_;
  my ($p1,$p2, $p3,$p4) = @$points;
  ### segment_intersection_segment(): $points

  #   p1------p2            p1---p2              p1------p2
  #       p3------p4    p3-----------p4      p3------p4
  #
  #   p1------p2            p3---p4              p1------p2
  #       p4------p3    p1-----------p2      p4------p3
  #

  my $c1 = segment_contains_point([$p3,$p4, $p1]);
  my $c2 = segment_contains_point([$p3,$p4, $p2]);
  ### $c1
  ### $c2
  if ($c1 && $c2) {
    ### p1,p2 entirely within p3,p4 ...
    return [$p1,$p2];
  }

  my $c3 = segment_contains_point([$p1,$p2, $p3]);
  my $c4 = segment_contains_point([$p1,$p2, $p4]);
  ### $c3
  ### $c4
  if ($c3 && $c4) {
    ### p3,p4 entirely within p1,p2 ...
    return [$p3,$p4];
  }

  if (($c1||$c2) && ($c3||$c4)) {
    ### partial overlap ...
    return [$c1 ? $p1 : $p2,
            $c3 ? $p3 : $p4];
  }

  foreach my $a ($p1,$p2) {
    foreach my $b ($p3,$p4) {
      if ($a->[0]==$b->[0] && $a->[1]==$b->[1]) {
        ### endpoint in common ...
        return [$a,$a];
      }
    }
  }

  ### try point intersection ...
  if (my $p = Math::Geometry::Planar::SegmentIntersection($points)) {
    return [$p,$p];
  }
  return 0;
}

sub distance_segment_to_segment {
  my ($points) = @_;
  my ($p1,$p2, $p3,$p4) = @$points;

  # DistanceToSegment() is +ve on the left and -ve on the right.
  # Here want absolute value.
  # 
  # Shortest distance is always attained going to the endpoint of one
  # segment, since straight lines.

  my $ret;
  foreach (0,1) {
    foreach my $i (2,3) {
      my $d = abs(DistanceToSegment([$points->[0],$points->[1],$points->[$i]]));
      $ret = min($ret // $d, $d)
        or return $ret;  # if 0
    }
    $points = [reverse @$points];
  }
  return $ret;
}

# $points1 and $points2 are arrayrefs of points [ [x,y], [x,y], ...]
# which are simple polygons.
# Return the shortest distance between a point on the boundary of $points1
# and a point on the boundary of $points2.
# If their boundaries touch or cross then the return is 0.
# One polygon can be within the other.  The distance is still between their
# boundaries.
sub poly_distance_boundary_to_boundary {
  my ($points1, $points2) = @_;
  my $ret;
 OUTER: foreach my $i (0 .. $#$points1) {
    foreach my $j (0 .. $#$points2) {
      my $d = distance_segment_to_segment([$points1->[$i-1],$points1->[$i],
                                           $points2->[$j-1],$points2->[$j]]);
      if (defined $ret) {
        $ret = min($ret, $d);
      } else {
        $ret = $d;
      }
      $ret or last OUTER;
    }
  }
  return $ret;
}

sub poly_union {
  my ($points1, $points2) = @_;
  my $gpc = Math::Geometry::Planar::GpcClip('UNION',
                                            points_to_gpc($points1),
                                            points_to_gpc($points2));
  if (defined $gpc) {
    return gpc_to_points_list($gpc);
  }
  return;
}

sub poly_intersection {
  my ($points1, $points2) = @_;
  my $gpc = Math::Geometry::Planar::GpcClip('INTERSECTION',
                                            points_to_gpc($points1),
                                            points_to_gpc($points2));
  if (defined $gpc) {
    return gpc_to_points_list($gpc);
  }
  return undef;