File Coverage

blib/lib/CAD/Calc.pm

Criterion	Covered	Total	%
statement	36	487	7.3
branch	2	126	1.5
condition	0	20	0.0
subroutine	10	70	14.2
pod	61	61	100.0
total	109	764	14.2

package CAD::Calc;
our $VERSION = 0.27;

use Math::Vec qw(
	:terse
	NewVec
	);
use Math::Complex qw(acos);
use Math::Round::Var;
use Math::BigFloat;

# FIXME: add explicit exports to cleanup my namespace / make
# dependencies clearer

use vars qw(
	$linear_precision
	$angular_precision
	$linr
	$angr
	$pi
	);
$linear_precision = 1.0e-7;
$angular_precision = 1.0e-6;
$pi = atan2(1,1) * 4;

require Exporter;
@ISA='Exporter';
@EXPORT_OK = qw(
	pi
	distdivide
	subdivide
	shorten_line
	dist
	dist2d
	line_vec
	slope
	segs_as_transform
	chevron_to_ray
	signdist
	offset
	shift_line
	line_to_rectangle
	isleft
	howleft
	iswithin
	iswithinc
	unitleft
	unitright
	unit_angle
	angle_reduce
	angle_parse
	angle_quadrant
	collinear
	triangle_angles
	intersection_data
	line_intersection
	seg_line_intersection
	seg_seg_intersection
	line_ray_intersection
	seg_ray_intersection
	ray_pgon_int_index
	ray_pgon_closest_index
	perp_through_point
	foot_on_line
	foot_on_segment
	Determinant
	pgon_as_segs
	pgon_area
	pgon_centroid
	pgon_lengths
	pgon_angles
	pgon_deltas
	pgon_direction
	pgon_bisectors
	sort_pgons_lr
	pgon_start_index
	re_order_pgon
	order_pgon
	stringify
	stringify_line
	pol_to_cart
	cart_to_pol
	print_line
	point_avg
	arc_2pt
	);



use strict;
use Carp;

=pod

=head1 NAME

CAD::Calc - generic cad-related geometry calculations

=head1 AUTHOR

Eric Wilhelm @

http://scratchcomputing.com

=head1 COPYRIGHT

This module is copyright (C) 2004, 2005, 2006, 2008 Eric L. Wilhelm.
Portions copyright (C) 2003 by Eric L. Wilhelm and A. Zahner Co.

=head1 LICENSE

This module is distributed under the same terms as Perl.  See the Perl
source package for details.

You may use this software under one of the following licenses:

  (1) GNU General Public License
    (found at http://www.gnu.org/copyleft/gpl.html)
  (2) Artistic License
    (found at http://www.perl.com/pub/language/misc/Artistic.html)

=head1 NO WARRANTY

This software is distributed with ABSOLUTELY NO WARRANTY.  The author,
his former employer, and any other contributors will in no way be held
liable for any loss or damages resulting from its use.

=head1 Modifications

The source code of this module is made freely available and
distributable under the GPL or Artistic License.  Modifications to and
use of this software must adhere to one of these licenses.  Changes to
the code should be noted as such and this notification (as well as the
above copyright information) must remain intact on all copies of the
code.

Additionally, while the author is actively developing this code,
notification of any intended changes or extensions would be most helpful
in avoiding repeated work for all parties involved.  Please contact the
author with any such development plans.

=cut

=head1 Configuration

Used to set package global values such as precision.

=head2 import

Not called directly.  Triggered by the use() function.

  import(%options, @EXPORT_TAGS);

Example:

  use CAD::Calc (
  	-precision => 0.125,
	-angular   => 1.0e-6,
  	qw(
		seg_seg_intersection
		dist2d
		print_line
		)
	);

=cut
sub import {
	## print "import called with @_\n";
	local @ARGV = @_; # shame that Getopt::Long isn't structured better!
	use Getopt::Long ();
	Getopt::Long::GetOptions( '-',
		'precision=f' => \$linear_precision,
		'angular=f'   => \$angular_precision,
		) or croak("bad import arguments");
	## print "using $linear_precision for linear\n";
	## print "using $angular_precision for angular\n";
	$linr = Math::Round::Var->new($linear_precision);
	$angr = Math::Round::Var->new($angular_precision);
	## print "my linear rounding will be a ", ref($linr), "\n";
	## print "my angular rounding will be a ", ref($angr), "\n";
	CAD::Calc->export_to_level(1, @ARGV);
} # end subroutine import definition
########################################################################

=head1 Constants

=head2 pi

Returns the value of $CAD::Calc::pi

  pi;

=cut
sub pi() {
	return($pi);
} # end subroutine pi definition
########################################################################

=head1 Functions

These are all exported as options.

=head2 distdivide

Returns a list of point references resulting from dividing $line into
as many parts as possible which are at least $dist apart.

  @points = distdivide(\@line, $dist);

=cut
sub distdivide {
	my($line, $dist) = @_;
	$dist or croak("call to distdivide would cause divide by zero");
	my $ptA = NewVec(@{$line->[0]});
	my $ptB = NewVec(@{$line->[1]});
	my $seg = NewVec($ptB->Minus($ptA));
	my $length = $seg->Length();
	# optionally go for fewer points here?
	my $count = $length / $dist;
	$count = int($count);
	return(subdivide($line, $count));
} # end subroutine distdivide definition
########################################################################

=head2 subdivide

Returns a list of point references resulting from subdividing $line
into $count parts.  The list will be $count-1 items long, (does not
include $line->[0] and $line->[1]);

$line is of the form:  [ [x1, y1, z1], [x2, y2, z2] ] where z1 and z2
are optional.

  @points = subdivide($line, $count);

=cut
sub subdivide {
	my ($line, $count) = @_;
	$count || croak("cannot divide line into zero segments");
	my $ptA = NewVec(@{$line->[0]});
	my $ptB = NewVec(@{$line->[1]});
# 	print "line:  @$ptA -- @$ptB\n";
	my $seg = NewVec($ptB->Minus($ptA));
	my @points;
	for(my $st = 1; $st < $count; $st++) {
		push(@points, [$ptA->Plus( [ $seg->ScalarMult($st / $count) ] ) ] );
		}
	return(@points);
} # end subroutine subdivide definition
########################################################################

=head2 shorten_line

Shortens the line by the distances given in $lead and $tail.

  @line = shorten_line(\@line, $lead, $tail);

=cut
sub shorten_line {
	my ($line, $lead, $tail) = @_;
	my $ptA = NewVec(@{$line->[0]});
	my $ptB = NewVec(@{$line->[1]});
# 	print "line:  @$ptA -- @$ptB\n";
	my $seg = NewVec($ptB->Minus($ptA));
	my $len = $seg->Length();
	($lead + $tail >= $len) && return();
#        croak("CAD::Calc::shorten_line($lead, $tail)\n" .
#                "\t creates inverted line from length: $len\n");
	return(
		[$ptA->Plus([$seg->ScalarMult($lead / $len)])],
		[$ptB->Minus([$seg->ScalarMult($tail / $len)])],
		);
} # end subroutine shorten_line definition
########################################################################

=head2 dist

Returns the direct distance from ptA to ptB.

  dist($ptA, $ptB);

=cut
sub dist {
	my($ptA, $ptB) = @_;
	(ref($ptB) eq "ARRAY") || ($ptB = [0,0,0]);
	my $dist = sqrt(
		($ptB->[0] - $ptA->[0]) ** 2 +
		($ptB->[1] - $ptA->[1]) ** 2 +
		($ptB->[2] - $ptA->[2]) ** 2
		);
	return($dist);
} # end subroutine dist definition
########################################################################

=head2 dist2d

Purposefully ignores a z (2) coordinate.

  dist2d($ptA, $ptB);

=cut
sub dist2d {
	my($ptA, $ptB) = @_;
	# print "ref is: ", ref($ptB), "\n";
	# (ref($ptB) eq "ARRAY") || ($ptB = [0,0,0]);
	# XXX why was this ^-- here?!
	# print "ptB: @{$ptB}\n";
	my $dist = sqrt(
		($ptB->[0] - $ptA->[0]) ** 2 +
		($ptB->[1] - $ptA->[1]) ** 2
		);
	return($dist);
} # end subroutine dist2d definition
########################################################################

=head2 line_vec

Returns a Math::Vec object representing the vector from $ptA to $ptB
(which is actually a segment.)

  $vec = line_vec($ptA, $ptB);

=cut
sub line_vec {
	return(NewVec(signdist(@_)));
} # end subroutine line_vec definition
########################################################################

=head2 slope

Calculates the 2D slope between points @ptA and @ptB.  Slope is defined
as dy / dx (rise over run.)

If dx is 0, will return the string "inf", which Perl so kindly treats as
you would expect it to (except it doesn't like to answer the question
"what is infinity over infinity?") 5.8.? users: sorry, there seems to be
some regression here! (now we're using Math::BigFloat to return inf, so
rounding has to go through that)

  $slope = slope(\@ptA, \@ptB);

=cut
sub slope {
	my @line = @_;
	my @delta = map({$line[1][$_] - $line[0][$_]} 0..1);
	unless($delta[0]) {
		if($delta[1] > 0) {
			return(Math::BigFloat->binf());
		}
		else {
			return(Math::BigFloat->binf('-'));
		}
	}
	return($delta[1] / $delta[0]);
} # end subroutine slope definition
########################################################################

=head2 segs_as_transform

Allows two segments to specify transform data.

Returns: (\@translate, $rotate, $scale),

where:

@translate is a 2D array [$x, $y] basically describing segment @A

$rotate is the angular difference between $A[0]->$B[0] and $A[1]->$B[1]

$scale is the length of $A[1]->$B[1] divided by the length of
$A[0]->$B[0]

  my ($translate, $rotate, $scale) = segs_as_transform(\@A, \@B);

=cut
sub segs_as_transform {
	my ($A, $B) = @_;
	my $av = line_vec(@$A);
	# print_line($A);
	my $sd = line_vec($A->[0], $B->[0]);
	my $ed = line_vec($A->[1], $B->[1]);
	my $ang = $ed->Ang() - $sd->Ang();
	my $sl = $sd->Length();
	$sl or croak("no length for divisor\n");
	my $scale = $ed->Length() / $sl;
	return([$av->[0], $av->[1]], $ang, $scale);
} # end subroutine segs_as_transform definition
########################################################################

=head2 chevron_to_ray

Converts a chevron into a directional line by finding the midpoint
between the midpoints of each edge and connecting to the middle point.

  @line = chevron_to_ray(@pts);

=cut
sub chevron_to_ray {
	my (@pts) = @_;
	(scalar(@pts) == 3) or croak("chevron needs three points");
	my @mids;
	foreach my $seg (0,1) {
		($mids[$seg]) = subdivide([$pts[$seg], $pts[$seg+1]], 2);
	}
	my ($start) = subdivide(\@mids, 2);
	return($start, $pts[1]);
} # end subroutine chevron_to_ray definition
########################################################################

=head2 signdist

Returns the signed distance

  signdist(\@ptA, \@ptB);

=cut
sub signdist {
	my ($ptA, $ptB) = @_;
	my $b = NewVec(@{$ptB});
	return($b->Minus($ptA));
} # end subroutine signdist definition
########################################################################

=head2 offset

Creates a contour representing the offset of @polygon by $dist.
Positive distances are inward when @polygon is ccw.

  @polygons = offset(\@polygon, $dist);

=cut
sub offset {
	my ($polygon, $dist) = @_;
	# this gets the OffsetPolygon routine (which still needs work)
	my $helper = "Math::Geometry::Planar::Offset";
	eval("require $helper;");
	$@ and croak("cannot offset without $helper\n", $@);
	$helper->import('OffsetPolygon');
	my @pgons = OffsetPolygon($polygon, $dist);
	return(@pgons);
} # end subroutine offset definition
########################################################################

=head2 intersection_data

Calculates the two numerators and the denominator which are required
for various (seg-seg, line-line, ray-ray, seg-ray, line-ray, line-seg)
intersection calculations.

  ($k, $l, $d) = intersection_data(\@line, \@line);

=cut
sub intersection_data {
	my @l = @_;
	my $n1 = Determinant(
		$l[1][0][0]-$l[0][0][0],
		$l[1][0][0]-$l[1][1][0],
		$l[1][0][1]-$l[0][0][1],
		$l[1][0][1]-$l[1][1][1],
		);
	my $n2 = Determinant(
		$l[0][1][0]-$l[0][0][0],
		$l[1][0][0]-$l[0][0][0],
		$l[0][1][1]-$l[0][0][1],
		$l[1][0][1]-$l[0][0][1],
		);
	my $d  = Determinant(
		$l[0][1][0]-$l[0][0][0],
		$l[1][0][0]-$l[1][1][0],
		$l[0][1][1]-$l[0][0][1],
		$l[1][0][1]-$l[1][1][1],
		);
	return($n1, $n2, $d);

} # end subroutine intersection_data definition
########################################################################

=head2 line_intersection

Returns the intersection point of two lines.

  @pt = line_intersection(\@line, \@line, $tolerance);
  @pt or die "no intersection";

If tolerance is defined, it will be used to sprintf the parallel factor.
Beware of this, it is clunky and might change if I come up with
something better.

=cut
sub line_intersection {
	my @l = (shift, shift);
	my ($tol) = @_;
	foreach my $should (0,1) {
		# print "should have $should\n";
		# print $l[$should], "\n";
		(ref($l[$should]) eq "ARRAY") or warn "not good\n";
	}
	my ($n1, $n2, $d) = intersection_data(@l);
	## print "d: $d\n";
	if(defined($tol)) {
		$d = sprintf("%0.${tol}f", $d);
	}
	if($d == 0) {
		# print "parallel!\n";
		return(); # parallel
	}
	my @pt = (
		$l[0][0][0] + $n1 / $d * ($l[0][1][0] - $l[0][0][0]),
		$l[0][0][1] + $n1 / $d * ($l[0][1][1] - $l[0][0][1]),
		);
#    print "got point: @pt\n";
	return(@pt);
} # end subroutine line_intersection definition
########################################################################

=head2 seg_line_intersection

Finds the intersection of @segment and @line.

  my @pt = seg_line_intersection(\@segment, \@line);
  @pt or die "no intersection";
  unless(defined($pt[1])) {
    die "lines are parallel";
  }

=cut
sub seg_line_intersection {
	my (@l) = @_;
	my ($n1, $n2, $d) = intersection_data(@l);
	# XXX not consistent with line_intersection function
	if(sprintf("%0.9f", $d) == 0) {
		return(0); # lines are parallel
	}
	if( ! (($n1/$d <= 1) && ($n1/$d >=0)) ) {
		return(); # no intersection on segment
	}
	my @pt = (
		$l[0][0][0] + $n1 / $d * ($l[0][1][0] - $l[0][0][0]),
		$l[0][0][1] + $n1 / $d * ($l[0][1][1] - $l[0][0][1]),
		);
	return(@pt);
} # end subroutine seg_line_intersection definition
########################################################################

=head2 seg_seg_intersection

  my @pt = seg_seg_intersection(\@segmenta, \@segmentb);

=cut
sub seg_seg_intersection {
	my (@l) = @_;
	my ($n1, $n2, $d) = intersection_data(@l);
	# print "data $n1, $n2, $d\n";
	if(sprintf("%0.9f", $d) == 0) {
		return(0); # lines are parallel
	}
	if( ! ((sprintf("%0.9f", $n1/$d) <= 1) && (sprintf("%0.9f", $n1/$d) >=0)) ) {
		# warn("n1/d is ", $n1/$d);
		return(); # no intersection on segment a
	}
	if( ! ((sprintf("%0.9f", $n2/$d) <= 1) && (sprintf("%0.9f", $n2/$d) >=0)) ) {
		# warn("n2/d is ", $n2/$d);
		return(); # no intersection on segment b
	}
	my @pt = (
		$l[0][0][0] + $n1 / $d * ($l[0][1][0] - $l[0][0][0]),
		$l[0][0][1] + $n1 / $d * ($l[0][1][1] - $l[0][0][1]),
		);
	return(@pt);
} # end subroutine seg_seg_intersection definition
########################################################################

=head2 line_ray_intersection

Intersects @line with @ray, where $ray[1] is the direction of the
infinite ray.

  line_ray_intersection(\@line, \@ray);

=cut
sub line_ray_intersection {
	my (@l) = @_;
	my ($n1, $n2, $d) = intersection_data(@l);
	# $n1 is distance along segment (must be between 0 and 1)
	# $n2 is distance along ray (must be greater than 0)
	if(sprintf("%0.9f", $d) == 0) {
#        print "parallel\n";
		return(0); # lines are parallel
	}
	# same as seg_ray_intersection(), but we skip the segment check
	if($n2 / $d < 0) {
#        print "nothing on ray\n";
		# segment intersects behind ray
		return();
	}
	my @pt = (
		$l[0][0][0] + $n1 / $d * ($l[0][1][0] - $l[0][0][0]),
		$l[0][0][1] + $n1 / $d * ($l[0][1][1] - $l[0][0][1]),
		);
	return(@pt);
} # end subroutine line_ray_intersection definition
########################################################################

=head2 seg_ray_intersection

Intersects @seg with @ray, where $ray[1] is the direction of the
infinite ray.

  seg_ray_intersection(\@seg, \@ray);

=cut
sub seg_ray_intersection {
	my (@l) = @_;
	my ($n1, $n2, $d) = intersection_data(@l);
	# $n1 is distance along segment (must be between 0 and 1)
	# $n2 is distance along ray (must be greater than 0)
	if(sprintf("%0.9f", $d) == 0) {
#        print "parallel\n";
		return(0); # lines are parallel
	}
	if( ! (($n1/$d <= 1) && ($n1/$d >=0)) ) {
#        print "nothing on segment\n";
		return(); # no intersection on segment
	}
	if($n2 / $d < 0) {
#        print "nothing on ray\n";
		# segment intersects behind ray
		return();
	}
	my @pt = (
		$l[0][0][0] + $n1 / $d * ($l[0][1][0] - $l[0][0][0]),
		$l[0][0][1] + $n1 / $d * ($l[0][1][1] - $l[0][0][1]),
		);
	return(@pt);

} # end subroutine seg_ray_intersection definition
########################################################################

=head2 ray_pgon_int_index

Returns the first (lowest) index of @polygon which has a segment
intersected by @ray.

  $index = ray_pgon_int_index(\@ray, \@polygon);

=cut
sub ray_pgon_int_index {
	my ($ray, $pgon) = @_;
	(scalar(@$ray) == 2) or croak("not a ray");
	for(my $e = 0; $e < @$pgon; $e++) {
		my $n = $e + 1;
		($n > $#$pgon) && ($n -= @$pgon);
		my $seg = [$pgon->[$e], $pgon->[$n]];
		my @int = seg_ray_intersection($seg, $ray);
		if(defined($int[1])) {
			# print "intersect @int\n";
			return($e);
		}
	}
	return();
} # end subroutine ray_pgon_int_index definition
########################################################################

=head2 ray_pgon_closest_index

Returns the closest (according to dist2d) index of @polygon which has a
segment intersected by @ray.

  $index = ray_pgon_closest_index(\@ray, \@polygon);

=cut
sub ray_pgon_closest_index {
	my ($ray, $pgon) = @_;
	(scalar(@$ray) == 2) or croak("not a ray");
	my @found;
	for(my $e = 0; $e < @$pgon; $e++) {
		my $n = $e + 1;
		($n > $#$pgon) && ($n -= @$pgon);
		my $seg = [$pgon->[$e], $pgon->[$n]];
		my @int = seg_ray_intersection($seg, $ray);
		if(defined($int[1])) {
			# print "intersect @int\n";
			push(@found, [$e, dist2d($ray->[0], \@int)]);
		}
	}
	if(@found) {
		my $least = (sort({$a->[1] <=> $b->[1]} @found))[0];
		return($least->[0]);
	}
	else {
		return();
	}
} # end subroutine ray_pgon_closest_index definition
########################################################################

=head2 perp_through_point

  @line = perp_through_point(\@pt, \@line);

=cut
sub perp_through_point {
	my ($pt, $seg) = @_;
	my @nv = ( # normal vector:
		$seg->[1][1] - $seg->[0][1],
		- ($seg->[1][0] - $seg->[0][0]),
		);
	my @ep = ( # end point of ray
		$pt->[0] + $nv[0],
		$pt->[1] + $nv[1],
		);
	return($pt, \@ep);
} # end subroutine perp_through_point definition
########################################################################

=head2 foot_on_line

  @pt = foot_on_line(\@pt, \@line);

=cut
sub foot_on_line {
	my ($pt, $seg) = @_;
	return(line_intersection($seg, [perp_through_point($pt, $seg)]));
} # end subroutine foot_on_line definition
########################################################################

=head2 foot_on_segment

Returns the perpendicular foot of @pt on @seg.  See seg_ray_intersection.

  @pt = foot_on_segment(\@pt, \@seg);

=cut
sub foot_on_segment {
	my ($pt, $seg) = @_;
	return(seg_line_intersection($seg, [perp_through_point($pt, $seg)]));
} # end subroutine foot_on_segment definition
########################################################################

=head2 Determinant

  Determinant($x1, $y1, $x2, $y2);

=cut
sub Determinant {
	my ($x1,$y1,$x2,$y2) = @_;
	return($x1*$y2 - $x2*$y1);
} # end subroutine Determinant definition
########################################################################

=head2 pgon_as_segs

Returns a list of [[@ptA],[@ptB]] segments representing the edges of
@pgon, where segment "0" is from $pgon[0] to $pgon[1]

  @segs = pgon_as_segs(@pgon);

=cut
sub pgon_as_segs {
	my (@pgon) = @_;
	my @segs = ([])x scalar(@pgon);
	for(my $i = -1; $i < $#pgon; $i++) {
		$segs[$i] = [@pgon[$i, $i+1]];
	}
	return(@segs);
} # end subroutine pgon_as_segs definition
########################################################################

=head2 pgon_area

Returns the area of @polygon.  Returns a negative number for clockwise
polygons.

  $area = pgon_area(@polygon);

=cut
sub pgon_area {
	my @pgon = @_;
	(@pgon > 2) or return();
	my $atmp = 0;
	for(my $i = -1; $i < $#pgon; $i++) {
		my $j = $i+1;
		my ($xi, $yi) = @{$pgon[$i]};
		my ($xj, $yj) = @{$pgon[$j]};
		$atmp += $xi * $yj - $xj * $yi;
	}
	$atmp or return(); # no area
	return($atmp / 2);
} # end subroutine pgon_area definition
########################################################################

=head2 pgon_centroid

  @centroid = pgon_centroid(@polygon);

=cut
sub pgon_centroid {
	my @pgon = @_;
	(@pgon > 2) or return();
	my $atmp = 0;
	my $xtmp = 0;
	my $ytmp = 0;
	for(my $i = -1; $i < $#pgon; $i++) {
		my $j = $i+1;
		my ($xi, $yi) = @{$pgon[$i]};
		my ($xj, $yj) = @{$pgon[$j]};
		my $ai = $xi * $yj - $xj * $yi;
		$atmp += $ai;
		$xtmp += ($xj + $xi) * $ai;
		$ytmp += ($yj + $yi) * $ai;
	}
	$atmp or return(); # no area
	my $area = $atmp / 2;
	return($xtmp / (3 * $atmp), $ytmp / (3 * $atmp));
} # end subroutine pgon_centroid definition
########################################################################

=head2 pgon_lengths

  @lengths = pgon_lengths(@pgon);

=cut
sub pgon_lengths {
	my (@points) = @_;
	my @lengths = (0) x scalar(@points);
	for(my $i = -1; $i < $#points; $i++) {
		$lengths[$i] = dist2d(@points[$i, $i+1]);
	}
	return(@lengths);
} # end subroutine pgon_lengths definition
########################################################################

=head2 pgon_angles

Returns the angle of each edge of polygon in xy plane.  These fall
between -$pi and +$pi due to the fact that it is basically just a call
to the atan2() builtin.

Edges are numbered according to the index of the point which starts
the edge.

  @angles = pgon_angles(@points);

=cut
sub pgon_angles {
	my (@points)  = @_;
	my @angles = (0) x scalar(@points);
	# print "number of angles: @angles\n";
	for(my $i = -1; $i < $#points; $i++) {
		my $vec = NewVec(signdist(@points[$i, $i+1]));
		$angles[$i] = $vec->Ang();
	}
	return(@angles);
} # end subroutine pgon_angles definition
########################################################################

=head2 pgon_deltas

Returns the differences between the angles of each edge of @polygon.
These will be indexed according to the point at which they occur, and
will be positive radians for ccw angles.  Summing the @deltas will yield
+/-2pi (negative for cw polygons.)

  @deltas = pgon_deltas(@pgon);

=cut
sub pgon_deltas {
	my (@pts) = @_;
	my @angles = pgon_angles(@pts);
	return(ang_deltas(@angles));
} # end subroutine pgon_deltas definition
########################################################################

=head2 ang_deltas

Returns the same thing as pgon_deltas, but saves a redundant call to
pgon_angles.

  my @angs = pgon_angles(@pts);
  my @dels = ang_deltas(@angs);

=cut
sub ang_deltas {
	my (@angs) = @_;
	my @deltas = (0)x $#angs;
	for(my $i = 0; $i < @angs; $i++) {
		my $ang = angle_reduce($angs[$i] - $angs[$i-1]);
		$deltas[$i] = $ang;
	}
	return(@deltas);
} # end subroutine ang_deltas definition
########################################################################

=head2 pgon_direction

Returns 1 for counterclockwise and 0 for clockwise.  Uses the sum of the
differences of angles of @polygon.  If this sum is less than 0, the
polygon is clockwise.

  $ang_sum = pgon_direction(@polygon);

=cut
sub pgon_direction {
	my (@pgon) = @_;
	my @angs = pgon_deltas(@pgon);
	return(angs_direction(@angs));
} # end subroutine pgon_direction definition
########################################################################

=head2 angs_direction

Returns the same thing as pgon_direction, but saves a redundant call to
pgon_deltas.

  my @angs = pgon_deltas(@pgon);
  my $dir = angs_direction(@angs);

=cut
sub angs_direction {
	my (@angs) = @_;
	my $sum = 0;
	foreach my $ang (@angs) {
		$sum+= $ang;
	}
	return($sum > 0);
} # end subroutine angs_direction definition
########################################################################

=head2 pgon_bisectors

  pgon_bisectors();

=cut
sub pgon_bisectors {
	warn "unfinished";
	croak "finish it";
} # end subroutine pgon_bisectors definition
########################################################################

=head2 sort_pgons_lr

Sorts polygons by their average points returning a list which reads from
left to right.  (Rather odd place for this?)

  @pgons = sort_pgons_lr(@pgons);

=cut
sub sort_pgons_lr {
	my @pgons = @_;
	# no sense calculating all for naught:
	(scalar(@pgons) > 1) || return(@pgons);
	my @avg;
	foreach my $pgon (@pgons) {
		push(@avg, [point_avg(@$pgon)]);
	}
	my @ord = sort({$avg[$a][0] <=> $avg[$b][0]} 0..$#avg);
	return(@pgons[@ord]);
} # end subroutine sort_pgons_lr definition
########################################################################

=head2 pgon_start_index

Returns the index of pgon which is at the "lowest left".

  $i = pgon_start_index(@pgon);

=cut
sub pgon_start_index {
	my @pgon = @_;
	my @ordered = sort({
		my $c;
		$c = $pgon[$a][$_] <=> $pgon[$b][$_] and return $c for 0..1;
	} 0..$#pgon);
	# print "index order @ordered\n";
	return($ordered[0]);
} # end subroutine pgon_start_index definition
########################################################################

=head2 pgon_start_indexb

Returns the index of pgon which is at the "lowest left".

Different method (is it faster?)

  $i = pgon_start_indexb(@pgon);

=cut
sub pgon_start_indexb {
	my @pgon = @_;
	my %sort_hash;
	for(my $c = 0; $c < @pgon; $c++) {
		# this is still janky, should really do something about slope?
		my @pt = map({sprintf("%0.2f", $_)} @{$pgon[$c]});
		$sort_hash{$pt[0]}{$pt[1]} = $c;
	}
	my ($least_x) = sort({$a <=> $b} keys(%sort_hash));
	my ($least_y) = sort({$a <=> $b} keys(%{$sort_hash{$least_x}}));
	my $index = $sort_hash{$least_x}{$least_y};
	return($index);
} # end subroutine pgon_start_indexb definition
########################################################################

=head2 pgon_start_index_z

Yet another different method (is this even correct?)

  pgon_start_index_z();

=cut
sub pgon_start_index_z {
	my @pgon = @_;
	# use the quarter-length
	my @minmax = (sort({$a <=> $b} map({$_->[0]} @pgon)))[0,-1];
	my $x_fourth = $minmax[0] + ($minmax[1] - $minmax[0]) / 4;
	my @contend;
	for(my $i = 0; $i < @pgon; $i++) {
		if($pgon[$i][0] < $x_fourth) {
			push(@contend, $i);
		}
	}
	# print scalar(@contend), " contenders\n";
	my @ordered = sort({$pgon[$a][1] <=> $pgon[$b][1]} @contend);
	# to be even more thorough:
	my @yminmax = (sort({$a <=> $b} map({$_->[1]} @pgon)))[0,-1];
	# quantify with 1/4 of the yspan:
	my $yspan = ($yminmax[1] - $yminmax[0]) / 4;
	my $choice = shift(@ordered);
	foreach my $idx (@ordered) {
		# if it is below and left, then we already have it, if it above
		# and left, then we might want it
		if($pgon[$idx][1] < ($pgon[$choice][1] + $yspan)) {
			($pgon[$idx][0] < $pgon[$choice][0]) and ($choice = $idx);
		}
	}
	return($choice);
} # end subroutine pgon_start_index_z definition
########################################################################

=head2 re_order_pgon

Imposes counter-clockwise from "lower-left" ordering.

  @pgon = re_order_pgon(@pgon);

=cut
sub re_order_pgon {
	my @pgon = @_;
	unless(pgon_direction(@pgon)) {
		@pgon = reverse(@pgon);
	}
	my $index = pgon_start_index_z(@pgon);
	return(order_pgon($index, \@pgon));
} # end subroutine re_order_pgon definition
########################################################################

=head2 order_pgon

Rewinds the polygon (e.g. list) to the specified $start index.  This is
not restricted to polygons (just continuous (looped) lists.)

  @pgon = order_pgon($start, \@pgon);

=cut
sub order_pgon {
	my $index = shift;
	my $pg = shift;
	my @pgon = @{$pg};
	($index < 0) and ($index += @pgon);
	my @new;
	for(my $d = 0; $d < @pgon; $d++) {
		my $i = $index + $d;
		($i > $#pgon) and ($i -= @pgon);
		# print "using $i\n";
		push(@new, $pgon[$i]);
	}
	return(@new);
} # end subroutine order_pgon definition
########################################################################

=head2 shift_line

Shifts line to right or left by $distance.

  @line = shift_line(\@line, $distance, right|left);

=cut
sub shift_line {
	my ($line, $dist, $dir) = @_;
	my @line = @$line;
	my $mvec;
	if($dir eq "left") {
		$mvec = unitleft(@line);
	}
	elsif($dir eq "right") {
		$mvec = unitright(@line);
	}
	else {
		croak ("direction must be \"left\" or \"right\"\n");
	}
	$mvec = NewVec($mvec->ScalarMult($dist));
	my @newline = map({[$mvec->Plus($_)]} @line);
	return(@newline);
} # end subroutine shift_line definition
########################################################################

=head2 line_to_rectangle

Creates a rectangle, centered about @line.

  my @rec = line_to_rectangle(\@line, $offset, \%options);

The direction of the returned points will be counter-clockwise around
the original line, with the first point at the 'lower-left' (e.g. if
your line points up, $rec[0] will be below and to the left of
$line[0].)

Available options

  ends => 1|0,   # extend endpoints by $offset (default = 1)

=cut
sub line_to_rectangle {
	my ($ln, $offset, $opts) = @_;
	my %options = (ends => 1);
	(ref($opts) eq "HASH") && (%options = %$opts);
	my @line = @$ln;
	($offset > 0) or
		croak "offset ($offset) must be positive non-zero\n";
	my $a = NewVec(@{$line[0]});
	my $b = NewVec(@{$line[1]});
	# unit vector of line
	my $vec = NewVec(NewVec($b->Minus($a))->UnitVector());
	# crossed with unit vector make unit vector left
	my $perp = NewVec($vec->Cross([0,0,-1]));
	my ($back, $forth);
	if($options{ends}) {
		$back = NewVec($a->Minus([$vec->ScalarMult($offset)]));
		$forth = NewVec($b->Plus([$vec->ScalarMult($offset)]));
	}
	else {
		$back = $a;
		$forth = $b;
	}
	my $left = NewVec($perp->ScalarMult($offset));
	my $right = NewVec($perp->ScalarMult(-$offset));
	# upper and lower here only mean anything
	#  if line originally pointed "up"
	my @ll = $back->Plus($left);
	my @lr = $back->Plus($right);
	my @ur = $forth->Plus($right);
	my @ul = $forth->Plus($left);
	return(\@ll, \@lr, \@ur, \@ul);
} # end subroutine line_to_rectangle definition
########################################################################

=head2 isleft

Returns true if @point is left of @line.

  $bool = isleft(\@line, \@point);

=cut
sub isleft {
	my ($line, $pt) = @_;
	my $how = howleft($line, $pt);
	return($how > 0);
} # end subroutine isleft definition
########################################################################

=head2 howleft

Returns positive if @point is left of @line.

  $number = howleft(\@line, \@point);

=cut
sub howleft {
	my ($line, $pt) = @_;
	my $isleft = ($line->[1][0] - $line->[0][0]) *
					($pt->[1] - $line->[0][1]) -
				 ($line->[1][1] - $line->[0][1]) *
				 	($pt->[0] - $line->[0][0]);
	return($isleft);
} # end subroutine howleft definition
########################################################################

=head2 iswithin

Returns true if @pt is within the polygon @bound.  This will be negative
for clockwise input.

  $fact = iswithin(\@bound, \@pt);

=cut
sub iswithin {
	my ($bnd, $pt) = @_;
	my $winding = 0;
	my @bound = @$bnd;
	for(my $n = -1; $n < $#bound; $n ++) {
		my $next = $n+1;
		my @seg = ($bound[$n], $bound[$next]);
		my $isleft = howleft(\@seg, $pt);
		if($seg[0][1] <= $pt->[1]) {
			if($seg[1][1] > $pt->[1]) {
				($isleft > 0) && $winding++;
#                print "winding up\n";
			}
		}
		elsif($seg[1][1] <= $pt->[1]) {
			($isleft < 0) && $winding--;
#                print "winding up\n";
		}
	} # end for $n
#    print "winding is $winding\n";
	return($winding);
} # end subroutine iswithin definition
########################################################################

=head2 iswithinc

Seems to be consistently much faster than the typical winding-number
iswithin.  The true return value is always positive regardless of the
polygon's direction.

  $fact = iswithinc(\@bound, \@pt);

=cut
sub iswithinc {
	my ($bnd, $pt) = @_;
	my $c = 0;
	my @bound = @$bnd;
	my ($x, $y) = @$pt;
	# straight from the comp.graphics.algorithms faq:
	for (my $i = 0, my $j = $#bound; $i < @bound; $j = $i++) {
#        print "checking from $j to $i\n";
		(((($bound[$i][1]<=$y) && ($y<$bound[$j][1])) ||
			(($bound[$j][1]<=$y) && ($y<$bound[$i][1]))) &&
			($x < ($bound[$j][0] - $bound[$i][0]) * ($y - $bound[$i][1]) / ($bound[$j][1] - $bound[$i][1]) + $bound[$i][0]))
			and ($c = !$c);
	}
	return($c);
} # end subroutine iswithinc definition
########################################################################

=head2 unitleft

Returns a unit vector which is perpendicular and to the left of @line.
Purposefully ignores any z-coordinates.

  $vec = unitleft(@line);

=cut
sub unitleft {
	my (@line) = @_;
	my $ln = NewVec(
			NewVec(@{$line[1]}[0,1])->Minus([@{$line[0]}[0,1]])
			);
	$ln = NewVec($ln->UnitVector());
	my $left = NewVec($ln->Cross([0,0,-1]));
	## my $isleft = isleft(\@line, [$left->Plus($line[0])]);
	## print "fact said $isleft\n";
	return($left);
} # end subroutine unitleft definition
########################################################################

=head2 unitright

Negative of unitleft().

  $vec = unitright(@line);

=cut
sub unitright {
	my $vec = unitleft(@_);
	$vec = NewVec($vec->ScalarMult(-1));
	return($vec);
} # end subroutine unitright definition
########################################################################

=head2 unit_angle

Returns a Math::Vec vector which has a length of one at angle $ang (in
the XY plane.) $ang is fed through angle_parse().

  $vec = unit_angle($ang);

=cut
sub unit_angle {
	my ($ang) = @_;
	$ang = angle_parse($ang);
	my $x = cos($ang);
	my $y = sin($ang);
	return(NewVec($x, $y));
} # end subroutine unit_angle definition
########################################################################

=head2 angle_reduce

Reduces $ang (in radians) to be between -pi and +pi.

  $ang = angle_reduce($ang);

=cut
sub angle_reduce {
	my $ang = shift;
	while($ang > $pi) {
		$ang -= 2*$pi;
	}
	while($ang <= -$pi) {
		$ang += 2*$pi;
	}
	return($ang);
} # end subroutine angle_reduce definition
########################################################################

=head2 angle_parse

Parses the variable $ang and returns a variable in radians.  To convert
degrees to radians: $rad = angle_parse($deg . "d")

  $rad = angle_parse($ang);

=cut
sub angle_parse {
	my $ang = shift;
	if($ang =~ s/d$//) {
		$ang *= $pi / 180;
	}
	return($ang);
} # end subroutine angle_parse definition
########################################################################

=head2 angle_quadrant

Returns the index of the quadrant which contains $angle.  $angle is in
radians.

  $q = angle_quadrant($angle);
  @syms = qw(I II III IV);
  print "angle is in quadrant: $syms[$q]\n";

=cut
sub angle_quadrant {
	my $ang = shift;
	my $x = cos($ang);
	my $y = sin($ang);
	my $vert = ($x < 0);
	my $hori = ($y < 0);
	my @list = (
		[0,3],
		[1,2],
		);
	return($list[$vert][$hori]);
} # end subroutine angle_quadrant definition
########################################################################

=head2 collinear

  $fact = collinear(\@pt1, \@pt2, \@pt3);

=cut
sub collinear {
	my @pts = @_;
	(@pts == 3) or croak("must call with 3 points");
	my ($pta, $ptb, $ptc) = @pts;
	my $va = line_vec($pta, $ptb);
	my $vb = line_vec($ptb, $ptc);
	my $cp = NewVec($va->Cross($vb));
	my $ta = $cp->Length();
#    print "my vectors: @$va\n@$vb\n@$cp\n";
#    print "angs: ", $va->Ang(), " and ", $vb->Ang(), "\n";
#    print "ta: $ta\n";
	return(abs($ta) < 0.001);
} # end subroutine collinear definition
########################################################################

=head2 triangle_angles

Calculates the angles of a triangle based on it's lengths.

  @angles = triangle_angles(@lengths);

The order of the returned angle will be "the angle before the edge".

=cut
sub triangle_angles {
	my @len = @_;
	(@len == 3) or croak("triangle must have 3 sides");
	my @angs = (
		acos(
			($len[2]**2 + $len[0]**2 - $len[1]**2) /
			(2 * $len[2] * $len[0])
			),
		acos(
			($len[1]**2 + $len[0]**2 - $len[2]**2) /
			(2 * $len[1] * $len[0])
			),
		);
	$angs[2] = $pi - $angs[0] - $angs[1];
	print "angs: @angs\n";
} # end subroutine triangle_angles definition
########################################################################

=head2 stringify

Turns point into a string rounded according to $rnd.  The optional
$count allows you to specify how many coordinates to use.

  $string = stringify(\@pt, $rnd, $count);

=cut
sub stringify {
	my ($pt, $rnd, $count) = @_;
	# FIXME: # rounding should be able to do fancier things here:
	unless(defined($count)) {
		$count = scalar(@{$pt});
	}
	my $top = $count - 1;
	my $str = join(",",
		map( {sprintf("%0.${rnd}f", $_)} @{$pt}[0..$top]) );
	return($str);

} # end subroutine stringify definition
########################################################################

=head2 stringify_line

Turns a line (or polyline) into a string.  See stringify().

  stringify_line(\@line, $char, $rnd, $count);

=cut
sub stringify_line {
	my ($line, $char, $rnd, $count) = @_;
	defined($char) or ($char = "\n");
	defined($rnd) or ($rnd = 2);
	defined($count) or ($count = 2);
	return(join($char, map({stringify($_, $rnd, $count)} @$line)));
} # end subroutine stringify_line definition
########################################################################

=head2 pol_to_cart

Convert from polar to cartesian coordinates.

  my ($x, $y, $z) = pol_to_cart($radius, $theta, $z);

=cut
sub pol_to_cart {
	my ($r, $th, $z) = @_;
	my $x = $r * cos($th);
	my $y = $r * sin($th);
	return($x, $y, $z);
} # end subroutine pol_to_cart definition
########################################################################

=head2 cart_to_pol

Convert from polar to cartesian coordinates.

  my ($radius, $theta, $z) = cart_to_pol($x, $y, $z);

=cut
sub cart_to_pol {
	my ($x, $y, $z) = @_;
	my $r = sqrt($x**2 + $y**2);
	my $th = atan2($y, $x);
	return($r, $th, $z);
} # end subroutine cart_to_pol definition
########################################################################

=head2 print_line

  print_line(\@line, $message);

=cut
sub print_line {
	my ($line, $message) = @_;
	unless($message) {
		$message = "line:";
	}
	print join("\n\t", $message,
		map({join(" ", @$_)} @$line)), "\n";
} # end subroutine print_line definition
########################################################################

=head2 point_avg

Averages the x and y coordinates of a list of points.

	my ($x, $y) = point_avg(@points);

=cut
sub point_avg {
	my(@points) = @_;
	my $i;
	my $num = scalar(@points);
	my $x_avg = 0;
	my $y_avg = 0;
	# print "num is $num\n";
	for($i = 0; $i < $num; $i++) {
		# print "point: $points[$i][0]\n";
		$x_avg += $points[$i][0];
		$y_avg += $points[$i][1];
		}
	# print "avgs:  $x_avg $y_avg\n";
	$x_avg = $x_avg / $num;
	$y_avg = $y_avg / $num;
	return($x_avg, $y_avg);
} # end subroutine point_avg definition

=head2 arc_2pt

Given a pair of endpoints and an angle (in radians), returns an arc with
center, radius, and start/end angles.

  my %arc = arc_2pt(\@pts, $angle);

=cut
sub arc_2pt {
	my ($pts, $angle) = @_;
	my $dir = (($angle >= 0) ? 1 : -1);
	$angle = abs($angle);
	my %arc;
	my $chord = V(@{$pts->[1]}) - $pts->[0];
	my $clen = abs($chord);
	# warn "chord: $chord\n";
	# warn "chord length: $clen\n";
	my $eps = $angle /4;
	(cos($eps) == 0) and die "ack";
	my $blg = sin($eps)/cos($eps);
	my $s = $clen / 2 * $blg;
	my $r = (($clen/2)**2 + $s**2) / (2 * $s);
	## warn "radius: $r\n";
	## my $mid = $pts->[1] + $chord / 2;
	my $gamma = (pi - $angle) / 2;
	## warn "gamma: $gamma\n";
	my $cang = $chord->Ang;
	my $phi = $cang + $dir * $gamma;
	## warn "phi: $phi\n";
	my $conn = V(pol_to_cart($r, $phi));
	my $center = $pts->[0] + $conn;
	## warn "center: $center\n";
	$arc{pt} = [@$center[0,1]];
	$arc{rad} = $r;
	$arc{angs} = [
		(- $conn)->Ang,
		($pts->[1] - $center)->Ang
		];
	($dir > 0) or ($arc{angs} = [reverse(@{$arc{angs}})]);
	$arc{direction} = $dir;
	return(%arc);
} # end subroutine arc_2pt definition
########################################################################

1;