chiark / gitweb /
fairphone-case: make catch catchier
[reprap-play.git] / 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);