Skeining algorithm totally rewritten

lib/Slic3r.pm

@@ -55,6 +55,7 @@ our $flow_width;
 # print options
 our $perimeter_offsets  = 3;
 our $solid_layers       = 3;
+our $bridge_overlap     = 2;    # mm
 our $fill_type          = 'rectilinear';
 our $fill_density       = 0.4;  # 1 = 100%
 our $fill_angle         = 0;

lib/Slic3r/Geometry.pm

@@ -5,7 +5,7 @@ use warnings;
 require Exporter;
 our @ISA = qw(Exporter);
 our @EXPORT_OK = qw(
-    epsilon slope line_atan lines_parallel three_points_aligned
+    PI epsilon slope line_atan lines_parallel three_points_aligned
     line_point_belongs_to_segment points_coincide distance_between_points 
     line_length midpoint point_in_polygon point_in_segment segment_in_segment
     point_is_on_left_of_segment polyline_lines polygon_lines nearest_point
@@ -14,10 +14,10 @@ our @EXPORT_OK = qw(
     rotate_points move_points remove_coinciding_points clip_segment_polygon
     sum_vectors multiply_vector subtract_vectors dot perp polygon_points_visibility
     line_intersection bounding_box bounding_box_intersect 
-    clip_segment_complex_polygon longest_segment
+    clip_segment_complex_polygon longest_segment angle3points
 );
 
-use Slic3r::Geometry::DouglasPeucker;
+use Slic3r::Geometry::DouglasPeucker ();
 use XXX;
 
 use constant PI => 4 * atan2(1, 1);
@@ -564,4 +564,15 @@ sub clip_segment_complex_polygon {
     return [@lines];
 }
 
+sub angle3points {
+    my ($p1, $p2, $p3) = @_;
+    # p1 is the center
+    
+    my $angle = atan2($p2->[X] - $p1->[X], $p2->[Y] - $p1->[Y])
+              - atan2($p3->[X] - $p1->[X], $p3->[Y] - $p1->[Y]);
+    
+    # we only want to return only positive angles
+    return $angle <= 0 ? $angle + 2*PI() : $angle;
+}
+
 1;

lib/Slic3r/Geometry/DouglasPeucker.pm

@@ -160,7 +160,7 @@ sub angle3points					# Angle between three points in radians
  {
   my $p1	= shift ;
   my $p2	= shift ;
-  return( sprintf("%0.6f",atan2( (@$p2[1] - @$p1[1]),( @$p2[0] - @$p1[0] ))) ) ;
+  return atan2( (@$p2[1] - @$p1[1]),( @$p2[0] - @$p1[0] ));
  }
 }
 

lib/Slic3r/Layer.pm

@@ -3,9 +3,12 @@ use Moo;
 
 use Math::Clipper ':all';
 use Math::ConvexHull qw(convex_hull);
+use Slic3r::Geometry qw(polygon_lines points_coincide angle3points polyline_lines);
 use XXX;
 
 use constant PI => 4 * atan2(1, 1);
+use constant A => 0;
+use constant B => 1;
 
 # a sequential number of layer, starting at 0
 has 'id' => (
@@ -100,6 +103,7 @@ sub add_line {
     my ($line) = @_;
     
     $line = Slic3r::Line->cast($line);
+    return if $line->a->coincides_with($line->b);
     
     push @{ $self->lines }, $line;
     return $line;
@@ -118,141 +122,78 @@ sub remove_surface {
 }
 
 # build polylines of lines which do not already belong to a surface
-# okay, this code is a mess.  will need some refactoring.  sorry.
 sub make_polylines {
     my $self = shift;
     
-    # remove line duplicates
-    if (0) {
-        # this removes any couple of coinciding Slic3r::Line::FacetEdge
-        my %lines_map = ();
-        foreach my $line (grep $_->isa('Slic3r::Line::FacetEdge'), @{ $self->lines }) {
-            my $ordered_id = $line->ordered_id;
-            if (exists $lines_map{$ordered_id}) {
-                delete $lines_map{$ordered_id};
-                next;
-            }
-            $lines_map{$ordered_id} = $line;
-        }
-        
-        @{ $self->lines } = (values(%lines_map), grep !$_->isa('Slic3r::Line::FacetEdge'), @{ $self->lines });
-    }
-    if (1) {
-        # this removes any duplicate, leaving one
-        my %lines_map = map { join(',', sort map $_->id, @{$_->points} ) => "$_" } @{ $self->lines };
-        %lines_map = reverse %lines_map;
-        @{ $self->lines } = grep $lines_map{"$_"}, @{ $self->lines };
-    }
+    my @lines = ();
+    push @lines, map $_->p, @{$self->lines};
     
-    # now remove lines that are already part of a surface
-    if (1) {
-        my @lines = @{ $self->lines };
-        @{ $self->lines } = ();
-        LINE: foreach my $line (@lines) {
-            if (!$line->isa('Slic3r::Line::FacetEdge')) {
-                push @{ $self->lines }, $line;
-                next LINE;
-            }
-            foreach my $surface (@{$self->surfaces}) {
-                if ($surface->surface_type eq $line->edge_type && $surface->contour->has_segment($line)) {
-                    next LINE;
-                }
-            }
-            push @{ $self->lines }, $line;
-        }
-    }
+    #use Slic3r::SVG;
+    #Slic3r::SVG::output(undef, "lines.svg",
+    #    lines       => [ map $_->p, grep !$_->isa('Slic3r::Line::FacetEdge'), @{$self->lines} ],
+    #    red_lines   => [ map $_->p, grep  $_->isa('Slic3r::Line::FacetEdge'), @{$self->lines} ],
+    #);
+    
+    my $get_point_id = sub { sprintf "%d,%d", @{$_[0]} };
     
-    # make a cache of line endpoints
     my (%pointmap) = ();
-    foreach my $line (@{ $self->lines }) {
-        for my $point (@{ $line->points }) {
-            $pointmap{$point->id} ||= [];
-            push @{ $pointmap{$point->id} }, $line;
-        }
-    }
-    foreach my $point_id (keys %pointmap) {
-        $pointmap{$point_id} = [
-            sort { $a->isa('Slic3r::Line::FacetEdge') <=> $b->isa('Slic3r::Line::FacetEdge') } 
-                @{$pointmap{$point_id}} ];
+    foreach my $line (@lines) {
+        my $point_id = $get_point_id->($line->[A]);
+        $pointmap{$point_id} ||= [];
+        push @{ $pointmap{$point_id} }, $line;
     }
     
-    if (0) {
-        # defensive programming
-        for (keys %pointmap) {
-            next if @{$pointmap{$_}} == 2;
+    my $n = 0;
+    my @polylines = ();
+    while (my $first_line = shift @lines) {
+        my @points = @$first_line;
+        my %seen_points = map { $get_point_id->($points[$_]) => $_ } 0..1;
+        
+        CYCLE: while (1) {
+            my $next_lines = $pointmap{ $get_point_id->($points[-1]) }
+                or die sprintf "No lines start at point %d,%d. This shouldn't happen", @{$points[-1]};
+            last CYCLE if !@$next_lines;
             
-            use Slic3r::SVG;
-            Slic3r::SVG::output(undef, "lines_and_points.svg",
-                lines       => [ map $_->p, grep !$_->isa('Slic3r::Line::FacetEdge'), @{$self->lines} ],
-                red_lines   => [ map $_->p, grep $_->isa('Slic3r::Line::FacetEdge'), @{$self->lines} ],
-                points      => [ map [split /,/], keys %pointmap ],
-                red_points  => [ [split /,/, $_ ] ],
-            );
+            my @ordered_next_lines = sort 
+                { angle3points($points[-1], $points[-2], $next_lines->[$a][B]) <=> angle3points($points[-1], $points[-2], $next_lines->[$b][B]) } 
+                0..$#$next_lines;
             
-            YYY $pointmap{$_};
+            #if (@$next_lines > 1) {
+            #    Slic3r::SVG::output(undef, "next_line.svg",
+            #        lines        => $next_lines,
+            #        red_lines    => [ polyline_lines([@points]) ],
+            #        green_lines  => [ $next_lines->[ $ordered_next_lines[0] ] ],
+            #    );
+            #}
+            
+            my ($next_line) = splice @$next_lines, $ordered_next_lines[0], 1;
             
-            die sprintf "No point should be endpoint of less or more than 2 lines ($_ => %d)!", scalar(@{$pointmap{$_}});
-        }
-        
-        while (my @single_line_points = grep @{$pointmap{$_}} == 1, keys %pointmap) {
-            for my $point_id (@single_line_points) {
-                foreach my $lines (values %pointmap) {
-                    next unless $pointmap{$point_id}->[0];
-                    @$lines = grep $_ ne $pointmap{$point_id}->[0], @$lines;
-                }
-                delete $pointmap{$point_id};
-            }
-        }
-    }
-    
-    # make a subroutine to remove lines from pointmap
-    my $remove_line = sub {
-        my $line = shift;
-        foreach my $lines ($pointmap{$line->a->id}, $pointmap{$line->b->id}) {
-            @$lines = grep $_ ne $line, @$lines;
-        }
-    };
-    
-    my $polylines = [];
-    
-    # loop while we have spare lines
-    while (my ($first_line) = map @$_, values %pointmap) {
-        # add first line to a new polyline
-        my $points = [ $first_line->a, $first_line->b ];
-        $remove_line->($first_line);
-        my $last_point = $first_line->b;
-        
-        # loop through connected lines until we return to the first point
-        while (my $next_line = $pointmap{$last_point->id}->[0]) {
             
-            # get next point
-            ($last_point) = grep $_->id ne $last_point->id, @{$next_line->points};
+            push @points, $next_line->[B];
+            
+            my $point_id = $get_point_id->($points[-1]);
+            if ($seen_points{$point_id}) {
+                splice @points, 0, $seen_points{$point_id};
+                last CYCLE;
+            }
             
-            # add point to polyline
-            push @$points, $last_point;
-            $remove_line->($next_line);
+            $seen_points{$point_id} = $#points;
         }
         
-        # remove last point as it coincides with first one
-        pop @$points;
-        
-        if (@$points == 1 && $first_line->isa('Slic3r::Line::FacetEdge')) {
-            Slic3r::debugf "Skipping spare facet edge";
+        if (@points < 4 || !points_coincide($points[0], $points[-1])) {
             next;
         }
         
-        die sprintf "Invalid polyline with only %d points\n", scalar(@$points) if @$points < 3;
-        
-        Slic3r::debugf "Discovered polyline of %d points (%s)\n", scalar @$points,
-            join ' - ', map $_->id, @$points;
-        push @$polylines, Slic3r::Polyline::Closed->new(points => $points);
-        
-        # 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
+        pop @points;
+        Slic3r::debugf "Discovered polyline of %d points\n", scalar(@points);
+        push @polylines, [@points];
     }
     
-    return $polylines;
+    #Slic3r::SVG::output(undef, "polylines.svg",
+    #    polylines => [ @polylines ],
+    #);
+    
+    return [ map Slic3r::Polyline::Closed->cast($_), @polylines ];
 }
 
 sub make_surfaces {
@@ -336,7 +277,7 @@ sub merge_contiguous_surfaces {
         Slic3r::debugf "Initial surfaces (%d):\n", scalar @{ $self->surfaces };
         Slic3r::debugf "  [%s] %s (%s with %d holes)\n", $_->surface_type, $_->id, 
             ($_->contour->is_counter_clockwise ? 'ccw' : 'cw'), scalar @{$_->holes} for @{ $self->surfaces };
-        #Slic3r::SVG::output_polygons($main::print, "polygons-before.svg", [ map $_->contour->p, @{$self->surfaces} ]);
+        #Slic3r::SVG::output_polygons(undef, "polygons-before.svg", [ map $_->contour->p, @{$self->surfaces} ]);
     }
     
     my %resulting_surfaces = ();
@@ -487,12 +428,13 @@ sub process_bridges {
         
         # now connect the first point to the last of each polyline
         @supported_polylines = map [ $_->[0]->[0], $_->[-1]->[-1] ], @supported_polylines;
+        # @supported_polylines becomes actually an array of lines
         
         # if we got more than two supports, get the longest two
         if (@supported_polylines > 2) {
-            my %lengths = map { "$_" => Slic3r::Geometry::line_length($_) }, @supported_polylines;
+            my %lengths = map { $_ => Slic3r::Geometry::line_length($_) } @supported_polylines;
             @supported_polylines = sort { $lengths{"$a"} <=> $lengths{"$b"} } @supported_polylines;
-            @supported_polylines = @supported_polylines[0,1];
+            @supported_polylines = @supported_polylines[-2,-1];
         }
         
         # connect the midpoints, that will give the the optimal infill direction
@@ -517,8 +459,8 @@ sub process_bridges {
         
         # now, extend our bridge by taking a portion of supporting surfaces
         {
-            # offset the bridge by 5mm
-            my $bridge_offset = ${ offset([$surface_p], 5 / $Slic3r::resolution, $Slic3r::resolution * 100, JT_MITER, 2) }[0];
+            # offset the bridge by the specified amount of mm
+            my $bridge_offset = ${ offset([$surface_p], $Slic3r::bridge_overlap / $Slic3r::resolution, $Slic3r::resolution * 100, JT_MITER, 2) }[0];
             
             # calculate the new bridge
             my $clipper = Math::Clipper->new;

lib/Slic3r/STL.pm

@@ -3,6 +3,7 @@ use Moo;
 
 use CAD::Format::STL;
 use Math::Clipper qw(integerize_coordinate_sets is_counter_clockwise);
+use Slic3r::Geometry qw(three_points_aligned longest_segment);
 use XXX;
 
 use constant X => 0;
@@ -82,7 +83,7 @@ sub parse_file {
             
             # round Z coordinates to the nearest multiple of layer height
             # XY will be rounded automatically to integers with coercion
-            $vertex->[Z] = sprintf('%.0f', $vertex->[Z] * $Slic3r::resolution / $Slic3r::layer_height)
+            $vertex->[Z] = int($vertex->[Z] * $Slic3r::resolution / $Slic3r::layer_height)
                 * $Slic3r::layer_height / $Slic3r::resolution;
         }
         
@@ -118,12 +119,38 @@ sub _facet {
     
     Slic3r::debugf "layers: min = %s, max = %s\n", $min_layer, $max_layer;
     
+    # reorder vertices so that the first one is the one with lowest Z
+    # this is needed to get all intersection lines in a consistent order
+    # (external on the right of the line)
+    {
+        my @z_order = sort { $vertices[$a][Z] <=> $vertices[$b][Z] } 0..2;
+        @vertices = (splice(@vertices, $z_order[0]), splice(@vertices, 0, $z_order[0]));
+    }
+    
     # is the facet horizontal?
     # (note that we can have $min_z == $max_z && $min_layer != $max_layer
     # if $min_z % $layer_height != 0)
     if ($min_z == $max_z) {
-        Slic3r::debugf "Facet is horizontal\n";
         my $layer = $print->layer($min_layer);
+        
+        # if all vertices are aligned, then facet is not horizontal but vertical
+        # with a height less than layer height: that's why it was squashed on a
+        # single layer
+        ##local $Slic3r::Geometry::parallel_degrees_limit = 1;
+        ##if (three_points_aligned(@vertices)) {
+        if (0 && abs($normal->[Z]) == 0) {
+            Slic3r::debugf "Facet is vertical with a height less than layer height\n";
+            
+            my ($p1, $p2, $p3) = @vertices;
+            $layer->add_line(Slic3r::Line::FacetEdge->cast(
+                $_,
+                edge_type => 'bottom',
+            )) for ([$p1, $p2], [$p2, $p3], [$p1, $p3], [$p2, $p1], [$p3, $p2], [$p3, $p1]);
+            
+            return;
+        }
+        
+        Slic3r::debugf "Facet is horizontal\n";
         my $surface = $layer->add_surface(@vertices);
         
         # to determine whether the surface is a top or bottom let's recompute
@@ -147,6 +174,7 @@ sub _facet {
         }
         
         if ($layer->id == 0 && !$clockwise) {
+            YYY $normal;
             die "Right-hand rule gives bad result for facets on base layer!\n";
         }
         
@@ -180,11 +208,13 @@ sub intersect_facet {
         
         if ($a->[Z] == $b->[Z] && $a->[Z] == $z) {
             # edge is horizontal and belongs to the current layer
+            my $edge_type = (grep $_->[Z] > $z, @$vertices) ? 'bottom' : 'top';
+            ($a, $b) = ($b, $a) if $edge_type eq 'bottom';
             push @lines, Slic3r::Line::FacetEdge->cast(
                 [ [$a->[X], $a->[Y]], [$b->[X], $b->[Y]] ],
-                edge_type => (grep $_->[Z] > $z, @$vertices) ? 'bottom' : 'top',
+                edge_type => $edge_type,
             );
-            #print "Horizontal!\n";
+            #print "Horizontal edge!\n";
             
         } elsif (($a->[Z] < $z && $b->[Z] > $z) || ($b->[Z] < $z && $a->[Z] > $z)) {
             # edge intersects the current layer; calculate intersection

lib/Slic3r/SVG.pm

@@ -14,7 +14,24 @@ sub factor {
 sub svg {
     my ($print) = @_;
     $print ||= Slic3r::Print->new(x_length => 200 / $Slic3r::resolution, y_length => 200 / $Slic3r::resolution);
-    return SVG->new(width => $print->max_length * factor(), height => $print->max_length * factor());
+    my $svg = SVG->new(width => $print->max_length * factor(), height => $print->max_length * factor());
+    
+    my $marker_end = $svg->marker(
+        id => "endArrow",
+        viewBox => "0 0 10 10",
+        refX => "1",
+        refY => "5",
+        markerUnits => "strokeWidth",
+        orient => "auto",
+        markerWidth => "10",
+        markerHeight => "8",
+    );
+    $marker_end->polyline(
+        points => "0,0 10,5 0,10 1,5",
+        fill => "darkblue",
+    );
+    
+    return $svg;
 }
 
 sub output {
@@ -40,6 +57,7 @@ sub output {
                 );
                 $g->$method(
                     %$path,
+                    'marker-end' => "url(#endArrow)",
                 );
             }
         }
@@ -65,9 +83,9 @@ sub output {
         }
     }
     
-    foreach my $type (qw(lines red_lines)) {
+    foreach my $type (qw(lines red_lines green_lines)) {
         if ($things{$type}) {
-            my ($colour) = $type eq 'lines' ? ('black') : ('red');
+            my ($colour) = $type =~ /^(red|green)_/;
             my $g = $svg->group(
                 style => {
                     'stroke-width' => 2,
@@ -80,8 +98,9 @@ sub output {
                     x2 => $line->[1][X] * factor(),
                     y2 => $line->[1][Y] * factor(),
                     style => {
-                        'stroke' => $colour,
+                        'stroke' => $colour || 'black',
                     },
+                    'marker-end' => "url(#endArrow)",
                 );
             }
         }

t/geometry.t

@@ -2,7 +2,7 @@ use Test::More;
 use strict;
 use warnings;
 
-plan tests => 6;
+plan tests => 15;
 
 BEGIN {
     use FindBin;
@@ -10,6 +10,7 @@ BEGIN {
 }
 
 use Slic3r;
+use Slic3r::Geometry qw(PI);
 
 #==========================================================
 
@@ -43,15 +44,19 @@ is_deeply Slic3r::Geometry::polygon_segment_having_point($polyline, $point),
 
 #==========================================================
 
-$point = [ 736310778.185108, 5017423926.8924 ];
-my $line = [ [627484000, 3695776000], [750000000, 3720147000] ];
-is Slic3r::Geometry::point_in_segment($point, $line), 0, 'point_in_segment';
+{
+    my $point = [ 736310778.185108, 5017423926.8924 ];
+    my $line = [ [627484000, 3695776000], [750000000, 3720147000] ];
+    is Slic3r::Geometry::point_in_segment($point, $line), 0, 'point_in_segment';
+}
 
 #==========================================================
 
-$point = [ 736310778.185108, 5017423926.8924 ];
-my $line = [ [627484000, 3695776000], [750000000, 3720147000] ];
-is Slic3r::Geometry::point_in_segment($point, $line), 0, 'point_in_segment';
+{
+    my $point = [ 736310778.185108, 5017423926.8924 ];
+    my $line = [ [627484000, 3695776000], [750000000, 3720147000] ];
+    is Slic3r::Geometry::point_in_segment($point, $line), 0, 'point_in_segment';
+}
 
 #==========================================================
 
@@ -81,3 +86,31 @@ my $points = [
 is Slic3r::Geometry::can_connect_points(@$points, $polygons), 0, 'can_connect_points';
 
 #==========================================================
+
+{
+    my $p1 = [10, 10];
+    my $p2 = [10, 20];
+    my $p3 = [10, 30];
+    my $p4 = [20, 20];
+    my $p5 = [0,  20];
+    
+    is Slic3r::Geometry::angle3points($p2, $p3, $p1),  PI(),   'angle3points';
+    is Slic3r::Geometry::angle3points($p2, $p1, $p3),  PI(),   'angle3points';
+    is Slic3r::Geometry::angle3points($p2, $p3, $p4),  PI()/2*3, 'angle3points';
+    is Slic3r::Geometry::angle3points($p2, $p4, $p3),  PI()/2, 'angle3points';
+    is Slic3r::Geometry::angle3points($p2, $p1, $p4),  PI()/2, 'angle3points';
+    is Slic3r::Geometry::angle3points($p2, $p1, $p5),  PI()/2*3, 'angle3points';
+}
+
+{
+    my $p1 = [30, 30];
+    my $p2 = [20, 20];
+    my $p3 = [10, 10];
+    my $p4 = [30, 10];
+    
+    is Slic3r::Geometry::angle3points($p2, $p1, $p3), PI(),       'angle3points';
+    is Slic3r::Geometry::angle3points($p2, $p1, $p4), PI()/2*3,   'angle3points';
+    is Slic3r::Geometry::angle3points($p2, $p1, $p1), 2*PI(),     'angle3points';
+}
+
+#==========================================================

t/stl.t

@@ -21,12 +21,12 @@ is_deeply lines(20, 20, 20), [
     [ $points[2], $points[0] ],
 ], 'horizontal';
 
-is_deeply lines(22, 20, 20), [ [ $points[1], $points[2] ] ], 'lower edge on layer';
+is_deeply lines(22, 20, 20), [ [ $points[2], $points[1] ] ], 'lower edge on layer';
 is_deeply lines(20, 20, 10), [ [ $points[0], $points[1] ] ], 'upper edge on layer';
 is_deeply lines(20, 15, 10), [                            ], 'upper vertex on layer';
 is_deeply lines(28, 20, 30), [                            ], 'lower vertex on layer';
-is_deeply lines(24, 10, 16), [ [ [4, 4],     [2, 6]     ] ], 'two edges intersect';
-is_deeply lines(24, 10, 20), [ [ [4, 4],     [1, 9]     ] ], 'one vertex on plane and one edge intersects';
+is_deeply lines(24, 10, 16), [ [ [2, 6],     [4, 4]     ] ], 'two edges intersect';
+is_deeply lines(24, 10, 20), [ [ [1, 9],     [4, 4]     ] ], 'one vertex on plane and one edge intersects';
 
 my @lower = $stl->intersect_facet(vertices(22, 20, 20), $z, $dz);
 my @upper = $stl->intersect_facet(vertices(20, 20, 10), $z, $dz);