← Back to branch summary

~ubuntu-branches/ubuntu/utopic/slic3r/utopic

« back to all changes in this revision

Viewing changes to lib/Slic3r/GCode/MotionPlanner.pm

  • Committer: Package Import Robot
  • Author(s): Chow Loong Jin
  • Date: 2014-06-17 01:27:26 UTC
  • Revision ID: package-import@ubuntu.com-20140617012726-2wrs4zdo251nr4vg
Tags: upstream-1.1.4+dfsg
Import upstream version 1.1.4+dfsg

Show diffs side-by-side

added added

removed removed

Lines of Context:
lib/Slic3r/GCode/MotionPlanner.pm
 
1
package Slic3r::GCode::MotionPlanner;
 
2
use Moo;
 
3
 
 
4
has 'islands'           => (is => 'ro', required => 1);  # arrayref of ExPolygons
 
5
has 'internal'          => (is => 'ro', default => sub { 1 });
 
6
has '_space'            => (is => 'ro', default => sub { Slic3r::GCode::MotionPlanner::ConfigurationSpace->new });
 
7
has '_inner'            => (is => 'ro', default => sub { [] });  # arrayref of ExPolygons
 
8
 
 
9
use List::Util qw(first max);
 
10
use Slic3r::Geometry qw(A B scale epsilon);
 
11
use Slic3r::Geometry::Clipper qw(offset offset_ex diff_ex intersection_pl);
 
12
 
 
13
# clearance (in mm) from the perimeters
 
14
has '_inner_margin' => (is => 'ro', default => sub { scale 1 });
 
15
has '_outer_margin' => (is => 'ro', default => sub { scale 2 });
 
16
 
 
17
# this factor weigths the crossing of a perimeter 
 
18
# vs. the alternative path. a value of 5 means that
 
19
# a perimeter will be crossed if the alternative path
 
20
# is >= 5x the length of the straight line we could
 
21
# follow if we decided to cross the perimeter.
 
22
# a nearly-infinite value for this will only permit
 
23
# perimeter crossing when there's no alternative path.
 
24
use constant CROSSING_PENALTY => 20;
 
25
 
 
26
use constant POINT_DISTANCE => 10;  # unscaled
 
27
 
 
28
# setup our configuration space
 
29
sub BUILD {
 
30
    my $self = shift;
 
31
    
 
32
    my $point_distance = scale POINT_DISTANCE;
 
33
    my $nodes = $self->_space->nodes;
 
34
    my $edges = $self->_space->edges;
 
35
    
 
36
    # process individual islands
 
37
    for my $i (0 .. $#{$self->islands}) {
 
38
        my $expolygon = $self->islands->[$i];
 
39
            
 
40
        # find external margin
 
41
        my $outer = offset([ @$expolygon ], +$self->_outer_margin);
 
42
        my @outer_points = map @{$_->equally_spaced_points($point_distance)}, @$outer;
 
43
        
 
44
        # add outer points to graph
 
45
        my $o_outer = $self->_space->add_nodes(@outer_points);
 
46
        
 
47
        # find pairs of visible outer points and add them to the graph
 
48
        for my $i (0 .. $#outer_points) {
 
49
            for my $j (($i+1) .. $#outer_points) {
 
50
                my ($a, $b) = ($outer_points[$i], $outer_points[$j]);
 
51
                my $line = Slic3r::Polyline->new($a, $b);
 
52
                # outer points are visible when their line has empty intersection with islands
 
53
                my $intersection = intersection_pl(
 
54
                    [ $line ],
 
55
                    [ map @$_, @{$self->islands} ],
 
56
                );
 
57
                if (!@$intersection) {
 
58
                    $self->_space->add_edge($i+$o_outer, $j+$o_outer, $line->length);
 
59
                }
 
60
            }
 
61
        }
 
62
        
 
63
        if ($self->internal) {
 
64
            # find internal margin
 
65
            my $inner = offset_ex([ @$expolygon ], -$self->_inner_margin);
 
66
            push @{ $self->_inner }, @$inner;
 
67
            my @inner_points = map @{$_->equally_spaced_points($point_distance)}, map @$_, @$inner;
 
68
            
 
69
            # add points to graph and get their offset
 
70
            my $o_inner = $self->_space->add_nodes(@inner_points);
 
71
            
 
72
            # find pairs of visible inner points and add them to the graph
 
73
            for my $i (0 .. $#inner_points) {
 
74
                for my $j (($i+1) .. $#inner_points) {
 
75
                    my ($a, $b) = ($inner_points[$i], $inner_points[$j]);
 
76
                    my $line = Slic3r::Line->new($a, $b);
 
77
                    # turn $inner into an ExPolygonCollection and use $inner->contains_line()
 
78
                    if (first { $_->contains_line($line) } @$inner) {
 
79
                        $self->_space->add_edge($i+$o_inner, $j+$o_inner, $line->length);
 
80
                    }
 
81
                }
 
82
            }
 
83
            
 
84
            # generate the stripe around slice contours
 
85
            my $contour = diff_ex(
 
86
                $outer,
 
87
                [ map @$_, @$inner ],
 
88
            );
 
89
            
 
90
            # find pairs of visible points in this area and add them to the graph
 
91
            for my $i (0 .. $#inner_points) {
 
92
                for my $j (0 .. $#outer_points) {
 
93
                    my ($a, $b) = ($inner_points[$i], $outer_points[$j]);
 
94
                    my $line = Slic3r::Line->new($a, $b);
 
95
                    # turn $contour into an ExPolygonCollection and use $contour->contains_line()
 
96
                    if (first { $_->contains_line($line) } @$contour) {
 
97
                        $self->_space->add_edge($i+$o_inner, $j+$o_outer, $line->length * CROSSING_PENALTY);
 
98
                    }
 
99
                }
 
100
            }
 
101
        }
 
102
    }
 
103
    
 
104
    # since Perl has no infinity symbol and we don't want to overcomplicate
 
105
    # the Dijkstra algorithm with string constants or -1 values
 
106
    $self->_space->_infinity(10 * (max(map values %$_, values %{$self->_space->edges}) // 0));
 
107
    
 
108
    if (0) {
 
109
        require "Slic3r/SVG.pm";
 
110
        Slic3r::SVG::output("space.svg",
 
111
            no_arrows       => 1,
 
112
            expolygons      => $self->islands,
 
113
            lines           => $self->_space->get_lines,
 
114
            points          => $self->_space->nodes,
 
115
        );
 
116
        printf "%d islands\n", scalar @{$self->islands};
 
117
        
 
118
        eval "use Devel::Size";
 
119
        print  "MEMORY USAGE:\n";
 
120
        printf "  %-19s = %.1fMb\n", $_, Devel::Size::total_size($self->$_)/1024/1024
 
121
            for qw(_space islands);
 
122
        printf "  %-19s = %.1fMb\n", $_, Devel::Size::total_size($self->_space->$_)/1024/1024
 
123
            for qw(nodes edges);
 
124
        printf "  %-19s = %.1fMb\n", 'self', Devel::Size::total_size($self)/1024/1024;
 
125
        
 
126
        exit if $self->internal;
 
127
    }
 
128
}
 
129
 
 
130
sub shortest_path {
 
131
    my $self = shift;
 
132
    my ($from, $to) = @_;
 
133
    
 
134
    return Slic3r::Polyline->new($from, $to)
 
135
        if !@{$self->_space->nodes};
 
136
    
 
137
    # create a temporary configuration space
 
138
    my $space = $self->_space->clone;
 
139
    
 
140
    # add from/to points to the temporary configuration space
 
141
    my $node_from   = $self->_add_point_to_space($from, $space);
 
142
    my $node_to     = $self->_add_point_to_space($to, $space);
 
143
    
 
144
    # compute shortest path
 
145
    my $path = $space->shortest_path($node_from, $node_to);
 
146
    
 
147
    if (!$path->is_valid) {
 
148
        Slic3r::debugf "Failed to compute shortest path.\n";
 
149
        return Slic3r::Polyline->new($from, $to);
 
150
    }
 
151
    
 
152
    if (0) {
 
153
        require "Slic3r/SVG.pm";
 
154
        Slic3r::SVG::output("path.svg",
 
155
            no_arrows       => 1,
 
156
            expolygons      => $self->islands,
 
157
            lines           => $space->get_lines,
 
158
            red_points      => [$from, $to],
 
159
            red_polylines   => [$path],
 
160
        );
 
161
        exit;
 
162
    }
 
163
    
 
164
    return $path;
 
165
}
 
166
 
 
167
# returns the index of the new node
 
168
sub _add_point_to_space {
 
169
    my ($self, $point, $space) = @_;
 
170
    
 
171
    my $n = $space->add_nodes($point);
 
172
    
 
173
    # check whether we are inside an island or outside
 
174
    my $inside = defined first { $self->islands->[$_]->contains_point($point) } 0..$#{$self->islands};
 
175
 
 
176
    # find candidates by checking visibility from $from to them
 
177
    foreach my $idx (0..$#{$space->nodes}) {
 
178
        my $line = Slic3r::Line->new($point, $space->nodes->[$idx]);
 
179
        # if $point is inside an island, it is visible from $idx when island contains their line
 
180
        # if $point is outside an island, it is visible from $idx when their line does not cross any island
 
181
        if (
 
182
            ($inside && defined first { $_->contains_line($line) } @{$self->_inner})
 
183
                || (!$inside && !@{intersection_pl(
 
184
                    [ $line->as_polyline ],
 
185
                    [ map @$_, @{$self->islands} ],
 
186
                )})
 
187
            ) {
 
188
            # $n ($point) and $idx are visible
 
189
            $space->add_edge($n, $idx, $line->length);
 
190
        }
 
191
    }
 
192
    
 
193
    # if we found no visibility, retry with larger margins
 
194
    if (!exists $space->edges->{$n} && $inside) {
 
195
        foreach my $idx (0..$#{$space->nodes}) {
 
196
            my $line = Slic3r::Line->new($point, $space->nodes->[$idx]);
 
197
            if (defined first { $_->contains_line($line) } @{$self->islands}) {
 
198
                # $n ($point) and $idx are visible
 
199
                $space->add_edge($n, $idx, $line->length);
 
200
            }
 
201
        }
 
202
    }
 
203
    
 
204
    warn "Temporary node is not visible from any other node"
 
205
        if !exists $space->edges->{$n};
 
206
    
 
207
    return $n;
 
208
}
 
209
 
 
210
package Slic3r::GCode::MotionPlanner::ConfigurationSpace;
 
211
use Moo;
 
212
 
 
213
has 'nodes'     => (is => 'rw', default => sub { [] });  # [ Point, ... ]
 
214
has 'edges'     => (is => 'rw', default => sub { {} });  # node_idx => { node_idx => distance, ... }
 
215
has '_infinity' => (is => 'rw');
 
216
 
 
217
sub clone {
 
218
    my $self = shift;
 
219
    
 
220
    return (ref $self)->new(
 
221
        nodes       => [ map $_->clone, @{$self->nodes} ],
 
222
        edges       => { map { $_ => { %{$self->edges->{$_}} } } keys %{$self->edges} },
 
223
        _infinity   => $self->_infinity,
 
224
    );
 
225
}
 
226
 
 
227
sub nodes_count {
 
228
    my $self = shift;
 
229
    return scalar(@{ $self->nodes });
 
230
}
 
231
 
 
232
sub add_nodes {
 
233
    my ($self, @nodes) = @_;
 
234
    
 
235
    my $offset = $self->nodes_count;
 
236
    push @{ $self->nodes }, @nodes;
 
237
    return $offset;
 
238
}
 
239
 
 
240
sub add_edge {
 
241
    my ($self, $a, $b, $dist) = @_;
 
242
    $self->edges->{$a}{$b} = $self->edges->{$b}{$a} = $dist;
 
243
}
 
244
 
 
245
sub shortest_path {
 
246
    my ($self, $node_from, $node_to) = @_;
 
247
    
 
248
    my $edges = $self->edges;
 
249
    my (%dist, %visited, %prev);
 
250
    $dist{$_} = $self->_infinity for keys %$edges;
 
251
    $dist{$node_from} = 0;
 
252
    
 
253
    my @queue = ($node_from);
 
254
    while (@queue) {
 
255
        my $u = -1;
 
256
        {
 
257
            # find node in @queue with smallest distance in %dist and has not been visited
 
258
            my $d = -1;
 
259
            foreach my $n (@queue) {
 
260
                next if $visited{$n};
 
261
                if ($u == -1 || $dist{$n} < $d) {
 
262
                    $u = $n;
 
263
                    $d = $dist{$n};
 
264
                }
 
265
            }
 
266
        }
 
267
        last if $u == $node_to;
 
268
        
 
269
        # remove $u from @queue
 
270
        @queue = grep $_ != $u, @queue;
 
271
        $visited{$u} = 1;
 
272
        
 
273
        # loop through neighbors of $u
 
274
        foreach my $v (keys %{ $edges->{$u} }) {
 
275
            my $alt = $dist{$u} + $edges->{$u}{$v};
 
276
            if ($alt < $dist{$v}) {
 
277
                $dist{$v} = $alt;
 
278
                $prev{$v} = $u;
 
279
                if (!$visited{$v}) {
 
280
                    push @queue, $v;
 
281
                }
 
282
            }
 
283
        }
 
284
    }
 
285
    
 
286
    my @points = ();
 
287
    {
 
288
        my $u = $node_to;
 
289
        while (exists $prev{$u}) {
 
290
            unshift @points, $self->nodes->[$u];
 
291
            $u = $prev{$u};
 
292
        }
 
293
        unshift @points, $self->nodes->[$node_from];
 
294
    }
 
295
    
 
296
    return Slic3r::Polyline->new(@points);
 
297
}
 
298
 
 
299
# for debugging purposes
 
300
sub get_lines {
 
301
    my $self = shift;
 
302
    
 
303
    my @lines = ();
 
304
    my %lines = ();
 
305
    for my $i (keys %{$self->edges}) {
 
306
        for my $j (keys %{$self->edges->{$i}}) {
 
307
            my $line_id = join '_', sort $i, $j;
 
308
            next if $lines{$line_id};
 
309
            $lines{$line_id} = 1;
 
310
            push @lines, Slic3r::Line->new(map $self->nodes->[$_], $i, $j);
 
311
        }
 
312
    }
 
313
    
 
314
    return [@lines];
 
315
}
 
316
 
 
317
1;