Initial import
This commit is contained in:
Alessandro Ranellucci
commit
55a523e1fa
49
README.markdown
Normal file
49
README.markdown
Normal file
@ -0,0 +1,49 @@
|
|||||||
|
_Q: Yet another RepRap slicer?_
|
||||||
|
|
||||||
|
A: Yes.
|
||||||
|
|
||||||
|
# Slic3r
|
||||||
|
|
||||||
|
## What's it?
|
||||||
|
|
||||||
|
Slic3r is (er, will be) an STL-to-GCODE translator for RepRap 3D printers,
|
||||||
|
like Enrique's Skeinforge or RevK's E3D.
|
||||||
|
|
||||||
|
## Why another one? Why Perl?
|
||||||
|
|
||||||
|
The goal is to build something more maintainable and flexible than both
|
||||||
|
Skeinforge and E3D. The code makes extensive use of object-oriented
|
||||||
|
programming to achieve some level of abstraction instead of working with
|
||||||
|
raw geometry and low-level data structures.
|
||||||
|
This should help to maintain code, fix bugs and implement new and better
|
||||||
|
algorithms in the future.
|
||||||
|
Of course, Perl's not that fast as C and usage of modules like Moose make
|
||||||
|
everything quite memory-hungry, but I'm happy with it. My goal is a "rapid
|
||||||
|
prototyping" architecture for a slicer.
|
||||||
|
|
||||||
|
Also, http://xkcd.com/224/
|
||||||
|
|
||||||
|
## What's its current status?
|
||||||
|
|
||||||
|
Slic3r can now successfully parse and analyze an STL file by slicing it in
|
||||||
|
layers and representing internally the following features:
|
||||||
|
|
||||||
|
* holes in surfaces;
|
||||||
|
* external top/bottom surfaces.
|
||||||
|
|
||||||
|
This kind of abstraction will allow to implement particular logic and allow the
|
||||||
|
user to specify custom options.
|
||||||
|
|
||||||
|
I need to implement algorithms to produce perimeter outlines and surface fill.
|
||||||
|
|
||||||
|
Future goals include support material, options to control bridges, skirt, cool.
|
||||||
|
|
||||||
|
## Can I help?
|
||||||
|
|
||||||
|
Sure! Send patches and/or drop me a line at aar@cpan.org. You can also
|
||||||
|
find me in #RepRap on FreeNode with the nickname _Sound_.
|
||||||
|
|
||||||
|
## What's Slic3r license?
|
||||||
|
|
||||||
|
Slic3r is dual-licensed under the _Perl Artistic License_ and the _AGPLv3_.
|
||||||
|
The author is Alessandro Ranellucci (that's me).
|
||||||
18
lib/Slic3r.pm
Normal file
18
lib/Slic3r.pm
Normal file
@ -0,0 +1,18 @@
|
|||||||
|
package Slic3r;
|
||||||
|
|
||||||
|
use strict;
|
||||||
|
use warnings;
|
||||||
|
|
||||||
|
use Slic3r::Layer;
|
||||||
|
use Slic3r::Line;
|
||||||
|
use Slic3r::Point;
|
||||||
|
use Slic3r::Polyline;
|
||||||
|
use Slic3r::Polyline::Closed;
|
||||||
|
use Slic3r::Print;
|
||||||
|
use Slic3r::STL;
|
||||||
|
use Slic3r::Surface;
|
||||||
|
|
||||||
|
our $layer_height = 0.4;
|
||||||
|
our $resolution = 0.1;
|
||||||
|
|
||||||
|
1;
|
||||||
325
lib/Slic3r/Layer.pm
Normal file
325
lib/Slic3r/Layer.pm
Normal file
@ -0,0 +1,325 @@
|
|||||||
|
package Slic3r::Layer;
|
||||||
|
use Moose;
|
||||||
|
|
||||||
|
use XXX;
|
||||||
|
|
||||||
|
has 'id' => (
|
||||||
|
is => 'ro',
|
||||||
|
isa => 'Int',
|
||||||
|
required => 1,
|
||||||
|
);
|
||||||
|
|
||||||
|
has 'pointmap' => (
|
||||||
|
traits => ['Hash'],
|
||||||
|
is => 'rw',
|
||||||
|
isa => 'HashRef[Slic3r::Point]',
|
||||||
|
default => sub { {} },
|
||||||
|
handles => {
|
||||||
|
points => 'values',
|
||||||
|
},
|
||||||
|
);
|
||||||
|
|
||||||
|
has 'lines' => (
|
||||||
|
is => 'rw',
|
||||||
|
isa => 'ArrayRef[Slic3r::Line]',
|
||||||
|
default => sub { [] },
|
||||||
|
);
|
||||||
|
|
||||||
|
has 'surfaces' => (
|
||||||
|
traits => ['Array'],
|
||||||
|
is => 'rw',
|
||||||
|
isa => 'ArrayRef[Slic3r::Surface]',
|
||||||
|
default => sub { [] },
|
||||||
|
);
|
||||||
|
|
||||||
|
sub z {
|
||||||
|
my $self = shift;
|
||||||
|
return $self->id * $Slic3r::layer_height / $Slic3r::resolution;
|
||||||
|
}
|
||||||
|
|
||||||
|
sub add_surface {
|
||||||
|
my $self = shift;
|
||||||
|
my (@vertices) = @_;
|
||||||
|
|
||||||
|
my @points = map $self->add_point($_), @vertices;
|
||||||
|
my $polyline = Slic3r::Polyline::Closed->new_from_points(@points);
|
||||||
|
my @lines = map $self->add_line($_), @{ $polyline->lines };
|
||||||
|
|
||||||
|
my $surface = Slic3r::Surface->new(
|
||||||
|
contour => Slic3r::Polyline::Closed->new(lines => \@lines),
|
||||||
|
);
|
||||||
|
push @{ $self->surfaces }, $surface;
|
||||||
|
|
||||||
|
return $surface;
|
||||||
|
}
|
||||||
|
|
||||||
|
sub add_line {
|
||||||
|
my $self = shift;
|
||||||
|
my ($a, $b) = @_;
|
||||||
|
|
||||||
|
# we accept either a Line object or a couple of points
|
||||||
|
my $line;
|
||||||
|
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) = @_;
|
||||||
|
@{ $self->lines } = grep $_ ne $line, @{ $self->lines };
|
||||||
|
}
|
||||||
|
|
||||||
|
sub remove_surface {
|
||||||
|
my $self = shift;
|
||||||
|
my ($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);
|
||||||
|
printf "Merging continuous lines %s and %s into %s\n",
|
||||||
|
$line->id, $neighbor_line->id, $new_line->id;
|
||||||
|
|
||||||
|
# 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
|
||||||
|
# connects at least two lines
|
||||||
|
foreach my $point ($self->points) {
|
||||||
|
if (grep $_, @{ $point->lines } < 2) {
|
||||||
|
warn "Found point connecting less than 2 lines:";
|
||||||
|
XXX $point;
|
||||||
|
}
|
||||||
|
}
|
||||||
|
|
||||||
|
my $polylines = [];
|
||||||
|
foreach my $line (@{ $self->lines }) {
|
||||||
|
next if $line->polyline;
|
||||||
|
|
||||||
|
my %points = map {$_ => $_} $line->points;
|
||||||
|
my %visited_lines = ();
|
||||||
|
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]
|
||||||
|
or last;
|
||||||
|
|
||||||
|
$points{$_} = $_ for grep $_ ne $cur_line->a && $_ ne $cur_line->b, $next_line->points;
|
||||||
|
$cur_line = $next_line;
|
||||||
|
}
|
||||||
|
|
||||||
|
printf "Discovered polyline of %d lines (%s)\n", scalar keys %points,
|
||||||
|
join('-', map $_->id, values %visited_lines);
|
||||||
|
push @$polylines, Slic3r::Polyline::Closed->new(lines => [values %visited_lines]);
|
||||||
|
}
|
||||||
|
|
||||||
|
return $polylines;
|
||||||
|
}
|
||||||
|
|
||||||
|
sub make_surfaces {
|
||||||
|
my $self = shift;
|
||||||
|
my ($polylines) = @_;
|
||||||
|
|
||||||
|
# count how many other polylines enclose each polyline
|
||||||
|
# even = contour; odd = hole
|
||||||
|
my %enclosing_polylines = ();
|
||||||
|
my %enclosing_polylines_count = ();
|
||||||
|
my $max_depth = 0;
|
||||||
|
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;
|
||||||
|
$enclosing_polylines{$polyline} =
|
||||||
|
[ grep $_ ne $polyline && $_->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;
|
||||||
|
}
|
||||||
|
|
||||||
|
# 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
|
||||||
|
$surface = Slic3r::Surface->new(contour => $polyline);
|
||||||
|
} else {
|
||||||
|
# this is a hole
|
||||||
|
# find the enclosing polyline having immediately close depth
|
||||||
|
my ($contour) = grep $enclosing_polylines_count{$_} == ($max_depth-1),
|
||||||
|
@{ $enclosing_polylines{$polyline} };
|
||||||
|
|
||||||
|
if ($contour->contour_of) {
|
||||||
|
$surface = $contour->contour_of;
|
||||||
|
$surface->add_hole($polyline);
|
||||||
|
} else {
|
||||||
|
$surface = Slic3r::Surface->new(
|
||||||
|
contour => $contour,
|
||||||
|
holes => [$polyline],
|
||||||
|
);
|
||||||
|
}
|
||||||
|
}
|
||||||
|
$surface->surface_type('internal');
|
||||||
|
push @{ $self->surfaces }, $surface;
|
||||||
|
|
||||||
|
printf "New surface: %s (holes: %s)\n",
|
||||||
|
$surface->id, join(', ', map $_->id, @{$surface->holes}) || 'none';
|
||||||
|
}
|
||||||
|
}
|
||||||
|
}
|
||||||
|
|
||||||
|
sub merge_contiguous_surfaces {
|
||||||
|
my $self = shift;
|
||||||
|
|
||||||
|
my $finished = 0;
|
||||||
|
CYCLE: while (!$finished) {
|
||||||
|
foreach my $surface (@{ $self->surfaces }) {
|
||||||
|
# look for a surface sharing one edge with this one
|
||||||
|
foreach my $neighbor_surface (@{ $self->surfaces }) {
|
||||||
|
next if $surface eq $neighbor_surface;
|
||||||
|
|
||||||
|
# find lines shared by the two surfaces (might be 0, 1, 2)
|
||||||
|
my @common_lines = ();
|
||||||
|
foreach my $line (@{ $neighbor_surface->contour->lines }) {
|
||||||
|
next unless grep $_ eq $line, @{ $surface->contour->lines };
|
||||||
|
push @common_lines, $line;
|
||||||
|
}
|
||||||
|
next if !@common_lines;
|
||||||
|
|
||||||
|
# defensive programming
|
||||||
|
if (@common_lines > 2) {
|
||||||
|
printf "Surfaces %s and %s share %d lines! How's it possible?\n",
|
||||||
|
$surface->id, $neighbor_surface->id, scalar @common_lines;
|
||||||
|
}
|
||||||
|
|
||||||
|
printf "Surfaces %s and %s share line/lines %s!\n",
|
||||||
|
$surface->id, $neighbor_surface->id,
|
||||||
|
join(', ', map $_->id, @common_lines);
|
||||||
|
|
||||||
|
# defensive programming
|
||||||
|
if ($surface->surface_type ne $neighbor_surface->surface_type) {
|
||||||
|
die "Surfaces %s and %s are of different types: %s, %s!\n",
|
||||||
|
$surface->id, $neighbor_surface->id,
|
||||||
|
$surface->surface_type, $neighbor_surface->surface_type;
|
||||||
|
}
|
||||||
|
|
||||||
|
# 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,
|
||||||
|
);
|
||||||
|
|
||||||
|
printf " merging into new surface %s\n", $new_surface->id;
|
||||||
|
push @{ $self->surfaces }, $surface;
|
||||||
|
|
||||||
|
$self->remove_surface($_) for ($surface, $neighbor_surface);
|
||||||
|
}
|
||||||
|
}
|
||||||
|
$finished = 1;
|
||||||
|
}
|
||||||
|
}
|
||||||
|
|
||||||
|
1;
|
||||||
69
lib/Slic3r/Line.pm
Normal file
69
lib/Slic3r/Line.pm
Normal file
@ -0,0 +1,69 @@
|
|||||||
|
package Slic3r::Line;
|
||||||
|
use Moose;
|
||||||
|
|
||||||
|
use Scalar::Util qw(weaken);
|
||||||
|
|
||||||
|
has 'a' => (
|
||||||
|
is => 'ro',
|
||||||
|
isa => 'Slic3r::Point',
|
||||||
|
required => 1,
|
||||||
|
);
|
||||||
|
|
||||||
|
has 'b' => (
|
||||||
|
is => 'ro',
|
||||||
|
isa => 'Slic3r::Point',
|
||||||
|
required => 1,
|
||||||
|
);
|
||||||
|
|
||||||
|
has 'polyline' => (
|
||||||
|
is => 'rw',
|
||||||
|
isa => 'Slic3r::Polyline',
|
||||||
|
weak_ref => 1,
|
||||||
|
);
|
||||||
|
|
||||||
|
sub BUILD {
|
||||||
|
my $self = shift;
|
||||||
|
|
||||||
|
# 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 id {
|
||||||
|
my $self = shift;
|
||||||
|
return $self->a->id . "-" . $self->b->id;
|
||||||
|
}
|
||||||
|
|
||||||
|
sub coincides_with {
|
||||||
|
my $self = shift;
|
||||||
|
my ($line) = @_;
|
||||||
|
|
||||||
|
return ($self->a->coincides_with($line->a) && $self->b->coincides_with($line->b))
|
||||||
|
|| ($self->a->coincides_with($line->b) && $self->b->coincides_with($line->a));
|
||||||
|
}
|
||||||
|
|
||||||
|
sub slope {
|
||||||
|
my $self = shift;
|
||||||
|
return undef if $self->b->x == $self->a->x; # line is vertical
|
||||||
|
return ($self->b->y - $self->a->y) / ($self->b->x - $self->a->x); #)
|
||||||
|
}
|
||||||
|
|
||||||
|
sub neighbors {
|
||||||
|
my $self = shift;
|
||||||
|
return grep $_ && $_ ne $self, map @{$_->lines}, $self->a, $self->b;
|
||||||
|
}
|
||||||
|
|
||||||
|
sub next {
|
||||||
|
my $self = shift;
|
||||||
|
return +(grep $_ && $_ ne $self, @{$self->b->lines})[0];
|
||||||
|
}
|
||||||
|
|
||||||
|
sub points {
|
||||||
|
my $self = shift;
|
||||||
|
return ($self->a, $self->b);
|
||||||
|
}
|
||||||
|
|
||||||
|
1;
|
||||||
41
lib/Slic3r/Point.pm
Normal file
41
lib/Slic3r/Point.pm
Normal file
@ -0,0 +1,41 @@
|
|||||||
|
package Slic3r::Point;
|
||||||
|
use Moose;
|
||||||
|
use Moose::Util::TypeConstraints;
|
||||||
|
|
||||||
|
subtype 'Slic3r::Point::Coordinate', as 'Int';
|
||||||
|
coerce 'Slic3r::Point::Coordinate', from 'Num', via { sprintf '%.0f', $_ };
|
||||||
|
|
||||||
|
has 'x' => (
|
||||||
|
is => 'ro',
|
||||||
|
isa => 'Slic3r::Point::Coordinate',
|
||||||
|
required => 1,
|
||||||
|
coerce => 1,
|
||||||
|
);
|
||||||
|
|
||||||
|
has 'y' => (
|
||||||
|
is => 'ro',
|
||||||
|
isa => 'Slic3r::Point::Coordinate',
|
||||||
|
required => 1,
|
||||||
|
coerce => 1,
|
||||||
|
);
|
||||||
|
|
||||||
|
# this array contains weak references, so it can contain undef's as well
|
||||||
|
has 'lines' => (
|
||||||
|
is => 'rw',
|
||||||
|
isa => 'ArrayRef[Slic3r::Line]',
|
||||||
|
default => sub { [] },
|
||||||
|
);
|
||||||
|
|
||||||
|
sub id {
|
||||||
|
my $self = shift;
|
||||||
|
return $self->x . "," . $self->y; #;;
|
||||||
|
}
|
||||||
|
|
||||||
|
sub coincides_with {
|
||||||
|
my $self = shift;
|
||||||
|
my ($point) = @_;
|
||||||
|
|
||||||
|
return $self->x == $point->x && $self->y == $point->y; #=
|
||||||
|
}
|
||||||
|
|
||||||
|
1;
|
||||||
64
lib/Slic3r/Polyline.pm
Normal file
64
lib/Slic3r/Polyline.pm
Normal file
@ -0,0 +1,64 @@
|
|||||||
|
package Slic3r::Polyline;
|
||||||
|
use Moose;
|
||||||
|
|
||||||
|
has 'lines' => (
|
||||||
|
traits => ['Array'],
|
||||||
|
is => 'rw',
|
||||||
|
isa => 'ArrayRef[Slic3r::Line]',
|
||||||
|
default => sub { [] },
|
||||||
|
handles => {
|
||||||
|
add_line => 'push',
|
||||||
|
},
|
||||||
|
);
|
||||||
|
|
||||||
|
after 'add_line' => sub {
|
||||||
|
my $self = shift;
|
||||||
|
|
||||||
|
# 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->points);
|
||||||
|
}
|
||||||
|
|
||||||
|
sub new_from_points {
|
||||||
|
my $class = shift;
|
||||||
|
my (@points) = @_;
|
||||||
|
|
||||||
|
# we accept Point objects or arrayrefs with point coordinates
|
||||||
|
@points = map {
|
||||||
|
ref $_ eq 'ARRAY'
|
||||||
|
? Slic3r::Point->new('x' => $_->[0], 'y' => $_->[1])
|
||||||
|
: $_
|
||||||
|
} @points;
|
||||||
|
|
||||||
|
my $polyline = __PACKAGE__->new;
|
||||||
|
my $previous_point;
|
||||||
|
$previous_point = $points[-1] if $class eq 'Slic3r::Polyline::Closed';
|
||||||
|
foreach my $point (@points) {
|
||||||
|
if ($previous_point) {
|
||||||
|
my $line = Slic3r::Line->new(a => $previous_point, b => $point);
|
||||||
|
$polyline->add_line($line);
|
||||||
|
}
|
||||||
|
$previous_point = $point;
|
||||||
|
}
|
||||||
|
|
||||||
|
return $polyline;
|
||||||
|
}
|
||||||
|
|
||||||
|
sub points {
|
||||||
|
my $self = shift;
|
||||||
|
my %points = ();
|
||||||
|
$points{$_} = $_ for map $_->points, @{ $self->lines };
|
||||||
|
return values %points;
|
||||||
|
}
|
||||||
|
|
||||||
|
1;
|
||||||
61
lib/Slic3r/Polyline/Closed.pm
Normal file
61
lib/Slic3r/Polyline/Closed.pm
Normal file
@ -0,0 +1,61 @@
|
|||||||
|
package Slic3r::Polyline::Closed;
|
||||||
|
use Moose;
|
||||||
|
|
||||||
|
extends 'Slic3r::Polyline';
|
||||||
|
|
||||||
|
has 'contour_of' => (
|
||||||
|
is => 'rw',
|
||||||
|
isa => 'Slic3r::Surface',
|
||||||
|
weak_ref => 1,
|
||||||
|
);
|
||||||
|
|
||||||
|
has 'hole_of' => (
|
||||||
|
is => 'rw',
|
||||||
|
isa => 'Slic3r::Surface',
|
||||||
|
weak_ref => 1,
|
||||||
|
);
|
||||||
|
|
||||||
|
override 'new_from_points' => sub {
|
||||||
|
my $class = shift;
|
||||||
|
my $polyline = super();
|
||||||
|
|
||||||
|
# polylines must be always closed, otherwise it means that our object is not manifold!
|
||||||
|
die "Polylines must be closed! Object not manifold?\n"
|
||||||
|
if ($polyline->lines->[0]->a != $polyline->lines->[-1]->b);
|
||||||
|
|
||||||
|
return $polyline;
|
||||||
|
};
|
||||||
|
|
||||||
|
sub encloses_point {
|
||||||
|
my $self = shift;
|
||||||
|
my ($point) = @_;
|
||||||
|
|
||||||
|
my @xy = map { $_->x, $_->y } $self->points; #}}
|
||||||
|
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;
|
||||||
|
}
|
||||||
|
|
||||||
|
1;
|
||||||
29
lib/Slic3r/Print.pm
Normal file
29
lib/Slic3r/Print.pm
Normal file
@ -0,0 +1,29 @@
|
|||||||
|
package Slic3r::Print;
|
||||||
|
use Moose;
|
||||||
|
|
||||||
|
has 'layers' => (
|
||||||
|
traits => ['Array'],
|
||||||
|
is => 'rw',
|
||||||
|
isa => 'ArrayRef[Slic3r::Layer]',
|
||||||
|
default => sub { [] },
|
||||||
|
handles => {
|
||||||
|
layer_count => 'count',
|
||||||
|
add_layer => 'push',
|
||||||
|
},
|
||||||
|
);
|
||||||
|
|
||||||
|
sub layer {
|
||||||
|
my $self = shift;
|
||||||
|
my ($layer_id) = @_;
|
||||||
|
|
||||||
|
# extend our print by creating all necessary layers
|
||||||
|
if ($self->layer_count < $layer_id + 1) {
|
||||||
|
for (my $i = $self->layer_count; $i <= $layer_id; $i++) {
|
||||||
|
$self->add_layer(Slic3r::Layer->new(id => $i));
|
||||||
|
}
|
||||||
|
}
|
||||||
|
|
||||||
|
return $self->layers->[$layer_id];
|
||||||
|
}
|
||||||
|
|
||||||
|
1;
|
||||||
158
lib/Slic3r/STL.pm
Normal file
158
lib/Slic3r/STL.pm
Normal file
@ -0,0 +1,158 @@
|
|||||||
|
package Slic3r::STL;
|
||||||
|
use Moose;
|
||||||
|
|
||||||
|
use CAD::Format::STL;
|
||||||
|
use XXX;
|
||||||
|
|
||||||
|
use constant X => 0;
|
||||||
|
use constant Y => 1;
|
||||||
|
use constant Z => 2;
|
||||||
|
|
||||||
|
sub parse_file {
|
||||||
|
my $self = shift;
|
||||||
|
my ($file) = @_;
|
||||||
|
|
||||||
|
my $print = Slic3r::Print->new;
|
||||||
|
|
||||||
|
my $stl = CAD::Format::STL->new->load($file);
|
||||||
|
|
||||||
|
# we only want to work with positive coordinates, so let's
|
||||||
|
# find our object extents to calculate coordinate displacements
|
||||||
|
my @extents = (map [99999999, -99999999], X,Y,Z);
|
||||||
|
foreach my $facet ($stl->part->facets) {
|
||||||
|
my ($normal, @vertices) = @$facet;
|
||||||
|
foreach my $vertex (@vertices) {
|
||||||
|
for (X,Y,Z) {
|
||||||
|
$extents[$_][0] = $vertex->[$_] if $vertex->[$_] < $extents[$_][0];
|
||||||
|
$extents[$_][1] = $vertex->[$_] if $vertex->[$_] > $extents[$_][0];
|
||||||
|
}
|
||||||
|
}
|
||||||
|
}
|
||||||
|
|
||||||
|
# calculate the displacements needed to
|
||||||
|
# have lowest value for each axis at coordinate 0
|
||||||
|
my @shift = map 0 - $extents[$_][0], X,Y,Z;
|
||||||
|
printf "shift = %d, %d, %d\n", @shift[X,Y,Z];
|
||||||
|
|
||||||
|
# process facets
|
||||||
|
foreach my $facet ($stl->part->facets) {
|
||||||
|
|
||||||
|
# transform vertex coordinates
|
||||||
|
my ($normal, @vertices) = @$facet;
|
||||||
|
foreach my $vertex (@vertices) {
|
||||||
|
$vertex->[$_] = sprintf('%.0f', ($vertex->[$_] + $shift[$_]) / $Slic3r::resolution)
|
||||||
|
for X,Y,Z;
|
||||||
|
}
|
||||||
|
|
||||||
|
$self->_facet($print, @$facet);
|
||||||
|
}
|
||||||
|
|
||||||
|
print "\n==> PROCESSING SLICES:\n";
|
||||||
|
foreach my $layer (@{ $print->layers }) {
|
||||||
|
printf "Processing 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;
|
||||||
|
|
||||||
|
# build surfaces of polylines (distinguishing contours from holes)
|
||||||
|
$layer->make_surfaces($polylines);
|
||||||
|
|
||||||
|
# merge surfaces having a common line
|
||||||
|
$layer->merge_contiguous_surfaces;
|
||||||
|
}
|
||||||
|
|
||||||
|
return $print;
|
||||||
|
}
|
||||||
|
|
||||||
|
sub _facet {
|
||||||
|
my $self = shift;
|
||||||
|
my ($print, $normal, @vertices) = @_;
|
||||||
|
printf "\n==> FACET (%s):\n", join('-', map join(',', @$_), @vertices);
|
||||||
|
|
||||||
|
# find the vertical extents of the facet
|
||||||
|
my ($min_z, $max_z) = (99999999, -99999999);
|
||||||
|
foreach my $vertex (@vertices) {
|
||||||
|
$min_z = $vertex->[Z] if $vertex->[Z] < $min_z;
|
||||||
|
$max_z = $vertex->[Z] if $vertex->[Z] > $max_z;
|
||||||
|
}
|
||||||
|
printf "z: min = %.0f, max = %.0f\n", $min_z, $max_z;
|
||||||
|
|
||||||
|
# calculate the layer extents
|
||||||
|
my ($min_layer, $max_layer) = map {$_ * $Slic3r::resolution / $Slic3r::layer_height} $min_z, $max_z;
|
||||||
|
printf "layers: min = %.0f, max = %.0f\n", $min_layer, $max_layer;
|
||||||
|
|
||||||
|
# is the facet horizontal?
|
||||||
|
if ($min_layer == $max_layer) {
|
||||||
|
printf "Facet is horizontal\n";
|
||||||
|
my $layer = $print->layer($min_layer);
|
||||||
|
my $surface = $layer->add_surface(@vertices);
|
||||||
|
|
||||||
|
# to determine whether the surface is a top or bottom let's recompute
|
||||||
|
# the normal using the right-hand rule
|
||||||
|
# (this relies on the STL to be well-formed)
|
||||||
|
# recompute the normal using the right-hand rule
|
||||||
|
my $clockwise = ($vertices[2]->[X] - $vertices[0]->[X]) * ($vertices[1]->[Y] - $vertices[0]->[Y])
|
||||||
|
- ($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)) {
|
||||||
|
die "STL normal and right-hand rule computation differ!\n";
|
||||||
|
}
|
||||||
|
if ($layer->id == 0 && $clockwise < 0) {
|
||||||
|
die "Right-hand rule gives bad result for facets on base layer!\n";
|
||||||
|
}
|
||||||
|
|
||||||
|
$surface->surface_type($clockwise < 0 ? 'top' : 'bottom');
|
||||||
|
|
||||||
|
return;
|
||||||
|
}
|
||||||
|
|
||||||
|
# build the three segments of the triangle facet
|
||||||
|
my @edges = (
|
||||||
|
[ $vertices[0], $vertices[1] ],
|
||||||
|
[ $vertices[1], $vertices[2] ],
|
||||||
|
[ $vertices[2], $vertices[0] ],
|
||||||
|
);
|
||||||
|
|
||||||
|
for (my $layer_id = $min_layer; $layer_id <= $max_layer; $layer_id++) {
|
||||||
|
my $layer = $print->layer($layer_id);
|
||||||
|
my $z = $layer->z;
|
||||||
|
|
||||||
|
my @intersection_points = ();
|
||||||
|
|
||||||
|
foreach my $edge (@edges) {
|
||||||
|
my ($a, $b) = @$edge;
|
||||||
|
if ($a->[Z] == $b->[Z] && $a->[Z] == $z) {
|
||||||
|
# edge is horizontal and belongs to the current layer
|
||||||
|
$layer->add_line([$a->[X], $a->[Y]], [$b->[X], $b->[Y]]);
|
||||||
|
|
||||||
|
} 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([
|
||||||
|
$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]),
|
||||||
|
]);
|
||||||
|
}
|
||||||
|
}
|
||||||
|
|
||||||
|
if (@intersection_points) {
|
||||||
|
# defensive programming:
|
||||||
|
die "Facets must intersect each plane 0 or 2 times" if @intersection_points != 2;
|
||||||
|
|
||||||
|
# check whether the two points coincide due to resolution rounding
|
||||||
|
if ($intersection_points[0]->coincides_with($intersection_points[1])) {
|
||||||
|
printf "Points coincide; removing\n";
|
||||||
|
$layer->remove_point($_) for @intersection_points;
|
||||||
|
next;
|
||||||
|
}
|
||||||
|
|
||||||
|
# connect points:
|
||||||
|
$layer->add_line(@intersection_points);
|
||||||
|
}
|
||||||
|
}
|
||||||
|
}
|
||||||
|
|
||||||
|
1;
|
||||||
58
lib/Slic3r/Surface.pm
Normal file
58
lib/Slic3r/Surface.pm
Normal file
@ -0,0 +1,58 @@
|
|||||||
|
package Slic3r::Surface;
|
||||||
|
use Moose;
|
||||||
|
|
||||||
|
use Moose::Util::TypeConstraints;
|
||||||
|
|
||||||
|
has 'contour' => (
|
||||||
|
is => 'ro',
|
||||||
|
isa => 'Slic3r::Polyline::Closed',
|
||||||
|
required => 1,
|
||||||
|
);
|
||||||
|
|
||||||
|
has 'holes' => (
|
||||||
|
traits => ['Array'],
|
||||||
|
is => 'rw',
|
||||||
|
isa => 'ArrayRef[Slic3r::Polyline::Closed]',
|
||||||
|
default => sub { [] },
|
||||||
|
handles => {
|
||||||
|
'add_hole' => 'push',
|
||||||
|
},
|
||||||
|
);
|
||||||
|
|
||||||
|
has 'surface_type' => (
|
||||||
|
is => 'rw',
|
||||||
|
isa => enum([qw(internal bottom top)]),
|
||||||
|
);
|
||||||
|
|
||||||
|
after 'add_hole' => sub {
|
||||||
|
my $self = shift;
|
||||||
|
|
||||||
|
# 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 id {
|
||||||
|
my $self = shift;
|
||||||
|
return $self->contour->id;
|
||||||
|
}
|
||||||
|
|
||||||
|
sub encloses_point {
|
||||||
|
my $self = shift;
|
||||||
|
my ($point) = @_;
|
||||||
|
|
||||||
|
return 0 if !$self->contour->encloses_point($point);
|
||||||
|
return 0 if grep $_->encloses_point($point), @{ $self->holes };
|
||||||
|
return 1;
|
||||||
|
}
|
||||||
|
|
||||||
|
1;
|
||||||
19
slic3r.pl
Normal file
19
slic3r.pl
Normal file
@ -0,0 +1,19 @@
|
|||||||
|
#!/usr/bin/perl
|
||||||
|
|
||||||
|
use strict;
|
||||||
|
use warnings;
|
||||||
|
|
||||||
|
BEGIN {
|
||||||
|
use FindBin;
|
||||||
|
use lib "$FindBin::Bin/lib";
|
||||||
|
}
|
||||||
|
|
||||||
|
use Slic3r;
|
||||||
|
use XXX;
|
||||||
|
|
||||||
|
my $stl_parser = Slic3r::STL->new;
|
||||||
|
my $print = $stl_parser->parse_file("testcube20mm.stl");
|
||||||
|
|
||||||
|
#XXX $print;
|
||||||
|
|
||||||
|
__END__
|
||||||
BIN
testcube20mm.stl
Normal file
BIN
testcube20mm.stl
Normal file
Binary file not shown.
Loading…
Reference in New Issue
Block a user