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' ;
use Slic3r::Geometry qw(X Y Z X1 Y1 X2 Y2 MIN MAX PI scale unscale move_points chained_path
convex_hull) ;
2013-11-02 14:44:30 +01:00
use Slic3r::Geometry::Clipper qw(diff_ex union_ex union_pt 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 new {
# TODO: port PlaceholderParser methods to C++, then its own constructor
2014-06-10 16:01:57 +02:00
# can call them and no need for this new() method at all
2014-05-06 11:07:18 +03:00
my ( $class ) = @_ ;
my $self = $class -> _new ;
$self -> placeholder_parser -> apply_env_variables ;
$self -> placeholder_parser -> update_timestamp ;
return $self ;
}
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-03-24 17:52:14 +01:00
sub apply_config {
my ( $self , $config ) = @_ ;
2013-12-18 18:54:11 +01:00
2014-03-27 00:01:33 +01:00
$config = $config -> clone ;
$config -> normalize ;
2014-03-24 17:52:14 +01:00
# apply variables to placeholder parser
$self -> placeholder_parser -> apply_config ( $config );
2014-03-24 17:02:25 +01:00
2014-06-12 09:29:26 +02:00
my $invalidated = 0 ;
2014-03-24 17:52:14 +01:00
# handle changes to print config
my $print_diff = $self -> config -> diff ( $config );
if ( @$print_diff ) {
$self -> config -> apply_dynamic ( $config );
2014-06-13 11:19:53 +02:00
$invalidated = 1
if $self -> invalidate_state_by_config_options ( $print_diff );
2014-03-24 17:02:25 +01:00
}
2014-03-24 17:52:14 +01:00
# handle changes to object config defaults
$self -> default_object_config -> apply_dynamic ( $config );
foreach my $object ( @ { $self -> objects }) {
# we don't assume that $config contains a full ObjectConfig,
# so we base it on the current print-wise default
my $new = $self -> default_object_config -> clone ;
2014-06-11 00:15:02 +02:00
$new -> apply_dynamic ( $config );
2014-03-24 17:52:14 +01:00
# we override the new config with object-specific options
2014-03-27 00:01:33 +01:00
my $model_object_config = $object -> model_object -> config -> clone ;
$model_object_config -> normalize ;
$new -> apply_dynamic ( $model_object_config );
2014-03-24 17:52:14 +01:00
# check whether the new config is different from the current one
my $diff = $object -> config -> diff ( $new );
if ( @$diff ) {
$object -> config -> apply ( $new );
2014-06-12 09:29:26 +02:00
2014-06-13 11:19:53 +02:00
$invalidated = 1
2014-06-17 20:33:29 +02:00
if $object -> invalidate_state_by_config_options ( $diff );
2014-03-24 17:52:14 +01:00
}
}
# handle changes to regions config defaults
$self -> default_region_config -> apply_dynamic ( $config );
2014-03-27 00:01:33 +01:00
# All regions now have distinct settings.
# Check whether applying the new region config defaults we'd get different regions.
my $rearrange_regions = 0 ;
2014-06-11 17:51:18 +02:00
my @other_region_configs = ();
2014-05-06 11:07:18 +03:00
REGION: foreach my $region_id ( 0 .. ( $self -> region_count - 1 )) {
2014-06-11 17:51:18 +02:00
my $region = $self -> regions -> [ $region_id ];
my @this_region_configs = ();
2014-03-24 17:52:14 +01:00
foreach my $object ( @ { $self -> objects }) {
2014-05-06 11:07:18 +03:00
foreach my $volume_id ( @ { $object -> get_region_volumes ( $region_id ) }) {
2014-03-24 17:52:14 +01:00
my $volume = $object -> model_object -> volumes -> [ $volume_id ];
2014-03-27 00:01:33 +01:00
my $new = $self -> default_region_config -> clone ;
{
my $model_object_config = $object -> model_object -> config -> clone ;
$model_object_config -> normalize ;
$new -> apply_dynamic ( $model_object_config );
}
2014-07-12 11:20:57 +02:00
if ( $volume -> material_id ne '' ) {
2014-04-30 02:04:49 +03:00
my $material_config = $object -> model_object -> model -> get_material ( $volume -> material_id ) -> config -> clone ;
2014-03-27 00:01:33 +01:00
$material_config -> normalize ;
$new -> apply_dynamic ( $material_config );
}
2014-06-11 17:51:18 +02:00
if ( defined first { ! $_ -> equals ( $new ) } @this_region_configs ) {
# if the new config for this volume differs from the other
# volume configs currently associated to this region, it means
# the region subdivision does not make sense anymore
2014-03-27 00:01:33 +01:00
$rearrange_regions = 1 ;
last REGION ;
}
2014-06-11 17:51:18 +02:00
push @this_region_configs , $new ;
if ( defined first { $_ -> equals ( $new ) } @other_region_configs ) {
# if the new config for this volume equals any of the other
# volume configs that are not currently associated to this
# region, it means the region subdivision does not make
# sense anymore
$rearrange_regions = 1 ;
last REGION ;
}
# if we're here and the new region config is different from the old
# one, we need to apply the new config and invalidate all objects
# (possible optimization: only invalidate objects using this region)
my $region_config_diff = $region -> config -> diff ( $new );
if ( @$region_config_diff ) {
$region -> config -> apply ( $new );
foreach my $o ( @ { $self -> objects }) {
2014-06-13 11:19:53 +02:00
$invalidated = 1
if $o -> invalidate_state_by_config_options ( $region_config_diff );
2014-06-11 17:51:18 +02:00
}
}
2014-03-24 17:52:14 +01:00
}
}
2014-06-11 17:51:18 +02:00
push @other_region_configs , @this_region_configs ;
2014-03-24 17:52:14 +01:00
}
2014-03-27 00:01:33 +01:00
if ( $rearrange_regions ) {
# the current subdivision of regions does not make sense anymore.
2014-03-24 17:52:14 +01:00
# we need to remove all objects and re-add them
2014-05-10 16:59:17 +02:00
my @model_objects = map $_ -> model_object , @ { $self -> objects };
2014-05-07 00:58:29 +02:00
$self -> clear_objects ;
2014-05-10 16:59:17 +02:00
$self -> add_model_object ( $_ ) for @model_objects ;
2014-06-12 09:29:26 +02:00
$invalidated = 1 ;
2014-03-24 17:52:14 +01:00
}
2014-06-12 09:29:26 +02:00
return $invalidated ;
2014-03-24 17:02:25 +01:00
}
2013-05-18 16:48:26 +02:00
# caller is responsible for supplying models whose objects don't collide
# and have explicit instance positions
2014-03-24 17:52:14 +01:00
sub add_model_object {
2012-08-29 16:49:38 +02:00
my $self = shift ;
2014-03-24 17:52:14 +01:00
my ( $object , $obj_idx ) = @_ ;
2012-08-29 16:49:38 +02:00
2014-03-27 00:01:33 +01:00
my $object_config = $object -> config -> clone ;
$object_config -> normalize ;
2014-05-06 11:07:18 +03:00
# initialize print object and store it at the given position
my $o ;
if ( defined $obj_idx ) {
2014-07-03 09:24:19 +02:00
$o = $self -> set_new_object ( $obj_idx , $object , $object -> raw_bounding_box );
2014-05-06 11:07:18 +03:00
} else {
2014-07-03 09:24:19 +02:00
$o = $self -> add_object ( $object , $object -> raw_bounding_box );
2014-05-06 11:07:18 +03:00
}
2014-07-04 10:45:29 +02:00
2014-05-06 11:07:18 +03:00
$o -> set_copies ([ map Slic3r::Point -> new_scale ( @ { $_ -> offset }), @ { $object -> instances } ]);
$o -> set_layer_height_ranges ( $object -> layer_height_ranges );
# TODO: translate _trigger_copies to C++, then this can be done by
# PrintObject constructor
$o -> _trigger_copies ;
2014-03-24 17:52:14 +01:00
foreach my $volume_id ( 0 .. $# { $object -> volumes }) {
my $volume = $object -> volumes -> [ $volume_id ];
2013-12-18 00:13:41 +01:00
2014-03-24 17:52:14 +01:00
# get the config applied to this volume: start from our global defaults
my $config = Slic3r::Config::PrintRegion -> new ;
$config -> apply ( $self -> default_region_config );
2014-03-24 17:02:25 +01:00
2014-07-11 20:09:01 +02:00
# override the defaults with per-object config and then with per-material and per-volume configs
2014-03-27 00:01:33 +01:00
$config -> apply_dynamic ( $object_config );
2014-07-11 20:09:01 +02:00
$config -> apply_dynamic ( $volume -> config );
2014-03-26 19:42:01 +01:00
2014-07-12 11:20:57 +02:00
if ( $volume -> material_id ne '' ) {
2014-05-10 16:59:17 +02:00
my $material_config = $volume -> material -> config -> clone ;
2014-03-27 00:01:33 +01:00
$material_config -> normalize ;
2014-03-24 17:52:14 +01:00
$config -> apply_dynamic ( $material_config );
2013-12-30 18:28:41 +01:00
}
2014-03-24 17:52:14 +01:00
# find an existing print region with the same config
my $region_id ;
2014-05-06 11:07:18 +03:00
foreach my $i ( 0 .. ( $self -> region_count - 1 )) {
2014-03-24 17:52:14 +01:00
my $region = $self -> regions -> [ $i ];
if ( $config -> equals ( $region -> config )) {
$region_id = $i ;
last ;
}
}
2013-12-30 18:28:41 +01:00
2014-03-24 17:52:14 +01:00
# if no region exists with the same config, create a new one
if ( ! defined $region_id ) {
2014-05-06 11:07:18 +03:00
my $r = $self -> add_region ();
2014-03-24 17:52:14 +01:00
$r -> config -> apply ( $config );
2014-05-06 11:07:18 +03:00
$region_id = $self -> region_count - 1 ;
2014-03-24 17:52:14 +01:00
}
# assign volume to region
2014-05-06 11:07:18 +03:00
$o -> add_region_volume ( $region_id , $volume_id );
2013-11-27 12:18:24 +01:00
}
2014-05-06 11:07:18 +03:00
2014-03-24 17:52:14 +01:00
# apply config to print object
$o -> config -> apply ( $self -> default_object_config );
2014-03-27 00:01:33 +01:00
$o -> config -> apply_dynamic ( $object_config );
2011-10-02 09:57:37 +02:00
}
2014-03-26 19:42:01 +01:00
sub reload_object {
my ( $self , $obj_idx ) = @_ ;
# TODO: this method should check whether the per-object config and per-material configs
# have changed in such a way that regions need to be rearranged or we can just apply
# the diff and invalidate something. Same logic as apply_config()
# For now we just re-add all objects since we haven't implemented this incremental logic yet.
# This should also check whether object volumes (parts) have changed.
2014-05-07 01:11:49 +02:00
my @models_objects = map $_ -> model_object , @ { $self -> objects };
2014-05-07 00:58:29 +02:00
$self -> clear_objects ;
2014-05-07 01:11:49 +02:00
$self -> add_model_object ( $_ ) for @models_objects ;
2014-03-26 19:42:01 +01:00
}
2012-05-23 11:47:52 +02:00
sub validate {
my $self = shift ;
2014-03-24 17:52:14 +01:00
if ( $self -> config -> complete_objects ) {
2012-05-23 11:47:52 +02:00
# check horizontal clearance
{
my @a = ();
2014-03-24 17:52:14 +01:00
foreach my $object ( @ { $self -> objects }) {
# get convex hulls of all meshes assigned to this print object
my @mesh_convex_hulls = map $object -> model_object -> volumes -> [ $_ ] -> mesh -> convex_hull ,
map @$_ ,
grep defined $_ ,
@ { $object -> region_volumes };
# make a single convex hull for all of them
my $convex_hull = convex_hull ([ map @$_ , @mesh_convex_hulls ]);
# apply the same transformations we apply to the actual meshes when slicing them
$object -> model_object -> instances -> [ 0 ] -> transform_polygon ( $convex_hull , 1 );
# align object to Z = 0 and apply XY shift
$convex_hull -> translate ( @ { $object -> _copies_shift });
# grow convex hull with the clearance margin
( $convex_hull ) = @ { offset ([ $convex_hull ], scale $self -> config -> extruder_clearance_radius / 2 , 1 , JT_ROUND , scale ( 0.1 ))};
# now we need that no instance of $convex_hull does not intersect any of the previously checked object instances
for my $copy ( @ { $object -> _shifted_copies }) {
my $p = $convex_hull -> clone ;
$p -> translate ( @$copy );
if ( @ { intersection ( \ @a , [ $p ]) }) {
2012-05-23 11:47:52 +02:00
die "Some objects are too close; your extruder will collide with them.\n" ;
}
2014-03-24 17:52:14 +01:00
@a = @ { union ([ @a , $p ])};
2012-05-23 11:47:52 +02:00
}
}
}
# check vertical clearance
{
2013-06-19 17:34:37 +02:00
my @object_height = ();
foreach my $object ( @ { $self -> objects }) {
2014-03-24 17:52:14 +01:00
my $height = $object -> size -> z ;
2013-06-19 17:34:37 +02:00
push @object_height , $height for @ { $object -> copies };
}
@object_height = sort { $a <=> $b } @object_height ;
# ignore the tallest *copy* (this is why we repeat height for all of them):
# it will be printed as last one so its height doesn't matter
pop @object_height ;
2014-03-24 17:52:14 +01:00
if ( @object_height && max ( @object_height ) > scale $self -> config -> extruder_clearance_height ) {
2012-05-23 11:47:52 +02:00
die "Some objects are too tall and cannot be printed without extruder collisions.\n" ;
}
}
}
2013-05-13 20:15:45 +02:00
2014-03-24 17:52:14 +01:00
if ( $self -> config -> spiral_vase ) {
2013-05-13 20:15:45 +02:00
if (( map @ { $_ -> copies }, @ { $self -> objects }) > 1 ) {
die "The Spiral Vase option can only be used when printing a single object.\n" ;
}
2013-05-13 21:55:34 +02:00
if ( @ { $self -> regions } > 1 ) {
die "The Spiral Vase option can only be used when printing single material objects.\n" ;
}
2013-05-13 20:15:45 +02:00
}
2014-08-03 11:49:00 +02:00
{
my $max_layer_height = max (
map { $_ -> config -> layer_height , $_ -> config -> get_value ( 'first_layer_height' ) } @ { $self -> objects },
);
my $extruders = $self -> extruders ;
die "Layer height can't be greater than nozzle diameter\n"
if grep { $max_layer_height > $self -> config -> get_at ( 'nozzle_diameter' , $_ ) } @$extruders ;
}
2012-05-23 11:47:52 +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
}
2014-07-24 18:32:07 +02:00
# the bounding box of objects placed in copies position
# (without taking skirt/brim/support material into account)
2012-04-30 14:56:01 +02:00
sub bounding_box {
my $self = shift ;
my @points = ();
2013-05-18 16:48:26 +02:00
foreach my $object ( @ { $self -> objects }) {
2014-03-24 17:52:14 +01:00
foreach my $copy ( @ { $object -> _shifted_copies }) {
2012-04-30 14:56:01 +02:00
push @points ,
[ $copy -> [ X ], $copy -> [ Y ] ],
2013-06-16 12:21:25 +02:00
[ $copy -> [ X ] + $object -> size -> [ X ], $copy -> [ Y ] + $object -> size -> [ Y ] ];
2012-04-30 14:56:01 +02:00
}
}
2013-08-26 23:27:51 +02:00
return Slic3r::Geometry::BoundingBox -> new_from_points ([ map Slic3r::Point -> new ( @$_ ), @points ]);
2012-04-30 14:56:01 +02:00
}
2014-07-24 18:32:07 +02:00
# the total bounding box of extrusions, including skirt/brim/support material
sub total_bounding_box {
my ( $self ) = @_ ;
# get objects bounding box
my $bb = $self -> bounding_box ;
# check how much we need to increase it
my $extra = 0 ;
if ( $self -> has_support_material ) {
$extra = & Slic3r::Print::SupportMaterial:: MARGIN ;
}
2014-07-24 23:43:19 +02:00
$extra = max ( $extra , $self -> config -> brim_width );
2014-07-24 18:32:07 +02:00
if ( $self -> config -> skirts > 0 ) {
my $skirt_flow = $self -> skirt_flow ;
2014-07-24 23:43:19 +02:00
$extra = max ( $extra , $self -> config -> brim_width + $self -> config -> skirt_distance + ( $self -> config -> skirts * $skirt_flow -> spacing ));
2014-07-24 18:32:07 +02:00
}
if ( $extra > 0 ) {
$bb -> offset ( scale $extra );
}
return $bb ;
}
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 ;
for ( @ { $self -> config -> post_process }) {
2012-04-30 14:56:01 +02:00
Slic3r:: debugf " '%s' '%s'\n" , $_ , $output_file ;
system ( $_ , $output_file );
}
}
}
sub export_svg {
my $self = shift ;
my %params = @_ ;
2014-03-24 17:52:14 +01:00
# is this needed?
2012-09-28 16:32:53 +02:00
$self -> init_extruders ;
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
my $print_size = $self -> size ;
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 ++ ;
# TODO: remove slic3r:z for raft layers
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
2014-05-26 11:13:53 +02:00
my @slices = sort { $a -> contour -> contains_point ( $b -> contour -> [ 0 ]) ? 0 : 1 } @ { $layer -> slices };
2014-01-11 17:40:09 +01:00
foreach my $copy ( @ { $layer -> object -> copies }) {
foreach my $slice ( @slices ) {
my $expolygon = $slice -> clone ;
$expolygon -> translate ( @$copy );
$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 ;
2014-06-13 20:18:34 +02:00
if ( $self -> config -> skirts == 0
&& ( ! $self -> config -> ooze_prevention || @ { $self -> extruders } == 1 )) {
$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.
# Note that unless skirt_height == -1 (which means it's printed on all layers)
# 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 }) {
my $skirt_height = ( $self -> config -> skirt_height == - 1 )
? scalar ( @ { $object -> layers })
: min ( $self -> config -> skirt_height , scalar ( @ { $object -> layers }));
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 ;
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 );
2014-03-24 17:52:14 +01:00
for ( my $i = $self -> config -> 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 ,
mm3_per_mm => $mm3_per_mm ,
width => $flow -> width ,
height => $first_layer_height ,
),
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-04-27 00:28:32 +03:00
my $extruder = Slic3r::Extruder -> new ( $extruder_idx , $self -> 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-03-24 17:52:14 +01:00
# brim is only printed on first layer and uses support material extruder
2014-07-24 18:32:07 +02:00
my $first_layer_height = $self -> skirt_first_layer_height ;
my $flow = $self -> skirt_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
}
2014-07-24 18:32:07 +02:00
sub skirt_first_layer_height {
my ( $self ) = @_ ;
return $self -> objects -> [ 0 ] -> config -> get_abs_value ( 'first_layer_height' );
}
sub skirt_flow {
my ( $self ) = @_ ;
return Slic3r::Flow -> new_from_width (
width => ( $self -> config -> first_layer_extrusion_width || $self -> regions -> [ 0 ] -> config -> perimeter_extrusion_width ),
role => FLOW_ROLE_PERIMETER ,
nozzle_diameter => $self -> config -> get_at ( 'nozzle_diameter' , $self -> objects -> [ 0 ] -> config -> support_material_extruder - 1 ),
layer_height => $self -> skirt_first_layer_height ,
bridge_flow_ratio => 0 ,
);
}
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-03-24 17:52:14 +01:00
2011-12-01 22:20:48 +01:00
# write some information
my @lt = localtime ;
2012-05-01 15:01:56 +02:00
printf $fh "; generated by Slic3r $Slic3r::VERSION on %04d-%02d-%02d at %02d:%02d:%02d\n\n" ,
2011-12-30 18:57:58 +01:00
$lt [ 5 ] + 1900 , $lt [ 4 ] + 1 , $lt [ 3 ], $lt [ 2 ], $lt [ 1 ], $lt [ 0 ];
2012-02-05 20:55:17 +01:00
2014-03-24 17:52:14 +01:00
print $fh "; $_\n" foreach split /\R/ , $self -> config -> notes ;
print $fh "\n" if $self -> config -> notes ;
2011-12-01 22:20:48 +01:00
2014-04-25 19:39:27 +02:00
my $first_object = $self -> objects -> [ 0 ];
my $layer_height = $first_object -> config -> layer_height ;
2014-03-24 17:52:14 +01:00
for my $region_id ( 0 .. $# { $self -> regions }) {
2014-06-09 21:14:48 +02:00
printf $fh "; external perimeters extrusion width = %.2fmm\n" ,
$self -> regions -> [ $region_id ] -> flow ( FLOW_ROLE_EXTERNAL_PERIMETER , $layer_height , 0 , 0 , undef , $first_object ) -> width ;
2014-03-24 17:52:14 +01:00
printf $fh "; perimeters extrusion width = %.2fmm\n" ,
2014-04-25 19:39:27 +02:00
$self -> regions -> [ $region_id ] -> flow ( FLOW_ROLE_PERIMETER , $layer_height , 0 , 0 , undef , $first_object ) -> width ;
2014-03-24 17:52:14 +01:00
printf $fh "; infill extrusion width = %.2fmm\n" ,
2014-04-25 19:39:27 +02:00
$self -> regions -> [ $region_id ] -> flow ( FLOW_ROLE_INFILL , $layer_height , 0 , 0 , undef , $first_object ) -> width ;
2014-03-24 17:52:14 +01:00
printf $fh "; solid infill extrusion width = %.2fmm\n" ,
2014-04-25 19:39:27 +02:00
$self -> regions -> [ $region_id ] -> flow ( FLOW_ROLE_SOLID_INFILL , $layer_height , 0 , 0 , undef , $first_object ) -> width ;
2014-03-24 17:52:14 +01:00
printf $fh "; top infill extrusion width = %.2fmm\n" ,
2014-04-25 19:39:27 +02:00
$self -> regions -> [ $region_id ] -> flow ( FLOW_ROLE_TOP_SOLID_INFILL , $layer_height , 0 , 0 , undef , $first_object ) -> width ;
2014-03-24 17:52:14 +01:00
printf $fh "; support material extrusion width = %.2fmm\n" ,
$self -> objects -> [ 0 ] -> support_material_flow -> width
if $self -> has_support_material ;
printf $fh "; first layer extrusion width = %.2fmm\n" ,
2014-04-25 19:39:27 +02:00
$self -> regions -> [ $region_id ] -> flow ( FLOW_ROLE_PERIMETER , $layer_height , 0 , 1 , undef , $self -> objects -> [ 0 ]) -> width
2014-03-24 17:52:14 +01:00
if $self -> regions -> [ $region_id ] -> config -> first_layer_extrusion_width ;
print $fh "\n" ;
2013-12-30 18:28:41 +01:00
}
2011-12-01 22:20:48 +01:00
2014-03-24 17:52:14 +01:00
# prepare the helper object for replacing placeholders in custom G-code and output filename
2014-04-25 19:47:13 +02:00
$self -> placeholder_parser -> update_timestamp ;
2014-03-24 17:52:14 +01:00
2014-06-05 16:24:47 +02:00
# estimate the total number of layer changes
# TODO: only do this when M73 is enabled
my $layer_count ;
if ( $self -> config -> complete_objects ) {
2014-06-10 16:01:57 +02:00
$layer_count = sum ( map { $_ -> total_layer_count * @ { $_ -> copies } } @ { $self -> objects });
2014-06-05 16:24:47 +02:00
} else {
# if sequential printing is not enable, all copies of the same object share the same layer change command(s)
2014-06-10 16:01:57 +02:00
$layer_count = sum ( map { $_ -> total_layer_count } @ { $self -> objects });
2014-06-05 16:24:47 +02:00
}
2014-03-24 17:52:14 +01:00
# set up our helper object
2012-09-23 02:40:25 +02:00
my $gcodegen = Slic3r::GCode -> new (
2014-03-24 17:52:14 +01:00
placeholder_parser => $self -> placeholder_parser ,
2014-06-05 16:24:47 +02:00
layer_count => $layer_count ,
2012-09-23 02:40:25 +02:00
);
2014-05-13 08:34:21 +02:00
$gcodegen -> config -> apply_print_config ( $self -> config );
$gcodegen -> set_extruders ( $self -> extruders , $self -> config );
2014-03-24 17:52:14 +01:00
print $fh "G21 ; set units to millimeters\n" if $self -> config -> gcode_flavor ne 'makerware' ;
print $fh $gcodegen -> set_fan ( 0 , 1 ) if $self -> config -> cooling && $self -> config -> disable_fan_first_layers ;
2012-05-20 20:07:39 +02:00
2013-07-31 18:55:23 +02:00
# set bed temperature
2014-03-24 17:52:14 +01:00
if (( my $temp = $self -> config -> first_layer_bed_temperature ) && $self -> config -> start_gcode !~ /M(?:190|140)/i ) {
2013-07-31 18:55:23 +02:00
printf $fh $gcodegen -> set_bed_temperature ( $temp , 1 );
}
# set extruder(s) temperature before and after start G-code
2012-08-22 17:58:38 +02:00
my $print_first_layer_temperature = sub {
2013-07-31 18:55:23 +02:00
my ( $wait ) = @_ ;
2014-03-24 17:52:14 +01:00
return if $self -> config -> start_gcode =~ /M(?:109|104)/i ;
for my $t ( @ { $self -> extruders }) {
my $temp = $self -> config -> get_at ( 'first_layer_temperature' , $t );
2013-11-15 16:01:15 +01:00
$temp += $self -> config -> standby_temperature_delta if $self -> config -> ooze_prevention ;
2013-07-31 18:55:23 +02:00
printf $fh $gcodegen -> set_temperature ( $temp , $wait , $t ) if $temp > 0 ;
2012-08-22 17:58:38 +02:00
}
};
2013-07-31 18:55:23 +02:00
$print_first_layer_temperature -> ( 0 );
2014-03-24 17:52:14 +01:00
printf $fh "%s\n" , $gcodegen -> placeholder_parser -> process ( $self -> config -> start_gcode );
2013-07-31 18:55:23 +02:00
$print_first_layer_temperature -> ( 1 );
# set other general things
2014-03-24 17:52:14 +01:00
print $fh "G90 ; use absolute coordinates\n" if $self -> config -> gcode_flavor ne 'makerware' ;
if ( $self -> config -> gcode_flavor =~ /^(?:reprap|teacup)$/ ) {
2012-07-06 19:57:58 +02:00
printf $fh $gcodegen -> reset_e ;
2014-03-24 17:52:14 +01:00
if ( $self -> config -> use_relative_e_distances ) {
2013-06-03 18:01:14 +02:00
print $fh "M83 ; use relative distances for extrusion\n" ;
} else {
print $fh "M82 ; use absolute distances for extrusion\n" ;
2012-02-20 11:44:30 +01:00
}
2011-09-03 20:47:38 +02:00
}
2012-08-23 15:42:58 +02:00
# initialize a motion planner for object-to-object travel moves
2014-03-24 17:52:14 +01:00
if ( $self -> config -> avoid_crossing_perimeters ) {
2012-08-23 15:42:58 +02:00
my $distance_from_objects = 1 ;
# compute the offsetted convex hull for each object and repeat it for each copy.
my @islands = ();
2014-05-06 11:07:18 +03:00
foreach my $obj_idx ( 0 .. ( $self -> object_count - 1 )) {
2013-02-04 19:33:30 +01:00
my $convex_hull = convex_hull ([
2014-03-24 17:52:14 +01:00
map @ { $_ -> contour }, map @ { $_ -> slices }, @ { $self -> objects -> [ $obj_idx ] -> layers },
2013-02-04 19:33:30 +01:00
]);
# discard layers only containing thin walls (offset would fail on an empty polygon)
if ( @$convex_hull ) {
2013-07-16 20:09:53 +02:00
my $expolygon = Slic3r::ExPolygon -> new ( $convex_hull );
my @island = @ { $expolygon -> offset_ex ( scale $distance_from_objects , 1 , JT_SQUARE )};
2014-03-24 17:52:14 +01:00
foreach my $copy ( @ { $self -> objects -> [ $obj_idx ] -> _shifted_copies }) {
2013-11-18 17:20:48 +01:00
push @islands , map { my $c = $_ -> clone ; $c -> translate ( @$copy ); $c } @island ;
2013-02-04 19:33:30 +01:00
}
2012-08-23 15:42:58 +02:00
}
}
2014-05-13 20:06:01 +02:00
$gcodegen -> external_mp ( Slic3r::MotionPlanner -> new ( union_ex ([ map @$_ , @islands ])));
2012-08-23 15:42:58 +02:00
}
2013-09-18 20:03:59 +02:00
# calculate wiping points if needed
2013-11-15 16:01:15 +01:00
if ( $self -> config -> ooze_prevention ) {
2014-05-08 11:07:37 +02:00
my @skirt_points = map @$_ , map @$_ , @ { $self -> skirt };
2014-03-24 17:52:14 +01:00
if ( @skirt_points ) {
my $outer_skirt = convex_hull ( \ @skirt_points );
my @skirts = ();
foreach my $extruder_id ( @ { $self -> extruders }) {
push @skirts , my $s = $outer_skirt -> clone ;
$s -> translate ( map scale ( $_ ), @ { $self -> config -> get_at ( 'extruder_offset' , $extruder_id )});
}
my $convex_hull = convex_hull ([ map @$_ , @skirts ]);
$gcodegen -> standby_points ([ map $_ -> clone , map @$_ , map $_ -> subdivide ( scale 10 ), @ { offset ([ $convex_hull ], scale 3 )} ]);
2013-11-15 15:52:11 +01:00
}
2013-09-18 20:03:59 +02:00
}
2013-05-18 16:57:44 +02:00
# prepare the layer processor
my $layer_gcode = Slic3r::GCode::Layer -> new (
print => $self ,
gcodegen => $gcodegen ,
);
2012-05-20 20:07:39 +02:00
2014-03-24 17:52:14 +01:00
# set initial extruder only after custom start G-code
print $fh $gcodegen -> set_extruder ( $self -> extruders -> [ 0 ]);
2012-05-20 20:07:39 +02:00
# do all objects for each layer
2014-03-24 17:52:14 +01:00
if ( $self -> config -> complete_objects ) {
2012-05-21 20:19:30 +02:00
# print objects from the smallest to the tallest to avoid collisions
# when moving onto next object starting point
2014-05-06 11:07:18 +03:00
my @obj_idx = sort { $self -> objects -> [ $a ] -> size -> [ Z ] <=> $self -> objects -> [ $b ] -> size -> [ Z ] } 0 .. ( $self -> object_count - 1 );
2012-05-20 20:07:39 +02:00
my $finished_objects = 0 ;
2012-05-21 20:19:30 +02:00
for my $obj_idx ( @obj_idx ) {
2014-05-26 15:19:13 +02:00
my $object = $self -> objects -> [ $obj_idx ];
2014-03-24 17:52:14 +01:00
for my $copy ( @ { $self -> objects -> [ $obj_idx ] -> _shifted_copies }) {
2012-05-20 20:07:39 +02:00
# move to the origin position for the copy we're going to print.
# this happens before Z goes down to layer 0 again, so that
# no collision happens hopefully.
if ( $finished_objects > 0 ) {
2014-03-24 17:52:14 +01:00
$gcodegen -> set_shift ( map unscale $copy -> [ $_ ], X , Y );
2012-06-28 14:44:54 +02:00
print $fh $gcodegen -> retract ;
2014-05-26 15:19:13 +02:00
print $fh $gcodegen -> G0 ( $object -> _copies_shift -> negative , undef , 0 , $gcodegen -> config -> travel_speed * 60 , 'move to origin position for next object' );
2012-05-20 20:07:39 +02:00
}
2013-04-04 01:17:44 +02:00
my $buffer = Slic3r::GCode::CoolingBuffer -> new (
2014-03-24 17:52:14 +01:00
config => $self -> config ,
2013-04-04 01:17:44 +02:00
gcodegen => $gcodegen ,
);
2013-07-29 20:49:54 +02:00
my @layers = sort { $a -> print_z <=> $b -> print_z } @ { $object -> layers }, @ { $object -> support_layers };
for my $layer ( @layers ) {
2012-05-20 20:07:39 +02:00
# if we are printing the bottom layer of an object, and we have already finished
# another one, set first layer temperatures. this happens before the Z move
# is triggered, so machine has more time to reach such temperatures
2013-03-10 15:36:52 +01:00
if ( $layer -> id == 0 && $finished_objects > 0 ) {
2014-03-24 17:52:14 +01:00
printf $fh $gcodegen -> set_bed_temperature ( $self -> config -> first_layer_bed_temperature ),
if $self -> config -> first_layer_bed_temperature ;
2012-08-22 17:58:38 +02:00
$print_first_layer_temperature -> ();
2012-05-20 20:07:39 +02:00
}
2013-05-31 12:18:33 +02:00
print $fh $buffer -> append (
$layer_gcode -> process_layer ( $layer , [ $copy ]),
2014-06-10 16:17:34 +02:00
$layer -> object -> ptr ,
2013-05-31 12:18:33 +02:00
$layer -> id ,
$layer -> print_z ,
);
2012-05-20 20:07:39 +02:00
}
2013-04-04 01:17:44 +02:00
print $fh $buffer -> flush ;
2012-05-20 20:07:39 +02:00
$finished_objects ++ ;
}
}
} else {
2013-06-03 21:54:55 +02:00
# order objects using a nearest neighbor search
2014-03-24 17:52:14 +01:00
my @obj_idx = @ { chained_path ([ map Slic3r::Point -> new ( @ { $_ -> _shifted_copies -> [ 0 ]}), @ { $self -> objects } ])};
2013-06-03 21:54:55 +02:00
# sort layers by Z
2013-07-29 20:49:54 +02:00
my %layers = (); # print_z => [ [layers], [layers], [layers] ] by obj_idx
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 ];
foreach my $layer ( @ { $object -> layers }, @ { $object -> support_layers }) {
2013-06-03 21:54:55 +02:00
$layers { $layer -> print_z } ||= [] ;
2013-07-29 20:49:54 +02:00
$layers { $layer -> print_z }[ $obj_idx ] ||= [] ;
push @ { $layers { $layer -> print_z }[ $obj_idx ]}, $layer ;
2013-06-03 21:54:55 +02:00
}
}
2013-04-04 01:17:44 +02:00
my $buffer = Slic3r::GCode::CoolingBuffer -> new (
2014-03-24 17:52:14 +01:00
config => $self -> config ,
2013-04-04 01:17:44 +02:00
gcodegen => $gcodegen ,
);
2013-06-03 21:54:55 +02:00
foreach my $print_z ( sort { $a <=> $b } keys %layers ) {
foreach my $obj_idx ( @obj_idx ) {
2013-07-29 20:49:54 +02:00
foreach my $layer ( @ { $layers { $print_z }[ $obj_idx ] // [] }) {
print $fh $buffer -> append (
2014-03-24 17:52:14 +01:00
$layer_gcode -> process_layer ( $layer , $layer -> object -> _shifted_copies ),
2014-06-10 16:17:34 +02:00
$layer -> object -> ptr . ref ( $layer ), # differentiate $obj_id between normal layers and support layers
2013-07-29 20:49:54 +02:00
$layer -> id ,
$layer -> print_z ,
);
}
2013-06-03 21:54:55 +02:00
}
2013-05-18 16:57:44 +02:00
}
2013-04-04 01:17:44 +02:00
print $fh $buffer -> flush ;
2011-09-03 20:47:38 +02:00
}
# write end commands to file
2013-03-30 00:36:14 +01:00
print $fh $gcodegen -> retract if $gcodegen -> extruder ; # empty prints don't even set an extruder
2012-06-28 14:44:54 +02:00
print $fh $gcodegen -> set_fan ( 0 );
2014-03-24 17:52:14 +01:00
printf $fh "%s\n" , $gcodegen -> placeholder_parser -> process ( $self -> config -> end_gcode );
2011-09-03 20:47:38 +02:00
2014-03-24 17:52:14 +01:00
$self -> total_used_filament ( 0 );
$self -> total_extruded_volume ( 0 );
foreach my $extruder_id ( @ { $self -> extruders }) {
my $extruder = $gcodegen -> extruders -> { $extruder_id };
# the final retraction doesn't really count as "used filament"
my $used_filament = $extruder -> absolute_E + $extruder -> retract_length ;
my $extruded_volume = $extruder -> extruded_volume ( $used_filament );
2013-08-28 20:13:18 +02:00
printf $fh "; filament used = %.1fmm (%.1fcm3)\n" ,
2014-03-24 17:52:14 +01:00
$used_filament , $extruded_volume / 1000 ;
$self -> total_used_filament ( $self -> total_used_filament + $used_filament );
$self -> total_extruded_volume ( $self -> total_extruded_volume + $extruded_volume );
2013-08-28 20:13:18 +02:00
}
2011-12-20 15:29:15 +01:00
2014-03-24 17:52:14 +01:00
# append full config
print $fh "\n" ;
2014-05-20 23:25:12 +02:00
foreach my $config ( $self -> config , $self -> default_object_config , $self -> default_region_config ) {
foreach my $opt_key ( sort @ { $config -> get_keys }) {
next if $ Slic3r::Config:: Options -> { $opt_key }{ shortcut };
printf $fh "; %s = %s\n" , $opt_key , $config -> serialize ( $opt_key );
}
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
my $extra = {
input_filename => $filename ,
input_filename_base => $filename_base ,
};
2012-04-30 14:56:01 +02:00
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 ;
2014-03-24 17:52:14 +01:00
return $self -> placeholder_parser -> process ( $path , $extra );
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
# but not having extruders set in the material config.
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-04-30 02:04:49 +03:00
my $material = $model_object -> model -> get_material ( $volume -> material_id );
2014-03-24 17:52:14 +01:00
my $config = $material -> config ;
my $extruder_id = $i + 1 ;
$config -> set_ifndef ( 'extruder' , $extruder_id );
}
}
2013-12-30 18:28:41 +01:00
}
2011-09-01 21:06:28 +02:00
1 ;