view release on metacpan or  search on metacpan

lib/CAD/Calc.pm  view on Meta::CPAN

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]) * 

lib/CAD/Calc.pm  view on Meta::CPAN

} # 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;