+#!/usr/bin/perl -w
+
+use strict;
+
+our @array = <DATA>;
+
+our %c;
+
+sub defvar ($;$) {
+ my ($cv,$v) = @_;
+ $c{$cv} = $v;
+}
+
+defvar('extruderate',0.97200);
+defvar('feedrate',540);
+defvar('jerkfeedrate',7800);
+defvar('retract',4.5);
+defvar('restart',4.5);
+defvar('restartfeedrate',1800);
+defvar('retractfeedrate',1800);
+defvar('movefeedrate',7800);
+defvar('zprint');
+defvar('zmove');
+
+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 ($$) {
+ my ($start,$end) = @_;
+ foreach my $lno ($start..$end) {
+ $_ = $array[$lno];
+ if (!m/^\!/) {
+ p($_);
+ next;
+ }
+ p(";$_");
+ if (s/^\!draw\s+//) {
+ my @undefs = grep { !defined $c{$_} } qw(zprint zmove);
+ die "@undefs ?" if @undefs;
+ my @coords = split /\s+/, $_;
+ @coords = map {
+ my $jerk = s/^\*//;
+ m/\,/ or die $!;
+ [ $`, $', !!$jerk ]; # '];
+ } @coords;
+ pl("G92 E0");
+ pl("G1 F$c{movefeedrate} Z$c{zmove}");
+ pl("G1 ".coords_g($coords[0]));
+ pl("G1 Z$c{zprint}");
+ pl("G1 F$c{restartfeedrate} E$c{restart}");
+ my $lastfeedrate=-1;
+ my $extrudepos=0;
+ foreach (my $ci=1; $ci<@coords; $ci++) {
+ my $g = "G1 ".coords_g($coords[$ci]);
+ my $wantfeedrate;
+ if (!$coords[$ci][3]) {
+ $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$extrudepos");
+ pl("G1 F$c{movefeedrate} Z$c{zmove}");
+ next;
+ } elsif (m/^\!(\w+)\=(\S+)$/) {
+ die "$1 ?" unless exists $c{$1};
+ $c{$1} = $2;
+ } else {
+ die "$_ ?";
+ }
+ }
+}
+
+proc(0, scalar @array);
+
+__DATA__
+; -*- fundamental -*-