2011-09-01 19:06:28 +00:00
package Slic3r::Print ;
2014-06-10 14:01:57 +00:00
use strict ;
use warnings ;
2011-09-01 19:06:28 +00:00
2012-04-30 12:56:01 +00:00
use File::Basename qw( basename fileparse ) ;
2012-08-07 21:37:16 +00:00
use File::Spec ;
2014-06-05 14:24:47 +00:00
use List::Util qw( min max first sum ) ;
2012-05-19 13:40:11 +00:00
use Slic3r::ExtrusionPath ':roles' ;
2014-03-24 16:52:14 +00:00
use Slic3r::Flow ':roles' ;
2014-11-30 17:09:06 +00:00
use Slic3r::Geometry qw( X Y Z X1 Y1 X2 Y2 MIN MAX PI scale unscale convex_hull ) ;
2014-10-25 09:15:12 +00:00
use Slic3r::Geometry::Clipper qw( diff_ex union_ex intersection_ex intersection offset
2014-03-24 16:52:14 +00:00
offset2 union union_pt_chained JT_ROUND JT_SQUARE ) ;
use Slic3r::Print::State ':steps' ;
2011-09-25 20:11:56 +00:00
2014-05-06 08:07:18 +00:00
our $ status_cb ;
2011-09-01 19:06:28 +00:00
2014-05-06 08:07:18 +00:00
sub set_status_cb {
my ( $ class , $ cb ) = @ _ ;
$ status_cb = $ cb ;
}
sub status_cb {
2014-06-13 22:06:49 +00:00
return $ status_cb // sub { } ;
2014-05-06 08:07:18 +00:00
}
2012-06-23 19:31:29 +00:00
2014-01-11 16:40:09 +00:00
# this value is not supposed to be compared with $layer->id
# since they have different semantics
2014-05-06 08:07:18 +00:00
sub total_layer_count {
2012-04-29 10:51:20 +00:00
my $ self = shift ;
2014-05-06 08:07:18 +00:00
return max ( map $ _ - > total_layer_count , @ { $ self - > objects } ) ;
2012-04-29 10:51:20 +00:00
}
2012-04-30 12:56:01 +00:00
sub size {
my $ self = shift ;
2013-06-16 10:21:25 +00:00
return $ self - > bounding_box - > size ;
2012-04-30 12:56:01 +00:00
}
2012-03-06 03:55:21 +00:00
2014-03-24 16:52:14 +00:00
sub process {
my ( $ self ) = @ _ ;
2014-06-13 18:05:18 +00: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 12:56:01 +00:00
2013-02-27 10:26:52 +00: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 13:02:13 +00:00
if ( 0 ) {
eval "use Slic3r::Test::SectionCut" ;
Slic3r::Test::SectionCut - > new ( print = > $ self ) - > export_svg ( "section_cut.svg" ) ;
}
2014-03-24 16:52:14 +00:00
}
sub export_gcode {
my $ self = shift ;
my % params = @ _ ;
2014-06-13 18:18:34 +00:00
# prerequisites
$ self - > process ;
2013-02-27 10:26:52 +00:00
2012-04-30 12:56:01 +00:00
# output everything to a G-code file
my $ output_file = $ self - > expanded_output_filepath ( $ params { output_file } ) ;
2014-06-13 18:18:34 +00:00
$ self - > status_cb - > ( 90 , "Exporting G-code" . ( $ output_file ? " to $output_file" : "" ) ) ;
2012-11-21 19:41:14 +00:00
$ self - > write_gcode ( $ params { output_fh } || $ output_file ) ;
2012-04-30 12:56:01 +00:00
# run post-processing scripts
2014-03-24 16:52:14 +00:00
if ( @ { $ self - > config - > post_process } ) {
2014-06-13 18:18:34 +00:00
$ self - > status_cb - > ( 95 , "Running post-processing scripts" ) ;
2014-03-24 16:52:14 +00:00
$ self - > config - > setenv ;
2015-01-17 09:50:34 +00:00
for my $ script ( @ { $ self - > config - > post_process } ) {
Slic3r:: debugf " '%s' '%s'\n" , $ script , $ output_file ;
2015-03-02 20:48:29 +00:00
# -x doesn't return true on Windows except for .exe files
if ( ( $^O eq 'MSWin32' ) ? ! ( - e $ script ) : ! ( - x $ script ) ) {
2015-01-17 09:50:34 +00:00
die "The configured post-processing script is not executable: check permissions. ($script)\n" ;
}
system ( $ script , $ output_file ) ;
2012-02-19 09:48:58 +00:00
}
}
}
2012-04-30 12:56:01 +00:00
sub export_svg {
2011-09-18 17:28:12 +00:00
my $ self = shift ;
2012-04-30 12:56:01 +00:00
my % params = @ _ ;
2013-03-16 18:39:00 +00:00
$ _ - > slice for @ { $ self - > objects } ;
2012-04-30 12:56:01 +00:00
2013-06-07 10:00:03 +00:00
my $ fh = $ params { output_fh } ;
2013-10-13 09:45:22 +00:00
if ( ! $ fh ) {
2013-06-07 10:00:03 +00: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 12:56:01 +00:00
2015-01-30 18:34:46 +00:00
my $ print_bb = $ self - > bounding_box ;
my $ print_size = $ print_bb - > size ;
2012-04-30 12:56:01 +00: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 16:29:19 +00:00
( $ type eq 'contour' ? 'white' : 'black' ) ;
2012-04-30 12:56:01 +00:00
} ;
2014-01-11 16:40:09 +00:00
my @ layers = sort { $ a - > print_z <=> $ b - > print_z }
map { @ { $ _ - > layers } , @ { $ _ - > support_layers } }
@ { $ self - > objects } ;
my $ layer_id = - 1 ;
2012-06-11 12:47:48 +00:00
my @ previous_layer_slices = ( ) ;
2014-01-11 16:40:09 +00:00
for my $ layer ( @ layers ) {
$ layer_id + + ;
2015-01-30 17:45:30 +00: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 12:56:01 +00:00
2012-06-11 12:47:48 +00:00
my @ current_layer_slices = ( ) ;
2014-01-11 16:40:09 +00:00
# sort slices so that the outermost ones come first
2015-01-30 18:34:46 +00: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 16:40:09 +00:00
foreach my $ slice ( @ slices ) {
my $ expolygon = $ slice - > clone ;
$ expolygon - > translate ( @$ copy ) ;
2015-01-30 18:34:46 +00:00
$ expolygon - > translate ( - $ print_bb - > x_min , - $ print_bb - > y_min ) ;
2014-01-11 16:40:09 +00:00
$ print_polygon - > ( $ expolygon - > contour , 'contour' ) ;
$ print_polygon - > ( $ _ , 'hole' ) for @ { $ expolygon - > holes } ;
push @ current_layer_slices , $ expolygon ;
2012-04-30 12:56:01 +00:00
}
}
2012-06-11 12:47:48 +00:00
# generate support material
2014-01-11 16:40:09 +00:00
if ( $ self - > has_support_material && $ layer - > id > 0 ) {
2012-06-11 12:47:48 +00:00
my ( @ supported_slices , @ unsupported_slices ) = ( ) ;
foreach my $ expolygon ( @ current_layer_slices ) {
my $ intersection = intersection_ex (
[ map @$ _ , @ previous_layer_slices ] ,
2014-08-03 09:35:18 +00:00
[ @$ expolygon ] ,
2012-06-11 12:47:48 +00: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-26 22:52:20 +00:00
my $ contour = $ expolygon - > contour ;
my $ support_point = $ contour - > first_point - > nearest_point ( \ @ supported_points )
2012-09-21 14:52:05 +00:00
or next ;
2013-08-26 22:52:20 +00:00
my $ anchor_point = $ support_point - > nearest_point ( [ @$ contour ] ) ;
2012-06-11 18:42:39 +00:00
printf $ fh qq{ <line x1="%s" y1="%s" x2="%s" y2="%s" style="stroke-width: 2; stroke: white" /> \ n } ,
2012-06-11 12:47:48 +00:00
map @$ _ , $ support_point , $ anchor_point ;
}
}
2012-04-30 12:56:01 +00:00
print $ fh qq{ </g> \ n } ;
2012-06-11 12:47:48 +00:00
@ previous_layer_slices = @ current_layer_slices ;
2012-04-30 12:56:01 +00:00
}
print $ fh "</svg>\n" ;
close $ fh ;
2013-06-07 10:00:03 +00:00
print "Done.\n" unless $ params { quiet } ;
2011-09-25 20:11:56 +00:00
}
2012-04-29 10:51:20 +00:00
sub make_skirt {
2011-11-13 17:41:12 +00:00
my $ self = shift ;
2014-05-10 18:54:12 +00:00
2014-06-13 18:05:18 +00: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 18:54:12 +00: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 08:56:58 +00:00
if ( ! $ self - > has_skirt ) {
2014-06-13 18:18:34 +00:00
$ self - > set_step_done ( STEP_SKIRT ) ;
return ;
}
$ self - > status_cb - > ( 88 , "Generating skirt" ) ;
2014-03-24 16:52:14 +00: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 08:56:58 +00:00
# Note that unless has_infinite_skirt() == true
2014-03-24 16:52:14 +00: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 08:56:58 +00:00
my $ skirt_height = $ self - > has_infinite_skirt
2015-05-17 22:49:16 +00:00
? $ object - > layer_count
: min ( $ self - > config - > skirt_height , $ object - > layer_count ) ;
2014-06-13 15:45:44 +00:00
my $ highest_layer = $ object - > get_layer ( $ skirt_height - 1 ) ;
2014-03-24 16:52:14 +00:00
$ skirt_height_z = max ( $ skirt_height_z , $ highest_layer - > print_z ) ;
}
2014-01-12 10:06:21 +00:00
2011-11-13 17:41:12 +00:00
# collect points from all layers contained in skirt height
2012-04-29 10:51:20 +00:00
my @ points = ( ) ;
2014-03-24 16:52:14 +00: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 18:49:54 +00:00
}
2012-04-29 10:51:20 +00:00
}
2012-03-31 16:32:53 +00:00
return if @ points < 3 ; # at least three points required for a convex hull
2011-11-13 17:41:12 +00:00
# find out convex hull
2014-03-24 16:52:14 +00:00
my $ convex_hull = convex_hull ( \ @ points ) ;
2011-11-13 17:41:12 +00:00
2012-10-29 10:17:57 +00:00
my @ extruded_length = ( ) ; # for each extruder
2013-02-22 15:08:11 +00:00
2014-03-24 16:52:14 +00: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 15:08:11 +00:00
# TODO: use each extruder's own flow
2014-07-24 16:32:07 +00:00
my $ first_layer_height = $ self - > skirt_first_layer_height ;
my $ flow = $ self - > skirt_flow ;
2014-03-24 16:52:14 +00:00
my $ spacing = $ flow - > spacing ;
2014-06-11 23:00:13 +00:00
my $ mm3_per_mm = $ flow - > mm3_per_mm ;
2013-02-22 15:08:11 +00:00
2012-10-29 10:17:57 +00:00
my @ extruders_e_per_mm = ( ) ;
my $ extruder_idx = 0 ;
2015-03-06 08:56:58 +00:00
my $ skirts = $ self - > config - > skirts ;
$ skirts || = 1 if $ self - > has_infinite_skirt ;
2011-11-13 17:41:12 +00:00
# draw outlines from outside to inside
2012-10-29 10:17:57 +00:00
# loop while we have less skirts than required or any extruder hasn't reached the min length if any
2014-07-24 21:43:19 +00:00
my $ distance = scale max ( $ self - > config - > skirt_distance , $ self - > config - > brim_width ) ;
2015-03-06 08:56:58 +00:00
for ( my $ i = $ skirts ; $ i > 0 ; $ i - - ) {
2012-10-29 10:17:57 +00:00
$ distance += scale $ spacing ;
2014-03-24 16:52:14 +00:00
my $ loop = offset ( [ $ convex_hull ] , $ distance , 1 , JT_ROUND , scale ( 0.1 ) ) - > [ 0 ] ;
2014-05-08 09:07:37 +00: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 17:55:16 +00:00
mm3_per_mm = > $ mm3_per_mm , # this will be overridden at G-code export time
2014-05-08 09:07:37 +00:00
width = > $ flow - > width ,
2014-12-16 17:55:16 +00:00
height = > $ first_layer_height , # this will be overridden at G-code export time
2014-05-08 09:07:37 +00:00
) ,
2013-09-16 08:33:30 +00:00
) ) ;
2012-10-29 10:17:57 +00:00
2014-03-24 16:52:14 +00:00
if ( $ self - > config - > min_skirt_length > 0 ) {
$ extruded_length [ $ extruder_idx ] || = 0 ;
if ( ! $ extruders_e_per_mm [ $ extruder_idx ] ) {
2014-11-06 20:11:59 +00:00
my $ config = Slic3r::Config::GCode - > new ;
$ config - > apply_print_config ( $ self - > config ) ;
my $ extruder = Slic3r::Extruder - > new ( $ extruder_idx , $ config ) ;
2014-03-24 16:52:14 +00: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 10:17:57 +00:00
if ( $ extruder_idx < $# { $ self - > extruders } ) {
$ extruder_idx + + ;
next ;
}
}
}
2011-11-13 17:41:12 +00:00
}
2012-10-29 10:17:57 +00:00
2013-09-16 08:33:30 +00:00
$ self - > skirt - > reverse ;
2014-06-13 18:05:18 +00:00
$ self - > set_step_done ( STEP_SKIRT ) ;
2012-02-19 11:03:36 +00:00
}
2012-06-23 19:31:29 +00:00
sub make_brim {
my $ self = shift ;
2014-03-24 16:52:14 +00:00
2014-06-13 18:05:18 +00: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 18:54:12 +00: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 18:18:34 +00:00
if ( $ self - > config - > brim_width == 0 ) {
$ self - > set_step_done ( STEP_BRIM ) ;
return ;
}
$ self - > status_cb - > ( 88 , "Generating brim" ) ;
2014-03-24 16:52:14 +00:00
2014-12-16 23:45:05 +00:00
# brim is only printed on first layer and uses perimeter extruder
2014-07-24 16:32:07 +00:00
my $ first_layer_height = $ self - > skirt_first_layer_height ;
2014-12-16 23:45:05 +00:00
my $ flow = $ self - > brim_flow ;
2014-06-11 23:00:13 +00:00
my $ mm3_per_mm = $ flow - > mm3_per_mm ;
2013-02-22 15:08:11 +00:00
my $ grow_distance = $ flow - > scaled_width / 2 ;
2012-06-23 19:31:29 +00:00
my @ islands = ( ) ; # array of polygons
2014-05-06 08:07:18 +00:00
foreach my $ obj_idx ( 0 .. ( $ self - > object_count - 1 ) ) {
2013-07-29 18:49:54 +00:00
my $ object = $ self - > objects - > [ $ obj_idx ] ;
2014-06-13 15:45:44 +00:00
my $ layer0 = $ object - > get_layer ( 0 ) ;
2012-08-06 18:54:49 +00:00
my @ object_islands = (
( map $ _ - > contour , @ { $ layer0 - > slices } ) ,
) ;
2013-07-29 18:49:54 +00:00
if ( @ { $ object - > support_layers } ) {
my $ support_layer0 = $ object - > support_layers - > [ 0 ] ;
push @ object_islands ,
2014-03-24 16:52:14 +00:00
( map @ { $ _ - > polyline - > grow ( $ grow_distance ) } , @ { $ support_layer0 - > support_fills } )
2013-07-29 18:49:54 +00:00
if $ support_layer0 - > support_fills ;
2013-07-31 14:29:44 +00:00
push @ object_islands ,
2014-03-24 16:52:14 +00:00
( map @ { $ _ - > polyline - > grow ( $ grow_distance ) } , @ { $ support_layer0 - > support_interface_fills } )
2013-07-31 14:29:44 +00:00
if $ support_layer0 - > support_interface_fills ;
2013-07-29 18:49:54 +00:00
}
2014-03-24 16:52:14 +00:00
foreach my $ copy ( @ { $ object - > _shifted_copies } ) {
2013-09-16 08:33:30 +00:00
push @ islands , map { $ _ - > translate ( @$ copy ) ; $ _ } map $ _ - > clone , @ object_islands ;
2012-06-23 19:31:29 +00:00
}
}
2013-05-09 12:52:56 +00:00
my @ loops = ( ) ;
2014-03-24 16:52:14 +00:00
my $ num_loops = sprintf "%.0f" , $ self - > config - > brim_width / $ flow - > width ;
2012-06-23 19:31:29 +00:00
for my $ i ( reverse 1 .. $ num_loops ) {
2012-08-06 18:26:08 +00:00
# JT_SQUARE ensures no vertex is outside the given offset distance
2013-05-09 12:52:56 +00:00
# -0.5 because islands are not represented by their centerlines
2013-08-09 12:22:41 +00:00
# (first offset more, then step back - reverse order than the one used for
# perimeters because here we're offsetting outwards)
2013-08-26 14:25:42 +00:00
push @ loops , @ { offset2 ( \ @ islands , ( $ i + 0.5 ) * $ flow - > scaled_spacing , - 1.0 * $ flow - > scaled_spacing , 100000 , JT_SQUARE ) } ;
2012-06-23 19:31:29 +00:00
}
2013-05-09 12:52:56 +00:00
2014-05-08 09:07:37 +00: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 16:52:14 +00:00
) , reverse @ { union_pt_chained ( \ @ loops ) } ) ;
2014-06-13 18:05:18 +00:00
$ self - > set_step_done ( STEP_BRIM ) ;
2012-06-23 19:31:29 +00:00
}
2012-04-30 12:56:01 +00:00
sub write_gcode {
2011-09-03 18:47:38 +00:00
my $ self = shift ;
my ( $ file ) = @ _ ;
2012-11-21 19:41:14 +00: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 09:18:34 +00:00
Slic3r:: open ( \ $ fh , ">" , $ file )
2012-11-21 19:41:14 +00:00
or die "Failed to open $file for writing\n" ;
2014-03-24 16:52:50 +00:00
# enable UTF-8 output since user might have entered Unicode characters in fields like notes
binmode $ fh , ':utf8' ;
2012-11-21 19:41:14 +00:00
}
2011-09-03 18:47:38 +00:00
2014-11-30 17:09:06 +00:00
my $ exporter = Slic3r::Print::GCode - > new (
print = > $ self ,
fh = > $ fh ,
2013-05-18 14:57:44 +00:00
) ;
2014-11-30 17:09:06 +00:00
$ exporter - > export ;
2012-11-18 18:53:52 +00:00
2011-09-03 18:47:38 +00:00
# close our gcode file
close $ fh ;
}
2012-09-12 14:30:44 +00:00
# this method will return the supplied input file path after expanding its
2012-04-30 12:56:01 +00:00
# format variables with their values
sub expanded_output_filepath {
my $ self = shift ;
2014-03-24 16:52:14 +00:00
my ( $ path ) = @ _ ;
2012-09-12 14:30:44 +00:00
2014-03-24 16:52:14 +00: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 22:41:36 +00: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 ) ;
2013-11-10 23:08:50 +00:00
2015-05-02 19:59:15 +00: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-10 23:08:50 +00: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 19:45:10 +00:00
2014-05-01 19:42:12 +00:00
# make sure we use an up-to-date timestamp
$ self - > placeholder_parser - > update_timestamp ;
2015-02-15 22:41:36 +00:00
return $ self - > placeholder_parser - > process ( $ path ) ;
2013-12-18 17:54:11 +00:00
}
2011-09-01 19:06:28 +00:00
1 ;