2011-09-01 21:06:28 +02:00
package Slic3r::Print ;
2014-06-10 16:01:57 +02:00
use strict ;
use warnings ;
2011-09-01 21:06:28 +02:00
2012-04-30 14:56:01 +02:00
use File::Basename qw(basename fileparse) ;
2012-08-07 23:37:16 +02:00
use File::Spec ;
2014-06-05 16:24:47 +02:00
use List::Util qw(min max first sum) ;
2012-05-19 15:40:11 +02:00
use Slic3r::ExtrusionPath ':roles' ;
2014-03-24 17:52:14 +01:00
use Slic3r::Flow ':roles' ;
2014-11-30 18:09:06 +01:00
use Slic3r::Geometry qw(X Y Z X1 Y1 X2 Y2 MIN MAX PI scale unscale convex_hull) ;
2014-10-25 11:15:12 +02:00
use Slic3r::Geometry::Clipper qw(diff_ex union_ex intersection_ex intersection offset
2014-03-24 17:52:14 +01:00
offset2 union union_pt_chained JT_ROUND JT_SQUARE) ;
use Slic3r::Print::State ':steps' ;
2011-09-25 22:11:56 +02:00
2014-05-06 11:07:18 +03:00
our $status_cb ;
2011-09-01 21:06:28 +02:00
2014-05-06 11:07:18 +03:00
sub set_status_cb {
my ( $class , $cb ) = @_ ;
$status_cb = $cb ;
}
sub status_cb {
2014-06-14 00:06:49 +02:00
return $status_cb // sub {};
2014-05-06 11:07:18 +03:00
}
2012-06-23 21:31:29 +02:00
2014-01-11 17:40:09 +01:00
# this value is not supposed to be compared with $layer->id
# since they have different semantics
2014-05-06 11:07:18 +03:00
sub total_layer_count {
2012-04-29 12:51:20 +02:00
my $self = shift ;
2014-05-06 11:07:18 +03:00
return max ( map $_ -> total_layer_count , @ { $self -> objects });
2012-04-29 12:51:20 +02:00
}
2012-04-30 14:56:01 +02:00
sub size {
my $self = shift ;
2013-06-16 12:21:25 +02:00
return $self -> bounding_box -> size ;
2012-04-30 14:56:01 +02:00
}
2014-03-24 17:52:14 +01:00
sub process {
my ( $self ) = @_ ;
2012-04-30 14:56:01 +02:00
2014-06-13 20:05:18 +02:00
$_ -> make_perimeters for @ { $self -> objects };
$_ -> infill for @ { $self -> objects };
$_ -> generate_support_material for @ { $self -> objects };
$self -> make_skirt ;
$self -> make_brim ; # must come after make_skirt
2012-04-30 14:56:01 +02:00
2013-02-27 11:26:52 +01:00
# time to make some statistics
if ( 0 ) {
eval "use Devel::Size" ;
print "MEMORY USAGE:\n" ;
printf " meshes = %.1fMb\n" , List::Util:: sum ( map Devel::Size:: total_size ( $_ -> meshes ), @ { $self -> objects }) /1024/ 1024 ;
printf " layer slices = %.1fMb\n" , List::Util:: sum ( map Devel::Size:: total_size ( $_ -> slices ), map @ { $_ -> layers }, @ { $self -> objects }) /1024/ 1024 ;
printf " region slices = %.1fMb\n" , List::Util:: sum ( map Devel::Size:: total_size ( $_ -> slices ), map @ { $_ -> regions }, map @ { $_ -> layers }, @ { $self -> objects }) /1024/ 1024 ;
printf " perimeters = %.1fMb\n" , List::Util:: sum ( map Devel::Size:: total_size ( $_ -> perimeters ), map @ { $_ -> regions }, map @ { $_ -> layers }, @ { $self -> objects }) /1024/ 1024 ;
printf " fills = %.1fMb\n" , List::Util:: sum ( map Devel::Size:: total_size ( $_ -> fills ), map @ { $_ -> regions }, map @ { $_ -> layers }, @ { $self -> objects }) /1024/ 1024 ;
printf " print object = %.1fMb\n" , Devel::Size:: total_size ( $self ) /1024/ 1024 ;
}
2013-04-27 15:02:13 +02:00
if ( 0 ) {
eval "use Slic3r::Test::SectionCut" ;
Slic3r::Test::SectionCut -> new ( print => $self ) -> export_svg ( "section_cut.svg" );
}
2014-03-24 17:52:14 +01:00
}
sub export_gcode {
my $self = shift ;
my %params = @_ ;
2014-06-13 20:18:34 +02:00
# prerequisites
$self -> process ;
2013-02-27 11:26:52 +01:00
2012-04-30 14:56:01 +02:00
# output everything to a G-code file
my $output_file = $self -> expanded_output_filepath ( $params { output_file });
2014-06-13 20:18:34 +02:00
$self -> status_cb -> ( 90 , "Exporting G-code" . ( $output_file ? " to $output_file" : "" ));
2012-11-21 20:41:14 +01:00
$self -> write_gcode ( $params { output_fh } || $output_file );
2012-04-30 14:56:01 +02:00
# run post-processing scripts
2014-03-24 17:52:14 +01:00
if ( @ { $self -> config -> post_process }) {
2014-06-13 20:18:34 +02:00
$self -> status_cb -> ( 95 , "Running post-processing scripts" );
2014-03-24 17:52:14 +01:00
$self -> config -> setenv ;
2015-01-17 10:50:34 +01:00
for my $script ( @ { $self -> config -> post_process }) {
Slic3r:: debugf " '%s' '%s'\n" , $script , $output_file ;
2015-03-02 21:48:29 +01:00
# -x doesn't return true on Windows except for .exe files
if (( $^O eq 'MSWin32' ) ? ! ( - e $script ) : ! ( - x $script )) {
2015-01-17 10:50:34 +01:00
die "The configured post-processing script is not executable: check permissions. ($script)\n" ;
}
system ( $script , $output_file );
2012-04-30 14:56:01 +02:00
}
}
}
sub export_svg {
my $self = shift ;
my %params = @_ ;
2013-03-16 19:39:00 +01:00
$_ -> slice for @ { $self -> objects };
2012-04-30 14:56:01 +02:00
2013-06-07 12:00:03 +02:00
my $fh = $params { output_fh };
2013-10-13 11:45:22 +02:00
if ( ! $fh ) {
2013-06-07 12:00:03 +02:00
my $output_file = $self -> expanded_output_filepath ( $params { output_file });
$output_file =~ s/\.gcode$/.svg/i ;
Slic3r:: open ( \ $fh , ">" , $output_file ) or die "Failed to open $output_file for writing\n" ;
print "Exporting to $output_file..." unless $params { quiet };
}
2012-04-30 14:56:01 +02:00
2015-01-30 19:34:46 +01:00
my $print_bb = $self -> bounding_box ;
my $print_size = $print_bb -> size ;
2012-04-30 14:56:01 +02:00
print $fh sprintf << "EOF" , unscale ( $print_size -> [ X ]), unscale ( $print_size -> [ Y ]);
< ? xml version = "1.0" encoding = "UTF-8" standalone = "yes" ? >
<! DOCTYPE svg PUBLIC "-//W3C//DTD SVG 1.0//EN" "http://www.w3.org/TR/2001/REC-SVG-20010904/DTD/svg10.dtd" >
< svg width = "%s" height = "%s" xmlns = "http://www.w3.org/2000/svg" xmlns:svg = "http://www.w3.org/2000/svg" xmlns:xlink = "http://www.w3.org/1999/xlink" xmlns:slic3r = "http://slic3r.org/namespaces/slic3r" >
<!--
Generated using Slic3r $ Slic3r:: VERSION
http: //s lic3r . org /
-->
EOF
my $print_polygon = sub {
my ( $polygon , $type ) = @_ ;
printf $fh qq{ <polygon slic3r:type="%s" points="%s" style="fill: %s" />\n} ,
$type , ( join ' ' , map { join ',' , map unscale $_ , @$_ } @$polygon ),
2012-05-21 18:29:19 +02:00
( $type eq 'contour' ? 'white' : 'black' );
2012-04-30 14:56:01 +02:00
};
2014-01-11 17:40:09 +01:00
my @layers = sort { $a -> print_z <=> $b -> print_z }
map { @ { $_ -> layers }, @ { $_ -> support_layers } }
@ { $self -> objects };
my $layer_id = - 1 ;
2012-06-11 14:47:48 +02:00
my @previous_layer_slices = ();
2014-01-11 17:40:09 +01:00
for my $layer ( @layers ) {
$layer_id ++ ;
2015-01-30 18:45:30 +01:00
if ( $layer -> slice_z == - 1 ) {
printf $fh qq{ <g id="layer%d">\n} , $layer_id ;
} else {
printf $fh qq{ <g id="layer%d" slic3r:z="%s">\n} , $layer_id , unscale ( $layer -> slice_z );
}
2012-04-30 14:56:01 +02:00
2012-06-11 14:47:48 +02:00
my @current_layer_slices = ();
2014-01-11 17:40:09 +01:00
# sort slices so that the outermost ones come first
2015-01-30 19:34:46 +01:00
my @slices = sort { $a -> contour -> contains_point ( $b -> contour -> first_point ) ? 0 : 1 } @ { $layer -> slices };
foreach my $copy ( @ { $layer -> object -> _shifted_copies }) {
2014-01-11 17:40:09 +01:00
foreach my $slice ( @slices ) {
my $expolygon = $slice -> clone ;
$expolygon -> translate ( @$copy );
2015-01-30 19:34:46 +01:00
$expolygon -> translate ( - $print_bb -> x_min , - $print_bb -> y_min );
2014-01-11 17:40:09 +01:00
$print_polygon -> ( $expolygon -> contour , 'contour' );
$print_polygon -> ( $_ , 'hole' ) for @ { $expolygon -> holes };
push @current_layer_slices , $expolygon ;
2012-04-30 14:56:01 +02:00
}
}
2012-06-11 14:47:48 +02:00
# generate support material
2014-01-11 17:40:09 +01:00
if ( $self -> has_support_material && $layer -> id > 0 ) {
2012-06-11 14:47:48 +02:00
my ( @supported_slices , @unsupported_slices ) = ();
foreach my $expolygon ( @current_layer_slices ) {
my $intersection = intersection_ex (
[ map @$_ , @previous_layer_slices ],
2014-08-03 11:35:18 +02:00
[ @$expolygon ],
2012-06-11 14:47:48 +02:00
);
@$intersection
? push @supported_slices , $expolygon
: push @unsupported_slices , $expolygon ;
}
my @supported_points = map @$_ , @$_ , @supported_slices ;
foreach my $expolygon ( @unsupported_slices ) {
# look for the nearest point to this island among all
# supported points
2013-08-27 00:52:20 +02:00
my $contour = $expolygon -> contour ;
my $support_point = $contour -> first_point -> nearest_point ( \ @supported_points )
2012-09-21 16:52:05 +02:00
or next ;
2013-08-27 00:52:20 +02:00
my $anchor_point = $support_point -> nearest_point ([ @$contour ]);
2012-06-11 20:42:39 +02:00
printf $fh qq{ <line x1="%s" y1="%s" x2="%s" y2="%s" style="stroke-width: 2; stroke: white" />\n} ,
2012-06-11 14:47:48 +02:00
map @$_ , $support_point , $anchor_point ;
}
}
2012-04-30 14:56:01 +02:00
print $fh qq{ </g>\n} ;
2012-06-11 14:47:48 +02:00
@previous_layer_slices = @current_layer_slices ;
2012-04-30 14:56:01 +02:00
}
print $fh "</svg>\n" ;
close $fh ;
2013-06-07 12:00:03 +02:00
print "Done.\n" unless $params { quiet };
2011-09-18 19:28:12 +02:00
}
2012-04-29 12:51:20 +02:00
sub make_skirt {
2011-11-13 18:41:12 +01:00
my $self = shift ;
2014-05-10 20:54:12 +02:00
2014-06-13 20:05:18 +02:00
# prerequisites
$_ -> make_perimeters for @ { $self -> objects };
$_ -> infill for @ { $self -> objects };
$_ -> generate_support_material for @ { $self -> objects };
return if $self -> step_done ( STEP_SKIRT );
$self -> set_step_started ( STEP_SKIRT );
2014-05-10 20:54:12 +02:00
# since this method must be idempotent, we clear skirt paths *before*
# checking whether we need to generate them
$self -> skirt -> clear ;
2015-03-06 09:56:58 +01:00
if ( ! $self -> has_skirt ) {
2014-06-13 20:18:34 +02:00
$self -> set_step_done ( STEP_SKIRT );
return ;
}
$self -> status_cb -> ( 88 , "Generating skirt" );
2014-03-24 17:52:14 +01:00
# First off we need to decide how tall the skirt must be.
# The skirt_height option from config is expressed in layers, but our
# object might have different layer heights, so we need to find the print_z
# of the highest layer involved.
2015-03-06 09:56:58 +01:00
# Note that unless has_infinite_skirt() == true
2014-03-24 17:52:14 +01:00
# the actual skirt might not reach this $skirt_height_z value since the print
# order of objects on each layer is not guaranteed and will not generally
# include the thickest object first. It is just guaranteed that a skirt is
# prepended to the first 'n' layers (with 'n' = skirt_height).
# $skirt_height_z in this case is the highest possible skirt height for safety.
my $skirt_height_z = - 1 ;
foreach my $object ( @ { $self -> objects }) {
2015-03-06 09:56:58 +01:00
my $skirt_height = $self -> has_infinite_skirt
2015-05-18 00:49:16 +02:00
? $object -> layer_count
: min ( $self -> config -> skirt_height , $object -> layer_count );
2014-06-13 18:45:44 +03:00
my $highest_layer = $object -> get_layer ( $skirt_height - 1 );
2014-03-24 17:52:14 +01:00
$skirt_height_z = max ( $skirt_height_z , $highest_layer -> print_z );
}
2014-01-12 11:06:21 +01:00
2011-11-13 18:41:12 +01:00
# collect points from all layers contained in skirt height
2012-04-29 12:51:20 +02:00
my @points = ();
2014-03-24 17:52:14 +01:00
foreach my $object ( @ { $self -> objects }) {
my @object_points = ();
# get object layers up to $skirt_height_z
foreach my $layer ( @ { $object -> layers }) {
last if $layer -> print_z > $skirt_height_z ;
push @object_points , map @$_ , map @$_ , @ { $layer -> slices };
}
# get support layers up to $skirt_height_z
foreach my $layer ( @ { $object -> support_layers }) {
last if $layer -> print_z > $skirt_height_z ;
push @object_points , map @ { $_ -> polyline }, @ { $layer -> support_fills } if $layer -> support_fills ;
push @object_points , map @ { $_ -> polyline }, @ { $layer -> support_interface_fills } if $layer -> support_interface_fills ;
}
# repeat points for each object copy
foreach my $copy ( @ { $object -> _shifted_copies }) {
my @copy_points = map $_ -> clone , @object_points ;
$_ -> translate ( @$copy ) for @copy_points ;
push @points , @copy_points ;
2013-07-29 20:49:54 +02:00
}
2012-04-29 12:51:20 +02:00
}
2012-03-31 18:32:53 +02:00
return if @points < 3 ; # at least three points required for a convex hull
2011-11-13 18:41:12 +01:00
# find out convex hull
2014-03-24 17:52:14 +01:00
my $convex_hull = convex_hull ( \ @points );
2011-11-13 18:41:12 +01:00
2012-10-29 11:17:57 +01:00
my @extruded_length = (); # for each extruder
2013-02-22 16:08:11 +01:00
2014-03-24 17:52:14 +01:00
# skirt may be printed on several layers, having distinct layer heights,
# but loops must be aligned so can't vary width/spacing
2013-02-22 16:08:11 +01:00
# TODO: use each extruder's own flow
2014-07-24 18:32:07 +02:00
my $first_layer_height = $self -> skirt_first_layer_height ;
my $flow = $self -> skirt_flow ;
2014-03-24 17:52:14 +01:00
my $spacing = $flow -> spacing ;
2014-06-12 01:00:13 +02:00
my $mm3_per_mm = $flow -> mm3_per_mm ;
2013-02-22 16:08:11 +01:00
2012-10-29 11:17:57 +01:00
my @extruders_e_per_mm = ();
my $extruder_idx = 0 ;
2015-03-06 09:56:58 +01:00
my $skirts = $self -> config -> skirts ;
$skirts ||= 1 if $self -> has_infinite_skirt ;
2011-11-13 18:41:12 +01:00
# draw outlines from outside to inside
2012-10-29 11:17:57 +01:00
# loop while we have less skirts than required or any extruder hasn't reached the min length if any
2014-07-24 23:43:19 +02:00
my $distance = scale max ( $self -> config -> skirt_distance , $self -> config -> brim_width );
2015-03-06 09:56:58 +01:00
for ( my $i = $skirts ; $i > 0 ; $i -- ) {
2012-10-29 11:17:57 +01:00
$distance += scale $spacing ;
2014-03-24 17:52:14 +01:00
my $loop = offset ([ $convex_hull ], $distance , 1 , JT_ROUND , scale ( 0.1 )) -> [ 0 ];
2014-05-08 11:07:37 +02:00
$self -> skirt -> append ( Slic3r::ExtrusionLoop -> new_from_paths (
Slic3r::ExtrusionPath -> new (
polyline => Slic3r::Polygon -> new ( @$loop ) -> split_at_first_point ,
role => EXTR_ROLE_SKIRT ,
2014-12-16 18:55:16 +01:00
mm3_per_mm => $mm3_per_mm , # this will be overridden at G-code export time
2014-05-08 11:07:37 +02:00
width => $flow -> width ,
2014-12-16 18:55:16 +01:00
height => $first_layer_height , # this will be overridden at G-code export time
2014-05-08 11:07:37 +02:00
),
2013-09-16 10:33:30 +02:00
));
2012-10-29 11:17:57 +01:00
2014-03-24 17:52:14 +01:00
if ( $self -> config -> min_skirt_length > 0 ) {
$extruded_length [ $extruder_idx ] ||= 0 ;
if ( ! $extruders_e_per_mm [ $extruder_idx ]) {
2014-11-06 21:11:59 +01:00
my $config = Slic3r::Config::GCode -> new ;
$config -> apply_print_config ( $self -> config );
my $extruder = Slic3r::Extruder -> new ( $extruder_idx , $config );
2014-03-24 17:52:14 +01:00
$extruders_e_per_mm [ $extruder_idx ] = $extruder -> e_per_mm ( $mm3_per_mm );
}
$extruded_length [ $extruder_idx ] += unscale $loop -> length * $extruders_e_per_mm [ $extruder_idx ];
$i ++ if defined first { ( $extruded_length [ $_ ] // 0 ) < $self -> config -> min_skirt_length } 0 .. $# { $self -> extruders };
if ( $extruded_length [ $extruder_idx ] >= $self -> config -> min_skirt_length ) {
2012-10-29 11:17:57 +01:00
if ( $extruder_idx < $# { $self -> extruders }) {
$extruder_idx ++ ;
next ;
}
}
}
2011-11-13 18:41:12 +01:00
}
2012-10-29 11:17:57 +01:00
2013-09-16 10:33:30 +02:00
$self -> skirt -> reverse ;
2014-06-13 20:05:18 +02:00
$self -> set_step_done ( STEP_SKIRT );
2012-02-19 12:03:36 +01:00
}
2012-06-23 21:31:29 +02:00
sub make_brim {
my $self = shift ;
2014-05-10 20:54:12 +02:00
2014-06-13 20:05:18 +02:00
# prerequisites
$_ -> make_perimeters for @ { $self -> objects };
$_ -> infill for @ { $self -> objects };
$_ -> generate_support_material for @ { $self -> objects };
$self -> make_skirt ;
return if $self -> step_done ( STEP_BRIM );
$self -> set_step_started ( STEP_BRIM );
2014-05-10 20:54:12 +02:00
# since this method must be idempotent, we clear brim paths *before*
# checking whether we need to generate them
$self -> brim -> clear ;
2014-06-13 20:18:34 +02:00
if ( $self -> config -> brim_width == 0 ) {
$self -> set_step_done ( STEP_BRIM );
return ;
}
$self -> status_cb -> ( 88 , "Generating brim" );
2012-06-23 21:31:29 +02:00
2014-12-17 00:45:05 +01:00
# brim is only printed on first layer and uses perimeter extruder
2014-07-24 18:32:07 +02:00
my $first_layer_height = $self -> skirt_first_layer_height ;
2014-12-17 00:45:05 +01:00
my $flow = $self -> brim_flow ;
2014-06-12 01:00:13 +02:00
my $mm3_per_mm = $flow -> mm3_per_mm ;
2013-02-22 16:08:11 +01:00
my $grow_distance = $flow -> scaled_width / 2 ;
2012-06-23 21:31:29 +02:00
my @islands = (); # array of polygons
2014-05-06 11:07:18 +03:00
foreach my $obj_idx ( 0 .. ( $self -> object_count - 1 )) {
2013-07-29 20:49:54 +02:00
my $object = $self -> objects -> [ $obj_idx ];
2014-06-13 18:45:44 +03:00
my $layer0 = $object -> get_layer ( 0 );
2012-08-06 20:54:49 +02:00
my @object_islands = (
( map $_ -> contour , @ { $layer0 -> slices }),
);
2013-07-29 20:49:54 +02:00
if ( @ { $object -> support_layers }) {
my $support_layer0 = $object -> support_layers -> [ 0 ];
push @object_islands ,
2014-03-24 17:52:14 +01:00
( map @ { $_ -> polyline -> grow ( $grow_distance )}, @ { $support_layer0 -> support_fills })
2013-07-29 20:49:54 +02:00
if $support_layer0 -> support_fills ;
2013-07-31 16:29:44 +02:00
push @object_islands ,
2014-03-24 17:52:14 +01:00
( map @ { $_ -> polyline -> grow ( $grow_distance )}, @ { $support_layer0 -> support_interface_fills })
2013-07-31 16:29:44 +02:00
if $support_layer0 -> support_interface_fills ;
2013-07-29 20:49:54 +02:00
}
2014-03-24 17:52:14 +01:00
foreach my $copy ( @ { $object -> _shifted_copies }) {
2013-09-16 10:33:30 +02:00
push @islands , map { $_ -> translate ( @$copy ); $_ } map $_ -> clone , @object_islands ;
2012-06-23 21:31:29 +02:00
}
}
2013-05-09 14:52:56 +02:00
my @loops = ();
2014-03-24 17:52:14 +01:00
my $num_loops = sprintf "%.0f" , $self -> config -> brim_width / $flow -> width ;
2012-06-23 21:31:29 +02:00
for my $i ( reverse 1 .. $num_loops ) {
2012-08-06 20:26:08 +02:00
# JT_SQUARE ensures no vertex is outside the given offset distance
2013-05-09 14:52:56 +02:00
# -0.5 because islands are not represented by their centerlines
2013-08-09 14:22:41 +02:00
# (first offset more, then step back - reverse order than the one used for
# perimeters because here we're offsetting outwards)
2013-08-26 16:25:42 +02:00
push @loops , @ { offset2 ( \ @islands , ( $i + 0.5 ) * $flow -> scaled_spacing , - 1.0 * $flow -> scaled_spacing , 100000 , JT_SQUARE )};
2012-06-23 21:31:29 +02:00
}
2013-05-09 14:52:56 +02:00
2014-05-08 11:07:37 +02:00
$self -> brim -> append ( map Slic3r::ExtrusionLoop -> new_from_paths (
Slic3r::ExtrusionPath -> new (
polyline => Slic3r::Polygon -> new ( @$_ ) -> split_at_first_point ,
role => EXTR_ROLE_SKIRT ,
mm3_per_mm => $mm3_per_mm ,
width => $flow -> width ,
height => $first_layer_height ,
),
2014-03-24 17:52:14 +01:00
), reverse @ { union_pt_chained ( \ @loops )});
2014-06-13 20:05:18 +02:00
$self -> set_step_done ( STEP_BRIM );
2012-06-23 21:31:29 +02:00
}
2012-04-30 14:56:01 +02:00
sub write_gcode {
2011-09-03 20:47:38 +02:00
my $self = shift ;
my ( $file ) = @_ ;
2012-11-21 20:41:14 +01:00
# open output gcode file if we weren't supplied a file-handle
my $fh ;
if ( ref $file eq 'IO::Scalar' ) {
$fh = $file ;
} else {
2013-01-13 10:18:34 +01:00
Slic3r:: open ( \ $fh , ">" , $file )
2012-11-21 20:41:14 +01:00
or die "Failed to open $file for writing\n" ;
2014-03-24 17:52:50 +01:00
# enable UTF-8 output since user might have entered Unicode characters in fields like notes
binmode $fh , ':utf8' ;
2012-11-21 20:41:14 +01:00
}
2011-09-03 20:47:38 +02:00
2014-11-30 18:09:06 +01:00
my $exporter = Slic3r::Print::GCode -> new (
print => $self ,
fh => $fh ,
2012-09-23 02:40:25 +02:00
);
2014-11-30 18:09:06 +01:00
$exporter -> export ;
2012-11-18 19:53:52 +01:00
2011-09-03 20:47:38 +02:00
# close our gcode file
close $fh ;
}
2012-09-12 16:30:44 +02:00
# this method will return the supplied input file path after expanding its
2012-04-30 14:56:01 +02:00
# format variables with their values
sub expanded_output_filepath {
my $self = shift ;
2014-03-24 17:52:14 +01:00
my ( $path ) = @_ ;
2012-09-12 16:30:44 +02:00
2014-03-24 17:52:14 +01:00
return undef if ! @ { $self -> objects };
my $input_file = first { defined $_ } map $_ -> model_object -> input_file , @ { $self -> objects };
return undef if ! defined $input_file ;
my $filename = my $filename_base = basename ( $input_file );
$filename_base =~ s/\.[^.]+$// ; # without suffix
2015-02-15 23:41:36 +01:00
# set filename in placeholder parser so that it's available also in custom G-code
$self -> placeholder_parser -> set ( input_filename => $filename );
$self -> placeholder_parser -> set ( input_filename_base => $filename_base );
2012-04-30 14:56:01 +02:00
2015-05-02 21:59:15 +02:00
# set other variables from model object
$self -> placeholder_parser -> set_multiple (
scale => [ map $_ -> model_object -> instances -> [ 0 ] -> scaling_factor * 100 . "%" , @ { $self -> objects } ],
);
2013-11-11 00:08:50 +01:00
if ( $path && - d $path ) {
# if output path is an existing directory, we take that and append
# the specified filename format
$path = File::Spec -> join ( $path , $self -> config -> output_filename_format );
} elsif ( ! $path ) {
# if no explicit output file was defined, we take the input
# file directory and append the specified filename format
$path = ( fileparse ( $input_file ))[ 1 ] . $self -> config -> output_filename_format ;
} else {
# path is a full path to a file so we use it as it is
}
2014-03-15 20:45:10 +01:00
2014-05-01 21:42:12 +02:00
# make sure we use an up-to-date timestamp
$self -> placeholder_parser -> update_timestamp ;
2015-02-15 23:41:36 +01:00
return $self -> placeholder_parser -> process ( $path );
2013-12-18 18:54:11 +01:00
}
2014-03-24 17:52:14 +01:00
# This method assigns extruders to the volumes having a material
2015-01-16 16:35:35 +01:00
# but not having extruders set in the volume config.
2014-03-24 17:52:14 +01:00
sub auto_assign_extruders {
my ( $self , $model_object ) = @_ ;
2014-03-27 00:01:33 +01:00
# only assign extruders if object has more than one volume
return if @ { $model_object -> volumes } == 1 ;
2014-03-24 17:52:14 +01:00
my $extruders = scalar @ { $self -> config -> nozzle_diameter };
foreach my $i ( 0 .. $# { $model_object -> volumes }) {
my $volume = $model_object -> volumes -> [ $i ];
2014-07-12 11:20:57 +02:00
if ( $volume -> material_id ne '' ) {
2014-03-24 17:52:14 +01:00
my $extruder_id = $i + 1 ;
2015-01-16 16:35:35 +01:00
$volume -> config -> set_ifndef ( 'extruder' , $extruder_id );
2014-03-24 17:52:14 +01:00
}
}
2013-12-30 18:28:41 +01:00
}
2011-09-01 21:06:28 +02:00
1 ;