view release on metacpan or  search on metacpan

lib/Graphics/Penplotter/GcodeXY/Geometry3D.pm  view on Meta::CPAN

# SECTION: SVG projection output
# ==========================================================================

sub project_to_svg ($self, $obj, %opts) {
    my $polylines;
    if (ref $obj eq 'HASH' && $obj->{verts}) {
        $polylines = $self->occlusion_clip($obj, %opts);
    } else {
        $polylines = $obj;
    }
    my ($mnx,$mny,$mxx,$mxy) = (1e99,1e99,-1e99,-1e99);
    for my $seg (@$polylines) {
        for my $p (@$seg) {
            $mnx=$p->[0] if $p->[0]<$mnx; $mxx=$p->[0] if $p->[0]>$mxx;
            $mny=$p->[1] if $p->[1]<$mny; $mxy=$p->[1] if $p->[1]>$mxy;
        }
    }
    $mnx=$mny=0 unless $mnx<$mxx;
    $mxx=$mxy=100 unless $mny<$mxy;
    my $svg = sprintf(
        "<svg xmlns=\"http://www.w3.org/2000/svg\" viewBox=\"%.4f %.4f %.4f %.4f\">\n",
        $mnx, $mny, $mxx-$mnx, $mxy-$mny
    );
    for my $seg (@$polylines) {
        my ($x1,$y1) = @{$seg->[0]};
        my ($x2,$y2) = @{$seg->[1]};
        $svg .= sprintf(
            "<line x1=\"%.4f\" y1=\"%.4f\" x2=\"%.4f\" y2=\"%.4f\" "
           ."stroke=\"black\" stroke-width=\"0.5\"/>\n",
            $x1,$y1,$x2,$y2
        );
    }
    $svg .= "</svg>\n";
    return $svg;
}

# ==========================================================================
# SECTION: Mesh I/O -- OBJ
# ==========================================================================

sub mesh_to_obj ($self, $mesh, $name='object') {
    my $out = "# Generated by Graphics::Penplotter::GcodeXY::Geometry3D\n";
    $out .= "o $name\n";
    for my $v (@{ $mesh->{verts} }) {
        $out .= sprintf("v %.6f %.6f %.6f\n", @$v);
    }
    for my $f (@{ $mesh->{faces} }) {
        $out .= sprintf("f %d %d %d\n", $f->[0]+1, $f->[1]+1, $f->[2]+1);
    }
    return $out;
}

sub mesh_from_obj ($self, $str) {
    my (@verts, @faces);
    for my $line (split /\n/, $str) {
        $line =~ s/^\s+//;
        if ($line =~ /^v\s+([\d.eE+\-]+)\s+([\d.eE+\-]+)\s+([\d.eE+\-]+)/) {
            push @verts, [$1+0, $2+0, $3+0];
        }
        elsif ($line =~ /^f\s+(\S+)\s+(\S+)\s+(\S+)/) {
            my @idx = map { (split m{/}, $_)[0] - 1 } ($1,$2,$3);
            push @faces, \@idx;
        }
    }
    return $self->mesh(\@verts, \@faces);
}

# ==========================================================================
# SECTION: Mesh I/O -- STL (ASCII)
# ==========================================================================

sub mesh_to_stl ($self, $mesh, $name='solid') {
    my $out = "solid $name\n";
    my @v   = @{ $mesh->{verts} };
    for my $f (@{ $mesh->{faces} }) {
        my ($a,$b,$c) = @$f;
        my ($ux,$uy,$uz) = map { $v[$b][$_]-$v[$a][$_] } 0..2;
        my ($wx,$wy,$wz) = map { $v[$c][$_]-$v[$a][$_] } 0..2;
        my ($nx,$ny,$nz) = ($uy*$wz-$uz*$wy, $uz*$wx-$ux*$wz, $ux*$wy-$uy*$wx);
        my $l = sqrt($nx*$nx+$ny*$ny+$nz*$nz) || 1;
        $out .= sprintf("  facet normal %.6f %.6f %.6f\n", $nx/$l,$ny/$l,$nz/$l);
        $out .= "    outer loop\n";
        $out .= sprintf("      vertex %.6f %.6f %.6f\n", @{$v[$a]});
        $out .= sprintf("      vertex %.6f %.6f %.6f\n", @{$v[$b]});
        $out .= sprintf("      vertex %.6f %.6f %.6f\n", @{$v[$c]});
        $out .= "    endloop\n  endfacet\n";
    }
    $out .= "endsolid $name\n";
    return $out;
}

sub mesh_from_stl ($self, $str) {
    my (@verts, @faces, %seen, @pending);
    my $vi = sub {
        my ($x,$y,$z) = @_;
        my $key = sprintf("%.9f,%.9f,%.9f", $x,$y,$z);
        unless (exists $seen{$key}) {
            $seen{$key} = scalar @verts;
            push @verts, [$x,$y,$z];
        }
        return $seen{$key};
    };
    for my $line (split /\n/, $str) {
        $line =~ s/^\s+//;
        if ($line =~ /^vertex\s+([\d.eE+\-]+)\s+([\d.eE+\-]+)\s+([\d.eE+\-]+)/) {
            push @pending, $vi->($1+0,$2+0,$3+0);
            if (@pending == 3) { push @faces, [@pending]; @pending = () }
        }
    }
    return $self->mesh(\@verts, \@faces);
}

# ==========================================================================
# SECTION: Numeric configuration
# ==========================================================================

sub set_tolerance ($self, $eps) {
    $eps > 0 or $self->_croak('set_tolerance: eps must be positive');
    $self->{_g3_tolerance} = $eps;
    return 1;
}