Move Slic3r::Test::GCodeReader to Slic3r::GCode::Reader

xs
Alessandro Ranellucci 2013-05-13 20:14:33 +02:00
parent ece6dd8a0b
commit baa1a8c736
11 changed files with 75 additions and 72 deletions

View File

@ -26,6 +26,7 @@ lib/Slic3r/Format/STL.pm
lib/Slic3r/GCode.pm
lib/Slic3r/GCode/CoolingBuffer.pm
lib/Slic3r/GCode/MotionPlanner.pm
lib/Slic3r/GCode/Reader.pm
lib/Slic3r/Geometry.pm
lib/Slic3r/Geometry/Clipper.pm
lib/Slic3r/GUI.pm

View File

@ -47,6 +47,7 @@ use Slic3r::Format::STL;
use Slic3r::GCode;
use Slic3r::GCode::CoolingBuffer;
use Slic3r::GCode::MotionPlanner;
use Slic3r::GCode::Reader;
use Slic3r::Geometry qw(PI);
use Slic3r::Layer;
use Slic3r::Layer::Region;

View File

@ -0,0 +1,66 @@
package Slic3r::GCode::Reader;
use Moo;
has 'gcode' => (is => 'ro', required => 1);
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});
our $Verbose = 0;
my @AXES = qw(X Y Z E);
sub parse {
my $self = shift;
my ($cb) = @_;
foreach my $raw_line (split /\R+/, $self->gcode) {
print "$raw_line\n" if $Verbose || $ENV{SLIC3R_TESTS_GCODE};
my $line = $raw_line;
$line =~ s/\s*;(.*)//; # strip comment
next if $line eq '';
my %info = (comment => $1, raw => $raw_line);
# parse command
my ($command, @args) = split /\s+/, $line;
my %args = map { /([A-Z])(.*)/; ($1 => $2) } @args;
# check retraction
if ($command =~ /^G[01]$/) {
foreach my $axis (@AXES) {
if (exists $args{$axis}) {
$info{"dist_$axis"} = $args{$axis} - $self->$axis;
$info{"new_$axis"} = $args{$axis};
} else {
$info{"dist_$axis"} = 0;
$info{"new_$axis"} = $self->$axis;
}
}
$info{dist_XY} = Slic3r::Line->new([0,0], [@info{qw(dist_X dist_Y)}])->length;
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
$cb->($self, $command, \%args, \%info);
# update coordinates
if ($command =~ /^(?:G[01]|G92)$/) {
for (@AXES, 'F') {
$self->$_($args{$_}) if exists $args{$_};
}
}
# TODO: update temperatures
}
}
1;

View File

@ -77,69 +77,4 @@ sub add_facet {
}
}
package Slic3r::Test::GCodeReader;
use Moo;
has 'gcode' => (is => 'ro', required => 1);
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});
our $Verbose = 0;
my @AXES = qw(X Y Z E);
sub parse {
my $self = shift;
my ($cb) = @_;
foreach my $line (split /\R+/, $self->gcode) {
print "$line\n" if $Verbose || $ENV{SLIC3R_TESTS_GCODE};
$line =~ s/\s*;(.*)//; # strip comment
next if $line eq '';
my $comment = $1;
# parse command
my ($command, @args) = split /\s+/, $line;
my %args = map { /([A-Z])(.*)/; ($1 => $2) } @args;
my %info = ();
# check retraction
if ($command =~ /^G[01]$/) {
foreach my $axis (@AXES) {
if (exists $args{$axis}) {
$info{"dist_$axis"} = $args{$axis} - $self->$axis;
$info{"new_$axis"} = $args{$axis};
} else {
$info{"dist_$axis"} = 0;
$info{"new_$axis"} = $self->$axis;
}
}
$info{dist_XY} = Slic3r::Line->new([0,0], [@info{qw(dist_X dist_Y)}])->length;
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
$cb->($self, $command, \%args, \%info);
# update coordinates
if ($command =~ /^(?:G[01]|G92)$/) {
for (@AXES, 'F') {
$self->$_($args{$_}) if exists $args{$_};
}
}
# TODO: update temperatures
}
}
1;

View File

@ -20,7 +20,7 @@ use Slic3r::Test;
my $print = Slic3r::Test::init_print('2x20x10', config => $conf);
my $last_move_was_z_change = 0;
Slic3r::Test::GCodeReader->new(gcode => Slic3r::Test::gcode($print))->parse(sub {
Slic3r::GCode::Reader->new(gcode => Slic3r::Test::gcode($print))->parse(sub {
my ($self, $cmd, $args, $info) = @_;
if ($last_move_was_z_change && $cmd ne $config->layer_gcode) {

View File

@ -111,7 +111,7 @@ sub scale_points (@) { map [scale $_->[X], scale $_->[Y]], @_ }
$config->set('solid_infill_below_area', 20000000);
my $print = Slic3r::Test::init_print('20mm_cube', config => $config);
Slic3r::Test::GCodeReader->new(gcode => Slic3r::Test::gcode($print))->parse(sub {
Slic3r::GCode::Reader->new(gcode => Slic3r::Test::gcode($print))->parse(sub {
my ($self, $cmd, $args, $info) = @_;
fail "solid_infill_below_area should be ignored when fill_density is 0"

View File

@ -21,7 +21,7 @@ my $test = sub {
my @z = ();
my @increments = ();
Slic3r::Test::GCodeReader->new(gcode => Slic3r::Test::gcode($print))->parse(sub {
Slic3r::GCode::Reader->new(gcode => Slic3r::Test::gcode($print))->parse(sub {
my ($self, $cmd, $args, $info) = @_;
if ($info->{dist_Z}) {

View File

@ -25,7 +25,7 @@ my $test = sub {
my $lifted = 0;
my $changed_tool = 0;
my $wait_for_toolchange = 0;
Slic3r::Test::GCodeReader->new(gcode => Slic3r::Test::gcode($print))->parse(sub {
Slic3r::GCode::Reader->new(gcode => Slic3r::Test::gcode($print))->parse(sub {
my ($self, $cmd, $args, $info) = @_;
if ($cmd =~ /^T(\d+)/) {

View File

@ -23,7 +23,7 @@ use Slic3r::Test;
my $print = Slic3r::Test::init_print('20mm_cube', config => $config);
my %layers_with_shells = (); # Z => $count
Slic3r::Test::GCodeReader->new(gcode => Slic3r::Test::gcode($print))->parse(sub {
Slic3r::GCode::Reader->new(gcode => Slic3r::Test::gcode($print))->parse(sub {
my ($self, $cmd, $args, $info) = @_;
if ($self->Z > 0) {

View File

@ -28,7 +28,7 @@ my $test = sub {
my %dir_time = (X => 0, Y => 0);
my %dir_sleep_time = (X => 0, Y => 0);
my $last_cmd_pause = 0;
Slic3r::Test::GCodeReader->new(gcode => Slic3r::Test::gcode($print))->parse(sub {
Slic3r::GCode::Reader->new(gcode => Slic3r::Test::gcode($print))->parse(sub {
my ($self, $cmd, $args, $info) = @_;
if ($cmd !~ /^G[01]$/) {

View File

@ -41,7 +41,7 @@ my %opt = (
# read paths
my %paths = (); # z => [ path, path ... ]
Slic3r::Test::GCodeReader->new(gcode => io($input_file)->all)->parse(sub {
Slic3r::GCode::Reader->new(gcode => io($input_file)->all)->parse(sub {
my ($self, $cmd, $args, $info) = @_;
if ($cmd eq 'G1' && $info->{extruding}) {