mirror of
https://github.com/SoftFever/OrcaSlicer.git
synced 2025-07-12 01:07:57 -06:00
Reduced the content of Geometry.pm, removed unused Perl subroutines.
Reduced the use Slic3r::Geometry and use Slic3r::Geometry::Clipper clauses to only reference used subroutines.
This commit is contained in:
bubnikv
parent
2c82a327dd
commit
81823fe7df
21 changed files with 51 additions and 437 deletions
|
|
@ -4,25 +4,32 @@ use warnings;
|
|||
|
||||
require Exporter;
|
||||
our @ISA = qw(Exporter);
|
||||
our @EXPORT_OK = qw(
|
||||
PI X Y Z A B X1 Y1 X2 Y2 Z1 Z2 MIN MAX epsilon slope
|
||||
line_point_belongs_to_segment points_coincide distance_between_points
|
||||
normalize tan move_points_3D
|
||||
point_in_polygon point_in_segment segment_in_segment
|
||||
polyline_lines polygon_lines
|
||||
point_along_segment polygon_segment_having_point polygon_has_subsegment
|
||||
deg2rad rad2deg
|
||||
rotate_points move_points
|
||||
dot perp
|
||||
line_intersection bounding_box bounding_box_intersect
|
||||
angle3points
|
||||
chained_path chained_path_from collinear scale unscale
|
||||
rad2deg_dir bounding_box_center line_intersects_any douglas_peucker
|
||||
polyline_remove_short_segments normal triangle_normal polygon_is_convex
|
||||
scaled_epsilon bounding_box_3D size_3D size_2D
|
||||
convex_hull directions_parallel directions_parallel_within
|
||||
);
|
||||
|
||||
# Exported by this module. The last section starting with convex_hull is exported by Geometry.xsp
|
||||
our @EXPORT_OK = qw(
|
||||
PI epsilon
|
||||
|
||||
angle3points
|
||||
collinear
|
||||
dot
|
||||
line_intersection
|
||||
normalize
|
||||
point_in_segment
|
||||
polyline_lines
|
||||
polygon_is_convex
|
||||
polygon_segment_having_point
|
||||
scale
|
||||
unscale
|
||||
scaled_epsilon
|
||||
size_2D
|
||||
|
||||
X Y Z
|
||||
convex_hull
|
||||
chained_path_from
|
||||
deg2rad
|
||||
rad2deg
|
||||
rad2deg_dir
|
||||
);
|
||||
|
||||
use constant PI => 4 * atan2(1, 1);
|
||||
use constant A => 0;
|
||||
|
|
@ -31,11 +38,6 @@ use constant X1 => 0;
|
|||
use constant Y1 => 1;
|
||||
use constant X2 => 2;
|
||||
use constant Y2 => 3;
|
||||
use constant Z1 => 4;
|
||||
use constant Z2 => 5;
|
||||
use constant MIN => 0;
|
||||
use constant MAX => 1;
|
||||
our $parallel_degrees_limit = abs(deg2rad(0.1));
|
||||
|
||||
sub epsilon () { 1E-4 }
|
||||
sub scaled_epsilon () { epsilon / &Slic3r::SCALING_FACTOR }
|
||||
|
|
@ -43,81 +45,7 @@ sub scaled_epsilon () { epsilon / &Slic3r::SCALING_FACTOR }
|
|||
sub scale ($) { $_[0] / &Slic3r::SCALING_FACTOR }
|
||||
sub unscale ($) { $_[0] * &Slic3r::SCALING_FACTOR }
|
||||
|
||||
sub tan {
|
||||
my ($angle) = @_;
|
||||
return (sin $angle) / (cos $angle);
|
||||
}
|
||||
|
||||
sub slope {
|
||||
my ($line) = @_;
|
||||
return undef if abs($line->[B][X] - $line->[A][X]) < epsilon; # line is vertical
|
||||
return ($line->[B][Y] - $line->[A][Y]) / ($line->[B][X] - $line->[A][X]);
|
||||
}
|
||||
|
||||
# this subroutine checks whether a given point may belong to a given
|
||||
# segment given the hypothesis that it belongs to the line containing
|
||||
# the segment
|
||||
sub line_point_belongs_to_segment {
|
||||
my ($point, $segment) = @_;
|
||||
|
||||
#printf " checking whether %f,%f may belong to segment %f,%f - %f,%f\n",
|
||||
# @$point, map @$_, @$segment;
|
||||
|
||||
my @segment_extents = (
|
||||
[ sort { $a <=> $b } map $_->[X], @$segment ],
|
||||
[ sort { $a <=> $b } map $_->[Y], @$segment ],
|
||||
);
|
||||
|
||||
return 0 if $point->[X] < ($segment_extents[X][0] - epsilon) || $point->[X] > ($segment_extents[X][1] + epsilon);
|
||||
return 0 if $point->[Y] < ($segment_extents[Y][0] - epsilon) || $point->[Y] > ($segment_extents[Y][1] + epsilon);
|
||||
return 1;
|
||||
}
|
||||
|
||||
sub points_coincide {
|
||||
my ($p1, $p2) = @_;
|
||||
return 1 if abs($p2->[X] - $p1->[X]) < epsilon && abs($p2->[Y] - $p1->[Y]) < epsilon;
|
||||
return 0;
|
||||
}
|
||||
|
||||
sub distance_between_points {
|
||||
my ($p1, $p2) = @_;
|
||||
return sqrt((($p1->[X] - $p2->[X])**2) + ($p1->[Y] - $p2->[Y])**2);
|
||||
}
|
||||
|
||||
# this will check whether a point is in a polygon regardless of polygon orientation
|
||||
sub point_in_polygon {
|
||||
my ($point, $polygon) = @_;
|
||||
|
||||
my ($x, $y) = @$point;
|
||||
my $n = @$polygon;
|
||||
my @x = map $_->[X], @$polygon;
|
||||
my @y = map $_->[Y], @$polygon;
|
||||
|
||||
# Derived from the comp.graphics.algorithms FAQ,
|
||||
# courtesy of Wm. Randolph Franklin
|
||||
my ($i, $j);
|
||||
my $side = 0; # 0 = outside; 1 = inside
|
||||
for ($i = 0, $j = $n - 1; $i < $n; $j = $i++) {
|
||||
if (
|
||||
# If the y is between the (y-) borders...
|
||||
($y[$i] <= $y && $y < $y[$j]) || ($y[$j] <= $y && $y < $y[$i])
|
||||
and
|
||||
# ...the (x,y) to infinity line crosses the edge
|
||||
# from the ith point to the jth point...
|
||||
($x < ($x[$j] - $x[$i]) * ($y - $y[$i]) / ($y[$j] - $y[$i]) + $x[$i])
|
||||
) {
|
||||
$side = not $side; # Jump the fence
|
||||
}
|
||||
}
|
||||
|
||||
# if point is not in polygon, let's check whether it belongs to the contour
|
||||
if (!$side && 0) {
|
||||
return 1 if polygon_segment_having_point($polygon, $point);
|
||||
}
|
||||
|
||||
return $side;
|
||||
}
|
||||
|
||||
# used by geometry.t, polygon_segment_having_point
|
||||
sub point_in_segment {
|
||||
my ($point, $line) = @_;
|
||||
|
||||
|
|
@ -141,41 +69,15 @@ sub point_in_segment {
|
|||
return abs($y3 - $y) < epsilon ? 1 : 0;
|
||||
}
|
||||
|
||||
sub segment_in_segment {
|
||||
my ($needle, $haystack) = @_;
|
||||
|
||||
# a segment is contained in another segment if its endpoints are contained
|
||||
return point_in_segment($needle->[A], $haystack) && point_in_segment($needle->[B], $haystack);
|
||||
}
|
||||
|
||||
# used by geometry.t
|
||||
sub polyline_lines {
|
||||
my ($polyline) = @_;
|
||||
my @points = @$polyline;
|
||||
return map Slic3r::Line->new(@points[$_, $_+1]), 0 .. $#points-1;
|
||||
}
|
||||
|
||||
sub polygon_lines {
|
||||
my ($polygon) = @_;
|
||||
return polyline_lines([ @$polygon, $polygon->[0] ]);
|
||||
}
|
||||
|
||||
# given a segment $p1-$p2, get the point at $distance from $p1 along segment
|
||||
sub point_along_segment {
|
||||
my ($p1, $p2, $distance) = @_;
|
||||
|
||||
my $point = [ @$p1 ];
|
||||
|
||||
my $line_length = sqrt( (($p2->[X] - $p1->[X])**2) + (($p2->[Y] - $p1->[Y])**2) );
|
||||
for (X, Y) {
|
||||
if ($p1->[$_] != $p2->[$_]) {
|
||||
$point->[$_] = $p1->[$_] + ($p2->[$_] - $p1->[$_]) * $distance / $line_length;
|
||||
}
|
||||
}
|
||||
|
||||
return Slic3r::Point->new(@$point);
|
||||
}
|
||||
|
||||
# given a $polygon, return the (first) segment having $point
|
||||
# used by geometry.t
|
||||
sub polygon_segment_having_point {
|
||||
my ($polygon, $point) = @_;
|
||||
|
||||
|
|
@ -185,15 +87,6 @@ sub polygon_segment_having_point {
|
|||
return undef;
|
||||
}
|
||||
|
||||
# return true if the given segment is contained in any edge of the polygon
|
||||
sub polygon_has_subsegment {
|
||||
my ($polygon, $segment) = @_;
|
||||
foreach my $line (polygon_lines($polygon)) {
|
||||
return 1 if segment_in_segment($segment, $line);
|
||||
}
|
||||
return 0;
|
||||
}
|
||||
|
||||
# polygon must be simple (non complex) and ccw
|
||||
sub polygon_is_convex {
|
||||
my ($points) = @_;
|
||||
|
|
@ -204,53 +97,6 @@ sub polygon_is_convex {
|
|||
return 1;
|
||||
}
|
||||
|
||||
sub rotate_points {
|
||||
my ($radians, $center, @points) = @_;
|
||||
$center //= [0,0];
|
||||
return map {
|
||||
[
|
||||
$center->[X] + cos($radians) * ($_->[X] - $center->[X]) - sin($radians) * ($_->[Y] - $center->[Y]),
|
||||
$center->[Y] + cos($radians) * ($_->[Y] - $center->[Y]) + sin($radians) * ($_->[X] - $center->[X]),
|
||||
]
|
||||
} @points;
|
||||
}
|
||||
|
||||
sub move_points {
|
||||
my ($shift, @points) = @_;
|
||||
return map {
|
||||
my @p = @$_;
|
||||
Slic3r::Point->new($shift->[X] + $p[X], $shift->[Y] + $p[Y]);
|
||||
} @points;
|
||||
}
|
||||
|
||||
sub move_points_3D {
|
||||
my ($shift, @points) = @_;
|
||||
return map [
|
||||
$shift->[X] + $_->[X],
|
||||
$shift->[Y] + $_->[Y],
|
||||
$shift->[Z] + $_->[Z],
|
||||
], @points;
|
||||
}
|
||||
|
||||
sub normal {
|
||||
my ($line1, $line2) = @_;
|
||||
|
||||
return [
|
||||
($line1->[Y] * $line2->[Z]) - ($line1->[Z] * $line2->[Y]),
|
||||
-($line2->[Z] * $line1->[X]) + ($line2->[X] * $line1->[Z]),
|
||||
($line1->[X] * $line2->[Y]) - ($line1->[Y] * $line2->[X]),
|
||||
];
|
||||
}
|
||||
|
||||
sub triangle_normal {
|
||||
my ($v1, $v2, $v3) = @_;
|
||||
|
||||
my $u = [ map +($v2->[$_] - $v1->[$_]), (X,Y,Z) ];
|
||||
my $v = [ map +($v3->[$_] - $v1->[$_]), (X,Y,Z) ];
|
||||
|
||||
return normal($u, $v);
|
||||
}
|
||||
|
||||
sub normalize {
|
||||
my ($line) = @_;
|
||||
|
||||
|
|
@ -260,25 +106,12 @@ sub normalize {
|
|||
}
|
||||
|
||||
# 2D dot product
|
||||
# used by 3DScene.pm
|
||||
sub dot {
|
||||
my ($u, $v) = @_;
|
||||
return $u->[X] * $v->[X] + $u->[Y] * $v->[Y];
|
||||
}
|
||||
|
||||
# 2D perp product
|
||||
sub perp {
|
||||
my ($u, $v) = @_;
|
||||
return $u->[X] * $v->[Y] - $u->[Y] * $v->[X];
|
||||
}
|
||||
|
||||
sub line_intersects_any {
|
||||
my ($line, $lines) = @_;
|
||||
for (@$lines) {
|
||||
return 1 if line_intersection($line, $_, 1);
|
||||
}
|
||||
return 0;
|
||||
}
|
||||
|
||||
sub line_intersection {
|
||||
my ($line1, $line2, $require_crossing) = @_;
|
||||
$require_crossing ||= 0;
|
||||
|
|
@ -376,43 +209,6 @@ sub _line_intersection {
|
|||
return [Slic3r::Point->new($x, $y), $h10 >= 0 && $h10 <= 1 && $h32 >= 0 && $h32 <= 1];
|
||||
}
|
||||
|
||||
# http://paulbourke.net/geometry/lineline2d/
|
||||
sub _line_intersection2 {
|
||||
my ($line1, $line2) = @_;
|
||||
|
||||
my $denom = ($line2->[B][Y] - $line2->[A][Y]) * ($line1->[B][X] - $line1->[A][X])
|
||||
- ($line2->[B][X] - $line2->[A][X]) * ($line1->[B][Y] - $line1->[A][Y]);
|
||||
my $numerA = ($line2->[B][X] - $line2->[A][X]) * ($line1->[A][Y] - $line2->[A][Y])
|
||||
- ($line2->[B][Y] - $line2->[A][Y]) * ($line1->[A][X] - $line2->[A][X]);
|
||||
my $numerB = ($line1->[B][X] - $line1->[A][X]) * ($line1->[A][Y] - $line2->[A][Y])
|
||||
- ($line1->[B][Y] - $line1->[A][Y]) * ($line1->[A][X] - $line2->[A][X]);
|
||||
|
||||
# are the lines coincident?
|
||||
if (abs($numerA) < epsilon && abs($numerB) < epsilon && abs($denom) < epsilon) {
|
||||
return Slic3r::Point->new(
|
||||
($line1->[A][X] + $line1->[B][X]) / 2,
|
||||
($line1->[A][Y] + $line1->[B][Y]) / 2,
|
||||
);
|
||||
}
|
||||
|
||||
# are the lines parallel?
|
||||
if (abs($denom) < epsilon) {
|
||||
return undef;
|
||||
}
|
||||
|
||||
# is the intersection along the segments?
|
||||
my $muA = $numerA / $denom;
|
||||
my $muB = $numerB / $denom;
|
||||
if ($muA < 0 || $muA > 1 || $muB < 0 || $muB > 1) {
|
||||
return undef;
|
||||
}
|
||||
|
||||
return Slic3r::Point->new(
|
||||
$line1->[A][X] + $muA * ($line1->[B][X] - $line1->[A][X]),
|
||||
$line1->[A][Y] + $muA * ($line1->[B][Y] - $line1->[A][Y]),
|
||||
);
|
||||
}
|
||||
|
||||
# 2D
|
||||
sub bounding_box {
|
||||
my ($points) = @_;
|
||||
|
|
@ -430,14 +226,6 @@ sub bounding_box {
|
|||
return @bb[X1,Y1,X2,Y2];
|
||||
}
|
||||
|
||||
sub bounding_box_center {
|
||||
my ($bounding_box) = @_;
|
||||
return Slic3r::Point->new(
|
||||
($bounding_box->[X2] + $bounding_box->[X1]) / 2,
|
||||
($bounding_box->[Y2] + $bounding_box->[Y1]) / 2,
|
||||
);
|
||||
}
|
||||
|
||||
sub size_2D {
|
||||
my @bounding_box = bounding_box(@_);
|
||||
return (
|
||||
|
|
@ -448,7 +236,7 @@ sub size_2D {
|
|||
|
||||
# bounding_box_intersect($d, @a, @b)
|
||||
# Return true if the given bounding boxes @a and @b intersect
|
||||
# in $d dimensions. Used by line_intersection().
|
||||
# in $d dimensions. Used by sub collinear.
|
||||
sub bounding_box_intersect {
|
||||
my ( $d, @bb ) = @_; # Number of dimensions and box coordinates.
|
||||
my @aa = splice( @bb, 0, 2 * $d ); # The first box.
|
||||
|
|
@ -464,27 +252,6 @@ sub bounding_box_intersect {
|
|||
return 1;
|
||||
}
|
||||
|
||||
# 3D
|
||||
sub bounding_box_3D {
|
||||
my ($points) = @_;
|
||||
|
||||
my @extents = (map [undef, undef], X,Y,Z);
|
||||
foreach my $point (@$points) {
|
||||
for (X,Y,Z) {
|
||||
$extents[$_][MIN] = $point->[$_] if !defined $extents[$_][MIN] || $point->[$_] < $extents[$_][MIN];
|
||||
$extents[$_][MAX] = $point->[$_] if !defined $extents[$_][MAX] || $point->[$_] > $extents[$_][MAX];
|
||||
}
|
||||
}
|
||||
return @extents;
|
||||
}
|
||||
|
||||
sub size_3D {
|
||||
my ($points) = @_;
|
||||
|
||||
my @extents = bounding_box_3D($points);
|
||||
return map $extents[$_][MAX] - $extents[$_][MIN], (X,Y,Z);
|
||||
}
|
||||
|
||||
# this assumes a CCW rotation from $p2 to $p3 around $p1
|
||||
sub angle3points {
|
||||
my ($p1, $p2, $p3) = @_;
|
||||
|
|
@ -497,109 +264,4 @@ sub angle3points {
|
|||
return $angle <= 0 ? $angle + 2*PI() : $angle;
|
||||
}
|
||||
|
||||
sub polyline_remove_short_segments {
|
||||
my ($points, $min_length, $isPolygon) = @_;
|
||||
for (my $i = $isPolygon ? 0 : 1; $i < $#$points; $i++) {
|
||||
if (distance_between_points($points->[$i-1], $points->[$i]) < $min_length) {
|
||||
# we can remove $points->[$i]
|
||||
splice @$points, $i, 1;
|
||||
$i--;
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
sub douglas_peucker {
|
||||
my ($points, $tolerance) = @_;
|
||||
no warnings "recursion";
|
||||
|
||||
my $results = [];
|
||||
my $dmax = 0;
|
||||
my $index = 0;
|
||||
for my $i (1..$#$points) {
|
||||
my $d = $points->[$i]->distance_to(Slic3r::Line->new($points->[0], $points->[-1]));
|
||||
if ($d > $dmax) {
|
||||
$index = $i;
|
||||
$dmax = $d;
|
||||
}
|
||||
}
|
||||
if ($dmax >= $tolerance) {
|
||||
my $dp1 = douglas_peucker([ @$points[0..$index] ], $tolerance);
|
||||
$results = [
|
||||
@$dp1[0..($#$dp1-1)],
|
||||
@{douglas_peucker([ @$points[$index..$#$points] ], $tolerance)},
|
||||
];
|
||||
} else {
|
||||
$results = [ $points->[0], $points->[-1] ];
|
||||
}
|
||||
return $results;
|
||||
}
|
||||
|
||||
sub douglas_peucker2 {
|
||||
my ($points, $tolerance) = @_;
|
||||
|
||||
my $anchor = 0;
|
||||
my $floater = $#$points;
|
||||
my @stack = ();
|
||||
my %keep = ();
|
||||
|
||||
push @stack, [$anchor, $floater];
|
||||
while (@stack) {
|
||||
($anchor, $floater) = @{pop @stack};
|
||||
|
||||
# initialize line segment
|
||||
my ($anchor_x, $anchor_y, $seg_len);
|
||||
if (grep $points->[$floater][$_] != $points->[$anchor][$_], X, Y) {
|
||||
$anchor_x = $points->[$floater][X] - $points->[$anchor][X];
|
||||
$anchor_y = $points->[$floater][Y] - $points->[$anchor][Y];
|
||||
$seg_len = sqrt(($anchor_x ** 2) + ($anchor_y ** 2));
|
||||
# get the unit vector
|
||||
$anchor_x /= $seg_len;
|
||||
$anchor_y /= $seg_len;
|
||||
} else {
|
||||
$anchor_x = $anchor_y = $seg_len = 0;
|
||||
}
|
||||
|
||||
# inner loop:
|
||||
my $max_dist = 0;
|
||||
my $farthest = $anchor + 1;
|
||||
for my $i (($anchor + 1) .. $floater) {
|
||||
my $dist_to_seg = 0;
|
||||
# compare to anchor
|
||||
my $vecX = $points->[$i][X] - $points->[$anchor][X];
|
||||
my $vecY = $points->[$i][Y] - $points->[$anchor][Y];
|
||||
$seg_len = sqrt(($vecX ** 2) + ($vecY ** 2));
|
||||
# dot product:
|
||||
my $proj = $vecX * $anchor_x + $vecY * $anchor_y;
|
||||
if ($proj < 0) {
|
||||
$dist_to_seg = $seg_len;
|
||||
} else {
|
||||
# compare to floater
|
||||
$vecX = $points->[$i][X] - $points->[$floater][X];
|
||||
$vecY = $points->[$i][Y] - $points->[$floater][Y];
|
||||
$seg_len = sqrt(($vecX ** 2) + ($vecY ** 2));
|
||||
# dot product:
|
||||
$proj = $vecX * (-$anchor_x) + $vecY * (-$anchor_y);
|
||||
if ($proj < 0) {
|
||||
$dist_to_seg = $seg_len
|
||||
} else { # calculate perpendicular distance to line (pythagorean theorem):
|
||||
$dist_to_seg = sqrt(abs(($seg_len ** 2) - ($proj ** 2)));
|
||||
}
|
||||
if ($max_dist < $dist_to_seg) {
|
||||
$max_dist = $dist_to_seg;
|
||||
$farthest = $i;
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
if ($max_dist <= $tolerance) { # use line segment
|
||||
$keep{$_} = 1 for $anchor, $floater;
|
||||
} else {
|
||||
push @stack, [$anchor, $farthest];
|
||||
push @stack, [$farthest, $floater];
|
||||
}
|
||||
}
|
||||
|
||||
return [ map $points->[$_], sort keys %keep ];
|
||||
}
|
||||
|
||||
1;
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue