2013-07-14 11:05:55 +00:00
|
|
|
#!/usr/bin/perl
|
|
|
|
|
|
|
|
use strict;
|
|
|
|
use warnings;
|
|
|
|
|
|
|
|
use Slic3r::XS;
|
2013-07-15 10:14:22 +00:00
|
|
|
use Test::More tests => 11;
|
2013-07-14 11:05:55 +00:00
|
|
|
|
|
|
|
my $square = [ # ccw
|
|
|
|
[100, 100],
|
|
|
|
[200, 100],
|
|
|
|
[200, 200],
|
|
|
|
[100, 200],
|
|
|
|
];
|
|
|
|
my $hole_in_square = [ # cw
|
|
|
|
[140, 140],
|
|
|
|
[140, 160],
|
|
|
|
[160, 160],
|
|
|
|
[160, 140],
|
|
|
|
];
|
|
|
|
|
|
|
|
my $expolygon = Slic3r::ExPolygon::XS->new($square, $hole_in_square);
|
|
|
|
my $surface = Slic3r::Surface->new(
|
|
|
|
expolygon => $expolygon,
|
|
|
|
surface_type => Slic3r::Surface::S_TYPE_INTERNAL,
|
|
|
|
);
|
|
|
|
|
|
|
|
$surface = $surface->clone;
|
|
|
|
|
|
|
|
isa_ok $surface->expolygon, 'Slic3r::ExPolygon::XS', 'expolygon';
|
2013-07-15 18:31:43 +00:00
|
|
|
is_deeply [ @{$surface->expolygon->arrayref_pp} ], [$square, $hole_in_square], 'expolygon roundtrip';
|
2013-07-14 11:05:55 +00:00
|
|
|
|
|
|
|
is $surface->surface_type, Slic3r::Surface::S_TYPE_INTERNAL, 'surface_type';
|
|
|
|
$surface->surface_type(Slic3r::Surface::S_TYPE_BOTTOM);
|
|
|
|
is $surface->surface_type, Slic3r::Surface::S_TYPE_BOTTOM, 'modify surface_type';
|
|
|
|
|
|
|
|
$surface->bridge_angle(30);
|
|
|
|
is $surface->bridge_angle, 30, 'bridge_angle';
|
|
|
|
|
|
|
|
$surface->extra_perimeters(2);
|
|
|
|
is $surface->extra_perimeters, 2, 'extra_perimeters';
|
|
|
|
|
2013-07-14 12:56:43 +00:00
|
|
|
{
|
|
|
|
my $collection = Slic3r::Surface::Collection->new($surface, $surface->clone);
|
|
|
|
is scalar(@$collection), 2, 'collection has the right number of items';
|
2013-07-15 18:31:43 +00:00
|
|
|
is_deeply $collection->[0]->expolygon->arrayref_pp, [$square, $hole_in_square],
|
2013-07-14 12:56:43 +00:00
|
|
|
'collection returns a correct surface expolygon';
|
|
|
|
$collection->clear;
|
|
|
|
is scalar(@$collection), 0, 'clear collection';
|
|
|
|
$collection->append($surface);
|
|
|
|
is scalar(@$collection), 1, 'append to collection';
|
2013-07-15 10:14:22 +00:00
|
|
|
|
|
|
|
my $item = $collection->[0];
|
|
|
|
$item->surface_type(Slic3r::Surface::S_TYPE_INTERNAL);
|
|
|
|
is $item->surface_type, $collection->[0]->surface_type, 'changing item affects actual item';
|
2013-07-14 12:56:43 +00:00
|
|
|
}
|
|
|
|
|
2013-07-14 11:05:55 +00:00
|
|
|
__END__
|