← Back to branch summary

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

« back to all changes in this revision

Viewing changes to lib/Slic3r/Test/SectionCut.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/Test/SectionCut.pm
 
1
package Slic3r::Test::SectionCut;
 
2
use Moo;
 
3
 
 
4
use List::Util qw(first max);
 
5
use Slic3r::Geometry qw(X Y A B X1 Y1 X2 Y2 unscale);
 
6
use Slic3r::Geometry::Clipper qw(union_ex intersection_pl);
 
7
use SVG;
 
8
                use Slic3r::SVG;
 
9
 
 
10
has 'scale' => (is => 'ro', default => sub {30});
 
11
has 'print' => (is => 'ro', required => 1);
 
12
has 'y_percent' => (is => 'ro', default => sub {0.5});
 
13
has 'line'  => (is => 'rw');
 
14
has 'height' => (is => 'rw');
 
15
 
 
16
sub BUILD {
 
17
    my $self = shift;
 
18
    
 
19
    my $bb = $self->print->bounding_box;
 
20
    my $y = ($bb->y_min + $bb->y_max) * $self->y_percent;
 
21
    my $line = Slic3r::Line->new([ $bb->x_min, $y ], [ $bb->x_max, $y ]);
 
22
    $self->line($line);
 
23
}
 
24
 
 
25
sub export_svg {
 
26
    my $self = shift;
 
27
    my ($filename) = @_;
 
28
    
 
29
    my $print_size = $self->print->size;
 
30
    $self->height(max(map $_->print_z, map @{$_->layers}, @{$self->print->objects}));
 
31
    my $svg = SVG->new(
 
32
        width  => $self->scale * unscale($print_size->[X]),
 
33
        height => $self->scale * $self->height,
 
34
    );
 
35
    
 
36
    my $group = sub {
 
37
        my %p = @_;
 
38
        my $g = $svg->group(style => $p{style});
 
39
        my $items = $self->_plot($p{filter});
 
40
        $g->rectangle(%$_) for @{ $items->{rectangles} };
 
41
        $g->circle(%$_)    for @{ $items->{circles} };
 
42
    };
 
43
    
 
44
    $group->(
 
45
        filter => sub { map @{$_->perimeters}, @{$_[0]->regions} },
 
46
        style  => {
 
47
            'stroke-width'  => 1,
 
48
            'stroke'        => 'grey',
 
49
            'fill'          => 'red',
 
50
        },
 
51
    );
 
52
    
 
53
    $group->(
 
54
        filter => sub { map @{$_->fills}, @{$_[0]->regions} },
 
55
        style  => {
 
56
            'stroke-width'  => 1,
 
57
            'stroke'        => '#444444',
 
58
            'fill'          => 'grey',
 
59
        },
 
60
    );
 
61
    
 
62
    $group->(
 
63
        filter => sub { $_[0]->isa('Slic3r::Layer::Support') ? ($_[0]->support_fills, $_[0]->support_interface_fills) : () },
 
64
        style  => {
 
65
            'stroke-width'  => 1,
 
66
            'stroke'        => '#444444',
 
67
            'fill'          => '#22FF00',
 
68
        },
 
69
    );
 
70
    
 
71
    Slic3r::open(\my $fh, '>', $filename);
 
72
    print $fh $svg->xmlify;
 
73
    close $fh;
 
74
    printf "Section cut SVG written to %s\n", $filename;
 
75
}
 
76
 
 
77
sub _plot {
 
78
    my $self = shift;
 
79
    my ($filter) = @_;
 
80
    
 
81
    my (@rectangles, @circles) = ();
 
82
    
 
83
    foreach my $object (@{$self->print->objects}) {
 
84
        foreach my $copy (@{$object->_shifted_copies}) {
 
85
            foreach my $layer (@{$object->layers}, @{$object->support_layers}) {
 
86
                # get all ExtrusionPath objects
 
87
                my @paths = 
 
88
                    map { $_->isa('Slic3r::ExtrusionLoop') ? $_->split_at_first_point : $_->clone }
 
89
                    map { $_->isa('Slic3r::ExtrusionPath::Collection') ? @$_ : $_ }
 
90
                    grep defined $_,
 
91
                    $filter->($layer);
 
92
                
 
93
                $_->polyline->translate(@$copy) for @paths;
 
94
                
 
95
                require "Slic3r/SVG.pm";
 
96
                Slic3r::SVG::output(
 
97
                    "line.svg",
 
98
                    no_arrows => 1,
 
99
                    #polygon => $line->grow(Slic3r::Geometry::scale $path->width/2),
 
100
                    polygons => [ $object->bounding_box->polygon ],
 
101
                    lines => [ $self->line ],
 
102
                    red_polylines => [ map $_->polyline, @paths ],
 
103
                );
 
104
                exit;
 
105
                
 
106
                foreach my $path (@paths) {
 
107
                    foreach my $line (@{$path->lines}) {
 
108
                        my @intersections = @{intersection_pl(
 
109
                            [ $self->line->as_polyline ],
 
110
                            $line->grow(Slic3r::Geometry::scale $path->width/2),
 
111
                        )};
 
112
                        
 
113
                        die "Intersection has more than two points!\n" if first { @$_ > 2 } @intersections;
 
114
                        
 
115
                        if ($path->is_bridge) {
 
116
                            foreach my $line (@intersections) {
 
117
                                my $radius = $path->width / 2;
 
118
                                my $width = unscale abs($line->[B][X] - $line->[A][X]);
 
119
                                if ((10 * Slic3r::Geometry::scale $radius) < $width) {
 
120
                                    # we're cutting the path in the longitudinal direction, so we've got a rectangle
 
121
                                    push @rectangles, {
 
122
                                        'x'         => $self->scale * unscale $line->[A][X],
 
123
                                        'y'         => $self->scale * $self->_y($layer->print_z),
 
124
                                        'width'     => $self->scale * $width,
 
125
                                        'height'    => $self->scale * $radius * 2,
 
126
                                        'rx'        => $self->scale * $radius * 0.35,
 
127
                                        'ry'        => $self->scale * $radius * 0.35,
 
128
                                    };
 
129
                                } else {
 
130
                                    push @circles, {
 
131
                                        'cx'        => $self->scale * (unscale($line->[A][X]) + $radius),
 
132
                                        'cy'        => $self->scale * $self->_y($layer->print_z - $radius),
 
133
                                        'r'         => $self->scale * $radius,
 
134
                                    };
 
135
                                }
 
136
                            }
 
137
                        } else {
 
138
                            push @rectangles, map {
 
139
                                my $height = $path->height;
 
140
                                $height = $layer->height if $height == -1;
 
141
                                {
 
142
                                    'x'         => $self->scale * unscale $_->[A][X],
 
143
                                    'y'         => $self->scale * $self->_y($layer->print_z),
 
144
                                    'width'     => $self->scale * unscale(abs($_->[B][X] - $_->[A][X])),
 
145
                                    'height'    => $self->scale * $height,
 
146
                                    'rx'        => $self->scale * $height * 0.35,
 
147
                                    'ry'        => $self->scale * $height * 0.35,
 
148
                                };
 
149
                            } @intersections;
 
150
                        }
 
151
                    }
 
152
                }
 
153
            }
 
154
        }
 
155
    }
 
156
    
 
157
    return {
 
158
        rectangles  => \@rectangles,
 
159
        circles     => \@circles,
 
160
    };
 
161
}
 
162
 
 
163
sub _y {
 
164
    my $self = shift;
 
165
    my ($y) = @_;
 
166
    return $y;
 
167
    return $self->height - $y;
 
168
}
 
169
 
 
170
1;