+#!/usr/bin/perl -w
+
+use strict;
+
+our @array;
+our %procs;
+
+sub readdata () {
+ my $l = '';
+ my $current = \@array;
+ while (<>) {
+ chomp or die;
+ s/\s+$//;
+ s/^\!\s*/!/;
+ $l .= $_;
+ next if $l =~ s/\\$//;
+
+ $_=$l; $l='';
+ if (m/^\!(\w+)\s*\(\)\s*\{$/) {
+ my $pname=$1;
+ die if $current ne \@array;
+ die if exists $procs{$pname};
+ $current = $procs{$pname} = [];
+ next;
+ }
+ if (m/^\!\}$/) {
+ $current = \@array;
+ next;
+ }
+ push @$current, $_;
+ }
+}
+readdata();
+
+our %c;
+
+sub defvar ($;$) {
+ my ($cv,$v) = @_;
+ $c{$cv} = $v;
+}
+
+defvar('extruderate',0.097200);
+defvar('feedrate',540);
+defvar('jerkfeedrate',7800);
+defvar('retract',4.5);
+defvar('restart',4.5);
+defvar('restartfeedrate',1800);
+defvar('retractfeedrate',1800);
+defvar('movefeedrate',7800);
+defvar('zlift',0.1);
+defvar('zprint');
+
+sub float_g ($) {
+ my ($f) = @_;
+ return sprintf "%.5f", $f;
+}
+sub coords_g ($) {
+ my ($coords) = @_;
+ return "X".float_g($coords->[0])." Y".float_g($coords->[1]);
+}
+
+sub p ($) { print "$_[0]" or die $!; }
+sub pl ($) { p("$_[0]\n"); }
+
+sub proc ($);
+
+sub proc ($) {
+ my ($aref) = @_;
+ local ($_);
+ foreach (@$aref) {
+ if (!m/^\!/) {
+ pl($_);
+ next;
+ }
+ pl(";$_");
+ if (m/^\!(\w+)\s*\(\)$/) {
+ my $pname = $1;
+ die "$pname ?" unless $procs{$pname};
+ proc($procs{$pname});
+ } elsif (m/^\!draw\s+/) {
+ my @coords = split /\s+/, $';
+ my @undefs = grep { !defined $c{$_} } qw(zprint);
+ die "@undefs ?" if @undefs;
+ @coords = map {
+ my $jerk = s/^\*//;
+ m/\,/ or die $!;
+ [ $`, $', !!$jerk ]; # '];
+ } @coords;
+ my $extrudepos=$c{restart};
+ pl("G92 E0");
+ my $zmove=$c{zprint}+$c{zlift};
+ pl("G1 F$c{movefeedrate} Z$zmove");
+ pl("G1 ".coords_g($coords[0]));
+ pl("G1 Z$c{zprint}");
+ pl("G1 F$c{restartfeedrate} E".float_g($extrudepos));
+ my $lastfeedrate=-1;
+ foreach (my $ci=1; $ci<@coords; $ci++) {
+ my $g = "G1 ".coords_g($coords[$ci]);
+ my $wantfeedrate;
+ if (!$coords[$ci][2]) {
+ $wantfeedrate=$c{feedrate};
+ my $dist = 0;
+ foreach my $xy (qw(0 1)) {
+ my $dxy = $coords[$ci][$xy] - $coords[$ci-1][$xy];
+ $dist += $dxy * $dxy;
+ }
+ $dist = sqrt($dist);
+ $extrudepos += $dist * $c{extruderate};
+ $g .= " E".float_g($extrudepos);
+ } else {
+ $wantfeedrate=$c{jerkfeedrate};
+ }
+ if ($wantfeedrate != $lastfeedrate) {
+ $g .= " F$wantfeedrate";
+ $lastfeedrate = $wantfeedrate;
+ }
+ pl($g);
+ }
+ $extrudepos -= $c{retract};
+ pl("G1 F$c{retractfeedrate} E".float_g($extrudepos));
+ pl("G1 F$c{movefeedrate} Z$zmove");
+ next;
+ } elsif (m/^\!(\w+)\=(\S+)$/) {
+ die "$1 ?" unless exists $c{$1};
+ $c{$1} = $2;
+ } else {
+ die "$_ ?";
+ }
+ }
+}
+
+proc(\@array);