sl2/: standalone slicer (WIP)

sfc/slicer.py has troubles with artefacts. It seems that we can do much
better by avoiding the high-level operations and doing all the slicing
"manually".

sl2/README

@@ -0,0 +1,8 @@
+Yet another slicer. This one picks up the idea from sfc/slicer.py but
+implements it without using FreeCAD. The FreeCAD-based solution turned
+out to produce weird artefacts for some reason, e.g., open paths that
+were then falsely closed and yielded bogus toolpaths.
+
+This slicer uses very strict conditions for horizontality: all the
+points of a horizontal facet must have identical Z coordinates. It
+also implicitly ensures that all paths are closed.

sl2/slicer.pl

@@ -0,0 +1,123 @@
+#!/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";
+	}
+}