2013-09-17 20:18:54 +02:00
use Test::More tests => 6 ;
2013-06-21 14:52:35 +02:00
use strict ;
use warnings ;
BEGIN {
use FindBin ;
use lib "$FindBin::Bin/../lib" ;
}
use Slic3r ;
2013-06-22 15:22:58 +02:00
use Slic3r::Geometry qw(PI) ;
2013-06-21 14:52:35 +02:00
use Slic3r::Test ;
{
my $config = Slic3r::Config -> new_from_defaults ;
$config -> set ( 'skirts' , 0 );
$config -> set ( 'fill_density' , 0 );
$config -> set ( 'perimeters' , 3 );
$config -> set ( 'top_solid_layers' , 0 );
$config -> set ( 'bottom_solid_layers' , 0 );
2013-06-21 15:38:58 +02:00
$config -> set ( 'cooling' , 0 ); # to prevent speeds from being altered
$config -> set ( 'first_layer_speed' , '100%' ); # to prevent speeds from being altered
2013-06-21 14:52:35 +02:00
{
my $print = Slic3r::Test:: init_print ( 'overhang' , config => $config );
my $has_cw_loops = 0 ;
my $cur_loop ;
2013-08-28 16:51:58 +02:00
Slic3r::GCode::Reader -> new -> parse ( Slic3r::Test:: gcode ( $print ), sub {
2013-06-21 14:52:35 +02:00
my ( $self , $cmd , $args , $info ) = @_ ;
2013-06-22 15:22:58 +02:00
if ( $info -> { extruding } && $info -> { dist_XY } > 0 ) {
2013-06-21 14:52:35 +02:00
$cur_loop ||= [ [ $self -> X , $self -> Y ] ];
push @$cur_loop , [ @$info { qw(new_X new_Y) } ];
} else {
if ( $cur_loop ) {
2013-08-27 01:26:44 +02:00
$has_cw_loops = 1 if Slic3r::Polygon -> new ( @$cur_loop ) -> is_clockwise ;
2013-06-21 14:52:35 +02:00
$cur_loop = undef ;
}
}
});
ok ! $has_cw_loops , 'all perimeters extruded ccw' ;
}
2013-06-23 00:05:08 +02:00
{
$config -> set ( 'external_perimeter_speed' , 68 );
2014-03-24 20:01:14 +01:00
my $print = Slic3r::Test:: init_print (
'cube_with_hole' ,
config => $config ,
duplicate => 2 , # we test two copies to make sure ExtrusionLoop objects are not modified in-place (the second object would not detect cw loops and thus would calculate wrong inwards moves)
);
2013-06-23 00:05:08 +02:00
my $has_cw_loops = my $has_outwards_move = 0 ;
my $cur_loop ;
my %external_loops = (); # print_z => count of external loops
2013-08-28 16:51:58 +02:00
Slic3r::GCode::Reader -> new -> parse ( Slic3r::Test:: gcode ( $print ), sub {
2013-06-23 00:05:08 +02:00
my ( $self , $cmd , $args , $info ) = @_ ;
if ( $info -> { extruding } && $info -> { dist_XY } > 0 ) {
$cur_loop ||= [ [ $self -> X , $self -> Y ] ];
push @$cur_loop , [ @$info { qw(new_X new_Y) } ];
} else {
if ( $cur_loop ) {
2013-09-02 22:10:52 +02:00
$has_cw_loops = 1 if Slic3r::Polygon -> new_scale ( @$cur_loop ) -> is_clockwise ;
2013-06-23 00:05:08 +02:00
if ( $self -> F == $config -> external_perimeter_speed * 60 ) {
2013-07-16 17:13:01 +02:00
my $move_dest = Slic3r::Point -> new_scale ( @$info { qw(new_X new_Y) });
2014-03-24 20:01:14 +01:00
# reset counter for second object
$external_loops { $self -> Z } = 0
if defined ( $external_loops { $self -> Z }) && $external_loops { $self -> Z } == 2 ;
2013-06-23 00:05:08 +02:00
$external_loops { $self -> Z } ++ ;
2013-11-21 18:42:16 +01:00
my $loop_contains_point = Slic3r::Polygon -> new_scale ( @$cur_loop ) -> contains_point ( $move_dest );
2013-06-23 00:05:08 +02:00
$has_outwards_move = 1
2013-11-21 18:42:16 +01:00
if ( ! $loop_contains_point && $external_loops { $self -> Z } == 2 ) # contour should include destination
|| ( $loop_contains_point && $external_loops { $self -> Z } == 1 ); # hole should not
2013-06-23 00:05:08 +02:00
}
$cur_loop = undef ;
}
}
});
ok ! $has_cw_loops , 'all perimeters extruded ccw' ;
ok ! $has_outwards_move , 'move inwards after completing external loop' ;
}
2013-06-22 15:22:58 +02:00
{
2013-07-06 02:44:50 +02:00
$config -> set ( 'start_perimeters_at_concave_points' , 1 );
2013-06-22 15:22:58 +02:00
my $print = Slic3r::Test:: init_print ( 'L' , config => $config );
my $loop_starts_from_convex_point = 0 ;
my $cur_loop ;
2013-08-28 16:51:58 +02:00
Slic3r::GCode::Reader -> new -> parse ( Slic3r::Test:: gcode ( $print ), sub {
2013-06-22 15:22:58 +02:00
my ( $self , $cmd , $args , $info ) = @_ ;
if ( $info -> { extruding } && $info -> { dist_XY } > 0 ) {
$cur_loop ||= [ [ $self -> X , $self -> Y ] ];
push @$cur_loop , [ @$info { qw(new_X new_Y) } ];
} else {
if ( $cur_loop ) {
$loop_starts_from_convex_point = 1
if Slic3r::Geometry:: angle3points ( @$cur_loop [ 0 , - 1 , 1 ]) >= PI ;
$cur_loop = undef ;
}
}
});
ok ! $loop_starts_from_convex_point , 'avoid starting from convex points' ;
}
2013-06-21 14:52:35 +02:00
{
$config -> set ( 'perimeters' , 1 );
$config -> set ( 'perimeter_speed' , 77 );
$config -> set ( 'external_perimeter_speed' , 66 );
$config -> set ( 'bridge_speed' , 99 );
2013-06-21 15:38:58 +02:00
$config -> set ( 'cooling' , 1 );
$config -> set ( 'fan_below_layer_time' , 0 );
$config -> set ( 'slowdown_below_layer_time' , 0 );
$config -> set ( 'bridge_fan_speed' , 100 );
2013-09-17 10:36:06 +02:00
$config -> set ( 'bridge_flow_ratio' , 33 ); # arbitrary value
2013-07-06 11:35:40 +02:00
$config -> set ( 'overhangs' , 1 );
2013-06-21 14:52:35 +02:00
my $print = Slic3r::Test:: init_print ( 'overhang' , config => $config );
my %layer_speeds = (); # print Z => [ speeds ]
2013-06-21 15:38:58 +02:00
my $fan_speed = 0 ;
2013-09-17 10:36:06 +02:00
my $bridge_mm_per_mm = ( $config -> nozzle_diameter -> [ 0 ] ** 2 ) / ( $config -> filament_diameter -> [ 0 ] ** 2 ) * $config -> bridge_flow_ratio ;
2013-08-28 16:51:58 +02:00
Slic3r::GCode::Reader -> new -> parse ( Slic3r::Test:: gcode ( $print ), sub {
2013-06-21 14:52:35 +02:00
my ( $self , $cmd , $args , $info ) = @_ ;
2013-06-21 15:38:58 +02:00
$fan_speed = 0 if $cmd eq 'M107' ;
$fan_speed = $args -> { S } if $cmd eq 'M106' ;
2013-06-21 14:52:35 +02:00
if ( $info -> { extruding } && $info -> { dist_XY } > 0 ) {
$layer_speeds { $self -> Z } ||= {};
$layer_speeds { $self -> Z }{ my $feedrate = $args -> { F } // $self -> F } = 1 ;
2013-06-21 15:38:58 +02:00
2013-06-21 14:52:35 +02:00
fail 'wrong speed found'
if $feedrate != $config -> perimeter_speed * 60
&& $feedrate != $config -> external_perimeter_speed * 60
&& $feedrate != $config -> bridge_speed * 60 ;
2013-06-21 15:38:58 +02:00
if ( $feedrate == $config -> bridge_speed * 60 ) {
fail 'printing overhang but fan is not enabled or running at wrong speed'
if $fan_speed != 255 ;
2013-09-17 10:36:06 +02:00
my $mm_per_mm = $info -> { dist_E } / $info -> { dist_XY };
fail 'wrong bridge flow' if abs ( $mm_per_mm - $bridge_mm_per_mm ) > 0.01 ;
2013-06-21 15:38:58 +02:00
} else {
fail 'fan is running when not supposed to'
if $fan_speed > 0 ;
}
2013-06-21 14:52:35 +02:00
}
});
is scalar ( grep { keys %$_ > 1 } values %layer_speeds ), 1 ,
'only overhang layer has more than one speed' ;
}
}
2013-09-17 20:18:54 +02:00
{
my $config = Slic3r::Config -> new_from_defaults ;
$config -> set ( 'skirts' , 0 );
$config -> set ( 'perimeters' , 3 );
$config -> set ( 'layer_height' , 0.4 );
$config -> set ( 'first_layer_height' , 0.35 );
$config -> set ( 'extra_perimeters' , 1 );
$config -> set ( 'cooling' , 0 ); # to prevent speeds from being altered
$config -> set ( 'first_layer_speed' , '100%' ); # to prevent speeds from being altered
$config -> set ( 'perimeter_speed' , 99 );
$config -> set ( 'external_perimeter_speed' , 99 );
$config -> set ( 'small_perimeter_speed' , 99 );
2014-03-02 22:26:52 +01:00
$config -> set ( 'thin_walls' , 0 );
2013-09-17 20:18:54 +02:00
my $print = Slic3r::Test:: init_print ( 'ipadstand' , config => $config );
my %perimeters = (); # z => number of loops
my $in_loop = 0 ;
Slic3r::GCode::Reader -> new -> parse ( Slic3r::Test:: gcode ( $print ), sub {
my ( $self , $cmd , $args , $info ) = @_ ;
if ( $info -> { extruding } && $info -> { dist_XY } > 0 && ( $args -> { F } // $self -> F ) == $config -> perimeter_speed * 60 ) {
$perimeters { $self -> Z } ++ if ! $in_loop ;
$in_loop = 1 ;
} else {
$in_loop = 0 ;
}
});
ok ! ( grep { $_ % $ config -> perimeters } values %perimeters ), 'no superfluous extra perimeters' ;
}
2013-06-21 14:52:35 +02:00
__END__