manual-gcode-generator

   1 #!/usr/bin/perl -w
   2
   3 use strict;
   4
   5 our @array;
   6 our %procs;
   7
   8 sub readdata () {
   9     my $l = '';
  10     my $current = \@array;
  11     while (<>) {
  12         chomp or die;
  13         s/\s+$//;
  14         s/^\s*\!\s*/!/;
  15         $l .= $_;
  16         next if $l =~ s/\\$//;
  17
  18         $_=$l; $l='';
  19         if (m/^\!(\w+)\s*\(\)\s*\{$/) {
  20             my $pname=$1;
  21             die if $current ne \@array;
  22             die if exists $procs{$pname};
  23             $current = $procs{$pname} = [];
  24             next;
  25         }
  26         if (m/^\!\}$/) {
  27             $current = \@array;
  28             next;
  29         }
  30         push @$current, $_;
  31     }
  32 }
  33 readdata();
  34
  35 our %c;
  36
  37 sub defvar ($;$) {
  38     my ($cv,$v) = @_;
  39     $c{$cv} = $v;
  40 }
  41
  42 defvar('extruderate',0.097200);
  43 defvar('feedrate',540);
  44 defvar('jerkfeedrate',7800);
  45 defvar('retract',4.5);
  46 defvar('restart',4.5);
  47 defvar('restartfeedrate',1800);
  48 defvar('retractfeedrate',1800);
  49 defvar('movefeedrate',7800);
  50 defvar('zlift',0.1);
  51 defvar('zprint');
  52 defvar('orgx',0);
  53 defvar('orgy',0);
  54
  55 sub float_g ($) {
  56     my ($f) = @_;
  57     return sprintf "%.5f", $f;
  58 }
  59 sub coords_g ($) {
  60     my ($coords) = @_;
  61     return "X".float_g($coords->[0])." Y".float_g($coords->[1]);
  62 }
  63
  64 sub p ($) { print "$_[0]" or die $!; }
  65 sub pl ($) { p("$_[0]\n"); }
  66
  67 sub proc ($);
  68
  69 sub proc ($) {
  70     my ($aref) = @_;
  71     local ($_);
  72     foreach (@$aref) {
  73         if (!m/^\!/) {
  74             pl($_);
  75             next;
  76         }
  77         pl(";$_");
  78         if (m/^\!(\w+)\s*\(\)$/) {
  79             my $pname = $1;
  80             die "$pname ?" unless $procs{$pname};
  81             proc($procs{$pname});
  82         } elsif (m/^\!draw\s+/) {
  83             my @coords = split /\s+/, $'; #';
  84             my @undefs = grep { !defined $c{$_} } qw(zprint);
  85             die "@undefs ?" if @undefs;
  86             @coords = map {
  87                 my $jerk = s/^\*//;
  88                 m/\,/ or die $!;
  89                 [ $`, $', !!$jerk ]; # '];
  90             } @coords;
  91             foreach my $co (@coords) {
  92                 foreach my $xy (qw(0 1)) {
  93                     my $xyv = $co->[$xy];
  94                     next unless $xyv =~ s/^\@//;
  95                     my $orgxy = ($c{orgx},$c{orgy})[$xy];
  96                     $co->[$xy] = float_g($xyv + $orgxy);
  97                 }
  98             }
  99             my $extrudepos=$c{restart};
 100             pl("G92 E0");
 101             my $zmove=$c{zprint}+$c{zlift};
 102             pl("G1 F$c{movefeedrate} Z$zmove");
 103             pl("G1 ".coords_g($coords[0]));
 104             pl("G1 Z$c{zprint}");
 105             pl("G1 F$c{restartfeedrate} E".float_g($extrudepos));
 106             my $lastfeedrate=-1;
 107             foreach (my $ci=1; $ci<@coords; $ci++) {
 108                 my $g = "G1 ".coords_g($coords[$ci]);
 109                 my $wantfeedrate;
 110                 if (!$coords[$ci][2]) {
 111                     $wantfeedrate=$c{feedrate};
 112                     my $dist = 0;
 113                     foreach my $xy (qw(0 1)) {
 114                         my $dxy = $coords[$ci][$xy] - $coords[$ci-1][$xy];
 115                         $dist += $dxy * $dxy;
 116                     }
 117                     $dist = sqrt($dist);
 118                     $extrudepos += $dist * $c{extruderate};
 119                     $g .= " E".float_g($extrudepos);
 120                 } else {
 121                     $wantfeedrate=$c{jerkfeedrate};
 122                 }
 123                 if ($wantfeedrate != $lastfeedrate) {
 124                     $g .= " F$wantfeedrate";
 125                     $lastfeedrate = $wantfeedrate;
 126                 }
 127                 pl($g);
 128             }
 129             $extrudepos -= $c{retract};
 130             pl("G1 F$c{retractfeedrate} E".float_g($extrudepos));
 131             pl("G1 F$c{movefeedrate} Z$zmove");
 132             next;
 133         } elsif (m/^\!(\w+)\=(\S+)$/) {
 134             die "$1 ?" unless exists $c{$1};
 135             $c{$1} = $2;
 136         } else {
 137             die "$_ ?";
 138         }
 139     }
 140 }
 141
 142 proc(\@array);