mirror of
				https://github.com/SoftFever/OrcaSlicer.git
				synced 2025-10-31 12:41:20 -06:00 
			
		
		
		
	
		
			
				
	
	
		
			69 lines
		
	
	
	
		
			1.7 KiB
		
	
	
	
		
			Perl
		
	
	
	
	
	
			
		
		
	
	
			69 lines
		
	
	
	
		
			1.7 KiB
		
	
	
	
		
			Perl
		
	
	
	
	
	
| package Slic3r::Format::STL;
 | |
| use Moo;
 | |
| 
 | |
| use Slic3r::Geometry qw(X Y Z triangle_normal);
 | |
| 
 | |
| sub read_file {
 | |
|     my $self = shift;
 | |
|     my ($file) = @_;
 | |
|     
 | |
|     my $tmesh = Slic3r::TriangleMesh::XS->new;
 | |
|     $tmesh->ReadSTLFile($file);
 | |
|     $tmesh->Repair;
 | |
|     my ($vertices, $facets) = @{$tmesh->ToPerl};
 | |
|     
 | |
|     my $model = Slic3r::Model->new;
 | |
|     my $object = $model->add_object(vertices => $vertices);
 | |
|     my $volume = $object->add_volume(facets => $facets);
 | |
|     return $model;
 | |
| }
 | |
| 
 | |
| sub write_file {
 | |
|     my $self = shift;
 | |
|     my ($file, $model, %params) = @_;
 | |
|     
 | |
|     Slic3r::open(\my $fh, '>', $file);
 | |
|     
 | |
|     $params{binary}
 | |
|         ? _write_binary($fh, $model->mesh)
 | |
|         : _write_ascii($fh, $model->mesh);
 | |
|     
 | |
|     close $fh;
 | |
| }
 | |
| 
 | |
| sub _write_binary {
 | |
|     my ($fh, $mesh) = @_;
 | |
|     
 | |
|     die "bigfloat" unless length(pack "f", 1) == 4;
 | |
|     
 | |
|     binmode $fh;
 | |
|     print $fh pack 'x80';
 | |
|     print $fh pack 'L', scalar(@{$mesh->facets});
 | |
|     foreach my $facet (@{$mesh->facets}) {
 | |
|         print $fh pack '(f<3)4S',
 | |
|             @{_facet_normal($mesh, $facet)},
 | |
|             (map @{$mesh->vertices->[$_]}, @$facet[-3..-1]),
 | |
|             0;
 | |
|     }
 | |
| }
 | |
| 
 | |
| sub _write_ascii {
 | |
|     my ($fh, $mesh) = @_;
 | |
|     
 | |
|     printf $fh "solid\n";
 | |
|     foreach my $facet (@{$mesh->facets}) {
 | |
|         printf $fh "   facet normal %f %f %f\n", @{_facet_normal($mesh, $facet)};
 | |
|         printf $fh "      outer loop\n";
 | |
|         printf $fh "         vertex %f %f %f\n", @{$mesh->vertices->[$_]} for @$facet[-3..-1];
 | |
|         printf $fh "      endloop\n";
 | |
|         printf $fh "   endfacet\n";
 | |
|     }
 | |
|     printf $fh "endsolid\n";
 | |
| }
 | |
| 
 | |
| sub _facet_normal {
 | |
|     my ($mesh, $facet) = @_;
 | |
|     return triangle_normal(map $mesh->vertices->[$_], @$facet[-3..-1]);
 | |
| }
 | |
| 
 | |
| 1;
 | 
