package Slic3r::GCode::MotionPlanner; use Moo; has 'islands' => (is => 'ro', required => 1); # arrayref of ExPolygons has 'internal' => (is => 'ro', default => sub { 1 }); has '_space' => (is => 'ro', default => sub { Slic3r::GCode::MotionPlanner::ConfigurationSpace->new }); has '_inner' => (is => 'ro', default => sub { [] }); # arrayref of ExPolygons use List::Util qw(first max); use Slic3r::Geometry qw(A B scale epsilon); use Slic3r::Geometry::Clipper qw(offset offset_ex diff_ex intersection_pl); # clearance (in mm) from the perimeters has '_inner_margin' => (is => 'ro', default => sub { scale 1 }); has '_outer_margin' => (is => 'ro', default => sub { scale 2 }); # this factor weigths the crossing of a perimeter # vs. the alternative path. a value of 5 means that # a perimeter will be crossed if the alternative path # is >= 5x the length of the straight line we could # follow if we decided to cross the perimeter. # a nearly-infinite value for this will only permit # perimeter crossing when there's no alternative path. use constant CROSSING_PENALTY => 20; use constant POINT_DISTANCE => 10; # unscaled # setup our configuration space sub BUILD { my $self = shift; my $point_distance = scale POINT_DISTANCE; my $nodes = $self->_space->nodes; my $edges = $self->_space->edges; # process individual islands for my $i (0 .. $#{$self->islands}) { my $expolygon = $self->islands->[$i]; # find external margin my $outer = offset([ @$expolygon ], +$self->_outer_margin); my @outer_points = map @{$_->equally_spaced_points($point_distance)}, @$outer; # add outer points to graph my $o_outer = $self->_space->add_nodes(@outer_points); # find pairs of visible outer points and add them to the graph for my $i (0 .. $#outer_points) { for my $j (($i+1) .. $#outer_points) { my ($a, $b) = ($outer_points[$i], $outer_points[$j]); my $line = Slic3r::Polyline->new($a, $b); # outer points are visible when their line has empty intersection with islands my $intersection = intersection_pl( [ $line ], [ map @$_, @{$self->islands} ], ); if (!@$intersection) { $self->_space->add_edge($i+$o_outer, $j+$o_outer, $line->length); } } } if ($self->internal) { # find internal margin my $inner = offset_ex([ @$expolygon ], -$self->_inner_margin); push @{ $self->_inner }, @$inner; my @inner_points = map @{$_->equally_spaced_points($point_distance)}, map @$_, @$inner; # add points to graph and get their offset my $o_inner = $self->_space->add_nodes(@inner_points); # find pairs of visible inner points and add them to the graph for my $i (0 .. $#inner_points) { for my $j (($i+1) .. $#inner_points) { my ($a, $b) = ($inner_points[$i], $inner_points[$j]); my $line = Slic3r::Line->new($a, $b); # turn $inner into an ExPolygonCollection and use $inner->contains_line() if (first { $_->contains_line($line) } @$inner) { $self->_space->add_edge($i+$o_inner, $j+$o_inner, $line->length); } } } # generate the stripe around slice contours my $contour = diff_ex( $outer, [ map @$_, @$inner ], ); # find pairs of visible points in this area and add them to the graph for my $i (0 .. $#inner_points) { for my $j (0 .. $#outer_points) { my ($a, $b) = ($inner_points[$i], $outer_points[$j]); my $line = Slic3r::Line->new($a, $b); # turn $contour into an ExPolygonCollection and use $contour->contains_line() if (first { $_->contains_line($line) } @$contour) { $self->_space->add_edge($i+$o_inner, $j+$o_outer, $line->length * CROSSING_PENALTY); } } } } } # since Perl has no infinity symbol and we don't want to overcomplicate # the Dijkstra algorithm with string constants or -1 values $self->_space->_infinity(10 * (max(map values %$_, values %{$self->_space->edges}) // 0)); if (0) { require "Slic3r/SVG.pm"; Slic3r::SVG::output("space.svg", no_arrows => 1, expolygons => $self->islands, lines => $self->_space->get_lines, points => $self->_space->nodes, ); printf "%d islands\n", scalar @{$self->islands}; eval "use Devel::Size"; print "MEMORY USAGE:\n"; printf " %-19s = %.1fMb\n", $_, Devel::Size::total_size($self->$_)/1024/1024 for qw(_space islands); printf " %-19s = %.1fMb\n", $_, Devel::Size::total_size($self->_space->$_)/1024/1024 for qw(nodes edges); printf " %-19s = %.1fMb\n", 'self', Devel::Size::total_size($self)/1024/1024; exit if $self->internal; } } sub shortest_path { my $self = shift; my ($from, $to) = @_; return Slic3r::Polyline->new($from, $to) if !@{$self->_space->nodes}; # create a temporary configuration space my $space = $self->_space->clone; # add from/to points to the temporary configuration space my $node_from = $self->_add_point_to_space($from, $space); my $node_to = $self->_add_point_to_space($to, $space); # compute shortest path my $path = $space->shortest_path($node_from, $node_to); if (!$path->is_valid) { Slic3r::debugf "Failed to compute shortest path.\n"; return Slic3r::Polyline->new($from, $to); } if (0) { require "Slic3r/SVG.pm"; Slic3r::SVG::output("path.svg", no_arrows => 1, expolygons => $self->islands, lines => $space->get_lines, red_points => [$from, $to], red_polylines => [$path], ); exit; } return $path; } # returns the index of the new node sub _add_point_to_space { my ($self, $point, $space) = @_; my $n = $space->add_nodes($point); # check whether we are inside an island or outside my $inside = defined first { $self->islands->[$_]->contains_point($point) } 0..$#{$self->islands}; # find candidates by checking visibility from $from to them foreach my $idx (0..$#{$space->nodes}) { my $line = Slic3r::Line->new($point, $space->nodes->[$idx]); # if $point is inside an island, it is visible from $idx when island contains their line # if $point is outside an island, it is visible from $idx when their line does not cross any island if ( ($inside && defined first { $_->contains_line($line) } @{$self->_inner}) || (!$inside && !@{intersection_pl( [ $line->as_polyline ], [ map @$_, @{$self->islands} ], )}) ) { # $n ($point) and $idx are visible $space->add_edge($n, $idx, $line->length); } } # if we found no visibility, retry with larger margins if (!exists $space->edges->{$n} && $inside) { foreach my $idx (0..$#{$space->nodes}) { my $line = Slic3r::Line->new($point, $space->nodes->[$idx]); if (defined first { $_->contains_line($line) } @{$self->islands}) { # $n ($point) and $idx are visible $space->add_edge($n, $idx, $line->length); } } } warn "Temporary node is not visible from any other node" if !exists $space->edges->{$n}; return $n; } package Slic3r::GCode::MotionPlanner::ConfigurationSpace; use Moo; has 'nodes' => (is => 'rw', default => sub { [] }); # [ Point, ... ] has 'edges' => (is => 'rw', default => sub { {} }); # node_idx => { node_idx => distance, ... } has '_infinity' => (is => 'rw'); sub clone { my $self = shift; return (ref $self)->new( nodes => [ map $_->clone, @{$self->nodes} ], edges => { map { $_ => { %{$self->edges->{$_}} } } keys %{$self->edges} }, _infinity => $self->_infinity, ); } sub nodes_count { my $self = shift; return scalar(@{ $self->nodes }); } sub add_nodes { my ($self, @nodes) = @_; my $offset = $self->nodes_count; push @{ $self->nodes }, @nodes; return $offset; } sub add_edge { my ($self, $a, $b, $dist) = @_; $self->edges->{$a}{$b} = $self->edges->{$b}{$a} = $dist; } sub shortest_path { my ($self, $node_from, $node_to) = @_; my $edges = $self->edges; my (%dist, %visited, %prev); $dist{$_} = $self->_infinity for keys %$edges; $dist{$node_from} = 0; my @queue = ($node_from); while (@queue) { my $u = -1; { # find node in @queue with smallest distance in %dist and has not been visited my $d = -1; foreach my $n (@queue) { next if $visited{$n}; if ($u == -1 || $dist{$n} < $d) { $u = $n; $d = $dist{$n}; } } } last if $u == $node_to; # remove $u from @queue @queue = grep $_ != $u, @queue; $visited{$u} = 1; # loop through neighbors of $u foreach my $v (keys %{ $edges->{$u} }) { my $alt = $dist{$u} + $edges->{$u}{$v}; if ($alt < $dist{$v}) { $dist{$v} = $alt; $prev{$v} = $u; if (!$visited{$v}) { push @queue, $v; } } } } my @points = (); { my $u = $node_to; while (exists $prev{$u}) { unshift @points, $self->nodes->[$u]; $u = $prev{$u}; } unshift @points, $self->nodes->[$node_from]; } return Slic3r::Polyline->new(@points); } # for debugging purposes sub get_lines { my $self = shift; my @lines = (); my %lines = (); for my $i (keys %{$self->edges}) { for my $j (keys %{$self->edges->{$i}}) { my $line_id = join '_', sort $i, $j; next if $lines{$line_id}; $lines{$line_id} = 1; push @lines, Slic3r::Line->new(map $self->nodes->[$_], $i, $j); } } return [@lines]; } 1;