cae-tools/sl2/slicer.pl

#!/usr/bin/perl
#
# slicer.pl - Standalone STL to Gnuplot slicer
#
# Written 2015 by Werner Almesberger
# Copyright 2015 by Werner Almesberger
#
# This program//library is free software; you can redistribute it and/or
# modify it under the terms of the GNU Lesser General Public
# License as published by the Free Software Foundation; either
# version 2.1 of the License, or (at your option) any later version.
#


$epsilon = 0.0001;

$flip = 1;


$v_n = 0;
$e_n = 0;
while (<>) {
        if (/\bfacet/) {
		undef @f;
                next;
        }
        if (/endfacet/) {
		if ($f[2] == $f[5] && $f[2] == $f[8]) {
			$z_level{$f[2]} = 1;
		} else {
			push(@m, [ @f ]);
		}
                next;
        }
        if (/vertex\s+/) {
		my @tmp = split(/\s+/, $');

		if ($flip) {
			push(@f, -$tmp[0], $tmp[1], -$tmp[2]);
		} else {
			push(@f, @tmp);
		}
                next;
        }
}


sub cut
{
	local ($z, $a, $b, @f) = @_;

	if ($f[$a + 2] < $z &&$f[$b + 2] > $z) {
		my $dx = $f[$b] - $f[$a];
		my $dy = $f[$b + 1] - $f[$a + 1];
		my $dz = $f[$b + 2] - $f[$a + 2];

		my $f = ($z - $f[$a + 2]) / $dz;
		return [ $dx * $f + $f[$a], $dy * $f + $f[$a + 1] ];
	}
	if ($f[$a + 2] > $z &&$f[$b + 2] < $z) {
		return &cut($z, $b, $a, @f);
	}
	return ();
}


sub remove
{
	local ($a, $b) = @_;

#print STDERR "\tremove $b from $a (", join(",", @{ $next{$a} }), "\n";
	my @tmp = grep($_ ne $b, @{ $next{$a} });
	if ($#tmp == -1) {
		delete $next{$a};
	} else {
		$next{$a} = [ @tmp ];
	}
}


for $level (sort keys %z_level) {
	my $z = $level + $epsilon;

#	print STDERR "level = $level\n";
	undef %next;
	for (@m) {
		my @f = @{ $_ };
		my @p = &cut($z, 0, 3, @f);
		push(@p, &cut($z, 0, 6, @f));
		push(@p, &cut($z, 3, 6, @f));

		next if $#p < 1;
		die "BAD $#p" if $#p > 1;

		my $a = "$p[0][0] $p[0][1]";
		my $b = "$p[1][0] $p[1][1]";
		push(@{ $next{$a} }, $b);
		push(@{ $next{$b} }, $a);
#		print STDERR "$z: ($a) to ($b)\n";
	}

	while (1) {
		my @k = keys %next;

		last if $#k == -1;
		my $p0 = $k[0];
		$p = $p0;
		while (1) {
			my $next = $next{$p}[0];

			print "$p $z\n";
#			print STDERR "at $p\n";
#			print STDERR "\tnext $next\n";
			die "open path" unless defined $next;	
			&remove($p, $next);
			&remove($next, $p);
			last if $p0 eq $next;
			$p = $next;
		}
		print "$p0 $z\n";
		print "\n";
	}
}