2013-05-13 18:14:33 +00:00
|
|
|
package Slic3r::GCode::Reader;
|
|
|
|
use Moo;
|
|
|
|
|
2014-11-23 17:59:18 +00:00
|
|
|
has 'config' => (is => 'ro', default => sub { Slic3r::Config::GCode->new });
|
2013-05-13 18:14:33 +00:00
|
|
|
has 'X' => (is => 'rw', default => sub {0});
|
|
|
|
has 'Y' => (is => 'rw', default => sub {0});
|
|
|
|
has 'Z' => (is => 'rw', default => sub {0});
|
|
|
|
has 'E' => (is => 'rw', default => sub {0});
|
|
|
|
has 'F' => (is => 'rw', default => sub {0});
|
2014-11-23 17:59:18 +00:00
|
|
|
has '_extrusion_axis' => (is => 'rw', default => sub {"E"});
|
2013-05-13 18:14:33 +00:00
|
|
|
|
|
|
|
our $Verbose = 0;
|
|
|
|
my @AXES = qw(X Y Z E);
|
|
|
|
|
2014-11-23 17:59:18 +00:00
|
|
|
sub apply_print_config {
|
|
|
|
my ($self, $print_config) = @_;
|
|
|
|
|
2015-12-16 11:33:19 +00:00
|
|
|
$self->config->apply_static($print_config);
|
2014-11-23 17:59:18 +00:00
|
|
|
$self->_extrusion_axis($self->config->get_extrusion_axis);
|
|
|
|
}
|
|
|
|
|
2014-02-13 15:06:52 +00:00
|
|
|
sub clone {
|
|
|
|
my $self = shift;
|
|
|
|
return (ref $self)->new(
|
2016-09-23 10:59:20 +00:00
|
|
|
map { $_ => $self->$_ } (@AXES, 'F', '_extrusion_axis', 'config'),
|
2014-02-13 15:06:52 +00:00
|
|
|
);
|
|
|
|
}
|
|
|
|
|
2013-05-13 18:14:33 +00:00
|
|
|
sub parse {
|
|
|
|
my $self = shift;
|
2013-08-28 14:51:58 +00:00
|
|
|
my ($gcode, $cb) = @_;
|
2013-05-13 18:14:33 +00:00
|
|
|
|
2013-08-28 14:51:58 +00:00
|
|
|
foreach my $raw_line (split /\R+/, $gcode) {
|
2013-05-13 18:14:33 +00:00
|
|
|
print "$raw_line\n" if $Verbose || $ENV{SLIC3R_TESTS_GCODE};
|
|
|
|
my $line = $raw_line;
|
|
|
|
$line =~ s/\s*;(.*)//; # strip comment
|
|
|
|
my %info = (comment => $1, raw => $raw_line);
|
|
|
|
|
|
|
|
# parse command
|
|
|
|
my ($command, @args) = split /\s+/, $line;
|
2013-12-23 00:19:02 +00:00
|
|
|
$command //= '';
|
2013-05-13 18:14:33 +00:00
|
|
|
my %args = map { /([A-Z])(.*)/; ($1 => $2) } @args;
|
|
|
|
|
2014-11-23 17:59:18 +00:00
|
|
|
# convert extrusion axis
|
|
|
|
if (exists $args{ $self->_extrusion_axis }) {
|
|
|
|
$args{E} = $args{ $self->_extrusion_axis };
|
|
|
|
}
|
|
|
|
|
2013-05-30 18:06:05 +00:00
|
|
|
# check motion
|
2013-05-13 18:14:33 +00:00
|
|
|
if ($command =~ /^G[01]$/) {
|
|
|
|
foreach my $axis (@AXES) {
|
|
|
|
if (exists $args{$axis}) {
|
2014-11-30 19:26:00 +00:00
|
|
|
$self->$axis(0) if $axis eq 'E' && $self->config->use_relative_e_distances;
|
2013-05-13 18:14:33 +00:00
|
|
|
$info{"dist_$axis"} = $args{$axis} - $self->$axis;
|
|
|
|
$info{"new_$axis"} = $args{$axis};
|
|
|
|
} else {
|
|
|
|
$info{"dist_$axis"} = 0;
|
|
|
|
$info{"new_$axis"} = $self->$axis;
|
|
|
|
}
|
|
|
|
}
|
2014-12-21 11:39:19 +00:00
|
|
|
$info{dist_XY} = sqrt(($info{dist_X}**2) + ($info{dist_Y}**2));
|
2013-05-13 18:14:33 +00:00
|
|
|
if (exists $args{E}) {
|
|
|
|
if ($info{dist_E} > 0) {
|
|
|
|
$info{extruding} = 1;
|
|
|
|
} elsif ($info{dist_E} < 0) {
|
|
|
|
$info{retracting} = 1
|
|
|
|
}
|
|
|
|
} else {
|
|
|
|
$info{travel} = 1;
|
|
|
|
}
|
|
|
|
}
|
|
|
|
|
|
|
|
# run callback
|
2013-08-28 16:12:20 +00:00
|
|
|
$cb->($self, $command, \%args, \%info);
|
2013-05-13 18:14:33 +00:00
|
|
|
|
|
|
|
# update coordinates
|
|
|
|
if ($command =~ /^(?:G[01]|G92)$/) {
|
2013-08-28 14:51:58 +00:00
|
|
|
for my $axis (@AXES, 'F') {
|
|
|
|
$self->$axis($args{$axis}) if exists $args{$axis};
|
2013-05-13 18:14:33 +00:00
|
|
|
}
|
|
|
|
}
|
|
|
|
|
|
|
|
# TODO: update temperatures
|
|
|
|
}
|
|
|
|
}
|
|
|
|
|
|
|
|
1;
|