#!/usr/bin/perl # # fped2stl.pl - Convert fped 2D stacks to STL meshes # # Written 2013 by Werner Almesberger # Copyright 2013 Werner Almesberger # # This program is free software; you can redistribute it and/or modify # it under the terms of the GNU General Public License as published by # the Free Software Foundation; either version 2 of the License, or # (at your option) any later version. # use POSIX; sub usage { print STDERR "usage: $0 [-x] [-y] prefix [file ...]\n\n"; exit(1); } sub flush { local ($name, $z, $z1, $s) = @_; return unless defined $s; $z = sprintf("%e", $z); $z1 = sprintf("%e", $z1); print STDERR "$name $z ...\n"; $^F = 20; pipe SR, SW; pipe RR, RW; $pid = fork(); if (!$pid) { close SW; close RR; $sn = fileno SR; $rn = fileno RW; open(PIPE, "|cameo >/dev/fd/$rn") || die "cameo: $!"; print PIPE "gnuplot 0mm /dev/fd/$sn\n"; print PIPE "stl\n"; close PIPE; exit; } close SR; close RW; print SW $s; close SW; while () { s/cameo/$name/; s/(vertex.*)0\.0*e\+00$/$1$z/ || s/(vertex.*)1\.0*e\+00$/$1$z1/; print; } close RR; } while ($ARGV[0] =~ /^-/) { if ($ARGV[0] == "-x") { $flip_x = 1; } elsif ($ARGV[0] == "-y") { $flip_y = 1; } elsif ($ARGV[0] =~ /^-[^0-9]/) { last; } else { &usage; } shift; } $pfx = shift @ARGV; &usage unless defined $pfx; $skip = 1; while (<>) { if (/^# $pfx(.*?)-(\d+(\.\d*)?)\s*$/) { $z = $2; $name{$z} = $1; undef $s{$z}; $skip = 0; } elsif (/^# /) { $skip = 1; } next if $skip; next if /^#/; $s{$z} .= $_; if (/^(-?[0-9]*\.[0-9]*)\s+(-?[0-9]*\.[0-9]*)/) { $xmin = $1 if $1 < $xmin || !defined $xmin; $xmax = $1 if $1 > $xmax || !defined $xmax; $ymin = $2 if $2 < $ymin || !defined $ymin; $ymax = $2 if $2 > $ymax || !defined $ymax; } } for $z (keys %s) { undef $t; for $s (split(/\n/, $s{$z})) { if ($s =~ /^(-?[0-9]*\.[0-9]*)\s+(-?[0-9]*\.[0-9]*)/) { $s = (($xmax+$xmin)/2-$1)." $2" if $flip_y; # re-scan, so that we can flip on both axes die unless $s =~ /^(-?[0-9]*\.[0-9]*)\s+(-?[0-9]*\.[0-9]*)/; $s = "$1 ".(($ymax+$ymin)/2-$2) if $flip_x; } $t .= "$s\n"; } $s{$z} = $t; } undef $last; for $z (sort { $b <=> $a } keys %s) { &flush($name{$last}, $last, $z, $s{$last}) if defined $last; $last = $z; } &flush($name{$last}, $last, 0, $s{$last});