pcb/pcb-panelise

   1 #!/usr/bin/perl -w
   2 #
   3 # Panelises PCB layouts
   4 #
   5 # Usage:
   6 #       pcb-panelise [options] layout1.pcb layout2.pcb ...
   7 #
   8 # Options:
   9 #      -gTHOU   set inter-board gap to THOU
  10 #               (should occur _before_ the board which _precedes_ the
  11 #               gap, and then affects all later gaps)
  12 #
  13 # Layouts are currently simply placed parallel from top to bottom.
  14 # Making it put them somewhere else wouldn't be _too_ hard; basically,
  15 # make an option for the user to specify xpos and ypos between layouts.
  16 #
  17 # Rotation will be slightly more difficult and will involve a careful
  18 # review of Stuff, to see where additional transformations etc. are needed.
  19 # It might be eaiser to use pcb to rotate the boards.
  20 #
  21 # We use a trick to make net and element names unique: we append
  22 # spaces to the names in the 2nd and subsequent boards.  This seems to
  23 # work fine in pcb snapshot 1.99.20040530-0.0.1 but means that
  24 #   - you mustn't feed this program's output to itself!
  25 #   - you probably don't want to edit the output (but you didn't
  26 #     edit output files anyway, did you?)
  27 #
  28 # On the other hand, pcb's builtin netlist correspondence checker and
  29 # DRC system ought to work properly.
  30
  31 use strict qw(vars);
  32
  33 use IO::File;
  34
  35 our ($line,$indent,$command,$lbrack,$rbrack);
  36 our (@a, $output_file, $accumulate);
  37
  38 our ($xpos,$ypos,$spaces,@titles);
  39 our ($xmax,$ymax,$gap);
  40 our ($cutlinewidth,$idstring_size);
  41
  42 sub init () {
  43     $xpos=$ypos=0;
  44     $xmax=0,$ymax=0;
  45
  46     # 100s of thou like in PCB
  47     $gap=20000;
  48     $cutlinewidth=800;
  49     $idstring_size=100;
  50
  51     $spaces= '';
  52     $output_file= '';
  53     @titles= ();
  54 }
  55
  56 sub process () {
  57     my ($filename,$fn,$f,$argstring,@stack);
  58     my ($q,$z);
  59     @stack= ();
  60     foreach $filename (@ARGV) {
  61         if ($filename =~ m/^\-g(\d+)$/) {
  62             $gap= $1 * 100;
  63             next;
  64         } elsif ($filename =~ m/^\-/) {
  65             die "$filename ?";
  66         }
  67         $f = new IO::File $filename, 'r' or die $filename;
  68         &beginfile__;
  69         while (<$f>) {
  70             next if m/^\#/;
  71             next unless m/\S/;
  72             $line= $_;
  73             if (m/^(\s*) ( [A-Z][A-Za-z]* ) \s* ([[(]) (.*) ([])]) \s* $/x) {
  74                 ($indent, $command, $lbrack, $argstring, $rbrack) =
  75                     ($1,$2,$3,$4,$5);
  76                 die unless ($lbrack eq '[') == ($rbrack eq ']');
  77                 foreach $q (qw(' ")) {
  78                     $argstring =~ s/ $q ([^$q]*) $q /
  79                         $z= $1; $z =~ s, ,\001,g; $q.$z.$q;
  80                     /gxe; #"')){
  81                 }
  82                 @a= split / /, $argstring;
  83 #print STDERR "$argstring>".join("|",@a)."<\n";
  84                 map {
  85                     die "$_ ?" unless
  86                         m/^(?: \-? (?: 0 | [1-9]\d* ) (?: \. \d* )?
  87                             | 0x[0-9a-f]{8} | 0x[0-9a-f]{16} |
  88                             \" (?: \w | [-():,.] | \001 | \$ )* \" |
  89                             \'.\' )$/x;
  90                     s/\001/ /g;
  91                 } @a;
  92                 if (defined $accumulate) {
  93                     $accumulate .= $line;
  94                 } else {
  95                     $fn= join '__', 'op',@stack,$command;
  96                     &$fn;
  97                 }
  98             } elsif (m/^ (?: \s+ \[ \-? \d+ \s+ \-? \d+ \] )+ \s* $/x) {
  99                 $line= $_;
 100                 $fn= join '__', 'polygondata',@stack;
 101                 &$fn;
 102             } elsif (m/^ \s* \( \s* $/x) {
 103                 die unless defined $command;
 104                 push @stack, $command;
 105                 undef $command;
 106                 $fn= join '__', 'begin',@stack;
 107                 &$fn;
 108             } elsif (m/^ \s* \) \s* $/x) {
 109                 $fn= join '__', 'end',@stack;
 110                 &$fn;
 111                 die unless @stack;
 112                 pop @stack;
 113                 undef $command;
 114             } else {
 115                 die;
 116             }
 117         }
 118         die if @stack;
 119         undef $command;
 120         &endfile__;
 121         die if defined $accumulate;
 122         $f->error and die "$filename $!";
 123         close $f;
 124     }
 125     &endall__;
 126
 127     print $output_file or die $!;
 128 }
 129
 130 sub transform ($;\@) {
 131     my ($ix,$ar) = @_;
 132     $ar= \@a unless defined $ar;
 133     defined $ar->[$ix] or die;
 134     defined $ar->[$ix+1] or die;
 135     $ar->[$ix] += $xpos;
 136     $ar->[$ix+1] += $ypos;
 137 }
 138
 139 sub fromfirst () {
 140     return if length $spaces;
 141     copy();
 142 }
 143 sub copy () {
 144     die unless defined $command;
 145     $output_file .= $indent. $command. $lbrack. join(' ',@a). $rbrack. "\n";
 146 }
 147 sub copyline () {
 148     $output_file .= $line;
 149 }
 150
 151 our (%identical_map);
 152 sub identical (;$) {
 153     my ($key) = @_;
 154     if (!defined $key) { $key= $command; }
 155     if (!exists $identical_map{$key}) {
 156         $identical_map{$key}= $line;
 157         copy();
 158     } else {
 159         die unless $identical_map{$key} eq $line;
 160     }
 161 }
 162
 163 our ($define_identical_key, %define_identical_map);
 164 sub define_identical_do () { $define_identical_key= $line; }
 165 sub define_identical_begin () { $accumulate=''; }
 166 sub define_identical_end () {
 167     if (exists $define_identical_map{$define_identical_key}) {
 168         die unless $define_identical_map{$define_identical_key} eq
 169             $accumulate;
 170     } else {
 171         $define_identical_map{$define_identical_key}= $accumulate;
 172         $output_file .= $define_identical_key."(\n".$accumulate.")\n";
 173     }
 174     undef $accumulate;
 175 }
 176
 177 our (@thisextent, @last_horizline);
 178 our ($netlist_aside,$netlist_data);
 179 our ($layer,$layer_aside,%layer_name,%layer_data);
 180
 181 sub horizline {
 182     my ($xlhs,$xrhs,$y) = @_;
 183     $layer_data{10} .= "\tLine[".
 184         "$xlhs $y $xrhs $y $cutlinewidth 0 0x00000020".
 185             "]\n";
 186 }
 187
 188 sub beginfile__ {
 189     @thisextent= ();
 190     if (@last_horizline) { horizline(@last_horizline); }
 191 }
 192 sub op__PCB {
 193     $a[0] =~ m/^"(.+)"$/ or die;
 194     push @titles, $1;
 195     die if @thisextent;
 196     @thisextent= @a[1..2];
 197     transform(0,@thisextent);
 198     $xmax= $xpos + $thisextent[0] if $xpos + $thisextent[0] > $xmax;
 199     $ymax=         $thisextent[1] if         $thisextent[1] > $ymax;
 200     if (length $spaces) { horizline($xpos,$thisextent[0],$ypos); }
 201 }
 202 sub endfile__ {
 203     if (@ARGV) {
 204         @last_horizline= ($xpos,$thisextent[0],$thisextent[1]);
 205         if ($idstring_size && !length $spaces) {
 206             $layer_data{10} .= sprintf
 207                 ("\tText[%d %d %d %d \"%s\" 0x%08lx]",
 208                  $xpos+$gap, $thisextent[1] + $idstring_size * 10,
 209                  0, $idstring_size, 'assembled by '.
 210                  '$Id$',
 211                  0); #');
 212         }
 213     }
 214     $ypos= $thisextent[1] + $gap;
 215     $spaces .= ' ';
 216 }
 217
 218 sub op__Grid { fromfirst(); }
 219 sub op__Cursor { fromfirst(); }
 220 sub op__Thermal { identical(); }
 221 sub op__DRC { identical(); }
 222 sub op__Flags { identical(); }
 223 sub op__Groups { identical(); }
 224 sub op__Styles { fromfirst(); }
 225
 226 sub op__Symbol { define_identical_do(); }
 227 sub begin__Symbol { define_identical_begin(); }
 228 sub end__Symbol { define_identical_end(); }
 229
 230 sub op__Via { transform(0); copy(); }
 231 sub op__Element {
 232     $a[2] =~ s/^\"(.*)\"/\"$1$spaces\"/ or die;
 233     transform(4);
 234     copy();
 235 }
 236 sub begin__Element { copyline(); }
 237 sub end__Element { copyline(); }
 238 sub op__Element__Pin { copy(); }
 239 sub op__Element__ElementLine { copy(); }
 240 sub op__Element__ElementArc { copy(); }
 241
 242 sub op__Layer {
 243     if (exists $layer_name{$a[0]}) {
 244         die unless $layer_name{$a[0]} eq $a[1];
 245     } else {
 246         $layer_name{$a[0]}= $a[1];
 247     }
 248     $layer= $a[0];
 249 }
 250 sub begin_aside (\$) {
 251     my ($asideref) = @_;
 252     $$asideref= $output_file;
 253     $output_file= '';
 254 }
 255 sub end_aside (\$) {
 256     my ($asideref) = @_;
 257     $output_file= $$asideref;
 258     undef $$asideref;
 259 }
 260 sub begin__Layer {
 261     begin_aside($layer_aside);
 262 }
 263 sub op__Layer__Line {
 264     transform(0);
 265     transform(2);
 266     copy();
 267 }
 268 sub op__Layer__Text {
 269     transform(0);
 270     copy();
 271 }
 272 sub op__Layer__Arc {
 273     transform(0);
 274     copy();
 275 }
 276 sub op__Layer__Polygon {
 277     copy();
 278 }
 279 sub begin__Layer__Polygon { copyline(); }
 280 sub polygondata__Layer__Polygon {
 281     my (@polypoint);
 282     $line =~ s/ \[ (\-?\d+) \ (\-?\d+) \] /
 283         @polypoint= ($1,$2);
 284         transform(0,@polypoint);
 285         "[@polypoint]";
 286         /egx;
 287     $output_file .= $line;
 288 }
 289 sub end__Layer__Polygon { copyline(); }
 290 sub end__Layer {
 291     $layer_data{$layer} .= $output_file;
 292     end_aside($layer_aside);
 293 }
 294
 295 sub op__NetList {
 296     die if @a;
 297 }
 298 sub begin__NetList {
 299     begin_aside($netlist_aside);
 300 }
 301 sub op__NetList__Net {
 302     $a[0] =~ s/^\"(.*)\"$/\"$1$spaces\"/ or die;
 303     copy();
 304 }
 305 sub begin__NetList__Net { copyline(); }
 306 sub op__NetList__Net__Connect {
 307     $a[0] =~ s/^\"([^-]+)\-(\d+)\"$/\"$1$spaces-$2\"/ or die;
 308     copy();
 309 }
 310 sub end__NetList__Net { copyline(); }
 311 sub end__NetList {
 312     $netlist_data .= $output_file;
 313     end_aside($netlist_aside);
 314 }
 315
 316 sub endall__ {
 317     $output_file= ('# made by pcb-panelise $Id$'."\n".
 318                    "PCB[\"".join('+',@titles).".pcb\" $xmax $ymax]\n".
 319                    $output_file);
 320     foreach $layer (sort keys %layer_data) {
 321         $output_file .= "Layer($layer $layer_name{$layer})\n";
 322         $output_file .= "(\n";
 323         $output_file .= $layer_data{$layer};
 324         $output_file .= ")\n";
 325     }
 326     $output_file .= "NetList()\n";
 327     $output_file .= "(\n";
 328     $output_file .= $netlist_data;
 329     $output_file .= ")\n";
 330 }
 331
 332 die unless @ARGV;
 333 init();
 334 process();