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