2012-11-21 19:41:14 +00:00
|
|
|
package Slic3r::Test;
|
|
|
|
use strict;
|
|
|
|
use warnings;
|
|
|
|
|
2012-12-21 12:25:03 +00:00
|
|
|
require Exporter;
|
|
|
|
our @ISA = qw(Exporter);
|
|
|
|
our @EXPORT_OK = qw(_eq);
|
|
|
|
|
2012-11-21 19:41:14 +00:00
|
|
|
use IO::Scalar;
|
2012-12-30 15:27:20 +00:00
|
|
|
use List::Util qw(first);
|
|
|
|
use Slic3r::Geometry qw(epsilon X Y Z);
|
2012-11-21 19:41:14 +00:00
|
|
|
|
2012-12-09 17:33:25 +00:00
|
|
|
my %cuboids = (
|
|
|
|
'20mm_cube' => [20,20,20],
|
|
|
|
'2x20x10' => [2, 20,10],
|
|
|
|
);
|
|
|
|
|
2013-02-23 16:40:38 +00:00
|
|
|
sub model {
|
|
|
|
my ($model_name) = @_;
|
2012-11-21 19:41:14 +00:00
|
|
|
|
2013-02-23 16:40:38 +00:00
|
|
|
my ($vertices, $facets);
|
|
|
|
if ($cuboids{$model_name}) {
|
|
|
|
my ($x, $y, $z) = @{ $cuboids{$model_name} };
|
|
|
|
$vertices = [
|
|
|
|
[$x,$y,0], [$x,0,0], [0,0,0], [0,$y,0], [$x,$y,$z], [0,$y,$z], [0,0,$z], [$x,0,$z],
|
|
|
|
];
|
|
|
|
$facets = [
|
|
|
|
[0,1,2], [0,2,3], [4,5,6], [4,6,7], [0,4,7], [0,7,1], [1,7,6], [1,6,2], [2,6,5], [2,5,3], [4,0,3], [4,3,5],
|
|
|
|
],
|
2012-11-21 19:41:14 +00:00
|
|
|
}
|
|
|
|
|
2013-02-23 16:40:38 +00:00
|
|
|
my $model = Slic3r::Model->new;
|
|
|
|
$model->add_object(vertices => $vertices)->add_volume(facets => $facets);
|
|
|
|
return $model;
|
|
|
|
}
|
|
|
|
|
|
|
|
sub init_print {
|
|
|
|
my ($model_name, %params) = @_;
|
|
|
|
|
2012-11-21 19:41:14 +00:00
|
|
|
my $config = Slic3r::Config->new_from_defaults;
|
|
|
|
$config->apply($params{config}) if $params{config};
|
2012-12-21 14:14:44 +00:00
|
|
|
$config->set('gcode_comments', 1) if $ENV{SLIC3R_TESTS_GCODE};
|
2012-11-21 19:41:14 +00:00
|
|
|
|
|
|
|
my $print = Slic3r::Print->new(config => $config);
|
2013-02-23 16:40:38 +00:00
|
|
|
$print->add_model(model($model_name));
|
2012-11-21 19:41:14 +00:00
|
|
|
$print->validate;
|
|
|
|
|
|
|
|
return $print;
|
|
|
|
}
|
|
|
|
|
|
|
|
sub gcode {
|
|
|
|
my ($print) = @_;
|
|
|
|
|
|
|
|
my $fh = IO::Scalar->new(\my $gcode);
|
|
|
|
$print->export_gcode(output_fh => $fh, quiet => 1);
|
|
|
|
$fh->close;
|
|
|
|
|
|
|
|
return $gcode;
|
|
|
|
}
|
|
|
|
|
2012-12-21 12:25:03 +00:00
|
|
|
sub _eq {
|
2012-11-21 19:41:14 +00:00
|
|
|
my ($a, $b) = @_;
|
|
|
|
return abs($a - $b) < epsilon;
|
|
|
|
}
|
|
|
|
|
2012-12-30 15:27:20 +00:00
|
|
|
sub add_facet {
|
|
|
|
my ($facet, $vertices, $facets) = @_;
|
|
|
|
|
|
|
|
push @$facets, [];
|
|
|
|
for my $i (0..2) {
|
|
|
|
my $v = first { $vertices->[$_][X] == $facet->[$i][X] && $vertices->[$_][Y] == $facet->[$i][Y] && $vertices->[$_][Z] == $facet->[$i][Z] } 0..$#$vertices;
|
|
|
|
if (!defined $v) {
|
|
|
|
push @$vertices, [ @{$facet->[$i]}[X,Y,Z] ];
|
|
|
|
$v = $#$vertices;
|
|
|
|
}
|
|
|
|
$facets->[-1][$i] = $v;
|
|
|
|
}
|
|
|
|
}
|
|
|
|
|
2012-11-21 19:41:14 +00:00
|
|
|
1;
|