2012-08-25 12:23:46 +00:00
use Test::More ;
use strict ;
use warnings ;
2012-10-27 19:20:32 +00:00
plan skip_all = > 'variable-width paths are currently disabled' ;
2012-08-25 12:23:46 +00:00
plan tests = > 20 ;
BEGIN {
use FindBin ;
use lib "$FindBin::Bin/../lib" ;
2017-08-18 07:58:50 +00:00
use local::lib "$FindBin::Bin/../local-lib" ;
2012-08-25 12:23:46 +00:00
}
use List::Util qw( first ) ;
use Slic3r ;
use Slic3r::Geometry qw( X Y scale epsilon ) ;
use Slic3r::Surface ':types' ;
sub scale_points (@) { map [ scale $ _ - > [ X ] , scale $ _ - > [ Y ] ] , @ _ }
{
my $ square = Slic3r::ExPolygon - > new ( [
scale_points [ 0 , 0 ] , [ 10 , 0 ] , [ 10 , 10 ] , [ 0 , 10 ] ,
] ) ;
2013-07-16 18:09:53 +00:00
my @ offsets = @ { $ square - > noncollapsing_offset_ex ( - scale 5 ) } ;
2012-08-25 12:23:46 +00:00
is scalar @ offsets , 1 , 'non-collapsing offset' ;
}
{
2012-10-27 19:20:32 +00:00
local $ Slic3r:: Config = Slic3r::Config - > new (
perimeters = > 3 ,
) ;
2012-08-25 12:23:46 +00:00
my $ w = 0.7 ;
2012-10-27 19:20:32 +00:00
my $ perimeter_flow = Slic3r::Flow - > new (
2012-08-25 12:23:46 +00:00
nozzle_diameter = > 0.5 ,
layer_height = > 0.4 ,
width = > $ w ,
) ;
2012-10-27 19:20:32 +00:00
my $ print = Slic3r::Print - > new ;
my $ region = Slic3r::Print::Region - > new (
print = > $ print ,
flows = > { perimeter = > $ perimeter_flow } ,
) ;
push @ { $ print - > regions } , $ region ;
my $ object = Slic3r::Print::Object - > new (
print = > $ print ,
size = > [ 1 , 1 ] ,
) ;
2012-08-25 12:23:46 +00:00
my $ make_layer = sub {
my ( $ width ) = @ _ ;
my $ layer = Slic3r::Layer - > new (
2012-10-27 19:20:32 +00:00
object = > $ object ,
2012-08-25 12:23:46 +00:00
id = > 1 ,
slices = > [
Slic3r::Surface - > new (
surface_type = > S_TYPE_INTERNAL ,
expolygon = > Slic3r::ExPolygon - > new ( [ scale_points [ 0 , 0 ] , [ 50 , 0 ] , [ 50 , $ width ] , [ 0 , $ width ] ] ) ,
) ,
] ,
thin_walls = > [] ,
) ;
2012-10-27 19:20:32 +00:00
my $ layerm = $ layer - > region ( 0 ) ;
2012-08-25 12:23:46 +00:00
$ layer - > make_perimeters ;
2012-10-27 19:20:32 +00:00
return $ layerm ;
2012-08-25 12:23:46 +00:00
} ;
my % widths = (
1 * $ w = > { perimeters = > 1 , gaps = > 0 } ,
2012-10-27 19:20:32 +00:00
1.3 * $ w = > { perimeters = > 1 , gaps = > 1 , gap_flow_spacing = > $ perimeter_flow - > clone ( width = > 0.2 * $ w ) - > spacing } ,
1.5 * $ w = > { perimeters = > 1 , gaps = > 1 , gap_flow_spacing = > $ perimeter_flow - > clone ( width = > 0.5 * $ w ) - > spacing } ,
2 * $ w = > { perimeters = > 1 , gaps = > 1 , gap_flow_spacing = > $ perimeter_flow - > spacing } ,
2.5 * $ w = > { perimeters = > 1 , gaps = > 1 , gap_flow_spacing = > $ perimeter_flow - > clone ( width = > 1.5 * $ w ) - > spacing } ,
2012-08-25 12:23:46 +00:00
3 * $ w = > { perimeters = > 2 , gaps = > 0 } ,
2012-10-27 19:20:32 +00:00
4 * $ w = > { perimeters = > 2 , gaps = > 1 , gap_flow_spacing = > $ perimeter_flow - > spacing } ,
2012-08-25 12:23:46 +00:00
) ;
foreach my $ width ( sort keys % widths ) {
2012-10-27 19:20:32 +00:00
my $ layerm = $ make_layer - > ( $ width ) ;
is scalar @ { $ layerm - > perimeters } , $ widths { $ width } { perimeters } , 'right number of perimeters' ;
is scalar @ { $ layerm - > thin_fills } ? 1 : 0 , $ widths { $ width } { gaps } ,
2012-08-25 12:23:46 +00:00
( $ widths { $ width } { gaps } ? 'gaps were filled' : 'no gaps detected' ) ; # TODO: we should check the exact number of gaps, but we need a better medial axis algorithm
2013-07-16 07:49:34 +00:00
my @ gaps = map $ _ , @ { $ layerm - > thin_fills } ;
2012-08-25 12:23:46 +00:00
if ( @ gaps ) {
ok + ( ! first { abs ( $ _ - > flow_spacing - $ widths { $ width } { gap_flow_spacing } ) > epsilon } @ gaps ) ,
'flow spacing was dynamically adjusted' ;
}
}
}
__END__