--- /dev/null
+#!/usr/bin/perl -w
+
+use strict qw(vars);
+
+use IO::File;
+
+our ($line,$indent,$command,$lbrack,$argstring,$rbrack);
+our (@a, $output_file, $accumulate);
+
+our ($xpos,$ypos,$spaces,@titles);
+our ($xmax,$ymax,$gap);
+
+sub init () {
+ $xpos=$ypos=0;
+ $xmax=0,$ymax=0;
+ $gap=500;
+
+ $spaces= '';
+ $output_file= '';
+ @titles= ();
+}
+
+sub process () {
+ my ($filename,$fn,$f,$argstring,@stack);
+ my ($q,$z);
+ @stack= ();
+ foreach $filename (@ARGV) {
+ $f = new IO::File $filename, 'r' or die $filename;
+ &beginfile__;
+ while (<$f>) {
+ next if m/^\#/;
+ next unless m/\S/;
+ $line= $_;
+ if (m/^(\s*) ( [A-Z][A-Za-z]* ) \s* ([[(]) (.*) ([])]) \s* $/x) {
+ ($indent, $command, $lbrack, $argstring, $rbrack) =
+ ($1,$2,$3,$4,$5);
+ die unless ($lbrack eq '[') == ($rbrack eq ']');
+ foreach $q (qw(' ")) {
+ $argstring =~ s/ $q ([^$q]*) $q /
+ $z= $1; $z =~ s, ,\001,g; $q.$z.$q;
+ /gxe; #"')){
+ }
+ @a= split / /, $argstring;
+#print STDERR "$argstring>".join("|",@a)."<\n";
+ map {
+ die "$_ ?" unless
+ m/^(?: (?: 0 | \-? [1-9]\d* ) (?: \. \d* )?
+ | 0x[0-9a-f]{8} | 0x[0-9a-f]{16} |
+ \" (?: \w | [-():,.] | \001 | \$ )* \" |
+ \'.\' )$/x;
+ s/\001/ /g;
+ } @a;
+ if (defined $accumulate) {
+ $accumulate .= $line;
+ } else {
+ $fn= join '__', 'op',@stack,$command;
+ &$fn;
+ }
+ } elsif (m/^ (?: \s+ \[ \-? \d+ \s+ \-? \d+ \] )+ \s* $/x) {
+ $line= $_;
+ $fn= join '__', 'polygondata',@stack;
+ &$fn;
+ } elsif (m/^ \s* \( \s* $/x) {
+ die unless defined $command;
+ push @stack, $command;
+ undef $command;
+ $fn= join '__', 'begin',@stack;
+ &$fn;
+ } elsif (m/^ \s* \) \s* $/x) {
+ $fn= join '__', 'end',@stack;
+ &$fn;
+ die unless @stack;
+ pop @stack;
+ undef $command;
+ } else {
+ die;
+ }
+ }
+ die if @stack;
+ undef $command;
+ &endfile__;
+ die if defined $accumulate;
+ $f->error and die "$filename $!";
+ close $f;
+ }
+ &endall__;
+
+ print $output_file or die $!;
+}
+
+sub transform ($;\@) {
+ my ($ix,$ar) = @_;
+ $ar= \@a unless defined $ar;
+ defined $ar->[$ix] or die;
+ defined $ar->[$ix+1] or die;
+ $ar->[$ix] += $xpos;
+ $ar->[$ix+1] += $ypos;
+}
+
+sub fromfirst () {
+ return if length $spaces;
+ copy();
+}
+sub copy () {
+ die unless defined $command;
+ $output_file .= $indent. $command. $lbrack. join(' ',@a). $rbrack. "\n";
+}
+sub copyline () {
+ $output_file .= $line;
+}
+
+our (%identical_map);
+sub identical (;$) {
+ my ($key) = @_;
+ if (!defined $key) { $key= $command; }
+ if (!exists $identical_map{$key}) {
+ $identical_map{$key}= $line;
+ copy();
+ } else {
+ die unless $identical_map{$key} eq $line;
+ }
+}
+
+our ($define_identical_key, %define_identical_map);
+sub define_identical_do () { $define_identical_key= $line; }
+sub define_identical_begin () { $accumulate=''; }
+sub define_identical_end () {
+ if (exists $define_identical_map{$define_identical_key}) {
+ die unless $define_identical_map{$define_identical_key} eq
+ $accumulate;
+ } else {
+ $define_identical_map{$define_identical_key}= $accumulate;
+ $output_file .= $define_identical_key."(\n".$accumulate.")\n";
+ }
+ undef $accumulate;
+}
+
+our (@thiscoords);
+our ($netlist_aside,$netlist_data);
+our ($layer,$layer_aside,%layer_name,%layer_data);
+
+sub beginfile__ {
+ @thiscoords= ();
+}
+sub op__PCB {
+ $a[0] =~ m/^"(.+)"$/ or die;
+ push @titles, $1;
+ die if @thiscoords;
+ @thiscoords= @a[1..2];
+ transform(0,@thiscoords);
+ $xmax= $xpos + $thiscoords[0] if $xpos + $thiscoords[0] > $xmax;
+ $ymax= $ypos + $thiscoords[0] if $ypos + $thiscoords[0] > $xmax;
+}
+sub endfile__ {
+ $ypos= $thiscoords[1] + $gap;
+ $spaces .= ' ';
+}
+
+sub op__Grid { fromfirst(); }
+sub op__Cursor { fromfirst(); }
+sub op__Thermal { identical(); }
+sub op__DRC { identical(); }
+sub op__Flags { identical(); }
+sub op__Groups { identical(); }
+sub op__Styles { fromfirst(); }
+
+sub op__Symbol { define_identical_do(); }
+sub begin__Symbol { define_identical_begin(); }
+sub end__Symbol { define_identical_end(); }
+
+sub op__Via { transform(0); copy(); }
+sub op__Element {
+ $a[2] =~ s/^\"(.*)\"/\"$1$spaces\"/ or die;
+ transform(4);
+ copy();
+}
+sub begin__Element { copyline(); }
+sub end__Element { copyline(); }
+sub op__Element__Pin { copy(); }
+sub op__Element__ElementLine { copy(); }
+sub op__Element__ElementArc { copy(); }
+
+sub op__Layer {
+ if (exists $layer_name{$a[0]}) {
+ die unless $layer_name{$a[0]} eq $a[1];
+ } else {
+ $layer_name{$a[0]}= $a[1];
+ }
+ $layer= $a[0];
+}
+sub begin_aside (\$) {
+ my ($asideref) = @_;
+ $$asideref= $output_file;
+ $output_file= '';
+}
+sub end_aside (\$) {
+ my ($asideref) = @_;
+ $output_file= $$asideref;
+ undef $$asideref;
+}
+sub begin__Layer {
+ begin_aside($layer_aside);
+}
+sub op__Layer__Line {
+ transform(0);
+ transform(2);
+ copy();
+}
+sub op__Layer__Text {
+ transform(0);
+ copy();
+}
+sub op__Layer__Arc {
+ transform(0);
+ copy();
+}
+sub op__Layer__Polygon {
+ copy();
+}
+sub begin__Layer__Polygon { copyline(); }
+sub polygondata__Layer__Polygon {
+ my (@polypoint);
+ $line =~ s/ \[ (\-?\d+) \ (\-?\d+) \] /
+ @polypoint= ($1,$2);
+ transform(0,@polypoint);
+ "[@polypoint]";
+ /egx;
+ $output_file .= $line;
+}
+sub end__Layer__Polygon { copyline(); }
+sub end__Layer {
+ $layer_data{$layer} .= $output_file;
+ end_aside($layer_aside);
+}
+
+sub op__NetList {
+ die if @a;
+}
+sub begin__NetList {
+ begin_aside($netlist_aside);
+}
+sub op__NetList__Net {
+ $a[0] =~ s/^\"(.*)\"$/\"$1$spaces\"/ or die;
+ copy();
+}
+sub begin__NetList__Net { copyline(); }
+sub op__NetList__Net__Connect {
+ $a[0] =~ s/^\"([^-]+)\-(\d+)\"$/\"$1$spaces-$2\"/ or die;
+ copy();
+}
+sub end__NetList__Net { copyline(); }
+sub end__NetList {
+ $netlist_data .= $output_file;
+ end_aside($netlist_aside);
+}
+
+sub endall__ {
+ $output_file= ('# made by pcb-panelise $Id$'."\n".
+ "PCB[\"".join('+',@titles).".pcb\" $xmax $ymax]\n".
+ $output_file);
+ foreach $layer (sort keys %layer_data) {
+ $output_file .= "Layer($layer $layer_name{$layer})\n";
+ $output_file .= "(\n";
+ $output_file .= $layer_data{$layer};
+ $output_file .= ")\n";
+ }
+ $output_file .= "NetList()\n";
+ $output_file .= "(\n";
+ $output_file .= $netlist_data;
+ $output_file .= ")\n";
+}
+
+die unless @ARGV;
+init();
+process();
~ijackson / trains.git / commitdiff