2013-04-27 13:02:13 +00:00
|
|
|
package Slic3r::Test::SectionCut;
|
|
|
|
use Moo;
|
|
|
|
|
2013-05-10 18:53:49 +00:00
|
|
|
use List::Util qw(first max);
|
2013-04-27 13:02:13 +00:00
|
|
|
use Slic3r::Geometry qw(X Y A B X1 Y1 X2 Y2 unscale);
|
|
|
|
use Slic3r::Geometry::Clipper qw(union_ex);
|
|
|
|
use SVG;
|
|
|
|
|
|
|
|
has 'scale' => (is => 'ro', default => sub {30});
|
|
|
|
has 'print' => (is => 'ro', required => 1);
|
2013-04-27 20:18:57 +00:00
|
|
|
has 'y_percent' => (is => 'ro', default => sub {0.5});
|
2013-04-27 13:02:13 +00:00
|
|
|
has 'line' => (is => 'lazy');
|
|
|
|
has 'height' => (is => 'rw');
|
|
|
|
|
|
|
|
sub _build_line {
|
|
|
|
my $self = shift;
|
|
|
|
|
2013-06-16 10:21:25 +00:00
|
|
|
my $bb = $self->print->bounding_box;
|
|
|
|
my $y = $bb->size->[Y] * $self->y_percent;
|
|
|
|
return [ [ $bb->x_min, $y ], [ $bb->x_max, $y ] ]
|
2013-04-27 13:02:13 +00:00
|
|
|
}
|
|
|
|
|
|
|
|
sub export_svg {
|
|
|
|
my $self = shift;
|
|
|
|
my ($filename) = @_;
|
|
|
|
|
|
|
|
my $print_size = $self->print->size;
|
2013-07-28 22:27:53 +00:00
|
|
|
$self->height(max(map $_->print_z, map @{$_->layers}, @{$self->print->objects}));
|
2013-04-27 13:02:13 +00:00
|
|
|
my $svg = SVG->new(
|
|
|
|
width => $self->scale * unscale($print_size->[X]),
|
|
|
|
height => $self->scale * $self->height,
|
|
|
|
);
|
|
|
|
|
|
|
|
my $group = sub {
|
|
|
|
my %p = @_;
|
|
|
|
my $g = $svg->group(style => $p{style});
|
2013-05-10 18:53:49 +00:00
|
|
|
my $items = $self->_plot($p{filter});
|
|
|
|
$g->rectangle(%$_) for @{ $items->{rectangles} };
|
|
|
|
$g->circle(%$_) for @{ $items->{circles} };
|
2013-04-27 13:02:13 +00:00
|
|
|
};
|
|
|
|
|
|
|
|
$group->(
|
|
|
|
filter => sub { map @{$_->perimeters}, @{$_[0]->regions} },
|
|
|
|
style => {
|
|
|
|
'stroke-width' => 1,
|
|
|
|
'stroke' => 'grey',
|
|
|
|
'fill' => 'red',
|
|
|
|
},
|
|
|
|
);
|
|
|
|
|
|
|
|
$group->(
|
|
|
|
filter => sub { map @{$_->fills}, @{$_[0]->regions} },
|
|
|
|
style => {
|
|
|
|
'stroke-width' => 1,
|
|
|
|
'stroke' => '#444444',
|
|
|
|
'fill' => 'grey',
|
|
|
|
},
|
|
|
|
);
|
|
|
|
|
|
|
|
$group->(
|
2013-07-29 18:49:54 +00:00
|
|
|
filter => sub { $_[0]->isa('Slic3r::Layer::Support') ? ($_[0]->support_fills, $_[0]->support_interface_fills) : () },
|
2013-04-27 13:02:13 +00:00
|
|
|
style => {
|
|
|
|
'stroke-width' => 1,
|
|
|
|
'stroke' => '#444444',
|
|
|
|
'fill' => '#22FF00',
|
|
|
|
},
|
|
|
|
);
|
|
|
|
|
|
|
|
Slic3r::open(\my $fh, '>', $filename);
|
|
|
|
print $fh $svg->xmlify;
|
|
|
|
close $fh;
|
|
|
|
printf "Section cut SVG written to %s\n", $filename;
|
|
|
|
}
|
|
|
|
|
2013-05-10 18:53:49 +00:00
|
|
|
sub _plot {
|
2013-04-27 13:02:13 +00:00
|
|
|
my $self = shift;
|
|
|
|
my ($filter) = @_;
|
|
|
|
|
2013-05-10 18:53:49 +00:00
|
|
|
my (@rectangles, @circles) = ();
|
2013-04-27 13:02:13 +00:00
|
|
|
|
|
|
|
foreach my $object (@{$self->print->objects}) {
|
|
|
|
foreach my $copy (@{$object->copies}) {
|
2013-07-29 18:49:54 +00:00
|
|
|
foreach my $layer (@{$object->layers}, @{$object->support_layers}) {
|
2013-04-27 13:02:13 +00:00
|
|
|
# get all ExtrusionPath objects
|
|
|
|
my @paths =
|
|
|
|
map { $_->polyline->translate(@$copy); $_ }
|
|
|
|
map { $_->isa('Slic3r::ExtrusionLoop') ? $_->split_at_first_point : $_ }
|
2013-08-08 00:10:34 +00:00
|
|
|
map { $_->isa('Slic3r::ExtrusionPath::Collection') ? @$_ : $_ }
|
2013-04-27 13:02:13 +00:00
|
|
|
grep defined $_,
|
|
|
|
$filter->($layer);
|
|
|
|
|
|
|
|
foreach my $path (@paths) {
|
2013-08-08 00:10:34 +00:00
|
|
|
foreach my $line (@{$path->lines}) {
|
2013-04-27 13:02:13 +00:00
|
|
|
my @intersections = @{ Boost::Geometry::Utils::polygon_multi_linestring_intersection(
|
2013-11-20 10:35:58 +00:00
|
|
|
Slic3r::ExPolygon->new(@{$line->grow(Slic3r::Geometry::scale $path->flow_spacing/2)})->pp,
|
2013-04-27 13:02:13 +00:00
|
|
|
[ $self->line ],
|
|
|
|
) };
|
2013-05-10 18:53:49 +00:00
|
|
|
die "Intersection has more than two points!\n" if first { @$_ > 2 } @intersections;
|
2013-04-27 13:02:13 +00:00
|
|
|
|
2013-05-10 18:53:49 +00:00
|
|
|
if ($path->is_bridge) {
|
|
|
|
foreach my $line (@intersections) {
|
|
|
|
my $radius = $path->flow_spacing / 2;
|
2013-05-13 13:21:26 +00:00
|
|
|
my $width = unscale abs($line->[B][X] - $line->[A][X]);
|
2013-05-10 18:53:49 +00:00
|
|
|
if ((10 * Slic3r::Geometry::scale $radius) < $width) {
|
|
|
|
# we're cutting the path in the longitudinal direction, so we've got a rectangle
|
|
|
|
push @rectangles, {
|
|
|
|
'x' => $self->scale * unscale $line->[A][X],
|
2013-07-28 22:27:53 +00:00
|
|
|
'y' => $self->scale * $self->_y($layer->print_z),
|
2013-05-13 13:21:26 +00:00
|
|
|
'width' => $self->scale * $width,
|
2013-05-10 18:53:49 +00:00
|
|
|
'height' => $self->scale * $radius * 2,
|
|
|
|
'rx' => $self->scale * $radius * 0.35,
|
|
|
|
'ry' => $self->scale * $radius * 0.35,
|
|
|
|
};
|
|
|
|
} else {
|
|
|
|
push @circles, {
|
2013-05-14 18:11:05 +00:00
|
|
|
'cx' => $self->scale * (unscale($line->[A][X]) + $radius),
|
2013-07-28 22:27:53 +00:00
|
|
|
'cy' => $self->scale * $self->_y($layer->print_z - $radius),
|
2013-05-13 13:21:26 +00:00
|
|
|
'r' => $self->scale * $radius,
|
2013-05-10 18:53:49 +00:00
|
|
|
};
|
|
|
|
}
|
|
|
|
}
|
|
|
|
} else {
|
|
|
|
push @rectangles, map {
|
2013-09-17 12:16:29 +00:00
|
|
|
my $height = $path->height;
|
|
|
|
$height = $layer->height if $height == -1;
|
2013-05-10 18:53:49 +00:00
|
|
|
{
|
|
|
|
'x' => $self->scale * unscale $_->[A][X],
|
2013-07-28 22:27:53 +00:00
|
|
|
'y' => $self->scale * $self->_y($layer->print_z),
|
2013-05-10 18:53:49 +00:00
|
|
|
'width' => $self->scale * unscale(abs($_->[B][X] - $_->[A][X])),
|
|
|
|
'height' => $self->scale * $height,
|
|
|
|
'rx' => $self->scale * $height * 0.35,
|
|
|
|
'ry' => $self->scale * $height * 0.35,
|
|
|
|
};
|
|
|
|
} @intersections;
|
|
|
|
}
|
2013-04-27 13:02:13 +00:00
|
|
|
}
|
|
|
|
}
|
|
|
|
}
|
|
|
|
}
|
|
|
|
}
|
|
|
|
|
2013-05-10 18:53:49 +00:00
|
|
|
return {
|
|
|
|
rectangles => \@rectangles,
|
|
|
|
circles => \@circles,
|
|
|
|
};
|
2013-04-27 13:02:13 +00:00
|
|
|
}
|
|
|
|
|
|
|
|
sub _y {
|
|
|
|
my $self = shift;
|
|
|
|
my ($y) = @_;
|
|
|
|
|
|
|
|
return $self->height - $y;
|
|
|
|
}
|
|
|
|
|
|
|
|
1;
|