use strict;
use warnings;
my @pnt_x_values = (-12, 0, 23);
my @pnt_y_values = (-83, 34, -76);
my @poly_x_min = (-13, 45, 22);
my @poly_x_max = (-11, 49, 24);
my @poly_y_min = (-82, 33, -2);
my @poly_y_max = (-84, 35, -6);
for my $polyI (0 .. $#poly_x_min) {
my $x1 = $poly_x_min[$polyI];
my $x2 = $poly_x_max[$polyI];
my $y1 = $poly_y_min[$polyI];
my $y2 = $poly_y_max[$polyI];
my @poly = map {{x => $_->[0], y =>$_->[1]}}
([$x1, $y1], [$x2, $y1], [$x2, $y2], [$x1, $y2]);
for my $pi (0 .. $#pnt_x_values) {
my %point = (x => $pnt_x_values[$pi], y => $pnt_y_values[$pi])
+;
next unless PointInPoly (\%point, \@poly);
print 'Point ' . ($pi + 1) . ' inside poly ' . (1 + $polyI) .
+"\n";
}
}
sub PointInPoly {
my ($point, $poly) = @_;
my $wCount = 0;
for my $i (0 .. $#$poly - 1, -1) {
# edge from$poly->[$i] to$poly->[$i + 1]
if ($poly->[$i]{y} <= $point->{y}) {
# start y <= $P->{y}
if ($poly->[$i + 1]->{y} > $point->{y}) {
# an upward crossing
if (isLeft ($poly->[$i], $poly->[$i + 1], $point) > 0)
+ {
# $P left of edge
++$wCount; # have a valid up intersect
}
}
} else {
# start y > $P->{y} (no test needed)
if ($poly->[$i + 1]->{y} <= $point->{y}) {
# a downward crossing
if (isLeft ($poly->[$i], $poly->[$i + 1], $point) < 0)
+ {
# $P right of edge
--$wCount; # have a valid down intersect
}
}
}
}
return $wCount;
}
sub isLeft {
my ($P0, $P1, $P2) = @_;
return ($P1->{x} - $P0->{x}) * ($P2->{y} - $P0->{y})
- ($P2->{x} - $P0->{x}) * ($P1->{y} - $P0->{y});
}
Prints:
Point 1 inside poly 1
Perl is environmentally friendly - it saves trees
|