Bugfixes for complex and dirty geometries

lib/Slic3r/Fill/Rectilinear.pm

@@ -33,9 +33,8 @@ sub make_fill {
             # set infill angle
             my (@rotate, @shift);
             $rotate[0] = Slic3r::Geometry::deg2rad($Slic3r::fill_angle);
-            $rotate[1] = [ $print->x_length / 2, $print->y_length / 2 ];
-            $shift[X] = $max_print_dimension / 2;
-            $shift[Y] = $max_print_dimension / 2;
+            $rotate[1] = [ $max_print_dimension / 2, $max_print_dimension / 2 ];
+            @shift = @{$rotate[1]};
             
             # alternate fill direction
             if ($layer->id % 2) {

lib/Slic3r/Geometry.pm

@@ -2,6 +2,7 @@ package Slic3r::Geometry;
 use strict;
 use warnings;
 
+use Slic3r::Geometry::DouglasPeucker;
 use XXX;
 
 use constant PI => 4 * atan2(1, 1);
@@ -11,6 +12,7 @@ use constant X => 0;
 use constant Y => 1;
 use constant epsilon => 1E-8;
 use constant epsilon2 => epsilon**2;
+our $parallel_degrees_limit = abs(deg2rad(10));
 
 sub slope {
     my ($line) = @_;
@@ -18,14 +20,15 @@ sub slope {
     return ($line->[B][Y] - $line->[A][Y]) / ($line->[B][X] - $line->[A][X]);
 }
 
+sub line_atan {
+    my ($line) = @_;
+    return atan2($line->[B][Y] - $line->[A][Y], $line->[B][X] - $line->[A][X]);
+}
+
 sub lines_parallel {
     my ($line1, $line2) = @_;
     
-    my @slopes = map slope($_), $line1, $line2;
-    return 1 if !defined $slopes[0] && !defined $slopes[1];
-    return 0 if grep !defined, @slopes;
-    return 1 if abs($slopes[0] - $slopes[1]) < epsilon;
-    return 0;
+    return abs(line_atan($line1) - line_atan($line2)) < $parallel_degrees_limit;
 }
 
 # this subroutine checks whether a given point may belong to a given

lib/Slic3r/Geometry/DouglasPeucker.pm

@@ -0,0 +1,167 @@
+package Slic3r::Geometry::DouglasPeucker;
+use strict;
+use warnings;
+
+BEGIN {
+ use Exporter ;
+ use vars qw ( $VERSION @ISA @EXPORT) ;
+ $VERSION	= 1.0 ;
+ @ISA		= qw ( Exporter ) ;
+ @EXPORT	= qw ( 
+ Douglas_Peucker
+ perp_distance
+ haversine_distance_meters
+ angle3points
+ ) ;
+}
+
+# Call as: @Opoints = &Douglas_Peucker( <reference to input array of points>, <tolerance>) ;
+# Returns: Array of points
+# Points Array Format:
+# ([lat1,lng1],[lat2,lng2],...[latn,lngn])
+#
+
+sub Douglas_Peucker
+{
+my $href	= shift ;
+my $tolerance	= shift ;
+my @Ipoints	= @$href ;
+my @Opoints	= ( ) ;
+my @stack	= ( ) ;
+my $fIndex	= 0 ;
+my $fPoint	= '' ;
+my $aIndex	= 0 ;
+my $anchor	= '' ;
+my $max		= 0 ;
+my $maxIndex	= 0 ;
+my $point	= '' ;
+my $dist	= 0 ;
+my $polygon	= 0 ;					# Line Type
+
+$anchor = $Ipoints[0] ; 				# save first point
+
+push( @Opoints, $anchor ) ;
+
+$aIndex = 0 ;						# Anchor Index
+
+# Check for a polygon: At least 4 points and the first point == last point...
+
+if ( $#Ipoints >= 4 and $Ipoints[0] == $Ipoints[$#Ipoints] )
+{
+ $fIndex = $#Ipoints - 1 ;				# Start from the next to last point
+ $polygon = 1 ;						# It's a polygon
+
+} else
+{
+ $fIndex = $#Ipoints ;					# It's a path (open polygon)
+}
+
+push( @stack, $fIndex ) ;
+
+# Douglas - Peucker algorithm...
+
+while(@stack)
+{
+ $fIndex = $stack[$#stack] ;
+ $fPoint = $Ipoints[$fIndex] ;
+ $max = $tolerance ;		 			# comparison values
+ $maxIndex = 0 ;
+
+ # Process middle points...
+
+ for (($aIndex+1) .. ($fIndex-1))
+ {
+  $point = $Ipoints[$_] ;
+  $dist = &perp_distance($anchor, $fPoint, $point);
+
+  if( $dist >= $max )
+  {
+   $max = $dist ;
+   $maxIndex = $_;
+  }
+ }
+
+ if( $maxIndex > 0 )
+ {
+  push( @stack, $maxIndex ) ;
+ } else
+ {
+  push( @Opoints, $fPoint ) ;
+  $anchor = $Ipoints[(pop @stack)] ;
+  $aIndex = $fIndex ;
+ }
+}
+
+if ( $polygon )						# Check for Polygon
+{
+ push( @Opoints, $Ipoints[$#Ipoints] ) ;		# Add the last point
+
+ # Check for collapsed polygons, use original data in that case...
+
+ if( $#Opoints < 4 )
+ {
+  @Opoints = @Ipoints ;
+ }
+}
+
+return ( @Opoints ) ;
+
+}
+
+# Calculate Perpendicular Distance in meters between a line (two points) and a point...
+# my $dist = &perp_distance( <line point 1>, <line point 2>, <point> ) ;
+
+sub perp_distance					# Perpendicular distance in meters
+{
+ my $lp1	= shift ;
+ my $lp2	= shift ;
+ my $p		= shift ;
+ my $dist	= &haversine_distance_meters( $lp1, $p ) ;
+ my $angle	= &angle3points( $lp1, $lp2, $p ) ; 
+
+ return ( sprintf("%0.6f", abs($dist * sin($angle)) ) ) ;
+}
+
+# Calculate Distance in meters between two points...
+
+sub haversine_distance_meters
+{
+ my $p1	= shift ;
+ my $p2	= shift ;
+
+ my $O = 3.141592654/180 ;
+ my $b = $$p1[0] * $O ;
+ my $c = $$p2[0] * $O ;
+ my $d = $b - $c ;
+ my $e = ($$p1[1] * $O) - ($$p2[1] * $O) ;
+ my $f = 2 * &asin( sqrt( (sin($d/2) ** 2) + cos($b) * cos($c) * (sin($e/2) ** 2)));
+
+ return sprintf("%0.4f",$f * 6378137) ; 		# Return meters
+
+ sub asin
+ {
+  atan2($_[0], sqrt(1 - $_[0] * $_[0])) ;
+ }
+}
+
+# Calculate Angle in Radians between three points...
+
+sub angle3points					# Angle between three points in radians
+{
+ my $p1	= shift ;
+ my $p2	= shift ;
+ my $p3 = shift ;
+ my $m1 = &slope( $p2, $p1 ) ;
+ my $m2 = &slope( $p3, $p1 ) ;
+ 
+ return ($m2 - $m1) ;
+
+ sub slope						# Slope in radians
+ {
+  my $p1	= shift ;
+  my $p2	= shift ;
+  return( sprintf("%0.6f",atan2( (@$p2[1] - @$p1[1]),( @$p2[0] - @$p1[0] ))) ) ;
+ }
+}
+
+1;

lib/Slic3r/Layer.pm

@@ -180,6 +180,7 @@ sub make_polylines {
         
         # actually this is not needed, as Math::Clipper used in make_surfaces() also cleans contours
         $polylines->[-1]->merge_continuous_lines;
+        #$polylines->[-1]->cleanup;  # not proven to be actually useful
     }
     
     return $polylines;

lib/Slic3r/Line.pm

@@ -51,11 +51,6 @@ sub has_endpoint {
     return $point->coincides_with($self->a) || $point->coincides_with($self->b);
 }
 
-sub slope {
-    my $self = shift;
-    return Slic3r::Geometry::slope($self->p);
-}
-
 sub parallel_to {
     my $self = shift;
     my ($line) = @_;

lib/Slic3r/Perimeter.pm

@@ -17,10 +17,11 @@ sub make_perimeter {
     die "Can't extrude object without any perimeter!\n"
         if $Slic3r::perimeter_offsets == 0;
     
-    my (@perimeters, %contours, %holes) = ();
+    my (%contours, %holes) = ();
     foreach my $surface (@{ $layer->surfaces }) {
         $contours{$surface} = [];
         $holes{$surface} = [];
+        my @last_offsets = ();
         
         # first perimeter
         {
@@ -28,21 +29,20 @@ sub make_perimeter {
             my ($contour_p, @holes_p) = ($polygon->{outer}, @{$polygon->{holes}});
             push @{ $contours{$surface} }, $contour_p;
             push @{ $holes{$surface} }, @holes_p;
-            push @perimeters, $polygon;
+            @last_offsets = ($polygon);
         }
         
         # create other offsets
         for (my $loop = 1; $loop < $Slic3r::perimeter_offsets; $loop++) {
             
             # offsetting a polygon can result in one or many offset polygons
-            my @offsets = $self->offset_polygon($perimeters[-1]);
+            @last_offsets = map $self->offset_polygon($_), @last_offsets;
             
-            foreach my $offset_polygon (@offsets) {
+            foreach my $offset_polygon (@last_offsets) {
                 my ($contour_p, @holes_p) = ($offset_polygon->{outer}, @{$offset_polygon->{holes}});
                 
                 push @{ $contours{$surface} }, $contour_p;
                 push @{ $holes{$surface} }, @holes_p;
-                push @perimeters, $offset_polygon;
             }
         }
         
@@ -55,7 +55,7 @@ sub make_perimeter {
                     holes        => [
                         map Slic3r::Polyline::Closed->cast($_), @{$_->{holes}}
                     ],
-                ), $self->offset_polygon($perimeters[-1]),
+                ), map $self->offset_polygon($_), @last_offsets
             ],
         );
     }

lib/Slic3r/Polyline.pm

@@ -21,7 +21,7 @@ sub cast {
     my $class = shift;
     my ($points) = @_;
     
-    @$points = map { ref $_ eq 'ARRAY' ? Slic3r::Point->cast($_) : $_ } @$points;
+    $points = [ map { ref $_ eq 'ARRAY' ? Slic3r::Point->cast($_) : $_ } @$points ];
     return $class->new(points => $points);
 }
 
@@ -46,22 +46,34 @@ sub p {
 sub merge_continuous_lines {
     my $self = shift;
     
-    my $last_line;
-    foreach my $line ($self->lines) {
-        if (defined $last_line && $line->parallel_to($last_line)) {
-            # $line and $last_line are parallel and continuous,
-            # so we can remove their common point from our polyline
-            
-            # find common point
-            my ($common_point) = grep $_ eq $line->a || $_ eq $line->b, @{$last_line->points};
-            
-            # remove point from polyline
-            @{$self->points} = grep $_ ne $common_point, @{$self->points};
+    my $finished = 0;
+    CYCLE: while (!$finished) {
+        my $last_line;
+        foreach my $line ($self->lines) {
+            if (defined $last_line && $line->parallel_to($last_line)) {
+                # $line and $last_line are parallel and continuous,
+                # so we can remove their common point from our polyline
+                
+                # find common point
+                my ($common_point) = grep $_ eq $line->a || $_ eq $line->b, @{$last_line->points};
+                
+                # remove point from polyline
+                @{$self->points} = grep $_ ne $common_point, @{$self->points};
+                $finished = 0;
+            }
+            $last_line = $line;
         }
-        $last_line = $line;
+        $finished = 1;
     }
 }
 
+sub cleanup {
+    my $self = shift;
+    my $tolerance = shift || (1 / $Slic3r::resolution);
+    @{$self->points} = map Slic3r::Point->cast($_), 
+        Slic3r::Geometry::Douglas_Peucker($self->p, $tolerance);
+}
+
 sub reverse_points {
     my $self = shift;
     @{$self->points} = reverse @{$self->points};

lib/Slic3r/STL.pm

@@ -69,7 +69,7 @@ sub parse_file {
     
     # calculate the displacements needed to 
     # have lowest value for each axis at coordinate 0
-    my @shift = map -$extents[$_][MIN], X,Y,Z;
+    my @shift = map sprintf('%.0f', -$extents[$_][MIN] / $Slic3r::resolution), X,Y,Z;
     
     # process facets
     foreach my $facet ($stl->part->facets) {
@@ -77,7 +77,7 @@ sub parse_file {
         # transform vertex coordinates
         my ($normal, @vertices) = @$facet;
         foreach my $vertex (@vertices) {
-            $vertex->[$_] = sprintf('%.0f', ($Slic3r::scale * $vertex->[$_] + $shift[$_]) / $Slic3r::resolution) 
+            $vertex->[$_] = sprintf('%.0f', ($Slic3r::scale * $vertex->[$_] / $Slic3r::resolution) + $shift[$_]) 
                 for X,Y,Z;
         }
         

t/clean_polylines.t

@@ -0,0 +1,58 @@
+use Test::More;
+
+plan tests => 3;
+
+BEGIN {
+    use FindBin;
+    use lib "$FindBin::Bin/../lib";
+}
+
+use Slic3r;
+
+my $polyline = Slic3r::Polyline::Closed->cast([
+    [5,0], [10,0], [15,0], [20,0], [20,10], [20,30], [0,0],
+]);
+
+$polyline->merge_continuous_lines;
+is scalar(@{$polyline->points}), 3, 'merge_continuous_lines';
+
+my $gear = [
+    [144.9694,317.1543], [145.4181,301.5633], [146.3466,296.921], [131.8436,294.1643], [131.7467,294.1464], 
+    [121.7238,291.5082], [117.1631,290.2776], [107.9198,308.2068], [100.1735,304.5101], [104.9896,290.3672], 
+    [106.6511,286.2133], [93.453,279.2327], [81.0065,271.4171], [67.7886,286.5055], [60.7927,280.1127], 
+    [69.3928,268.2566], [72.7271,264.9224], [61.8152,253.9959], [52.2273,242.8494], [47.5799,245.7224], 
+    [34.6577,252.6559], [30.3369,245.2236], [42.1712,236.3251], [46.1122,233.9605], [43.2099,228.4876], 
+    [35.0862,211.5672], [33.1441,207.0856], [13.3923,212.1895], [10.6572,203.3273], [6.0707,204.8561], 
+    [7.2775,204.4259], [29.6713,196.3631], [25.9815,172.1277], [25.4589,167.2745], [19.8337,167.0129], 
+    [5.0625,166.3346], [5.0625,156.9425], [5.3701,156.9282], [21.8636,156.1628], [25.3713,156.4613], 
+    [25.4243,155.9976], [29.3432,155.8157], [30.3838,149.3549], [26.3596,147.8137], [27.1085,141.2604], 
+    [29.8466,126.8337], [24.5841,124.9201], [10.6664,119.8989], [13.4454,110.9264], [33.1886,116.0691], 
+    [38.817,103.1819], [45.8311,89.8133], [30.4286,76.81], [35.7686,70.0812], [48.0879,77.6873], 
+    [51.564,81.1635], [61.9006,69.1791], [72.3019,58.7916], [60.5509,42.5416], [68.3369,37.1532], 
+    [77.9524,48.1338], [80.405,52.2215], [92.5632,44.5992], [93.0123,44.3223], [106.3561,37.2056], 
+    [100.8631,17.4679], [108.759,14.3778], [107.3148,11.1283], [117.0002,32.8627], [140.9109,27.3974], 
+    [145.7004,26.4994], [145.1346,6.1011], [154.502,5.4063], [156.9398,25.6501], [171.0557,26.2017], 
+    [181.3139,27.323], [186.2377,27.8532], [191.6031,8.5474], [200.6724,11.2756], [197.2362,30.2334], 
+    [220.0789,39.1906], [224.3261,41.031], [236.3506,24.4291], [243.6897,28.6723], [234.2956,46.7747], 
+    [245.6562,55.1643], [257.2523,65.0901], [261.4374,61.5679], [273.1709,52.8031], [278.555,59.5164], 
+    [268.4334,69.8001], [264.1615,72.3633], [268.2763,77.9442], [278.8488,93.5305], [281.4596,97.6332], 
+    [286.4487,95.5191], [300.2821,90.5903], [303.4456,98.5849], [286.4523,107.7253], [293.7063,131.1779], 
+    [294.9748,135.8787], [314.918,133.8172], [315.6941,143.2589], [300.9234,146.1746], [296.6419,147.0309], 
+    [297.1839,161.7052], [296.6136,176.3942], [302.1147,177.4857], [316.603,180.3608], [317.1658,176.7341], 
+    [315.215,189.6589], [315.1749,189.6548], [294.9411,187.5222], [291.13,201.7233], [286.2615,215.5916], 
+    [291.1944,218.2545], [303.9158,225.1271], [299.2384,233.3694], [285.7165,227.6001], [281.7091,225.1956], 
+    [273.8981,237.6457], [268.3486,245.2248], [267.4538,246.4414], [264.8496,250.0221], [268.6392,253.896], 
+    [278.5017,265.2131], [272.721,271.4403], [257.2776,258.3579], [234.4345,276.5687], [242.6222,294.8315], 
+    [234.9061,298.5798], [227.0321,286.2841], [225.2505,281.8301], [211.5387,287.8187], [202.3025,291.0935], 
+    [197.307,292.831], [199.808,313.1906], [191.5298,315.0787], [187.3082,299.8172], [186.4201,295.3766], 
+    [180.595,296.0487], [161.7854,297.4248], [156.8058,297.6214], [154.3395,317.8592],
+];
+$polyline = Slic3r::Polyline::Closed->cast($gear);
+$polyline->merge_continuous_lines;
+diag sprintf "original points: %d\nnew points: %d", scalar(@$gear), scalar(@{$polyline->points});
+ok (@{$polyline->points} < @$gear), 'gear was simplified using merge_continuous_lines';
+
+my $num_points = scalar @{$polyline->points};
+$polyline->cleanup;
+diag sprintf "original points: %d\nnew points: %d", $num_points, scalar(@{$polyline->points});
+ok (@{$polyline->points} < $num_points), 'gear was further simplified using Douglas-Peucker';