Lots of changes and refactoring after testing with hollow objects

README.markdown

@@ -43,6 +43,7 @@ Roadmap includes the following goals:
 * option for filling multiple solid layers near external surfaces;
 * support material for internal perimeters;
 * ability to infill in the direction of bridges;
+* input object transform (scale, rotate, multiply);
 * cool;
 * nice packaging for cross-platform deployment.
 

lib/Slic3r.pm

@@ -10,6 +10,7 @@ sub debugf {
 
 use Slic3r::ExtrusionPath;
 use Slic3r::Fill;
+use Slic3r::Geometry;
 use Slic3r::Layer;
 use Slic3r::Line;
 use Slic3r::Perimeter;
@@ -35,7 +36,7 @@ our $travel_feed_rate           = 80;   # mm/sec
 our $bottom_layer_speed_ratio   = 0.6;
 
 # accuracy options
-our $resolution         = 0.01;
+our $resolution         = 0.001;
 our $layer_height       = 0.4;
 our $flow_width;
 

lib/Slic3r/Fill/Rectilinear.pm

@@ -1,14 +1,18 @@
 package Slic3r::Fill::Rectilinear;
 use Moo;
 
-use constant epsilon => 1E-10;
 use constant PI => 4 * atan2(1, 1);
 use constant X1 => 0;
 use constant Y1 => 1;
 use constant X2 => 2;
 use constant Y2 => 3;
+use constant A => 0;
+use constant B => 1;
+use constant X => 0;
+use constant Y => 1;
 
 use Math::Geometry::Planar;
+use POSIX qw(ceil);
 use XXX;
 
 sub make_fill {
@@ -16,32 +20,38 @@ sub make_fill {
     my ($print, $layer) = @_;
     printf "Filling layer %d:\n", $layer->id;
     
-    # let's alternate fill direction
+    my $max_print_dimension = $print->max_length;
-    my @axes = $layer->id % 2 == 0 ? (0,1) : (1,0);
+    my $n = 1;
-    
     SURFACE: foreach my $surface (@{ $layer->fill_surfaces }) {
         Slic3r::debugf " Processing surface %s:\n", $surface->id;
         my $polygon = $surface->mgp_polygon;
         
-        # rotate surface as needed
+        # alternate fill direction
-        if ($axes[0] == 1) {
+        my (@rotate, @shift);
-            $polygon = $polygon->rotate(PI/2)->move($print->x_length, $print->y_length);
+        if ($layer->id % 2) {
+            @rotate = ( PI/2, [ $print->x_length / 2, $print->y_length / 2 ] );
+            $shift[X] = $print->y_length / 2 - $print->x_length / 2;
+            $shift[Y] = -$shift[X];
         }
         
+        # TODO: here we should implement an "infill in direction of bridges" option
+        
+        # rotate surface as needed
+        $polygon = $polygon->rotate(@rotate)->move(@shift) if @rotate;
+        
         # force 100% density for external surfaces
         my $density = $surface->surface_type eq 'internal' ? $Slic3r::fill_density : 1;
         next SURFACE unless $density > 0;
+        
         my $distance_between_lines = $Slic3r::flow_width / $Slic3r::resolution / $density;
-        my $number_of_lines = ($axes[0] == 0 ? $print->x_length : $print->y_length) / $distance_between_lines;
+        my $number_of_lines = ceil($max_print_dimension / $distance_between_lines);
+
+        printf "distance = %f\n", $distance_between_lines;
+        printf "number_of_lines = %d\n", $number_of_lines;
         
         # this arrayref will hold intersection points of the fill grid with surface segments
         my $points = [ map [], 0..$number_of_lines-1 ];
         foreach my $line (map $self->_lines_from_mgp_points($_), @{ $polygon->polygons }) {
-        
-            # for a possible implementation of "infill in direction of bridges"
-            # we should rotate $line so that primary axis is in detected direction;
-            # then, generated extrusion paths should be rotated back to the original
-            # coordinate system
             
             # find out the coordinates
             my @coordinates = map @$_, @$line;
@@ -50,8 +60,11 @@ sub make_fill {
             my @line_c = sort { $a <=> $b } @coordinates[X1, X2];
             Slic3r::debugf "Segment %d,%d - %d,%d (extents: %f, %f)\n", @coordinates, @line_c;
             
-            for (my $c = $line_c[0]; $c <= $line_c[1]; $c += $distance_between_lines) {
+            for (my $c = int($line_c[0] / $distance_between_lines) * $distance_between_lines; 
+                    $c <= $line_c[1]; $c += $distance_between_lines) {
+                next if $c < $line_c[0] || $c > $line_c[1];
                 my $i = sprintf('%.0f', $c / $distance_between_lines) - 1;
+                printf "CURRENT \$i = %d, \$c = %f\n", $i, $c;
                 
                 # if the segment is parallel to our ray, there will be two intersection points
                 if ($line_c[0] == $line_c[1]) {
@@ -69,12 +82,10 @@ sub make_fill {
         }
         
         # sort and remove duplicates
-        $points = [
+        for (my $i = 0; $i <= $#$points; $i++) {
-            map {
+            my %h = map { sprintf("%.9f", $_) => 1 } @{ $points->[$i] };
-                my %h = map { sprintf("%.0f", $_) => 1 } @$_;
+            $points->[$i] = [ sort { $a <=> $b } keys %h ];
-                [ sort keys %h ];
+        }
-            } @$points
-        ];
         
         # generate extrusion paths
         my (@paths, @path_points) = ();
@@ -83,22 +94,20 @@ sub make_fill {
         my $stop_path = sub {
             # defensive programming
             if (@path_points == 1) {
-                YYY \@path_points;
+                #warn "There shouldn't be only one point in the current path";
-                die "There shouldn't be only one point in the current path";
             }
                 
             # if we were constructing a path, stop it
-            push @paths, [ @path_points ] if @path_points;
+            push @paths, [ @path_points ] if @path_points > 1;
             @path_points = ();
         };
         
         # loop until we have spare points
-        while (map @$_, @$points) {
+        CYCLE: while (scalar map(@$_, @$points) > 1) {
-        
             # loop through rows
-            ROW: for (my $i = 0; $i < $number_of_lines; $i++) {
+            ROW: for (my $i = 0; $i <= $#$points; $i++) {
                 my $row = $points->[$i] or next ROW;
-                Slic3r::debugf "Processing row %d...\n", $i;
+                Slic3r::debugf "\nProcessing row %d (direction: %d)...\n", $i, $direction;
                 if (!@$row) {
                     Slic3r::debugf "  no points\n";
                     $stop_path->();
@@ -111,12 +120,14 @@ sub make_fill {
                 
                 # need to start a path?
                 if (!@path_points) {
+                    Slic3r::debugf "  path starts at %d\n", $row->[0];
                     push @path_points, [ $c, shift @$row ];
                 }
                 
-                my @connectable_points = $self->find_connectable_points($polygon, $path_points[-1], $c, $row);
+                my @search_points = @$row;
-                @connectable_points = reverse @connectable_points if $direction == 1;
+                @search_points = reverse @search_points if $direction == 1;
-                Slic3r::debugf "  found %d connectable points = %s\n", scalar(@connectable_points),
+                my @connectable_points = $self->find_connectable_points($polygon, $path_points[-1], $c, [@search_points]);
+                Slic3r::debugf "  ==> found %d connectable points = %s\n", scalar(@connectable_points),
                     join ', ', @connectable_points if $Slic3r::debug;
                 
                 if (!@connectable_points && @path_points && $path_points[-1][0] != $c) {
@@ -124,6 +135,12 @@ sub make_fill {
                     $stop_path->();
                 }
                 
+                if (@connectable_points == 1 && $path_points[0][0] != $c 
+                    && (($connectable_points[0] == $row->[-1] && $direction == 0)
+                        || ($connectable_points[0] == $row->[0] && $direction == 1))) {
+                    $i--; # keep searching on current row in the opposite direction
+                }
+                
                 foreach my $p (@connectable_points) {
                     push @path_points, [ $c, $p ];
                     @$row = grep $_ != $p, @$row;  # remove point from row
@@ -136,13 +153,14 @@ sub make_fill {
         }
         
         # paths must be rotated back
-        if ($axes[0] == 1) {
+        if (@rotate) {
-            @paths = map $self->_mgp_from_points_ref($_)->move(-$print->x_length, -$print->y_length)->rotate(-PI()/2)->points, @paths;
+            # TODO: this skips 2-points paths! we shouldn't create a mgp polygon
+            @paths = map $self->_mgp_from_points_ref($_)->move(map -$_, @shift)->rotate(-$rotate[0], $rotate[1])->points, @paths;
         }
         
         # save into layer
-        push @{ $layer->fills }, map Slic3r::ExtrusionPath->new_from_points(@$_), @paths;
+        FINISH: push @{ $layer->fills }, map Slic3r::ExtrusionPath->cast([ @$_ ]), @paths;
-    }
+    }#exit if $layer->id == 1;
 }
 
 # this function will select the first contiguous block of 
@@ -153,8 +171,11 @@ sub find_connectable_points {
     
     my @connectable_points = ();
     foreach my $p (@$points) {
-        push @connectable_points, $p 
+        if (!$self->can_connect($polygon, $point, [ $c, $p ])) {
-            if $self->can_connect($polygon, $point, [ $c, $p ]);
+             @connectable_points ? last : next;
+        }
+        push @connectable_points, $p;
+        $point = [ $c, $p ] if $point->[0] != $c;
     }
     return @connectable_points;
 }
@@ -164,32 +185,100 @@ sub find_connectable_points {
 sub can_connect {
     my $self = shift;
     my ($polygon, $p1, $p2) = @_;
+    printf "  Checking connectability of point %d\n", $p2->[1];
     
     # there's room for optimization here
     
     # this is not needed since we assume that $p1 and $p2 belong to $polygon
-    ###for ($p1, $p2) {
+    for ($p1, $p2) {
-        ###return 0 unless $polygon->isinside($_);
+        #return 0 unless $polygon->isinside($_);
-    ###}
+        
+        # TODO: re-enable this one after testing point_in_polygon() which
+        # doesn't detect well points on the contour of polygon
+        #return 0 unless Slic3r::Geometry::point_in_polygon($_, $polygon->points);
+    }
     
     # check whether the $p1-$p2 segment doesn't intersect any segment
     # of the contour or of holes
-    foreach my $points (@{ $polygon->polygons }) {
+    my ($contour_p, @holes_p) = $polygon->get_polygons;
+    foreach my $points ($contour_p, @holes_p) {
         foreach my $line ($self->_lines_from_mgp_points($points)) {
-            my $point = SegmentIntersection([$p1, $p2, @$line]);
+            
-            if ($point && !$self->points_coincide($point, $p1) && !$self->points_coincide($point, $p2)) {
+            # theoretically speaking, SegmentIntersection() would be the right tool for the 
-                return 0;
+            # job; however floating point math often makes it not return any intersection
+            # point between our hypothetical extrusion segment and any other one, even 
+            # if, of course, the final point of the extrusion segment is taken from
+            # $point and thus it's a point that belongs for sure to a segment.
+            # then, let's calculate intersection considering extrusion segment as a ray
+            # instead of a segment, and then check whether the intersection point 
+            # belongs to the segment
+            my $point = SegmentRayIntersection([@$line, $p1, $p2]);
+            #printf "    intersecting ray %f,%f - %f,%f and segment %f,%f - %f,%f\n",
+            #    @$p1, @$p2, map @$_, @$line;
+            
+            if ($point && Slic3r::Geometry::line_point_belongs_to_segment($point, [$p1, $p2])) {
+                #printf "  ...point intersects!\n";
+                #YYY [ $point, $p1, $p2 ];
+                
+                # our $p1-$p2 line intersects $line
+                
+                # if the intersection point is an intermediate point of $p1-$p2
+                # it means that $p1-$p2 crosses $line, thus we're sure that 
+                # $p1 and $p2 are not connectible (one is inside polygon and one
+                # is outside), unless $p1-$p2 and $line coincide but we've got
+                # an intersection due to floating point math
+                my @points_not_belonging_to_line = grep !Slic3r::Geometry::points_coincide($point, $_), $p1, $p2;
+                if (@points_not_belonging_to_line == 2) {
+                
+                    # make sure $p1-$p2 and $line are two distinct lines; we do this
+                    # by checking their slopes
+                    if (!Slic3r::Geometry::lines_parallel([$p1, $p2], $line)) {
+                        #printf "  ...lines cross!\n";
+                        #Slic3r::SVG::output_lines($main::print, "lines" . $n++ . ".svg", [ @lines, [$p1, $p2] ]);
+                        return 0;
+                    }
+                    
+                }
+                
+                # defensive programming, this shouldn't happen
+                if (@points_not_belonging_to_line == 0) {
+                    die "SegmentIntersection is not expected to return an intersection point "
+                        . "if \$line coincides with \$p1-\$p2";
+                }
+                
+                # if we're here, then either $p1 or $p2 belong to $line
+                # so we have to check whether the other point falls inside
+                # the polygon or not
+                # we rely on Math::Geometry::Planar returning contour points
+                # in counter-clockwise order and hole points in clockwise
+                # order, so that if the point falls on the left of $line
+                # it's inside the polygon and viceversa
+                my $C = $points_not_belonging_to_line[0];
+                my $isInside = (($line->[B][X] - $line->[A][X])*($C->[Y] - $line->[A][Y]) 
+                    - ($line->[B][Y] - $line->[A][Y])*($C->[X] - $line->[A][X])) > 0;
+                
+                #printf "  \$line is inside polygon: %d\n", $isInside;
+                
+                
+                # if the line is outside the polygon then points are not connectable
+                return 0 if !$isInside;
+                #Slic3r::SVG::output_lines($main::print, "lines" . $n++ . ".svg", [ @lines, [$p1, $p2] ])
+                #    if !$isInside;
             }
         }
     }
-    
-    return 1;
-}
 
-sub points_coincide {
+    # even if no intersection is found, we should check whether both $p1 and $p2 are
-    my $self = shift;
+    # inside a hole; this may happen due to floating point path
-    my ($p1, $p2) = @_;
+    #foreach my $hole_p (map $self->_mgp_from_points_ref($_), @holes_p) {
-    return 0 if $p2->[0] - $p1->[0] < epsilon && $p2->[1] - $p1->[1] < epsilon;
+    #    if ($hole_p->isinside($p1) || $hole_p->isinside($p2)) {
+    #        return 0;
+    #    }
+    #}
+    
+    #use Slic3r::SVG;
+    #Slic3r::SVG::output_lines($main::print, "lines" . $n++ . ".svg", [ @lines, [$p1, $p2] ]);
+    
     return 1;
 }
 

lib/Slic3r/Geometry.pm

@@ -0,0 +1,118 @@
+package Slic3r::Geometry;
+use strict;
+use warnings;
+
+use XXX;
+
+use constant A => 0;
+use constant B => 1;
+use constant X => 0;
+use constant Y => 1;
+use constant epsilon => 1E-8;
+use constant epsilon2 => epsilon**2;
+
+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]);
+}
+
+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;
+}
+
+# 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);
+}
+
+sub point_in_polygon {
+    my ($point, $polygon) = @_;
+    
+    my ($x, $y) = @$point;
+    my @xy = map @$_, @$polygon;
+    
+    # Derived from the comp.graphics.algorithms FAQ,
+    # courtesy of Wm. Randolph Franklin
+    my $n = @xy / 2;                        # Number of points in polygon
+    my @i = map { 2*$_ } 0..(@xy/2);        # The even indices of @xy
+    my @x = map { $xy[$_]     } @i;         # Even indices: x-coordinates
+    my @y = map { $xy[$_ + 1] } @i;         # Odd indices:  y-coordinates
+    
+    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) {
+        foreach my $line (polygon_lines($polygon)) {
+            # calculate the Y in line at X of the point
+            if ($line->[A][X] == $line->[B][X]) {
+                return 1 if abs($x - $line->[A][X]) < epsilon;
+                next;
+            }
+            my $y3 = $line->[A][Y] + ($line->[B][Y] - $line->[A][Y])
+                * ($x - $line->[A][X]) / ($line->[B][X] - $line->[A][X]);
+            return 1 if abs($y3 - $y) < epsilon2;
+        }
+    }
+    
+    return $side;
+}
+
+sub polygon_lines {
+    my ($polygon) = @_;
+    
+    my @lines = ();
+    my $last_point = $polygon->[-1];
+    foreach my $point (@$polygon) {
+        push @lines, [ $last_point, $point ];
+        $last_point = $point;
+    }
+    
+    return @lines;
+}
+
+1;

lib/Slic3r/Layer.pm

@@ -1,6 +1,8 @@
 package Slic3r::Layer;
 use Moo;
 
+use Math::Clipper ':all';
+use Math::Geometry::Planar;
 use XXX;
 
 # a sequential number of layer, starting at 0
@@ -10,18 +12,8 @@ has 'id' => (
     required    => 1,
 );
 
-# index of points generated by slicing the original geometry
+# collection of spare segments generated by slicing the original geometry;
-# keys are stringified coordinates (example: "0,0")
+# these need to be merged in continuos (closed) polylines
-# each points connects exactly two segments
-has 'pointmap' => (
-    traits      => ['Hash'],
-    is          => 'rw',
-    #isa         => 'HashRef[Slic3r::Point]',
-    default     => sub { {} },
-);
-
-# collection of segments generated by slicing the original geometry
-# each segment is part of a closed polyline
 has 'lines' => (
     is      => 'rw',
     #isa     => 'ArrayRef[Slic3r::Line]',
@@ -30,7 +22,6 @@ has 'lines' => (
 
 # collection of surfaces generated by slicing the original geometry
 has 'surfaces' => (
-    traits  => ['Array'],
     is      => 'rw',
     #isa     => 'ArrayRef[Slic3r::Surface]',
     default => sub { [] },
@@ -53,7 +44,6 @@ has 'skirts' => (
 # collection of surfaces generated by offsetting the innermost perimeter(s)
 # they represent boundaries of areas to fill
 has 'fill_surfaces' => (
-    traits  => ['Array'],
     is      => 'rw',
     #isa     => 'ArrayRef[Slic3r::Surface]',
     default => sub { [] },
@@ -71,24 +61,21 @@ sub z {
     return $self->id * $Slic3r::layer_height / $Slic3r::resolution;
 }
 
-sub points {
-    my $self = shift;
-    return values %{ $self->pointmap };
-}
-
 sub add_surface {
     my $self = shift;
     my (@vertices) = @_;
     
-    my @points = map $self->add_point($_), @vertices;
+    # convert arrayref points to Point objects
-    my $polyline = Slic3r::Polyline::Closed->new_from_points(@points);
+    @vertices = map Slic3r::Point->cast($_), @vertices;
-    my @lines = map $self->add_line($_), @{ $polyline->lines };
     
     my $surface = Slic3r::Surface->new(
-        contour => Slic3r::Polyline::Closed->new(lines => \@lines),
+        contour => Slic3r::Polyline::Closed->new(points => \@vertices),
     );
     push @{ $self->surfaces }, $surface;
     
+    # make sure our contour has its points in counter-clockwise order
+    $surface->contour->make_counter_clockwise;
+    
     return $surface;
 }
 
@@ -97,60 +84,12 @@ sub add_line {
     my ($a, $b) = @_;
     
     # we accept either a Line object or a couple of points
-    my $line;
+    my $line = Slic3r::Line->cast([ $a, $b ]);
-    if ($b) {
-        ($a, $b) = map $self->add_point($_), ($a, $b);
-        $line = Slic3r::Line->new(a => $a, b => $b);
-    } elsif (ref $a eq 'Slic3r::Line') {
-        $line = $a;
-    }
-    
-    # check whether we already have such a line
-    foreach my $point ($line->a, $line->b) {
-        foreach my $existing_line (grep $_, @{$point->lines}) {
-            return $existing_line 
-                if $line->coincides_with($existing_line) && $line ne $existing_line;
-        }
-    }
     
     push @{ $self->lines }, $line;
     return $line;
 }
 
-sub add_point {
-    my $self = shift;
-    my ($point) = @_;
-    
-    # we accept either a Point object or a pair of coordinates
-    if (ref $point eq 'ARRAY') {
-        $point = Slic3r::Point->new('x' => $point->[0], 'y' => $point->[1]);
-    }
-    
-    # check whether we already defined this point
-    if (my $existing_point = $self->pointmap_get($point->x, $point->y)) { #)
-        return $existing_point;
-    }
-    
-    # define the new point
-    $self->pointmap->{ $point->id } = $point; #}}
-    
-    return $point;
-}
-
-sub pointmap_get {
-    my $self = shift;
-    my ($x, $y) = @_;
-    
-    return $self->pointmap->{"$x,$y"};
-}
-
-sub remove_point {
-    my $self = shift;
-    my ($point) = @_;
-    
-    delete $self->pointmap->{ $point->id }; #}}
-}
-
 sub remove_line {
     my $self = shift;
     my ($line) = @_;
@@ -163,81 +102,62 @@ sub remove_surface {
     @{ $self->surfaces } = grep $_ ne $surface, @{ $self->surfaces };
 }
 
-# merge parallel and continuous lines
-sub merge_continuous_lines {
-    my $self = shift;
-    
-    my $finished = 0;
-    CYCLE: while (!$finished) {
-        foreach my $line (@{ $self->lines }) {
-            # TODO: we shouldn't skip lines already included in polylines
-            next if $line->polyline;
-            my $slope = $line->slope;
-            
-            foreach my $point ($line->points) {
-                # skip points connecting more than two lines
-                next if @{ $point->lines } > 2;
-                
-                foreach my $neighbor_line (@{ $point->lines }) {
-                    next if $neighbor_line eq $line;
-                    
-                    # skip line if it's not parallel to ours
-                    my $neighbor_slope = $neighbor_line->slope;
-                    next if (!defined $neighbor_slope &&  defined $slope)
-                          || (defined $neighbor_slope && !defined $slope)
-                          || (defined $neighbor_slope &&  defined $slope && $neighbor_slope != $slope);
-                    
-                    # create new line
-                    my ($a, $b) = grep $_ ne $point, $line->points, $neighbor_line->points;
-                    my $new_line = $self->add_line($a, $b);
-                    Slic3r::debugf "Merging continuous lines %s and %s into %s\n", 
-                        $line->id, $neighbor_line->id, $new_line->id if $Slic3r::debug;
-                    
-                    # delete merged lines
-                    $self->remove_line($_) for ($line, $neighbor_line);
-                    
-                    # restart cycle
-                    next CYCLE;
-                }
-            }
-        }
-        $finished = 1;
-    }
-}
-
 # build polylines of lines which do not already belong to a surface
 sub make_polylines {
     my $self = shift;
     
-    # defensive programming: let's check that every point
+    # make a cache of line endpoints
-    # connects at least two lines
+    my %pointmap = ();
-    foreach my $point ($self->points) {
+    foreach my $line (@{ $self->lines }) {
-        if (grep $_, @{ $point->lines } < 2) {
+        for my $point (@{ $line->points }) {
-            warn "Found point connecting less than 2 lines:";
+            $pointmap{$point->id} ||= [];
-            XXX $point;
+            push @{ $pointmap{$point->id} }, $line;
         }
     }
     
+    # defensive programming
+    die "No point should be endpoint of less or more than 2 lines!"
+        if grep @$_ != 2, values %pointmap;
+    
+    # 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 = [];
-    foreach my $line (@{ $self->lines }) {
+    
-        next if $line->polyline;
+    # 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;
         
-        my %points = map {$_ => $_} $line->points;
+        # loop through connected lines until we return to the first point
-        my %visited_lines = ();
+        while (my $next_line = $pointmap{$last_point->id}->[0]) {
-        my ($cur_line, $next_line) = ($line, undef);
-        while (!$next_line || $next_line ne $line) {
-            $visited_lines{ $cur_line } = $cur_line;
             
-            $next_line = +(grep !$visited_lines{$_}, $cur_line->neighbors)[0]
+            # get next point
-                or last;
+            ($last_point) = grep $_->id ne $last_point->id, @{$next_line->points};
             
-            $points{$_} = $_ for grep $_ ne $cur_line->a && $_ ne $cur_line->b, $next_line->points;
+            # add point to polyline
-            $cur_line = $next_line;
+            push @$points, $last_point;
+            $remove_line->($next_line);
         }
         
-        Slic3r::debugf "Discovered polyline of %d lines (%s)\n", scalar keys %points,
+        # remove last point as it coincides with first one
-            join('-', map $_->id, values %visited_lines) if $Slic3r::debug;
+        pop @$points;
-        push @$polylines, Slic3r::Polyline::Closed->new(lines => [values %visited_lines]);
+        
+        die "Invalid polyline with only 2 points\n" if @$points == 2;
+        
+        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;
     }
     
     return $polylines;
@@ -255,46 +175,59 @@ sub make_surfaces {
     foreach my $polyline (@$polylines) {
         # a polyline encloses another one if any point of it is enclosed
         # in the other
-        my $point = $polyline->lines->[0]->a;
+        my $point = $polyline->points->[0];
+        my $ordered_id = $polyline->id;
+        
         $enclosing_polylines{$polyline} = 
-            [ grep $_ ne $polyline && $_->encloses_point($point), @$polylines ];
+            [ grep $_->id ne $ordered_id && $_->encloses_point($point), @$polylines ];
         $enclosing_polylines_count{$polyline} = scalar @{ $enclosing_polylines{$polyline} };
         
         $max_depth = $enclosing_polylines_count{$polyline}
             if $enclosing_polylines_count{$polyline} > $max_depth;
     }
     
+    # make a cache for contours and surfaces
+    my %surfaces = ();   # contour => surface
+    
     # start looking at most inner polylines
     for (; $max_depth > -1; $max_depth--) {
         foreach my $polyline (@$polylines) {
-            next if $polyline->contour_of or $polyline->hole_of;
             next unless $enclosing_polylines_count{$polyline} == $max_depth;
             
             my $surface;
             if ($enclosing_polylines_count{$polyline} % 2 == 0) {
                 # this is a contour
+                $polyline->make_counter_clockwise;
                 $surface = Slic3r::Surface->new(contour => $polyline);
             } else {
                 # this is a hole
+                $polyline->make_clockwise;
+                
                 # find the enclosing polyline having immediately close depth
                 my ($contour) = grep $enclosing_polylines_count{$_} == ($max_depth-1), 
                     @{ $enclosing_polylines{$polyline} };
                 
-                if ($contour->contour_of) {
+                if ($surfaces{$contour}) {
-                    $surface = $contour->contour_of;
+                    $surface = $surfaces{$contour};
                     $surface->add_hole($polyline);
                 } else {
                     $surface = Slic3r::Surface->new(
                         contour => $contour,
                         holes   => [$polyline],
                     );
+                    $surfaces{$contour} = $surface;
                 }
             }
+            
+            # check whether we already have this surface
+            next if grep $_->id eq $surface->id, @{ $self->surfaces };
+            
             $surface->surface_type('internal');
             push @{ $self->surfaces }, $surface;
             
-            Slic3r::debugf "New surface: %s (holes: %s)\n", 
+            Slic3r::debugf "New surface: %s (%d holes: %s)\n", 
-                $surface->id, join(', ', map $_->id, @{$surface->holes}) || 'none'
+                $surface->id, scalar @{$surface->holes},
+                join(', ', map $_->id, @{$surface->holes}) || 'none'
                 if $Slic3r::debug;
         }
     }
@@ -303,62 +236,71 @@ sub make_surfaces {
 sub merge_contiguous_surfaces {
     my $self = shift;
     
-    my $finished = 0;
+    if ($Slic3r::debug) {
-    CYCLE: while (!$finished) {
+        Slic3r::debugf "Initial surfaces (%d):\n", scalar @{ $self->surfaces };
-        foreach my $surface (@{ $self->surfaces }) {
+        Slic3r::debugf "  [%s] %s (%s with %d holes)\n", $_->surface_type, $_->id, 
-            # look for a surface sharing one edge with this one
+            ($_->contour->is_counter_clockwise ? 'ccw' : 'cw'), scalar @{$_->holes} for @{ $self->surfaces };
-            foreach my $neighbor_surface (@{ $self->surfaces }) {
+        #Slic3r::SVG::output_polygons($main::print, "polygons-before.svg", [ map $_->contour->p, @{$self->surfaces} ]);
-                next if $surface eq $neighbor_surface;
+    }
-                
+    
-                # find lines shared by the two surfaces (might be 0, 1, 2)
+    my %resulting_surfaces = ();
-                my @common_lines = ();
+    
-                foreach my $line (@{ $neighbor_surface->contour->lines }) {
+    # only merge surfaces with same type
-                    next unless grep $_ eq $line, @{ $surface->contour->lines };
+    foreach my $type (qw(bottom top internal)) {
-                    push @common_lines, $line;
+        my $clipper = Math::Clipper->new;
-                }
+        my @surfaces = grep $_->surface_type eq $type, @{$self->surfaces}
-                next if !@common_lines;
+            or next;
-                
+        
-                # defensive programming
+        #Slic3r::SVG::output_polygons($main::print, "polygons-$type-before.svg", [ map $_->contour->p, @surfaces ]);
-                if (@common_lines > 2) {
+        $clipper->add_subject_polygons([ map $_->contour->p, @surfaces ]);
-                    Slic3r::debugf "Surfaces %s and %s share %d lines! How's it possible?\n",
+        
-                        $surface->id, $neighbor_surface->id, scalar @common_lines if $Slic3r::debug;
+        my $result = $clipper->ex_execute(CT_UNION, PFT_NONZERO, PFT_NONZERO);
-                }
+        $clipper->clear;
-                
+        
-                Slic3r::debugf "Surfaces %s and %s share line/lines %s!\n",
+        my @extra_holes = map @{$_->{holes}}, @$result;
-                    $surface->id, $neighbor_surface->id,
+        $result = [ map $_->{outer}, @$result ];
-                    join(', ', map $_->id, @common_lines) if $Slic3r::debug;
+        #Slic3r::SVG::output_polygons($main::print, "polygons-$type-union.svg", $result);
-                
+        
-                # defensive programming
+        # subtract bottom or top surfaces from internal
-                if ($surface->surface_type ne $neighbor_surface->surface_type) {
+        if ($type eq 'internal') {
-                    die "Surfaces %s and %s are of different types: %s, %s!\n",
+            $clipper->add_subject_polygons($result);
-                        $surface->id, $neighbor_surface->id,
+            $clipper->add_clip_polygons([ map $_->{outer}, @{$resulting_surfaces{$_}} ])
-                        $surface->surface_type, $neighbor_surface->surface_type;
+                for qw(bottom top);
-                }
+            $result = $clipper->execute(CT_DIFFERENCE, PFT_NONZERO, PFT_NONZERO);
-                
+            $clipper->clear;
-                # build new contour taking all lines of the surfaces' contours
-                # and removing the ones that matched
-                my @new_lines = map @{$_->contour->lines}, $surface, $neighbor_surface;
-                foreach my $line (@common_lines) {
-                    @new_lines = grep $_ ne $line, @new_lines;
-                }
-                my $new_contour = Slic3r::Polyline::Closed->new(
-                    lines => [ @new_lines ],
-                );
-                
-                # build new surface by combining all holes in the two surfaces
-                my $new_surface = Slic3r::Surface->new(
-                    contour         => $new_contour,
-                    holes           => [ map @{$_->holes}, $surface, $neighbor_surface ],
-                    surface_type    => $surface->surface_type,
-                );
-                
-                Slic3r::debugf "  merging into new surface %s\n", $new_surface->id;
-                push @{ $self->surfaces }, $new_surface;
-                
-                $self->remove_surface($_) for ($surface, $neighbor_surface);
-            }
         }
-        $finished = 1;
+        
+        # apply holes
+        $clipper->add_subject_polygons($result);
+        $result = $clipper->execute(CT_DIFFERENCE, PFT_NONZERO, PFT_NONZERO);
+        $clipper->clear;
+        
+        $clipper->add_subject_polygons($result);
+        $clipper->add_clip_polygons([ @extra_holes ]) if @extra_holes;
+        $clipper->add_clip_polygons([ map $_->p, map @{$_->holes}, @surfaces ]);
+        my $result2 = $clipper->ex_execute(CT_DIFFERENCE, PFT_NONZERO, PFT_NONZERO);
+        
+        $resulting_surfaces{$type} = $result2;
+    }
+    
+    # save surfaces
+    @{ $self->surfaces } = ();
+    foreach my $type (keys %resulting_surfaces) {
+        foreach my $p (@{ $resulting_surfaces{$type} }) {
+            push @{ $self->surfaces }, Slic3r::Surface->new(
+                surface_type => $type,
+                contour => Slic3r::Polyline::Closed->cast($p->{outer}),
+                holes   => [
+                    map Slic3r::Polyline::Closed->cast($_), @{$p->{holes}}
+                ],
+            );
+        }
+    }
+    
+    if ($Slic3r::debug) {
+        Slic3r::debugf "Final 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 };
     }
 }
 

lib/Slic3r/Line.pm

@@ -2,40 +2,27 @@ package Slic3r::Line;
 use Moo;
 use Scalar::Util qw(weaken);
 
-has 'a' => (
+# arrayref of points
-    is          => 'ro',
+has 'points' => (
-    #isa         => 'Slic3r::Point',
-    required    => 1,
-);
-
-has 'b' => (
-    is          => 'ro',
-    #isa         => 'Slic3r::Point',
-    required    => 1,
-);
-
-has 'polyline' => (
     is          => 'rw',
-    #isa         => 'Slic3r::Polyline',
+    default     => sub { [] },
-    weak_ref    => 1,
+    required    => 1,
 );
 
-has 'solid_side' => (
+sub cast {
-    is      => 'rw',
+    my $class = shift;
-    #isa     => enum([qw(left right)]),  # going from a to b
+    my ($line) = @_;
-);
+    if (ref $line eq 'ARRAY') {
-
+        @$line == 2 or die "Line needs two points!";
-sub BUILD {
+        return Slic3r::Line->new(points => [ map Slic3r::Point->cast($_), @$line ]);
-    my $self = shift;
+    } else {
-    
+        return $line;
-    # add a weak reference to this line in point objects
-    # (avoid circular refs)
-    for ($self->a, $self->b) {
-        push @{ $_->lines }, $self;
-        weaken($_->lines->[-1]);
     }
 }
 
+sub a { return $_[0]->points->[0] }
+sub b { return $_[0]->points->[1] }
+
 sub id {
     my $self = shift;
     return $self->a->id . "-" . $self->b->id;
@@ -46,6 +33,11 @@ sub coordinates {
     return ($self->a->coordinates, $self->b->coordinates);
 }
 
+sub p {
+    my $self = shift;
+    return [ $self->a->p, $self->b->p ];
+}
+
 sub coincides_with {
     my $self = shift;
     my ($line) = @_;
@@ -62,23 +54,13 @@ sub has_endpoint {
 
 sub slope {
     my $self = shift;
-    return undef if $self->b->x == $self->a->x;  # line is vertical
+    return Slic3r::Geometry::slope($self->p);
-    return ($self->b->y - $self->a->y) / ($self->b->x - $self->a->x); #)
 }
 
-sub neighbors {
+sub parallel_to {
     my $self = shift;
-    return grep $_ && $_ ne $self, map @{$_->lines}, $self->a, $self->b;
+    my ($line) = @_;
-}
+    return Slic3r::Geometry::lines_parallel($self->p, $line->p);
-
-sub next {
-    my $self = shift;
-    return +(grep $_ && $_ ne $self, @{$self->b->lines})[0];
-}
-
-sub points {
-    my $self = shift;
-    return ($self->a, $self->b);
 }
 
 1;

lib/Slic3r/Perimeter.pm

@@ -1,8 +1,10 @@
 package Slic3r::Perimeter;
 use Moo;
 
+use Math::Clipper ':all';
 use Math::Geometry::Planar;
 *Math::Geometry::Planar::OffsetPolygon = *Math::Geometry::Planar::Offset::OffsetPolygon;
+use XXX;
 
 use constant X => 0;
 use constant Y => 1;
@@ -23,8 +25,8 @@ sub make_perimeter {
         
         # first perimeter
         {
-            my $polygon = $surface->mgp_polygon;
+            my $polygon = $surface->clipper_polygon;
-            my ($contour_p, @holes_p) = @{ $polygon->polygons };
+            my ($contour_p, @holes_p) = ($polygon->{outer}, @{$polygon->{holes}});
             push @{ $contours{$surface} }, $contour_p;
             push @{ $holes{$surface} }, @holes_p;
             push @perimeters, $polygon;
@@ -37,7 +39,7 @@ sub make_perimeter {
             my @offsets = $self->offset_polygon($perimeters[-1]);
             
             foreach my $offset_polygon (@offsets) {
-                my ($contour_p, @holes_p) = @{ $offset_polygon->polygons };
+                my ($contour_p, @holes_p) = ($offset_polygon->{outer}, @{$offset_polygon->{holes}});
                 
                 push @{ $contours{$surface} }, $contour_p;
                 push @{ $holes{$surface} }, @holes_p;
@@ -46,17 +48,29 @@ sub make_perimeter {
         }
         
         # create one more offset to be used as boundary for fill
-        push @{ $layer->fill_surfaces }, 
+        push @{ $layer->fill_surfaces },
-            map Slic3r::Surface->new_from_mgp($_, surface_type => $surface->surface_type), 
+            map Slic3r::Surface->new(
-                $self->offset_polygon($perimeters[-1]);
+                surface_type => $surface->surface_type,
+                contour      => Slic3r::Polyline::Closed->cast($_->{outer}),
+                holes        => [
+                    map Slic3r::Polyline::Closed->cast($_), @{$_->{holes}}
+                ],
+            ), $self->offset_polygon($perimeters[-1]),
     }
     
     # generate paths for holes
     # we start from innermost loops (that is, external ones), do them
     # for all holes, than go on with inner loop and do that for all
     # holes and so on
-    foreach my $p (map @$_, values %holes) {
+    foreach my $hole (map @$_, values %holes) {
-        push @{ $layer->perimeters }, Slic3r::Polyline->new_from_points(@{ $p->points });
+        my @points = @$hole;
+        push @points, [ @{$points[0]} ];
+        # to avoid blobs, the first point is replaced by the point of
+        # the segment which is $Slic3r::flow_width / $Slic3r::resolution 
+        # away from it to avoid the extruder to get two times there
+        $points[0] = $self->_get_point_along_line($points[0], $points[1], 
+            $Slic3r::flow_width / $Slic3r::resolution);
+        push @{ $layer->perimeters }, Slic3r::ExtrusionPath->cast([@points]);
     }
     
     # generate paths for contours
@@ -74,10 +88,10 @@ sub make_perimeter {
             # away from it to avoid the extruder to get two times there
             push @$points, [ @{$points->[0]} ];
             $points->[0] = $self->_get_point_along_line($points->[0], $points->[1], 
-                $Slic3r::flow_width * 1.2 / $Slic3r::resolution);
+                $Slic3r::flow_width / $Slic3r::resolution);
             push @path_points, @$points;
         }
-        push @{ $layer->perimeters }, Slic3r::ExtrusionPath->new_from_points(reverse @path_points);
+        push @{ $layer->perimeters }, Slic3r::ExtrusionPath->cast([ reverse @path_points ]);
     }
     
     # generate skirt on bottom layer
@@ -85,7 +99,9 @@ sub make_perimeter {
         # find out convex hull
         my $points = [ map { @{ $_->mgp_polygon->polygons->[0] } } @{ $layer->surfaces } ];
         my $convex_hull = $self->_mgp_from_points_ref($points)->convexhull2;
-        my $convex_hull_polygon = $self->_mgp_from_points_ref($convex_hull);
+        my $convex_hull_polygon = ref $convex_hull eq 'ARRAY' 
+            ? $self->_mgp_from_points_ref($convex_hull)
+            : $convex_hull;
         
         # draw outlines from outside to inside
         for (my $i = $Slic3r::skirts - 1; $i >= 0; $i--) {
@@ -93,7 +109,7 @@ sub make_perimeter {
                 - ($Slic3r::skirt_distance + ($Slic3r::flow_width * $i)) / $Slic3r::resolution
             );
             push @{$outline->[0]}, $outline->[0][0]; # repeat first point as last to complete the loop
-            push @{ $layer->skirts }, Slic3r::ExtrusionPath->new_from_points(@{$outline->[0]});
+            push @{ $layer->skirts }, Slic3r::ExtrusionPath->cast([ @{$outline->[0]} ]);
         }
     }
 }
@@ -102,32 +118,67 @@ sub offset_polygon {
     my $self = shift;
     my ($polygon) = @_;
     
-    # $polygon holds a Math::Geometry::Planar object representing 
+    my $distance = $Slic3r::flow_width / $Slic3r::resolution;
-    # a polygon and its holes
-    my ($contour_p, @holes_p) = map $self->_mgp_from_points_ref($_), @{ $polygon->polygons };
-            
-    # generate offsets
-    my $contour_offsets = $contour_p->offset_polygon($Slic3r::flow_width / $Slic3r::resolution);
-    my @hole_offsets = map @$_, map $_->offset_polygon(- $Slic3r::flow_width / $Slic3r::resolution), @holes_p;
     
-    # now we subtract perimeter offsets from the contour offset polygon
+    # $polygon holds a Math::Clipper ExPolygon hashref representing 
-    # this will generate a single polygon with correct holes and also
+    # a polygon and its holes
-    # will take care of collisions between contour offset and holes
+    my ($contour_p, @holes_p) = ($polygon->{outer}, @{$polygon->{holes}});
-    my @resulting_offsets = ();
+    
-    foreach my $contour_points (@$contour_offsets) {
+    # generate offsets
-        my $tmp = $self->_mgp_from_points_ref($contour_points)->convert2gpc;
+    my $offsets = offset([ $contour_p, @holes_p ], -$distance, 1);
-        foreach my $hole_points (@hole_offsets) {
+    
-            $hole_points = $self->_mgp_from_points_ref($hole_points)->convert2gpc;
+    # fix order of holes
-            $tmp = GpcClip('DIFFERENCE', $tmp, $hole_points);
+    @$offsets = map [ reverse @$_ ], @$offsets;
+    
+    # defensive programming
+    my (@contour_offsets, @hole_offsets) = ();
+    for (@$offsets) {
+        if (is_counter_clockwise($_)) {
+            push @contour_offsets, $_;
+        } else {
+            push @hole_offsets, $_;
         }
-        
-        my ($result) = Gpc2Polygons($tmp);
-        # now we've got $result, which is a Math::Geometry::Planar
-        # representing the inner surface including hole perimeters
-        push @resulting_offsets, $result;
     }
     
-    return @resulting_offsets;
+    # apply all holes to all contours;
+    # this is improper, but Math::Clipper handles it
+    return map {{
+        outer => $_,
+        holes => [ @hole_offsets ],
+    }} @contour_offsets;
+    
+    
+    # OLD CODE to be removed
+    if (0) {
+        #my $contour_offsets = $contour_p->offset_polygon($Slic3r::flow_width / $Slic3r::resolution);
+        #my @hole_offsets = map @$_, map $_->offset_polygon(- $Slic3r::flow_width / $Slic3r::resolution), @holes_p;
+        Slic3r::SVG::output_polygons($main::print, "holes.svg", [ @holes_p ]);
+        my $contour_offsets = offset([ $contour_p ], -$distance);
+        my @hole_offsets = map { ref $_ eq 'ARRAY' ? @$_ : () } map offset([ $_ ], -$distance), @holes_p;
+        
+        # defensive programming
+        if (@$contour_offsets > 1) {
+            die "Got more than one contour offset!";
+        }
+        
+        # now we subtract perimeter offsets from the contour offset polygon
+        # this will generate a single polygon with correct holes and also
+        # will take care of collisions between contour offset and holes
+        my $clipper = Math::Clipper->new;
+        my @resulting_offsets = ();
+        foreach my $contour_points (@$contour_offsets) {
+            $clipper->clear;
+            $clipper->add_subject_polygon($contour_points);
+            $clipper->add_clip_polygon($_) for @hole_offsets;
+            
+            my $result = $clipper->ex_execute(CT_DIFFERENCE, PFT_NONZERO, PFT_NONZERO);
+            # now we've got @$result, which is an array of Math::Clipper ExPolygons
+            # representing the inner surface including hole perimeters
+            push @resulting_offsets, @$result;
+        }
+        
+        return @resulting_offsets;
+    }
 }
 
 sub _mgp_from_points_ref {

lib/Slic3r/Point.pm

@@ -3,24 +3,23 @@ use Moo;
 
 has 'x' => (
     is          => 'ro',
-    #isa         => 'Slic3r::Point::Coordinate',
     required    => 1,
     coerce      => sub { sprintf '%.0f', $_[0] },
 );
 
 has 'y' => (
     is          => 'ro',
-    #isa         => 'Slic3r::Point::Coordinate',
     required    => 1,
     coerce      => sub { sprintf '%.0f', $_[0] },
 );
 
-# this array contains weak references, so it can contain undef's as well
+sub cast {
-has 'lines' => (
+    my $class = shift;
-    is      => 'rw',
+    my ($point) = @_;
-    #isa     => 'ArrayRef[Slic3r::Line]',
+    return ref $point eq 'ARRAY' 
-    default => sub { [] },
+        ? Slic3r::Point->new(x => $point->[0], y => $point->[1])  # ==
-);
+        : $point;
+}
 
 sub id {
     my $self = shift;
@@ -32,20 +31,21 @@ sub coordinates {
     return ($self->x, $self->y); #))
 }
 
+sub p {
+    my $self = shift;
+    return [ $self->coordinates ];
+}
+
 sub coincides_with {
     my $self = shift;
     my ($point) = @_;
-    
+    return Slic3r::Geometry::points_coincide($self->p, $point->p);
-    $point = Slic3r::Point->new(x => $point->[0], y => $point->[1]) #==
-        if ref $point eq 'ARRAY';
-    return $self->x == $point->x && $self->y == $point->y; #=
 }
 
 sub distance_to {
     my $self = shift;
     my ($point) = @_;
-    
+    return Slic3r::Geometry::distance_between_points($self->p, $point->p);
-    return sqrt(($point->x - $self->x)**2 + ($point->y - $self->y)**2); #-
 }
 
 1;

lib/Slic3r/Polyline.pm

@@ -1,104 +1,85 @@
 package Slic3r::Polyline;
 use Moo;
 
-has 'lines' => (
+use Math::Clipper qw();
-    traits  => ['Array'],
+use Sub::Quote;
-    is      => 'rw',
+
-    #isa     => 'ArrayRef[Slic3r::Line]',
+# arrayref of ordered points
-    default => sub { [] },
+has 'points' => (
+    is          => 'rw',
+    required    => 1,
+    default     => sub { [] },
+    isa         => quote_sub q{ use Carp; confess "invalid points" if grep ref $_ ne 'Slic3r::Point', @{$_[0]} },
 );
 
-sub add_line {
-    my $self = shift;
-    my ($line) = @_;
-    
-    push @{ $self->lines }, $line;
-    
-    # add a weak reference to this polyline in line objects
-    # (avoid circular refs)
-    $self->lines->[-1]->polyline($self);
-}
-
-sub BUILD {
-    my $self = shift;
-    $_->polyline($self) for @{ $self->lines };
-}
-
 sub id {
     my $self = shift;
-    return join '-', map($_->id, $self->ordered_points(1));
+    return join ' - ', map $_->id, @{$self->points};
 }
 
-sub new_from_points {
+sub cast {
-    my $class = shift;
+    my $self = shift;
-    my (@points) = @_;
+    my ($points) = @_;
     
-    # we accept Point objects or arrayrefs with point coordinates
+    @$points = map { ref $_ eq 'ARRAY' ? Slic3r::Point->cast($_) : $_ } @$points;
-    @points = map {
+    return __PACKAGE__->new(points => $points);
-        ref $_ eq 'ARRAY' 
+}
-            ? Slic3r::Point->new('x' => $_->[0], 'y' => $_->[1])
+
-            : $_
+sub lines {
-    } @points;
+    my $self = shift;
-    
+    my @lines = ();
-    my $polyline = $class->new;
     my $previous_point;
-    $previous_point = $points[-1] if $class eq 'Slic3r::Polyline::Closed';
+    foreach my $point (@{ $self->points }) {
-    foreach my $point (@points) {
         if ($previous_point) {
-            my $line = Slic3r::Line->new(a => $previous_point, b => $point);
+            push @lines, Slic3r::Line->new(points => [ $previous_point, $point ]);
-            $polyline->add_line($line);
         }
         $previous_point = $point;
     }
-    
+    return @lines;
-    return $polyline;
 }
 
-sub points {
+sub p {
     my $self = shift;
-    my %points = ();
+    return [ map $_->p, @{$self->points} ];
-    $points{$_} = $_ for map $_->points, @{ $self->lines };
-    return values %points;
 }
 
-sub ordered_points {
+sub merge_continuous_lines {
     my $self = shift;
-    my ($as_objects) = @_;
-    my $points = [];
     
-    #printf "\n\n==> Number of lines: %d\n", scalar @{ $self->lines };
+    my $last_line;
-    my @lines = @{ $self->lines };
+    foreach my $line ($self->lines) {
-    while (@lines && @$points < @{ $self->lines }) {
+        if (defined $last_line && $line->parallel_to($last_line)) {
-        #printf "\nNumber of points: %d\n", scalar @{ $points };
+            # $line and $last_line are parallel and continuous,
-        my @temp = @lines;
+            # so we can remove their common point from our polyline
-        @lines = ();
+            
-        foreach my $line (@temp) {
+            # find common point
-            #printf "Line: %s\n", $line->id;
+            my ($common_point) = grep $_ eq $line->a || $_ eq $line->b, @{$last_line->points};
-            my $point;
+            
-            if (!@$points) {
+            # remove point from polyline
-                # make sure we start from a point not connected to another segment if any
+            @{$self->points} = grep $_ ne $common_point, @{$self->points};
-                push @$points, sort { @{$a->lines} <=> @{$b->lines} } $line->points;
-                next;
-            } elsif ($line->has_endpoint($points->[-1])) {
-                $point = +(grep $points->[-1] ne $_, $line->points)[0];
-            }
-            if (!$point) {
-                #printf "  no point found, retrying\n";
-                push @lines, $line;
-                next;
-            }
-            #printf "  adding point %s\n", $point->id;
-            push @$points, $point;
         }
+        $last_line = $line;
     }
-    
+}
-    pop @$points
+
-        if $self->isa('Slic3r::Polyline::Closed') && $points->[0]->coincides_with($points->[-1]);
+sub reverse_points {
-    
+    my $self = shift;
-    return @$points if $as_objects;
+    @{$self->points} = reverse @{$self->points};
-    
+}
-    $points = [ map [ $_->x, $_->y ], @$points ]; #]
+
-    return $points;
+sub is_counter_clockwise {
+    my $self = shift;
+    return Math::Clipper::is_counter_clockwise($self->p);
+}
+
+sub make_counter_clockwise {
+    my $self = shift;
+    $self->reverse_points if !$self->is_counter_clockwise;
+}
+
+sub make_clockwise {
+    my $self = shift;
+    $self->reverse_points if $self->is_counter_clockwise;
 }
 
 1;

lib/Slic3r/Polyline/Closed.pm

@@ -3,69 +3,40 @@ use Moo;
 
 extends 'Slic3r::Polyline';
 
-has 'contour_of' => (
+sub lines {
-    is          => 'rw',
+    my $self = shift;
-    #isa         => 'Slic3r::Surface',
+    my @lines = $self->SUPER::lines(@_);
-    weak_ref    => 1,
-);
-
-has 'hole_of' => (
-    is          => 'rw',
-    #isa         => 'Slic3r::Surface',
-    weak_ref    => 1,
-);
-
-sub new_from_points {
-    my $class = shift;
-    my $polyline = $class->SUPER::new_from_points(@_);
     
-    # polylines must be always closed, otherwise it means that our object is not manifold!
+    # since this is a closed polyline, we just add a line at the end,
-    die "Polylines must be closed! Object not manifold?\n"
+    # connecting the last and the first point
-        if ($polyline->lines->[0]->a != $polyline->lines->[-1]->b);
+    push @lines, Slic3r::Line->new(points => [$self->points->[-1], $self->points->[0]]);
+    return @lines;
+}
+
+# superclass doesn't check whether last line of our closed polyline
+# is parallel to first one, so let's do it here
+sub merge_continuous_lines {
+    my $self = shift;
+    $self->SUPER::merge_continuous_lines(@_);
     
-    return $polyline;
+    my @lines = $self->lines;
+    if ($lines[-1]->parallel_to($lines[0])) {
+        shift @{$self->points};
+    }
 }
 
 sub encloses_point {
     my $self = shift;
     my ($point) = @_;
     
-    my @xy = map { $_->x, $_->y } $self->points; #}}
+    return Slic3r::Geometry::point_in_polygon($point->p, $self->p);
-    my ($x, $y) = ($point->x, $point->y); #))
-    
-    # Derived from the comp.graphics.algorithms FAQ,
-    # courtesy of Wm. Randolph Franklin
-    my $n = @xy / 2;                        # Number of points in polygon
-    my @i = map { 2*$_ } 0..(@xy/2);        # The even indices of @xy
-    my @x = map { $xy[$_]     } @i;         # Even indices: x-coordinates
-    my @y = map { $xy[$_ + 1] } @i;         # Odd indices:  y-coordinates
-    
-    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
-        }
-    }
-    
-    return $side;
 }
 
 sub mgp_polygon {
     my $self = shift;
     
-    # we need a list of ordered points
-    my $points = $self->ordered_points;
-    
     my $p = Math::Geometry::Planar->new;
-    $p->points($points);
+    $p->points($self->points);
     return $p;
 }
 

lib/Slic3r/Print.pm

@@ -7,14 +7,12 @@ use constant Y => 1;
 
 has 'x_length' => (
     is          => 'ro',
-    #isa         => 'Slic3r::Line::Length',
     required    => 1,
     coerce      => sub { sprintf '%.0f', $_[0] },
 );
 
 has 'y_length' => (
     is          => 'ro',
-    #isa         => 'Slic3r::Line::Length',
     required    => 1,
     coerce      => sub { sprintf '%.0f', $_[0] },
 );
@@ -31,6 +29,11 @@ sub layer_count {
     return scalar @{ $self->layers };
 }
 
+sub max_length {
+    my $self = shift;
+    return ($self->x_length > $self->y_length) ? $self->x_length : $self->y_length;
+}
+
 sub layer {
     my $self = shift;
     my ($layer_id) = @_;
@@ -152,7 +155,7 @@ sub export_gcode {
         }
         
         # go to first point while compensating retraction
-        $G1->($path->lines->[0]->a, $z, 0, "move to first $description point");
+        $G1->($path->points->[0], $z, 0, "move to first $description point");
         
         # compensate retraction
         if ($retracted) {
@@ -161,7 +164,7 @@ sub export_gcode {
         }
         
         # extrude while going to next points
-        foreach my $line (@{ $path->lines }) {
+        foreach my $line ($path->lines) {
             # calculate how much filament to drive into the extruder
             # to get the desired amount of extruded plastic
             my $e = $line->a->distance_to($line->b) * $Slic3r::resolution

lib/Slic3r/STL.pm

@@ -38,7 +38,7 @@ sub parse_file {
     
     # calculate the displacements needed to 
     # have lowest value for each axis at coordinate 0
-    my @shift = map 0 - $extents[$_][MIN], X,Y,Z;
+    my @shift = map -$extents[$_][MIN], X,Y,Z;
     
     # process facets
     foreach my $facet ($stl->part->facets) {
@@ -55,11 +55,8 @@ sub parse_file {
     
     print "\n==> PROCESSING SLICES:\n";
     foreach my $layer (@{ $print->layers }) {
-        printf "Processing layer %d:\n", $layer->id;
+        printf "\nProcessing layer %d:\n", $layer->id;
     
-        # merge parallel and continuous lines
-        $layer->merge_continuous_lines;
-        
         # build polylines of lines which do not already belong to a surface
         my $polylines = $layer->make_polylines;
         
@@ -76,7 +73,7 @@ sub parse_file {
 sub _facet {
     my $self = shift;
     my ($print, $normal, @vertices) = @_;
-    Slic3r::debugf "\n==> FACET (%s):\n", join('-', map join(',', @$_), @vertices)
+    Slic3r::debugf "\n==> FACET (%f,%f,%f - %f,%f,%f - %f,%f,%f):\n", map @$_, @vertices
         if $Slic3r::debug;
     
     # find the vertical extents of the facet
@@ -105,8 +102,10 @@ sub _facet {
                       - ($vertices[1]->[X] - $vertices[0]->[X]) * ($vertices[2]->[Y] - $vertices[0]->[Y]);
         
         # defensive programming and/or input check
-        if (($normal->[Z] > 0 && $clockwise < 0) || ($normal->[Z] < 0 && $clockwise > 0)) {
+        if (($normal->[Z] > 0 && $clockwise > 0) || ($normal->[Z] < 0 && $clockwise < 0)) {
-            die "STL normal and right-hand rule computation differ!\n";
+            YYY $normal;
+            die sprintf "STL normal (%.0f) and right-hand rule computation (%s) differ!\n",
+                $normal->[Z], $clockwise > 0 ? 'clockwise' : 'counter-clockwise';
         }
         if ($layer->id == 0 && $clockwise < 0) {
             die "Right-hand rule gives bad result for facets on base layer!\n";
@@ -138,7 +137,7 @@ sub _facet {
                 
             } elsif (($a->[Z] < $z && $b->[Z] > $z) || ($b->[Z] < $z && $a->[Z] > $z)) {
                 # edge intersects the current layer; calculate intersection
-                push @intersection_points, $layer->add_point([
+                push @intersection_points, Slic3r::Point->cast([
                     $b->[X] + ($a->[X] - $b->[X]) * ($z - $b->[Z]) / ($a->[Z] - $b->[Z]),
                     $b->[Y] + ($a->[Y] - $b->[Y]) * ($z - $b->[Z]) / ($a->[Z] - $b->[Z]),
                 ]);
@@ -152,7 +151,6 @@ sub _facet {
             # check whether the two points coincide due to resolution rounding
             if ($intersection_points[0]->coincides_with($intersection_points[1])) {
                 Slic3r::debugf "Points coincide; removing\n";
-                $layer->remove_point($_) for @intersection_points;
                 next;
             }
             

lib/Slic3r/SVG.pm

@@ -0,0 +1,86 @@
+package Slic3r::SVG;
+use strict;
+use warnings;
+
+use SVG;
+
+use constant X => 0;
+use constant Y => 1;
+
+sub factor {
+    return $Slic3r::resolution * 10;
+}
+
+sub svg {
+    my ($print) = @_;
+    
+    return SVG->new(width => $print->max_length * factor(), height => $print->max_length * factor());
+}
+
+sub output_polygons {
+    my ($print, $filename, $polygons) = @_;
+    
+    my $svg = svg($print);
+    my $g = $svg->group(
+        style => {
+            'stroke-width' => 2,
+        },
+    );
+    foreach my $polygon (@$polygons) {
+        my $path = $svg->get_path(
+            'x' => [ map($_->[X] * factor(), @$polygon) ],
+            'y' => [ map($_->[Y] * factor(), @$polygon) ],
+            -type => 'polygon',
+        );
+        $g->polygon(
+            %$path,
+        );
+    }
+    
+    write_svg($svg, $filename);
+}
+
+sub output_lines {
+    my ($print, $filename, $lines) = @_;
+    
+    my $svg = svg($print);
+    my $g = $svg->group(
+        style => {
+            'stroke-width' => 2,
+        },
+    );
+    
+    my $color = 'red';
+    my $draw_line = sub {
+        my ($line) = @_;
+        $g->line(
+            x1 => $line->[0][X] * factor(),
+            y1 => $line->[0][Y] * factor(),
+            x2 => $line->[1][X] * factor(),
+            y2 => $line->[1][Y] * factor(),
+            style => {
+                'stroke' => $color,
+            },
+        );
+    };
+    
+    my $last = pop @$lines;
+    foreach my $line (@$lines) {
+        $draw_line->($line);
+    }
+    $color = 'black';
+    $draw_line->($last);
+    
+    write_svg($svg, $filename);
+}
+
+sub write_svg {
+    my ($svg, $filename) = @_;
+    
+    open my $fh, '>', $filename;
+    print $fh $svg->xmlify;
+    close $fh;
+    printf "SVG written to %s\n", $filename;
+}
+
+1;

lib/Slic3r/Surface.pm

@@ -28,19 +28,6 @@ sub add_hole {
     my ($hole) = @_;
     
     push @{ $self->holes }, $hole;
-    
-    # add a weak reference to this surface in polyline objects
-    # (avoid circular refs)
-    $self->holes->[-1]->hole_of($self);
-}
-
-sub BUILD {
-    my $self = shift;
-    
-    # add a weak reference to this surface in polyline objects
-    # (avoid circular refs)
-    $self->contour->contour_of($self) if $self->contour;
-    $_->hole_of($self) for @{ $self->holes };
 }
 
 sub new_from_mgp {
@@ -50,9 +37,9 @@ sub new_from_mgp {
     my ($contour_p, @holes_p) = @{ $polygon->polygons };
     
     return __PACKAGE__->new(
-        contour => Slic3r::Polyline::Closed->new_from_points(@$contour_p),
+        contour => Slic3r::Polyline::Closed->cast($contour_p),
         holes   => [
-            map Slic3r::Polyline::Closed->new_from_points(@$_), @holes_p
+            map Slic3r::Polyline::Closed->cast($_), @holes_p
         ],
         %params,
     );
@@ -76,10 +63,21 @@ sub mgp_polygon {
     my $self = shift;
     
     my $p = Math::Geometry::Planar->new;
-    $p->polygons([ map $_->points, $self->contour->mgp_polygon, map($_->mgp_polygon, @{ $self->holes }) ]);
+    $p->polygons([ $self->contour->p, map($_->p, @{ $self->holes }) ]);
     return $p;
 }
 
+sub clipper_polygon {
+    my $self = shift;
+    
+    return {
+        outer => $self->contour->p,
+        holes => [
+            map $_->p, @{$self->holes}
+        ],
+    };
+}
+
 sub lines {
     my $self = shift;
     return @{ $self->contour->lines }, map @{ $_->lines }, @{ $self->holes };

slic3r.pl

@@ -68,7 +68,8 @@ GetOptions(
         if $Slic3r::nozzle_diameter < 0;
     die "--layer-height can't be greater than --nozzle-diameter\n"
         if $Slic3r::layer_height > $Slic3r::nozzle_diameter;
-    $Slic3r::flow_width = $Slic3r::layer_height * ($Slic3r::nozzle_diameter**2);
+    $Slic3r::flow_width = 4 * (($Slic3r::nozzle_diameter/2)**2) / $Slic3r::layer_height;
+    Slic3r::debugf "Flow width = $Slic3r::flow_width\n";
     
     # --perimeters
     die "Invalid value for --perimeters\n"