2012-06-28 14:44:54 +02:00
package Slic3r::GCode ;
use Moo ;
2014-03-27 00:01:33 +01:00
use List::Util qw(min max first) ;
2014-05-12 21:49:17 +02:00
use Slic3r::ExtrusionLoop ':roles' ;
2012-06-28 14:44:54 +02:00
use Slic3r::ExtrusionPath ':roles' ;
2014-01-02 17:24:23 +01:00
use Slic3r::Flow ':roles' ;
2013-07-29 19:43:57 +02:00
use Slic3r::Geometry qw(epsilon scale unscale scaled_epsilon points_coincide PI X Y B) ;
2014-04-29 19:58:58 +02:00
use Slic3r::Geometry::Clipper qw(union_ex offset_ex) ;
2013-06-20 20:11:46 +02:00
use Slic3r::Surface ':types' ;
2012-06-28 14:44:54 +02:00
2014-05-13 08:34:21 +02:00
has 'config' => ( is => 'ro' , default => sub { Slic3r::Config::Full -> new });
2014-03-17 00:39:07 +01:00
has 'placeholder_parser' => ( is => 'rw' , default => sub { Slic3r::GCode::PlaceholderParser -> new });
2013-09-18 20:03:59 +02:00
has 'standby_points' => ( is => 'rw' );
2013-07-28 13:39:15 +02:00
has 'enable_loop_clipping' => ( is => 'rw' , default => sub { 1 });
2014-01-05 00:36:33 +01:00
has 'enable_wipe' => ( is => 'rw' , default => sub { 0 }); # at least one extruder has wipe enabled
2013-01-17 14:56:31 +01:00
has 'layer_count' => ( is => 'ro' , required => 1 );
2014-01-11 17:40:09 +01:00
has '_layer_index' => ( is => 'rw' , default => sub { - 1 }); # just a counter
2012-06-28 14:44:54 +02:00
has 'layer' => ( is => 'rw' );
2013-08-09 14:55:36 +02:00
has '_layer_islands' => ( is => 'rw' );
has '_upper_layer_islands' => ( is => 'rw' );
2014-05-24 22:10:28 +02:00
has '_seam_position' => ( is => 'ro' , default => sub { {} }); # $object => pos
2012-06-28 14:44:54 +02:00
has 'shift_x' => ( is => 'rw' , default => sub { 0 } );
has 'shift_y' => ( is => 'rw' , default => sub { 0 } );
2012-10-28 19:24:24 +01:00
has 'z' => ( is => 'rw' );
2014-01-05 00:36:33 +01:00
has 'extruders' => ( is => 'ro' , default => sub {{}});
2014-03-27 00:01:33 +01:00
has 'multiple_extruders' => ( is => 'rw' , default => sub { 0 });
2014-01-05 00:36:33 +01:00
has 'extruder' => ( is => 'rw' );
2012-08-23 21:10:04 +02:00
has 'external_mp' => ( is => 'rw' );
has 'layer_mp' => ( is => 'rw' );
has 'new_object' => ( is => 'rw' , default => sub { 0 });
has 'straight_once' => ( is => 'rw' , default => sub { 1 });
2012-06-28 14:44:54 +02:00
has 'elapsed_time' => ( is => 'rw' , default => sub { 0 } ); # seconds
has 'lifted' => ( is => 'rw' , default => sub { 0 } );
has 'last_pos' => ( is => 'rw' , default => sub { Slic3r::Point -> new ( 0 , 0 ) } );
has 'last_fan_speed' => ( is => 'rw' , default => sub { 0 });
2013-03-17 02:22:50 +01:00
has 'wipe_path' => ( is => 'rw' );
2012-06-28 14:44:54 +02:00
2014-01-03 18:27:46 +01:00
sub set_extruders {
2014-05-13 08:34:21 +02:00
my ( $self , $extruder_ids , $print_config ) = @_ ;
2014-01-03 18:27:46 +01:00
foreach my $i ( @$extruder_ids ) {
2014-05-13 08:34:21 +02:00
$self -> extruders -> { $i } = my $e = Slic3r::Extruder -> new ( $i , $print_config );
2014-01-05 00:36:33 +01:00
$self -> enable_wipe ( 1 ) if $e -> wipe ;
2014-01-03 18:27:46 +01:00
}
2014-03-27 00:01:33 +01:00
# we enable support for multiple extruder if any extruder greater than 0 is used
# (even if prints only uses that one) since we need to output Tx commands
# first extruder has index 0
$self -> multiple_extruders ( max ( @$extruder_ids ) > 0 );
2014-01-03 18:27:46 +01:00
}
2012-08-23 15:42:58 +02:00
sub set_shift {
2013-08-27 00:02:24 +02:00
my ( $self , @shift ) = @_ ;
2012-08-23 15:42:58 +02:00
2013-01-27 13:06:45 +01:00
# if shift increases (goes towards right), last_pos decreases because it goes towards left
2013-03-25 23:06:18 +01:00
my @translate = (
2013-01-27 12:48:16 +01:00
scale ( $self -> shift_x - $shift [ X ]),
scale ( $self -> shift_y - $shift [ Y ]),
2012-12-09 18:33:25 +01:00
);
2013-03-25 23:06:18 +01:00
$self -> last_pos -> translate ( @translate );
$self -> wipe_path -> translate ( @translate ) if $self -> wipe_path ;
2012-08-23 15:42:58 +02:00
$self -> shift_x ( $shift [ X ]);
$self -> shift_y ( $shift [ Y ]);
}
2012-06-28 14:44:54 +02:00
sub change_layer {
2013-08-27 00:02:24 +02:00
my ( $self , $layer ) = @_ ;
2012-06-28 14:44:54 +02:00
$self -> layer ( $layer );
2014-01-11 17:40:09 +01:00
$self -> _layer_index ( $self -> _layer_index + 1 );
2013-07-07 19:12:44 +02:00
2013-08-09 14:55:36 +02:00
# avoid computing islands and overhangs if they're not needed
2013-11-11 20:37:06 +01:00
$self -> _layer_islands ( $layer -> islands );
$self -> _upper_layer_islands ( $layer -> upper_layer ? $layer -> upper_layer -> islands : [] );
2014-05-13 08:34:21 +02:00
if ( $self -> config -> avoid_crossing_perimeters ) {
2012-08-23 21:10:04 +02:00
$self -> layer_mp ( Slic3r::GCode::MotionPlanner -> new (
2013-07-17 00:29:09 +02:00
islands => union_ex ([ map @$_ , @ { $layer -> slices } ], 1 ),
2012-08-23 15:42:58 +02:00
));
}
2013-01-17 14:56:31 +01:00
my $gcode = "" ;
2014-05-13 08:34:21 +02:00
if ( $self -> config -> gcode_flavor =~ /^(?:makerware|sailfish)$/ ) {
2013-01-17 14:56:31 +01:00
$gcode .= sprintf "M73 P%s%s\n" ,
2014-01-11 17:40:09 +01:00
int ( 99 * ( $self -> _layer_index / ( $self -> layer_count - 1 ))),
2014-05-13 08:34:21 +02:00
( $self -> config -> gcode_comments ? ' ; update progress' : '' );
2013-01-17 14:56:31 +01:00
}
2014-05-13 08:34:21 +02:00
if ( $self -> config -> first_layer_acceleration ) {
2013-08-09 14:30:43 +02:00
if ( $layer -> id == 0 ) {
2014-05-13 08:34:21 +02:00
$gcode .= $self -> set_acceleration ( $self -> config -> first_layer_acceleration );
2013-08-09 14:30:43 +02:00
} elsif ( $layer -> id == 1 ) {
2014-05-13 08:34:21 +02:00
$gcode .= $self -> set_acceleration ( $self -> config -> default_acceleration );
2013-08-09 14:30:43 +02:00
}
}
2013-08-09 19:46:20 +02:00
$gcode .= $self -> move_z ( $layer -> print_z );
2013-01-17 14:56:31 +01:00
return $gcode ;
2013-01-12 19:00:18 +01:00
}
2013-07-29 00:27:53 +02:00
# this method accepts Z in unscaled coordinates
2012-10-28 16:59:20 +01:00
sub move_z {
2013-08-27 00:02:24 +02:00
my ( $self , $z , $comment ) = @_ ;
2012-10-28 16:59:20 +01:00
2012-06-28 14:44:54 +02:00
my $gcode = "" ;
2013-12-07 14:52:59 +01:00
2014-05-13 08:34:21 +02:00
$z += $self -> config -> z_offset ;
2012-10-30 10:45:55 +01:00
my $current_z = $self -> z ;
2013-12-07 14:52:59 +01:00
my $nominal_z = defined $current_z ? ( $current_z - $self -> lifted ) : undef ;
if ( ! defined $current_z || $z > $current_z || $z < $nominal_z ) {
# we're moving above the current actual Z (so above the lift height of the current
# layer if any) or below the current nominal layer
# in both cases, we're going to the nominal Z of the next layer
2013-07-29 19:43:57 +02:00
$self -> lifted ( 0 );
2013-12-07 14:52:59 +01:00
if ( $self -> extruder -> retract_layer_change ) {
# this retraction may alter $self->z
$gcode .= $self -> retract ( move_z => $z );
$current_z = $self -> z ; # update current z in case retract() changed it
$nominal_z = defined $current_z ? ( $current_z - $self -> lifted ) : undef ;
}
2014-05-13 08:34:21 +02:00
$gcode .= $self -> G0 ( undef , $z , 0 , $self -> config -> travel_speed * 60 , $comment || ( 'move to next layer (' . $self -> layer -> id . ')' ))
2013-12-07 14:52:59 +01:00
if ! defined $current_z || abs ( $z - $nominal_z ) > epsilon ;
} elsif ( $z < $current_z ) {
# we're moving above the current nominal layer height and below the current actual one.
# we're basically advancing to next layer, whose nominal Z is still lower than the previous
2013-07-29 19:43:57 +02:00
# layer Z with lift.
2013-12-07 14:52:59 +01:00
$self -> lifted ( $current_z - $z );
2012-10-30 10:45:55 +01:00
}
2012-06-28 14:44:54 +02:00
return $gcode ;
}
sub extrude {
my $self = shift ;
2013-07-15 16:21:09 +02:00
$_ [ 0 ] -> isa ( 'Slic3r::ExtrusionLoop' )
2012-07-20 14:39:07 +02:00
? $self -> extrude_loop ( @_ )
: $self -> extrude_path ( @_ );
2012-06-28 14:44:54 +02:00
}
sub extrude_loop {
2014-05-18 17:02:18 +02:00
my ( $self , $loop , $description , $speed ) = @_ ;
2012-06-28 14:44:54 +02:00
2014-03-24 20:01:14 +01:00
# make a copy; don't modify the orientation of the original loop object otherwise
# next copies (if any) would not detect the correct orientation
$loop = $loop -> clone ;
2012-06-28 14:44:54 +02:00
# extrude all loops ccw
2013-07-16 17:13:01 +02:00
my $was_clockwise = $loop -> make_counter_clockwise ;
2012-06-28 14:44:54 +02:00
# find the point of the loop that is closest to the current extruder position
# or randomize if requested
my $last_pos = $self -> last_pos ;
2014-05-22 12:28:12 +02:00
if ( $self -> config -> spiral_vase ) {
$loop -> split_at ( $last_pos );
2014-05-24 22:10:28 +02:00
} elsif ( $self -> config -> seam_position eq 'nearest' || $self -> config -> seam_position eq 'aligned' ) {
2014-05-22 19:34:49 +02:00
my $polygon = $loop -> polygon ;
my @candidates = @ { $polygon -> concave_points ( PI * 4 / 3 )};
@candidates = @ { $polygon -> convex_points ( PI * 2 / 3 )} if ! @candidates ;
@candidates = @ { $polygon } if ! @candidates ;
my @non_overhang = grep ! $loop -> has_overhang_point ( $_ ), @candidates ;
@candidates = @non_overhang if @non_overhang ;
2014-05-24 22:10:28 +02:00
if ( $self -> config -> seam_position eq 'nearest' ) {
2014-05-22 19:34:49 +02:00
$loop -> split_at_vertex ( $last_pos -> nearest_point ( \ @candidates ));
2014-05-24 22:10:28 +02:00
} elsif ( $self -> config -> seam_position eq 'aligned' ) {
if ( defined $self -> layer && defined $self -> _seam_position -> { $self -> layer -> object }) {
$last_pos = $self -> _seam_position -> { $self -> layer -> object };
2014-05-22 19:34:49 +02:00
}
2014-05-24 22:10:28 +02:00
my $point = $self -> _seam_position -> { $self -> layer -> object } = $last_pos -> nearest_point ( \ @candidates );
2014-05-22 19:34:49 +02:00
$loop -> split_at_vertex ( $point );
}
2014-05-24 22:10:28 +02:00
} elsif ( $self -> config -> seam_position eq 'random' ) {
2014-05-22 19:34:49 +02:00
if ( $loop -> role == EXTRL_ROLE_CONTOUR_INTERNAL_PERIMETER ) {
my $polygon = $loop -> polygon ;
my $centroid = $polygon -> centroid ;
$last_pos = Slic3r::Point -> new ( $polygon -> bounding_box -> x_max , $centroid -> y ); #))
$last_pos -> rotate ( rand ( 2 * PI ), $centroid );
}
$loop -> split_at ( $last_pos );
2014-05-22 12:28:12 +02:00
}
2012-06-28 14:44:54 +02:00
# clip the path to avoid the extruder to get exactly on the first point of the loop;
# if polyline was shorter than the clipping distance we'd get a null polyline, so
# we discard it in that case
2014-05-08 11:07:37 +02:00
my $clip_length = $self -> enable_loop_clipping
? scale ( $self -> extruder -> nozzle_diameter ) * & Slic3r:: LOOP_CLIPPING_LENGTH_OVER_NOZZLE_DIAMETER
: 0 ;
2012-06-28 14:44:54 +02:00
2014-05-08 11:07:37 +02:00
# get paths
my @paths = @ { $loop -> clip_end ( $clip_length )};
return '' if ! @paths ;
2013-06-20 20:11:46 +02:00
2013-06-21 14:52:35 +02:00
# apply the small perimeter speed
2014-05-13 08:34:21 +02:00
if ( $paths [ 0 ] -> is_perimeter && $loop -> length <= & Slic3r:: SMALL_PERIMETER_LENGTH ) {
2014-05-18 17:02:18 +02:00
$speed // = $self -> config -> get_abs_value ( 'small_perimeter_speed' );
2013-06-21 14:52:35 +02:00
}
2014-05-18 17:02:18 +02:00
$speed // = - 1 ;
2013-06-21 14:52:35 +02:00
2012-06-28 14:44:54 +02:00
# extrude along the path
2014-05-13 08:34:21 +02:00
my $gcode = join '' , map $self -> extrude_path ( $_ , $description , $speed ), @paths ;
2014-05-08 11:07:37 +02:00
$self -> wipe_path ( $paths [ - 1 ] -> polyline -> clone ) if $self -> enable_wipe ; # TODO: don't limit wipe to last path
2012-12-05 11:31:35 +01:00
# make a little move inwards before leaving loop
2014-05-13 08:34:21 +02:00
if ( $paths [ - 1 ] -> role == EXTR_ROLE_EXTERNAL_PERIMETER && defined $self -> layer && $self -> config -> perimeters > 1 ) {
2014-05-08 11:07:37 +02:00
my $last_path_polyline = $paths [ - 1 ] -> polyline ;
2012-12-05 11:31:35 +01:00
# detect angle between last and first segment
# the side depends on the original winding order of the polygon (left for contours, right for holes)
my @points = $was_clockwise ? ( - 2 , 1 ) : ( 1 , - 2 );
2014-05-08 11:07:37 +02:00
my $angle = Slic3r::Geometry:: angle3points ( @$last_path_polyline [ 0 , @points ]) / 3 ;
2012-12-05 11:31:35 +01:00
$angle *= - 1 if $was_clockwise ;
# create the destination point along the first segment and rotate it
2013-03-09 17:15:45 +01:00
# we make sure we don't exceed the segment length because we don't know
# the rotation of the second segment so we might cross the object boundary
2014-05-08 11:07:37 +02:00
my $first_segment = Slic3r::Line -> new ( @$last_path_polyline [ 0 , 1 ]);
2014-01-03 20:02:00 +01:00
my $distance = min ( scale ( $self -> extruder -> nozzle_diameter ), $first_segment -> length );
2013-10-27 22:57:25 +01:00
my $point = $first_segment -> point_at ( $distance );
2014-05-08 11:07:37 +02:00
$point -> rotate ( $angle , $last_path_polyline -> first_point );
2012-12-05 11:31:35 +01:00
# generate the travel move
2014-05-08 11:07:37 +02:00
$gcode .= $self -> travel_to ( $point , $paths [ - 1 ] -> role , "move inwards before travel" );
2012-12-05 11:31:35 +01:00
}
return $gcode ;
2012-06-28 14:44:54 +02:00
}
sub extrude_path {
2014-05-13 08:34:21 +02:00
my ( $self , $path , $description , $speed ) = @_ ;
2012-06-28 14:44:54 +02:00
2012-11-18 17:38:08 +01:00
$path -> simplify ( & Slic3r:: SCALED_RESOLUTION );
2012-06-28 14:44:54 +02:00
# go to first point of extrusion path
2013-03-05 17:30:27 +01:00
my $gcode = "" ;
2013-08-29 01:36:42 +02:00
{
my $first_point = $path -> first_point ;
$gcode .= $self -> travel_to ( $first_point , $path -> role , "move to first $description point" )
if ! defined $self -> last_pos || ! $self -> last_pos -> coincides_with ( $first_point );
}
2012-06-28 14:44:54 +02:00
# compensate retraction
2012-12-21 15:14:44 +01:00
$gcode .= $self -> unretract ;
2012-06-28 14:44:54 +02:00
2013-03-09 20:28:03 +01:00
# adjust acceleration
my $acceleration ;
2014-05-13 08:34:21 +02:00
if ( ! $self -> config -> first_layer_acceleration || $self -> layer -> id != 0 ) {
if ( $self -> config -> perimeter_acceleration && $path -> is_perimeter ) {
$acceleration = $self -> config -> perimeter_acceleration ;
} elsif ( $self -> config -> infill_acceleration && $path -> is_fill ) {
$acceleration = $self -> config -> infill_acceleration ;
} elsif ( $self -> config -> infill_acceleration && $path -> is_bridge ) {
$acceleration = $self -> config -> bridge_acceleration ;
2013-08-09 14:30:43 +02:00
}
$gcode .= $self -> set_acceleration ( $acceleration ) if $acceleration ;
2013-03-09 20:31:09 +01:00
}
2013-03-09 20:28:03 +01:00
2012-07-03 18:05:31 +02:00
# calculate extrusion length per distance unit
2014-01-03 18:27:46 +01:00
my $e = $self -> extruder -> e_per_mm3 * $path -> mm3_per_mm ;
2014-05-15 15:54:16 +02:00
$e = 0 if ! $self -> config -> get_extrusion_axis ;
2012-06-28 14:44:54 +02:00
2012-12-05 10:47:41 +01:00
# set speed
2014-05-13 08:34:21 +02:00
my $F ;
2014-05-18 17:02:18 +02:00
if ( $path -> role == EXTR_ROLE_PERIMETER ) {
2014-05-13 08:34:21 +02:00
$F = $self -> config -> get_abs_value ( 'perimeter_speed' );
} elsif ( $path -> role == EXTR_ROLE_EXTERNAL_PERIMETER ) {
$F = $self -> config -> get_abs_value ( 'external_perimeter_speed' );
} elsif ( $path -> role == EXTR_ROLE_OVERHANG_PERIMETER || $path -> role == EXTR_ROLE_BRIDGE ) {
$F = $self -> config -> get_abs_value ( 'bridge_speed' );
} elsif ( $path -> role == EXTR_ROLE_FILL ) {
$F = $self -> config -> get_abs_value ( 'infill_speed' );
} elsif ( $path -> role == EXTR_ROLE_SOLIDFILL ) {
$F = $self -> config -> get_abs_value ( 'solid_infill_speed' );
} elsif ( $path -> role == EXTR_ROLE_TOPSOLIDFILL ) {
$F = $self -> config -> get_abs_value ( 'top_solid_infill_speed' );
} elsif ( $path -> role == EXTR_ROLE_GAPFILL ) {
$F = $self -> config -> get_abs_value ( 'gap_fill_speed' );
} else {
2014-05-15 15:54:16 +02:00
$F = $speed // - 1 ;
2014-05-13 08:34:21 +02:00
die "Invalid speed" if $F < 0 ; # $speed == -1
}
$F *= 60 ; # convert mm/sec to mm/min
2013-08-28 18:12:20 +02:00
if ( $self -> layer -> id == 0 ) {
2014-05-13 08:34:21 +02:00
$F = $self -> config -> get_abs_value_over ( 'first_layer_speed' , $F / 60 ) * 60 ;
2013-08-28 18:12:20 +02:00
}
2012-12-05 10:47:41 +01:00
# extrude arc or line
2013-08-28 18:12:20 +02:00
$gcode .= ";_BRIDGE_FAN_START\n" if $path -> is_bridge ;
2014-04-01 16:54:57 +03:00
my $path_length = unscale $path -> length ;
2013-08-28 19:50:16 +02:00
{
2014-04-01 16:54:57 +03:00
$gcode .= $path -> gcode ( $self -> extruder , $e , $F ,
2014-04-28 22:02:34 +02:00
$self -> shift_x - $self -> extruder -> extruder_offset -> x ,
$self -> shift_y - $self -> extruder -> extruder_offset -> y , #,,
2014-05-15 15:54:16 +02:00
$self -> config -> get_extrusion_axis ,
2014-05-13 08:34:21 +02:00
$self -> config -> gcode_comments ? " ; $description" : "" );
2014-04-01 16:54:57 +03:00
2013-08-29 01:36:42 +02:00
if ( $self -> enable_wipe ) {
2013-09-06 19:14:06 +02:00
$self -> wipe_path ( $path -> polyline -> clone );
2013-08-29 01:36:42 +02:00
$self -> wipe_path -> reverse ;
}
2012-06-28 14:44:54 +02:00
}
2013-08-28 18:12:20 +02:00
$gcode .= ";_BRIDGE_FAN_END\n" if $path -> is_bridge ;
2013-09-02 22:33:03 +02:00
$self -> last_pos ( $path -> last_point );
2012-06-28 14:44:54 +02:00
2014-05-13 08:34:21 +02:00
if ( $self -> config -> cooling ) {
2013-08-28 18:12:20 +02:00
my $path_time = $path_length / $F * 60 ;
2012-06-28 14:44:54 +02:00
$self -> elapsed_time ( $self -> elapsed_time + $path_time );
}
2013-03-09 20:28:03 +01:00
# reset acceleration
2014-05-13 08:34:21 +02:00
$gcode .= $self -> set_acceleration ( $self -> config -> default_acceleration )
if $acceleration && $self -> config -> default_acceleration ;
2013-03-09 20:28:03 +01:00
2012-06-28 14:44:54 +02:00
return $gcode ;
}
2012-08-23 15:42:58 +02:00
sub travel_to {
2013-08-27 00:02:24 +02:00
my ( $self , $point , $role , $comment ) = @_ ;
2012-08-23 15:42:58 +02:00
2012-08-23 21:10:04 +02:00
my $gcode = "" ;
2013-07-16 17:13:01 +02:00
my $travel = Slic3r::Line -> new ( $self -> last_pos , $point );
2013-03-05 17:30:27 +01:00
# move travel back to original layer coordinates for the island check.
# note that we're only considering the current object's islands, while we should
# build a more complete configuration space
$travel -> translate ( - $self -> shift_x , - $self -> shift_y );
2013-07-26 10:52:22 +02:00
# skip retraction if the travel move is contained in an island in the current layer
# *and* in an island in the upper layer (so that the ooze will not be visible)
2013-03-05 17:30:27 +01:00
if ( $travel -> length < scale $self -> extruder -> retract_before_travel
2014-05-13 08:34:21 +02:00
|| ( $self -> config -> only_retract_when_crossing_perimeters
2013-11-21 14:35:28 +01:00
&& ( first { $_ -> contains_line ( $travel ) } @ { $self -> _upper_layer_islands })
&& ( first { $_ -> contains_line ( $travel ) } @ { $self -> _layer_islands }))
|| ( defined $role && $role == EXTR_ROLE_SUPPORTMATERIAL && ( first { $_ -> contains_line ( $travel ) } @ { $self -> layer -> support_islands }))
2013-03-05 17:30:27 +01:00
) {
$self -> straight_once ( 0 );
2014-05-13 08:34:21 +02:00
$gcode .= $self -> G0 ( $point , undef , 0 , $self -> config -> travel_speed * 60 , $comment || "" );
} elsif ( ! $self -> config -> avoid_crossing_perimeters || $self -> straight_once ) {
2013-03-05 17:30:27 +01:00
$self -> straight_once ( 0 );
2013-10-13 16:20:01 +02:00
$gcode .= $self -> retract ;
2014-05-13 08:34:21 +02:00
$gcode .= $self -> G0 ( $point , undef , 0 , $self -> config -> travel_speed * 60 , $comment || "" );
2013-03-05 17:30:27 +01:00
} else {
2012-08-23 21:10:04 +02:00
if ( $self -> new_object ) {
$self -> new_object ( 0 );
2013-01-27 12:48:16 +01:00
# represent $point in G-code coordinates
$point = $point -> clone ;
my @shift = ( $self -> shift_x , $self -> shift_y );
$point -> translate ( map scale $_ , @shift );
# calculate path (external_mp uses G-code coordinates so we temporary need a null shift)
$self -> set_shift ( 0 , 0 );
2013-05-18 16:57:44 +02:00
$gcode .= $self -> _plan ( $self -> external_mp , $point , $comment );
2012-08-23 21:10:04 +02:00
$self -> set_shift ( @shift );
} else {
2013-05-18 16:57:44 +02:00
$gcode .= $self -> _plan ( $self -> layer_mp , $point , $comment );
2012-08-23 21:10:04 +02:00
}
2012-08-23 15:42:58 +02:00
}
2012-08-23 21:10:04 +02:00
return $gcode ;
2012-08-23 15:42:58 +02:00
}
2013-05-18 16:57:44 +02:00
sub _plan {
2013-08-27 00:02:24 +02:00
my ( $self , $mp , $point , $comment ) = @_ ;
2013-05-18 16:57:44 +02:00
my $gcode = "" ;
2013-09-06 22:52:56 +02:00
my @travel = @ { $mp -> shortest_path ( $self -> last_pos , $point ) -> lines };
2013-05-18 16:57:44 +02:00
# if the path is not contained in a single island we need to retract
2014-05-13 08:34:21 +02:00
my $need_retract = ! $self -> config -> only_retract_when_crossing_perimeters ;
2013-05-18 16:57:44 +02:00
if ( ! $need_retract ) {
$need_retract = 1 ;
2013-11-11 20:37:06 +01:00
foreach my $island ( @ { $self -> _upper_layer_islands }) {
2013-05-18 16:57:44 +02:00
# discard the island if at any line is not enclosed in it
2013-11-21 14:35:28 +01:00
next if first { ! $island -> contains_line ( $_ ) } @travel ;
2013-05-18 16:57:44 +02:00
# okay, this island encloses the full travel path
$need_retract = 0 ;
last ;
}
}
# do the retract (the travel_to argument is broken)
2013-10-13 16:20:01 +02:00
$gcode .= $self -> retract if $need_retract ;
2013-05-18 16:57:44 +02:00
# append the actual path and return
2013-06-05 17:12:34 +02:00
# use G1 because we rely on paths being straight (G0 may make round paths)
2014-05-13 08:34:21 +02:00
$gcode .= join '' , map $self -> G1 ( $_ -> b , undef , 0 , $self -> config -> travel_speed * 60 , $comment || "" ), @travel ;
2013-05-18 16:57:44 +02:00
return $gcode ;
}
2012-06-28 14:44:54 +02:00
sub retract {
2013-08-27 00:02:24 +02:00
my ( $self , %params ) = @_ ;
2012-06-28 14:44:54 +02:00
2012-08-22 20:31:03 +02:00
# get the retraction length and abort if none
my ( $length , $restart_extra , $comment ) = $params { toolchange }
? ( $self -> extruder -> retract_length_toolchange , $self -> extruder -> retract_restart_extra_toolchange , "retract for tool change" )
: ( $self -> extruder -> retract_length , $self -> extruder -> retract_restart_extra , "retract" );
2012-08-22 19:11:45 +02:00
2012-08-22 20:31:03 +02:00
# if we already retracted, reduce the required amount of retraction
$length -= $self -> extruder -> retracted ;
return "" unless $length > 0 ;
2013-03-17 02:22:50 +01:00
my $gcode = "" ;
# wipe
2013-03-25 23:06:18 +01:00
my $wipe_path ;
2013-04-03 19:08:12 +02:00
if ( $self -> extruder -> wipe && $self -> wipe_path ) {
2013-09-06 19:14:06 +02:00
my @points = @ { $self -> wipe_path };
2013-10-27 22:57:25 +01:00
$wipe_path = Slic3r::Polyline -> new ( $self -> last_pos , @ { $self -> wipe_path }[ 1 .. $# { $self -> wipe_path }]);
2014-05-13 08:34:21 +02:00
$wipe_path -> clip_end ( $wipe_path -> length - $self -> extruder -> scaled_wipe_distance ( $self -> config -> travel_speed ));
2013-03-17 02:22:50 +01:00
}
2012-06-28 14:44:54 +02:00
# prepare moves
2014-05-13 08:34:21 +02:00
my $retract = [ undef , undef , - $length , $self -> extruder -> retract_speed_mm_min , $comment ];
2014-05-15 15:54:16 +02:00
my $lift = ( $self -> config -> retract_lift -> [ 0 ] == 0 || defined $params { move_z }) && ! $self -> lifted
2012-06-28 14:44:54 +02:00
? undef
2014-05-15 15:54:16 +02:00
: [ undef , $self -> z + $self -> config -> retract_lift -> [ 0 ], 0 , $self -> config -> travel_speed * 60 , 'lift plate during travel' ];
2012-06-28 14:44:54 +02:00
2013-10-13 16:20:01 +02:00
# check that we have a positive wipe length
2013-10-13 17:04:47 +02:00
if ( $wipe_path ) {
2013-10-13 16:20:01 +02:00
# subdivide the retraction
my $retracted = 0 ;
2013-10-13 17:04:47 +02:00
foreach my $line ( @ { $wipe_path -> lines }) {
my $segment_length = $line -> length ;
# reduce retraction length a bit to avoid effective retraction speed to be greater than the configured one
# due to rounding
2014-05-13 08:34:21 +02:00
my $e = $retract -> [ 2 ] * ( $segment_length / $self -> extruder -> scaled_wipe_distance ( $self -> config -> travel_speed )) * 0.95 ;
2013-10-13 17:04:47 +02:00
$retracted += $e ;
2014-05-13 08:34:21 +02:00
$gcode .= $self -> G1 ( $line -> b , undef , $e , $self -> config -> travel_speed * 60 * 0.8 , $retract -> [ 3 ] . ";_WIPE" );
2013-10-13 16:20:01 +02:00
}
if ( $retracted > $retract -> [ 2 ]) {
# if we retracted less than we had to, retract the remainder
# TODO: add regression test
2014-05-13 08:34:21 +02:00
$gcode .= $self -> G1 ( undef , undef , $retract -> [ 2 ] - $retracted , $self -> extruder -> retract_speed_mm_min , $comment );
2012-06-28 14:44:54 +02:00
}
2014-05-13 08:34:21 +02:00
} elsif ( $self -> config -> use_firmware_retraction ) {
2013-10-27 16:59:18 +01:00
$gcode .= "G10 ; retract\n" ;
2012-06-28 14:44:54 +02:00
} else {
2013-10-13 16:20:01 +02:00
$gcode .= $self -> G1 ( @$retract );
}
if ( ! $self -> lifted ) {
2014-05-15 15:54:16 +02:00
if ( defined $params { move_z } && $self -> config -> retract_lift -> [ 0 ] > 0 ) {
my $travel = [ undef , $params { move_z } + $self -> config -> retract_lift -> [ 0 ], 0 , $self -> config -> travel_speed * 60 , 'move to next layer (' . $self -> layer -> id . ') and lift' ];
2013-10-13 16:20:01 +02:00
$gcode .= $self -> G0 ( @$travel );
2014-05-15 15:54:16 +02:00
$self -> lifted ( $self -> config -> retract_lift -> [ 0 ]);
2013-10-13 16:20:01 +02:00
} elsif ( $lift ) {
$gcode .= $self -> G1 ( @$lift );
2012-06-28 14:44:54 +02:00
}
}
2014-04-08 02:42:29 +03:00
$self -> extruder -> set_retracted ( $self -> extruder -> retracted + $length );
$self -> extruder -> set_restart_extra ( $restart_extra );
2014-05-15 15:54:16 +02:00
$self -> lifted ( $self -> config -> retract_lift -> [ 0 ]) if $lift ;
2012-06-28 14:44:54 +02:00
# reset extrusion distance during retracts
# this makes sure we leave sufficient precision in the firmware
2013-06-03 15:27:58 +02:00
$gcode .= $self -> reset_e ;
2012-06-28 14:44:54 +02:00
2014-05-13 08:34:21 +02:00
$gcode .= "M103 ; extruder off\n" if $self -> config -> gcode_flavor eq 'makerware' ;
2012-06-28 14:44:54 +02:00
return $gcode ;
}
sub unretract {
2013-08-27 00:02:24 +02:00
my ( $self ) = @_ ;
2012-08-22 18:57:03 +02:00
2012-06-28 14:44:54 +02:00
my $gcode = "" ;
2014-05-13 08:34:21 +02:00
$gcode .= "M101 ; extruder on\n" if $self -> config -> gcode_flavor eq 'makerware' ;
2012-06-28 14:44:54 +02:00
if ( $self -> lifted ) {
2014-05-13 08:34:21 +02:00
$gcode .= $self -> G0 ( undef , $self -> z - $self -> lifted , 0 , $self -> config -> travel_speed * 60 , 'restore layer Z' );
2012-06-28 14:44:54 +02:00
$self -> lifted ( 0 );
}
2012-12-21 15:14:44 +01:00
my $to_unretract = $self -> extruder -> retracted + $self -> extruder -> restart_extra ;
if ( $to_unretract ) {
2014-05-13 08:34:21 +02:00
if ( $self -> config -> use_firmware_retraction ) {
2013-10-27 16:59:18 +01:00
$gcode .= "G11 ; unretract\n" ;
2014-05-15 15:54:16 +02:00
} elsif ( $self -> config -> get_extrusion_axis ) {
2013-08-28 20:01:17 +02:00
# use G1 instead of G0 because G0 will blend the restart with the previous travel move
2013-11-24 12:37:36 +01:00
$gcode .= sprintf "G1 %s%.5f F%.3f" ,
2014-05-15 15:54:16 +02:00
$self -> config -> get_extrusion_axis ,
2013-08-28 20:13:18 +02:00
$self -> extruder -> extrude ( $to_unretract ),
2013-08-28 20:01:17 +02:00
$self -> extruder -> retract_speed_mm_min ;
2014-05-13 08:34:21 +02:00
$gcode .= " ; compensate retraction" if $self -> config -> gcode_comments ;
2013-08-28 20:01:17 +02:00
$gcode .= "\n" ;
}
2014-04-08 02:42:29 +03:00
$self -> extruder -> set_retracted ( 0 );
$self -> extruder -> set_restart_extra ( 0 );
2012-12-21 15:14:44 +01:00
}
2012-06-28 14:44:54 +02:00
return $gcode ;
}
2012-07-06 19:57:58 +02:00
sub reset_e {
2013-08-27 00:02:24 +02:00
my ( $self ) = @_ ;
2014-05-13 08:34:21 +02:00
return "" if $self -> config -> gcode_flavor =~ /^(?:mach3|makerware|sailfish)$/ ;
2012-07-06 19:57:58 +02:00
2014-04-08 02:42:29 +03:00
$self -> extruder -> set_E ( 0 ) if $self -> extruder ;
2014-05-15 15:54:16 +02:00
return sprintf "G92 %s0%s\n" , $self -> config -> get_extrusion_axis , ( $self -> config -> gcode_comments ? ' ; reset extrusion distance' : '' )
if $self -> config -> get_extrusion_axis && ! $self -> config -> use_relative_e_distances ;
2012-07-06 19:57:58 +02:00
}
2012-06-28 14:44:54 +02:00
sub set_acceleration {
2013-08-27 00:02:24 +02:00
my ( $self , $acceleration ) = @_ ;
2013-01-10 15:29:40 +01:00
return "" if ! $acceleration ;
2012-06-28 14:44:54 +02:00
2013-01-10 15:29:40 +01:00
return sprintf "M204 S%s%s\n" ,
2014-05-13 08:34:21 +02:00
$acceleration , ( $self -> config -> gcode_comments ? ' ; adjust acceleration' : '' );
2012-06-28 14:44:54 +02:00
}
sub G0 {
my $self = shift ;
2014-05-13 08:34:21 +02:00
return $self -> G1 ( @_ ) if ! ( $self -> config -> g0 || $self -> config -> gcode_flavor eq 'mach3' );
2012-06-28 14:44:54 +02:00
return $self -> _G0_G1 ( "G0" , @_ );
}
sub G1 {
my $self = shift ;
return $self -> _G0_G1 ( "G1" , @_ );
}
sub _G0_G1 {
2014-05-13 08:34:21 +02:00
my ( $self , $gcode , $point , $z , $e , $F , $comment ) = @_ ;
2012-06-28 14:44:54 +02:00
2013-08-28 18:12:20 +02:00
if ( $point ) {
$gcode .= sprintf " X%.3f Y%.3f" ,
2014-04-28 22:02:34 +02:00
( $point -> x * & Slic3r:: SCALING_FACTOR ) + $self -> shift_x - $self -> extruder -> extruder_offset -> x ,
( $point -> y * & Slic3r:: SCALING_FACTOR ) + $self -> shift_y - $self -> extruder -> extruder_offset -> y ; #**
2012-11-16 11:05:45 +01:00
$self -> last_pos ( $point -> clone );
2012-06-28 14:44:54 +02:00
}
2012-10-28 19:24:24 +01:00
if ( defined $z && ( ! defined $self -> z || $z != $self -> z )) {
2012-06-28 14:44:54 +02:00
$self -> z ( $z );
2013-08-28 18:12:20 +02:00
$gcode .= sprintf " Z%.3f" , $z ;
2012-06-28 14:44:54 +02:00
}
2014-05-13 08:34:21 +02:00
return $self -> _Gx ( $gcode , $e , $F , $comment );
2012-06-28 14:44:54 +02:00
}
sub _Gx {
2014-05-13 08:34:21 +02:00
my ( $self , $gcode , $e , $F , $comment ) = @_ ;
2014-05-15 19:22:41 +02:00
2013-08-28 18:12:20 +02:00
$gcode .= sprintf " F%.3f" , $F ;
2012-06-28 14:44:54 +02:00
# output extrusion distance
2014-05-15 15:54:16 +02:00
if ( $e && $self -> config -> get_extrusion_axis ) {
$gcode .= sprintf " %s%.5f" , $self -> config -> get_extrusion_axis , $self -> extruder -> extrude ( $e );
2012-06-28 14:44:54 +02:00
}
2014-05-13 08:34:21 +02:00
$gcode .= " ; $comment" if $comment && $self -> config -> gcode_comments ;
2012-06-28 14:44:54 +02:00
return "$gcode\n" ;
}
2012-09-23 02:40:25 +02:00
sub set_extruder {
2014-01-03 18:27:46 +01:00
my ( $self , $extruder_id ) = @_ ;
2012-06-28 14:44:54 +02:00
2012-09-23 02:40:25 +02:00
# return nothing if this extruder was already selected
2014-01-03 18:27:46 +01:00
return "" if ( defined $self -> extruder ) && ( $self -> extruder -> id == $extruder_id );
2012-08-22 19:20:34 +02:00
2012-08-22 19:47:59 +02:00
# if we are running a single-extruder setup, just set the extruder and return nothing
2012-09-23 02:40:25 +02:00
if ( ! $self -> multiple_extruders ) {
2014-01-05 00:36:33 +01:00
$self -> extruder ( $self -> extruders -> { $extruder_id });
2012-08-22 19:47:59 +02:00
return "" ;
}
2012-09-23 02:40:25 +02:00
# trigger retraction on the current extruder (if any)
2012-08-22 19:47:59 +02:00
my $gcode = "" ;
2012-09-23 02:40:25 +02:00
$gcode .= $self -> retract ( toolchange => 1 ) if defined $self -> extruder ;
2012-08-22 19:47:59 +02:00
2012-12-23 16:29:08 +01:00
# append custom toolchange G-code
2014-05-13 08:34:21 +02:00
if ( defined $self -> extruder && $self -> config -> toolchange_gcode ) {
$gcode .= sprintf "%s\n" , $self -> placeholder_parser -> process ( $self -> config -> toolchange_gcode , {
2012-12-23 16:29:08 +01:00
previous_extruder => $self -> extruder -> id ,
2014-01-03 18:27:46 +01:00
next_extruder => $extruder_id ,
2012-12-23 16:29:08 +01:00
});
}
2013-09-18 18:49:19 +02:00
# set the current extruder to the standby temperature
2013-12-24 15:33:54 +01:00
if ( $self -> standby_points && defined $self -> extruder ) {
2013-09-18 20:03:59 +02:00
# move to the nearest standby point
2014-05-15 19:22:41 +02:00
{
my $last_pos = $self -> last_pos -> clone ;
$last_pos -> translate ( scale + $self -> shift_x , scale + $self -> shift_y );
my $standby_point = $last_pos -> nearest_point ( $self -> standby_points );
$standby_point -> translate ( scale - $self -> shift_x , scale - $self -> shift_y );
$gcode .= $self -> travel_to ( $standby_point );
}
2013-09-18 20:03:59 +02:00
2014-05-18 23:56:00 +02:00
if ( $self -> config -> standby_temperature_delta != 0 ) {
my $temp = defined $self -> layer && $self -> layer -> id == 0
? $self -> extruder -> first_layer_temperature
: $self -> extruder -> temperature ;
# we assume that heating is always slower than cooling, so no need to block
$gcode .= $self -> set_temperature ( $temp + $self -> config -> standby_temperature_delta , 0 );
}
2013-09-18 18:49:19 +02:00
}
2012-09-23 02:40:25 +02:00
# set the new extruder
2014-01-05 00:36:33 +01:00
$self -> extruder ( $self -> extruders -> { $extruder_id });
2013-06-03 16:21:22 +02:00
$gcode .= sprintf "%s%d%s\n" ,
2014-05-13 08:34:21 +02:00
( $self -> config -> gcode_flavor eq 'makerware'
2013-06-03 16:21:22 +02:00
? 'M135 T'
2014-05-13 08:34:21 +02:00
: $self -> config -> gcode_flavor eq 'sailfish'
2013-06-03 16:21:22 +02:00
? 'M108 T'
: 'T' ),
2014-01-03 18:27:46 +01:00
$extruder_id ,
2014-05-13 08:34:21 +02:00
( $self -> config -> gcode_comments ? ' ; change extruder' : '' );
2013-01-17 15:02:40 +01:00
2013-06-03 16:21:22 +02:00
$gcode .= $self -> reset_e ;
2012-08-22 19:47:59 +02:00
2013-09-18 18:49:19 +02:00
# set the new extruder to the operating temperature
2014-05-18 23:56:00 +02:00
if ( $self -> config -> ooze_prevention && $self -> config -> standby_temperature_delta != 0 ) {
2013-09-18 18:49:19 +02:00
my $temp = defined $self -> layer && $self -> layer -> id == 0
? $self -> extruder -> first_layer_temperature
: $self -> extruder -> temperature ;
$gcode .= $self -> set_temperature ( $temp , 1 );
}
2012-08-22 19:47:59 +02:00
return $gcode ;
2012-06-28 14:44:54 +02:00
}
sub set_fan {
2013-08-27 00:02:24 +02:00
my ( $self , $speed , $dont_save ) = @_ ;
2012-06-28 14:44:54 +02:00
if ( $self -> last_fan_speed != $speed || $dont_save ) {
$self -> last_fan_speed ( $speed ) if ! $dont_save ;
if ( $speed == 0 ) {
2014-05-13 08:34:21 +02:00
my $code = $self -> config -> gcode_flavor eq 'teacup'
2012-11-19 15:30:55 +01:00
? 'M106 S0'
2014-05-13 08:34:21 +02:00
: $self -> config -> gcode_flavor =~ /^(?:makerware|sailfish)$/
2013-01-17 14:56:31 +01:00
? 'M127'
: 'M107' ;
2014-05-13 08:34:21 +02:00
return sprintf "$code%s\n" , ( $self -> config -> gcode_comments ? ' ; disable fan' : '' );
2012-06-28 14:44:54 +02:00
} else {
2014-05-13 08:34:21 +02:00
if ( $self -> config -> gcode_flavor =~ /^(?:makerware|sailfish)$/ ) {
return sprintf "M126%s\n" , ( $self -> config -> gcode_comments ? ' ; enable fan' : '' );
2013-01-17 14:56:31 +01:00
} else {
2014-05-13 08:34:21 +02:00
return sprintf "M106 %s%d%s\n" , ( $self -> config -> gcode_flavor eq 'mach3' ? 'P' : 'S' ),
( 255 * $speed / 100 ), ( $self -> config -> gcode_comments ? ' ; enable fan' : '' );
2013-01-17 14:56:31 +01:00
}
2012-06-28 14:44:54 +02:00
}
}
return "" ;
}
sub set_temperature {
2013-08-27 00:02:24 +02:00
my ( $self , $temperature , $wait , $tool ) = @_ ;
2012-06-28 14:44:54 +02:00
2014-05-13 08:34:21 +02:00
return "" if $wait && $self -> config -> gcode_flavor =~ /^(?:makerware|sailfish)$/ ;
2012-06-28 14:44:54 +02:00
2014-05-13 08:34:21 +02:00
my ( $code , $comment ) = ( $wait && $self -> config -> gcode_flavor ne 'teacup' )
2012-06-28 14:44:54 +02:00
? ( 'M109' , 'wait for temperature to be reached' )
: ( 'M104' , 'set temperature' );
2012-08-30 23:13:28 +02:00
my $gcode = sprintf "$code %s%d %s; $comment\n" ,
2014-05-13 08:34:21 +02:00
( $self -> config -> gcode_flavor eq 'mach3' ? 'P' : 'S' ), $temperature ,
( defined $tool && ( $self -> multiple_extruders || $self -> config -> gcode_flavor =~ /^(?:makerware|sailfish)$/ )) ? "T$tool " : "" ;
2012-08-30 23:13:28 +02:00
$gcode .= "M116 ; wait for temperature to be reached\n"
2014-05-13 08:34:21 +02:00
if $self -> config -> gcode_flavor eq 'teacup' && $wait ;
2012-08-30 23:13:28 +02:00
return $gcode ;
2012-06-28 14:44:54 +02:00
}
sub set_bed_temperature {
2013-08-27 00:02:24 +02:00
my ( $self , $temperature , $wait ) = @_ ;
2012-06-28 14:44:54 +02:00
2014-05-13 08:34:21 +02:00
my ( $code , $comment ) = ( $wait && $self -> config -> gcode_flavor ne 'teacup' )
? (( $self -> config -> gcode_flavor =~ /^(?:makerware|sailfish)$/ ? 'M109' : 'M190' ), 'wait for bed temperature to be reached' )
2012-06-28 14:44:54 +02:00
: ( 'M140' , 'set bed temperature' );
2012-08-30 23:13:28 +02:00
my $gcode = sprintf "$code %s%d ; $comment\n" ,
2014-05-13 08:34:21 +02:00
( $self -> config -> gcode_flavor eq 'mach3' ? 'P' : 'S' ), $temperature ;
2012-08-30 23:13:28 +02:00
$gcode .= "M116 ; wait for bed temperature to be reached\n"
2014-05-13 08:34:21 +02:00
if $self -> config -> gcode_flavor eq 'teacup' && $wait ;
2012-08-30 23:13:28 +02:00
return $gcode ;
2012-06-28 14:44:54 +02:00
}
1 ;