PrusaSlicer-NonPlainar/lib/Slic3r/Format/AMF.pm

package Slic3r::Format::AMF;
use Moo;

use Slic3r::Geometry qw(X Y Z);

sub read_file {
    my $self = shift;
    my ($file) = @_;
    
    eval "require Slic3r::Format::AMF::Parser; 1"
        or die "AMF parsing requires XML::SAX\n";
    
    open my $fh, '<', $file or die "Failed to open $file\n";
    
    my $vertices = [];
    my $materials = {};
    my $meshes_by_material = {};
    XML::SAX::PurePerl
        ->new(Handler => Slic3r::Format::AMF::Parser->new(
            _vertices           => $vertices,
            _materials          => $materials,
            _meshes_by_material => $meshes_by_material,
         ))
        ->parse_file($fh);
    
    close $fh;
    
    my $model = Slic3r::Model->new;
    my $object = $model->add_object(vertices => $vertices);
    foreach my $material (keys %$meshes_by_material) {
        push @{$model->materials}, $material;  # TODO: we should not add duplicate materials
        $object->add_volume(
            material_id => $#{$model->materials},
            facets      => $meshes_by_material->{$material},
        );
    }
    return $model;
}

sub write_file {
    my $self = shift;
    my ($file, $model, %params) = @_;
    
    my %vertices_offset = ();
    
    open my $fh, '>', $file;
    binmode $fh, ':utf8';
    printf $fh qq{<?xml version="1.0" encoding="UTF-8"?>\n};
    printf $fh qq{<amf unit="millimeter">\n};
    printf $fh qq{  <metadata type="cad">Slic3r %s</metadata>\n}, $Slic3r::VERSION;
    for my $material_id (0 .. $#{ $model->materials }) {
        my $material = $model->materials->[$material_id];
        printf $fh qq{  <material id="%d">\n}, $material_id;
        for (keys %$material) {
             printf $fh qq{    <metadata type=\"%s\">%s</metadata>\n}, $_, $material->{$_};
        }
        printf $fh qq{  </material>\n};
    }
    for my $object_id (0 .. $#{ $model->objects }) {
        my $object = $model->objects->[$object_id];
        printf $fh qq{  <object id="%d">\n}, $object_id;
        printf $fh qq{    <mesh>\n};
        printf $fh qq{      <vertices>\n};
        foreach my $vertex (@{$object->vertices}, ) {
            printf $fh qq{        <vertex>\n};
            printf $fh qq{          <coordinates>\n};
            printf $fh qq{            <x>%s</x>\n}, $vertex->[X];
            printf $fh qq{            <y>%s</y>\n}, $vertex->[Y];
            printf $fh qq{            <z>%s</z>\n}, $vertex->[Z];
            printf $fh qq{          </coordinates>\n};
            printf $fh qq{        </vertex>\n};
        }
        printf $fh qq{      </vertices>\n};
        foreach my $volume (@{ $object->volumes }) {
            printf $fh qq{      <volume%s>\n},
                (!defined $volume->material_id) ? '' : (sprintf ' materialid="%s"', $volume->material_id);
            foreach my $facet (@{$volume->facets}) {
                printf $fh qq{        <triangle>\n};
                printf $fh qq{          <v%d>%d</v%d>\n}, $_, $facet->[$_], $_ for -3..-1;
                printf $fh qq{        </triangle>\n};
            }
            printf $fh qq{      </volume>\n};
        }
        printf $fh qq{    </mesh>\n};
        printf $fh qq{  </object>\n};
    }
    printf $fh qq{</amf>\n};
    close $fh;
}

1;