#!/usr/bin/perl -w

use strict;

our @array;
our %procs;

sub readdata () {
    my $l = '';
    my $current = \@array;
    while (<DATA>) {
	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);

__DATA__
; -*- fundamental -*-

; layer_height = 0.4
; perimeters = 3
; solid_layers = 3
; fill_density = 0.4
; perimeter_speed = 30
; infill_speed = 60
; travel_speed = 130
; scale = 1
; nozzle_diameter = 0.59
; filament_diameter = 1.77
; extrusion_multiplier = 1
; single wall width = 0.71mm
; first layer single wall width = 0.60mm

M190 S65 ; wait for bed temperature to be reached
M104 S215 ; set temperature
G28 ; home all axes
M109 S215 ; wait for temperature to be reached
G90 ; use absolute coordinates
G21 ; set units to millimeters
G92 E0
M82 ; use absolute distances for extrusion

!zprint=0.4

!draw 10,10 100,10 102,12 102,14 100,16 10,16

!layer(){
!draw 68.498,79.498 \
71.502,79.498 \
71.502,82.502 \
68.498,82.502 \
68.498,79.588 \
*67.899,78.899 \
72.101,78.899 \
72.101,83.101 \
67.899,83.101 \
67.899,78.989 \
*67.300,78.300 \
72.700,78.300 \
72.700,83.700 \
67.300,83.700 \
67.300,78.390 \

!}

!layer()

M104 S210 ; set temperature
M140 S60 ; set bed temperature

!zprint=0.8
!layer()

M83 ; extruder relative
G1 F1000 ;1000mm/min extrusion
G1 E-10; retract
G1 F240 ;240mm/min vertical move
G1 Z70
G28 X0 Y0 ; home X and Y axis
M104 S0 ; turn off temperature
M140 S0 ; turn off bed
M84     ; disable motors