utils/gxyrs/gxyrs.pm

   1 #
   2 # Copyright (C) 2008 Carlos Nieves Onega
   3 # Copyright (C) 2008 other contributors
   4 #                        (see ChangeLog or SCM history for details)
   5
   6 # This file is part of gxyrs.
   7
   8 # This program is free software; you can redistribute it and/or
   9 # modify it under the terms of the GNU General Public License
  10 # as published by the Free Software Foundation; either version 2
  11 # of the License, or (at your option) any later version.
  12
  13 # This program is distributed in the hope that it will be useful,
  14 # but WITHOUT ANY WARRANTY; without even the implied warranty of
  15 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  16 # GNU General Public License for more details.
  17
  18 # You should have received a copy of the GNU General Public License
  19 # along with this program; if not, write to the Free Software
  20 # Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
  21 # 02110-1301, USA.
  22
  23 use strict;
  24 use warnings;
  25
  26 package gxyrs;
  27
  28 BEGIN {
  29         use Exporter   ();
  30         our ($VERSION, @ISA, @EXPORT, @EXPORT_OK, %EXPORT_TAGS);
  31
  32         # if using RCS/CVS, this may be preferred
  33         $VERSION = do { my @r = (q$Revision: 2.21 $ =~ /\d+/g); sprintf "%d."."%02d" x $#r, @r }; # must be all one line, for MakeMaker
  34         @ISA         = qw(Exporter);
  35         @EXPORT      = qw(&check_columns &del_line &rotate_comp &subst_col_val &change_col_units &add_number_to_col &translate_col_val @LINE &panelize_xyrs &mul_col_val &gxyrs_get_xy_transform_matrix &gxyrs_apply_xy_transform &swap_columns &insert_column);
  36         %EXPORT_TAGS = ( );     # eg: TAG => [ qw!name1 name2! ],
  37         # your exported package globals go here,
  38         # as well as any optionally exported functions
  39         @EXPORT_OK   = qw(@LINE $CASE_INSENSITIVE);
  40 }
  41
  42 use vars qw(
  43         $CASE_INSENSITIVE
  44 );
  45
  46 our @LINE ;# = ( "Package", "Filters" );
  47 #our $CASE_INSENSITIVE;
  48
  49 # Checks if a column number is a number between the specified range.
  50 #
  51 # Returns 1 if success, 0 otherwise
  52 # If error, prints an error with the function caller (passed as argument)
  53 # to STDERR
  54 sub check_column_number {
  55     my ($f_name,$number, $min, $max) = @_;
  56
  57     if ($number !~ /^[0-9]+$/ ) {
  58         print STDERR "Error: $f_name: wrong column argument: $number.\n";
  59         return 0;
  60     }
  61     # Column number must be a number within line columns number
  62     if (($number > $max) ||
  63         ($number < $min)) {
  64         print STDERR "Error: $f_name: Element number ($number) is not within ($min..$max).\n";
  65         return 0;
  66     }
  67     return 1;
  68 }
  69
  70 # This function checks if the data has the pattern specified by the checklist.
  71 # The data to be checked is in the global variable $LINE;
  72 # The check list is a list of elements. Each element is a list with two single elements specifying
  73 # the data number 'n' and the pattern. The element 'nth' of the data list should pass the pattern.
  74 # The first element of the data has the number 1.
  75 # The functions returns 1 if the data passes all the checks and 0 otherwise.
  76 #
  77 # Returns -1 if error, 0 if not match, 1 if match.
  78 #   if no argument is given, returns 1.
  79 #
  80 # Example: check_columns 2, '[0-9]+', 3, 'R[0-9]+';
  81 #   column 2 should be a number, and
  82 #   column 3 is a string beginning with R followed by a number.
  83 sub check_columns {
  84         my(@check_list) = @_;   # Check list. Each pair is (column, pattern)
  85
  86         # Pair list expected. The parameter number should be odd.
  87         if ( (@LINE == 0) || (@check_list & 1 != 0) )  { return 0 };
  88
  89         for (my $i=0; $i <= @check_list-1; $i+=2) {
  90           my($number, $pattern) = ($check_list[$i], $check_list[$i+1]);
  91           # Column number must be a number
  92           if ($number !~ /^[0-9]+$/ ) {
  93                 print STDERR "Error: check_columns: wrong column argument: $number.\n";
  94                 return -1;
  95           }
  96           # Column number must be a number within line columns number
  97           if (($number > @LINE) ||
  98              ($number <= 0)) {
  99              print STDERR "Error: Check pattern: Element number ($number) is not within (1..".(@LINE).").\n";
 100              return -1;
 101           }
 102           $number-=1;
 103
 104           if (! defined $CASE_INSENSITIVE ) {
 105                 print STDERR "Error: Check pattern: variable CASE_INSENSITIVE should be defined.\n";
 106                 print STDERR "Changing it to 0 (default).\n";
 107                 $CASE_INSENSITIVE=0;
 108           }
 109           if ($CASE_INSENSITIVE !~ /^[0,1]$/) {
 110                 print STDERR "Error: Check pattern: variable CASE_INSENSITIVE ($CASE_INSENSITIVE) should be 0 or 1.\n";
 111                 print STDERR "Changing it to 0 (default).\n";
 112                 $CASE_INSENSITIVE=0;
 113           }
 114           # Build the pattern, adding beginning and end marks.
 115           $pattern='^'.$pattern.'$';
 116
 117           # Test the pattern
 118           if ($CASE_INSENSITIVE == 1) {
 119               if (! ($LINE[$number] =~ /$pattern/i)) {
 120                   return 0; # Found one non-matching test. Return FALSE.
 121               }
 122           }
 123           else {
 124               if (! ($LINE[$number] =~ /$pattern/)) {
 125                   return 0; # Found one non-matching test. Return FALSE.
 126               }
 127           }
 128         }
 129         return 1;
 130 }
 131
 132
 133 # Delete the line (global variable @LINE) if it matches the pattern specified.
 134 # It uses check_columns for pattern matching, and if it matches,
 135 # then the line is deleted.
 136 #
 137 # Returns -1 if error, 0 if not match, 1 if match and changed.
 138 #
 139 # Example: del 2, 'R[0-9]+';
 140 #   delete all lines having a R followed by a number in column number 2.
 141 sub del_line {
 142         my (@check_list) = @_;
 143         my $rc = check_columns (@check_list);
 144         if ($rc == 1) {
 145                 splice(@LINE);
 146                 return 1;
 147         } else {
 148             return $rc;
 149         }
 150 }
 151
 152 # Rotate the component if it matches the pattern specified.
 153 # It uses check_columns for pattern matching, and if it matches,
 154 # then the component is rotated.
 155 #
 156 # Returns 1 if match and changed, 0 if not match, -1 if error.
 157 #
 158 # Example: rotate 5, 90, 2, 'R[0-9]+';
 159 #   rotate all components having a R followed by a number in column number 2,
 160 #   by 90º. Rotation angle is in column 5.
 161 sub rotate_comp {
 162         my ($angle_col, $angle, @check_list) = @_;
 163         my $rc;
 164
 165         if (! (check_column_number("rotate_comp",$angle_col, 0, scalar(@LINE)))) {
 166             return -1;
 167         }
 168
 169         if ($angle !~ /^[+-]??[0-9]*(\.[0-9]+)*$/ ) {
 170                 # Angle doesn't match the expression "number.number", where
 171                 # ".number" may not exist.
 172                 print STDERR "Error: rotate_comp: wrong angle: $angle.\n";
 173                 return -1;
 174         }
 175         $rc = check_columns (@check_list);
 176         if ($rc < 0) {
 177             return $rc;
 178         }
 179         if ($rc) {
 180                 $LINE[$angle_col-1] += $angle;
 181                 $LINE[$angle_col-1] -= 360*int($LINE[$angle_col-1] / 360) ;
 182                 return 1;
 183         }
 184         return 0;
 185 }
 186
 187 # Replace a column value if it matches the pattern specified.
 188 # It uses check_columns for pattern matching, and if it matches,
 189 # then the column is replaced.
 190 #
 191 # Returns 1 if match and changed, 0 if not match, -1 if error.
 192 #
 193 # Example: subst 3 , '100nF', 3, '0.1u';
 194 #   if the value in column 3 is "0.1u", then replace it with "100nF".
 195 #
 196 # Example: subst 2 , 'D1', 3, '1n4148';
 197 #   if the value in column 3 is "1n4148", then replace column 2 with "D1".
 198 sub subst_col_val {
 199         my ($col, $value, @check_list) = @_;
 200         my $rc;
 201
 202         if (! (check_column_number("subst_col_val",$col, 0, scalar(@LINE)))) {
 203             return -1;
 204         }
 205
 206         $rc = check_columns (@check_list);
 207         if ($rc < 0) {
 208             return $rc;
 209         }
 210         if ($rc) {
 211                 $LINE[$col-1] = $value;
 212                 return 1;
 213         }
 214         return 0;
 215 }
 216
 217 # Change units of a given text.
 218 # Returns:
 219 #   1 if match and changed,
 220 #   0 if not match,
 221 #  -1 if units not supported or wrong format.
 222 #  -2 if string to change has no units.
 223 #
 224 # Example: change_text_units 'mm', '102.40mil';
 225 #    replaces string '102.40mil' by the its equivalent in mm: '2.60096mm'
 226 #
 227 sub change_text_units {
 228     my($return_value) = 0;
 229     my($desired_units, $string) = @_; # $_[1] MUST be the string to be changed. See below.
 230
 231         # If the text has no units, warn the user.
 232         if ($string =~ /^[+-]??[0-9]*(\.[0-9]*)*$/) {
 233             print STDERR "Warning: change_text_units: Text ".$string." has no units. Leaving it as is.\n";
 234             return -2;
 235         }
 236
 237         # If it's only text, then warn the user.
 238         if ($string !~ /^[+-]??[0-9]/) {
 239             print STDERR "Warning: change_text_units: Text $string has no numbers!\n";
 240             return -2;
 241         }
 242
 243         # If it is already in the desired units, don't change it.
 244         if ($string =~ /^[+-]??[0-9]*(\.[0-9]*)*$desired_units$/) {
 245             return 0;
 246         }
 247         if ($desired_units =~ /^mm$/) {
 248             # The desired units are mm.
 249             if ($string =~ /^[+-]??[0-9]*(\.[0-9]*)*[A-Za-z]*$/) {
 250                 # The format is N.Nunits, where N is a number.
 251                 if ($string =~ /(.*)mil$/i) {
 252                     # The original units are mils (1/1000th inches).
 253                     $string = ($1*0.0254)."mm";
 254                     $_[1] = $string;
 255                     return 1;
 256                 }
 257                 elsif ($string =~ /(.*)in$/i) {
 258                     # The original units are inches.
 259                     $string = ($1*25.4)."mm";
 260                     $_[1] = $string;
 261                     return 1;
 262                 }
 263                 else {
 264                     # Units are not supported.
 265                     $_=$string;
 266                     m/([A-Za-z]*)$/;
 267                     print STDERR "Changing $string to mm: Units $1 not supported.\n";
 268                     print STDERR "Line: @LINE\n";
 269                     return -1;
 270                 }
 271             }
 272             else {
 273                 # Wrong format. It is not N.Nunits, where N is a number.
 274                 print STDERR "Error: change_text_units: Wrong format: $string.\n";
 275                 return -1;
 276             }
 277         }
 278         elsif ($desired_units =~ /^mil$/) {
 279             # The desired units are mils (1/1000th inches).
 280             if ($string =~ /^[+-]??[0-9]*(\.[0-9]*)*[A-Za-z]*$/) {
 281                 # The format is N.Nunits, where N is a number.
 282                 if ($string =~ /(.*)mm$/i) {
 283                     # The original units are mils (1/1000th inches).
 284                     $string = ($1/0.0254)."mil";
 285                     $_[1] = $string;
 286                     return 1;
 287                 }
 288                 elsif ($string =~ /(.*)in$/i) {
 289                     # The original units are inches.
 290                     $string = ($1*1000)."mm";
 291                     $_[1] = $string;
 292                     return 1;
 293                 }
 294                 else {
 295                     # Units are not supported.
 296                     $_=$string;
 297                     m/([A-Za-z]*)$/;
 298                     print STDERR "Changing to mils: Units $1 not supported.\n";
 299                     print STDERR "Line: @LINE\n";
 300                     return -1;
 301                 }
 302             }
 303             else {
 304                 # Wrong format. It is not N.Nunits, where N is a number.
 305                 print STDERR "Error: change_units: Wrong format: $string.\n";
 306                 return -1;
 307             }
 308         }
 309         else {
 310             # Desired units are not supported.
 311             print STDERR "Error: Desired units '$desired_units' not supported.\n";
 312             return -1;
 313         }
 314 }
 315
 316
 317 # Change units of a given column number.
 318 # Returns -1 if error, -2 if warning, and 1 if success.
 319 #
 320 # Example: change_units 'mm', 3, 5;
 321 #    convert all numbers in column 3 and 5 to its equivalent in mm.
 322 #
 323 sub change_col_units {
 324     my($return_value) = 0;
 325     my($value);
 326     my($changed) = 0;
 327     my($desired_units, @columns) = @_;
 328
 329     $return_value = 0;
 330     if (@columns == 0) {return 0};
 331     if (@LINE == 0) {return 0};
 332
 333     foreach $value (@columns) {
 334
 335         if (! (check_column_number("change_col_units",$value, 0, scalar(@LINE)))) {
 336             return -1;
 337         }
 338
 339         # If the column is empty, continue.
 340         if ($LINE[$value-1] =~ /^\s*$/) {next};
 341
 342         # Change the units
 343         $changed = change_text_units($desired_units, $LINE[$value-1]);
 344         if ($changed == -1) {
 345                 print STDERR "Error at column $value\n";
 346         }
 347         elsif ($changed == -2) {
 348                 print STDERR "Warning at column $value\n";
 349         }
 350
 351         # Update return value
 352         if ( ($changed == 1) && ($return_value == 0) ) {
 353                 $return_value++;
 354         }
 355         elsif ( ($changed == -2) && ($changed != -1) ) {
 356                 $return_value = -2;
 357         }
 358         elsif ($changed == -1) {
 359                 $return_value = -1;
 360         }
 361     }
 362     return $return_value;
 363 }
 364
 365
 366 # Adds a number to a value in a given column number.
 367 # Note: offset and the value to be changed can be in different units.
 368 # Returns -1 if error, -2 if warning, and 1 if success.
 369 #
 370 # Example: offset 3, '102.5mm', 4, 'R[0-9]+' ;
 371 #    if the text in column number 4 is R followed by a number, then adds
 372 #    102.5mm to the value in column 3.
 373 #    Note: Value in column 3 can be in other units. For example: '640mil'.
 374 #
 375 sub add_number_to_col {
 376     my($return_value) = 0;
 377     my($changed) = 0;
 378     my($column, $offset, @check_list) = @_;
 379     my($offset_value) = 0;
 380     my($units);
 381     my $rc;
 382
 383     $return_value = 0;
 384
 385     if (! (check_column_number("add_number_to_col",$column, 0, scalar(@LINE)))) {
 386         return -1;
 387     }
 388
 389     if (@LINE == 0) {return 0};
 390
 391     $rc = check_columns (@check_list);
 392     if ($rc < 0) {
 393         return $rc;
 394     }
 395     if ($rc) {
 396         # If the column is empty, continue.
 397         if ($LINE[$column-1] =~ /^\s*$/) {next};
 398
 399         # Guess the line's units.
 400         if ($LINE[$column-1] =~ /^[+-]??[0-9]*(\.[0-9]*)*[a-zA-Z]+$/) {
 401             if ($LINE[$column-1] =~ /^.*[0-9]+([a-zA-Z]+)$/) {
 402                 $units = $1;
 403             }
 404         }
 405         elsif ($LINE[$column-1] =~ /^[+-]??[0-9]*(\.[0-9]*)*$/) {
 406             # Line number has no units.
 407             $units = "";
 408
 409             if ($offset =~ /^[+-]??[0-9]*(\.[0-9]*)*[a-zA-Z]+$/) {
 410                 print STDERR "Error: add_number_to_col: Offset has units, but number $LINE[$column-1] has no units.\n";
 411                 return -1;
 412             }
 413         }
 414         else {
 415                 print STDERR "Error: add_number_to_col: Wrong value at column $column: $LINE[$column-1]\n";
 416                 return -1;
 417         }
 418
 419         # Change offset to line's units.
 420         if (! $units =~ /^$/) {
 421             $changed = change_text_units($units, $offset);
 422         }
 423         else {
 424             $changed = 1;
 425         }
 426
 427         # If there's an error changing the offset units, then return.
 428         if ($changed == -1 ) {
 429                 print STDERR "Error: add_number_to_col: Error with offset parameter: $offset.\n";
 430                 return -1;
 431         }
 432         elsif ($changed == -2) {
 433                 print STDERR "Warning: add_number_to_col: warning in offset parameter: $offset.\n";
 434         }
 435
 436         # Change the units
 437         $_=$offset;
 438         /(.*)$units$/i;
 439         $offset_value = $1;
 440
 441         $_=$LINE[$column-1];
 442         /(.*)$units$/i;
 443         $LINE[$column-1] = $1+$offset_value."$units";
 444
 445         # Update return value
 446         if ( ($changed == 1) && ($return_value == 0) ) {
 447                 $return_value++;
 448         }
 449         elsif ( ($changed == -2) && ($changed != -1) ) {
 450                 $return_value = -2;
 451         }
 452         elsif ($changed == -1) {
 453                 $return_value = -1;
 454         }
 455     }
 456     return $return_value;
 457 }
 458
 459 # Translate a string if it matches the pattern specified.
 460 # It uses check_columns for pattern matching, and if it matches,
 461 # then the column is replaced.
 462 #
 463 # Returns -1 if error, 0 if not match, 1 if match and changed.
 464 #
 465 # Example:
 466 #   translate 2, '^([0-9]+)n$','sprintf("%dnF",$1)', 3, 'C[0-9]+';
 467 #     if the value in column 3 is C followed by a number, then
 468 #     if the value in column 2 is a number followed by 'n', translate it
 469 #     to the same value followed by 'nF'.
 470 #     If there is 'C10' in column 3 and '10n' in column 2,
 471 #     change '10n' to '10nF'.
 472 sub translate_col_val {
 473         my($column, $string, $substitution, @checklist) = @_;
 474         my $rc;
 475
 476         if (! (check_column_number("translate_col_val",$column, 0, scalar(@LINE)))) {
 477             return -1;
 478         }
 479         if (@LINE == 0) {return 0};
 480
 481         if ( (! @checklist) || (@checklist)) {
 482             $rc = check_columns (@checklist);
 483             if ($rc <= 0) {
 484                 return $rc;
 485             }
 486             else {
 487                 if ($CASE_INSENSITIVE == 1) {
 488                     if ($LINE[$column-1] =~ s/$string/$substitution/ixee) {
 489                         return 1;
 490                     } else {
 491                         return 0;
 492                     }
 493                 }
 494                 else {
 495                     if ($LINE[$column-1] =~ s/$string/$substitution/xee) {
 496                         return 1;
 497                     } else {
 498                         return 0;
 499                     }
 500                 }
 501             }
 502         }
 503         return 0;
 504 }
 505
 506 # Panelize the list.
 507 #
 508 # Warning: this should ALWAYS be the last command in your script.
 509 sub panelize_xyrs {
 510     my ($no_x, $no_y, $AX, $AY, $X_COL, $Y_COL, $REF_COL, $REF_PATTERN) = @_;
 511     my ($i, $j);
 512     my @new_array = ();
 513     my $refdes;
 514
 515     if (! (check_column_number("panelize_xyrs", $X_COL, 0, scalar(@LINE)) &&
 516            check_column_number("panelize_xyrs", $Y_COL, 0, scalar(@LINE)) &&
 517            check_column_number("panelize_xyrs", $REF_COL, 0, scalar(@LINE)) )) {
 518         return -1;
 519     }
 520
 521     $refdes = $LINE[$REF_COL-1];
 522
 523     for ($i=0; $i<=$no_x-1; $i++) {
 524         for ($j=0; $j<=$no_y-1; $j++) {
 525             my @new_line = @LINE;
 526
 527
 528             if (length($REF_PATTERN) == 0) {
 529                 $new_line[$REF_COL-1] = $refdes."-$i-$j";
 530             }
 531             else {
 532                 $new_line[$REF_COL-1] = $refdes.$REF_PATTERN;
 533             }
 534
 535             if (($i == 0) && ($j == 0)) {
 536                 $LINE[$REF_COL-1] = $new_line[$REF_COL-1];
 537                 next;
 538             }
 539
 540             $new_line[$X_COL-1] = $LINE[$X_COL-1]+$i*$AX;
 541             $new_line[$Y_COL-1] = $LINE[$Y_COL-1]+$j*$AY;
 542
 543             unshift(@new_line, "\n");
 544             push (@new_array, @new_line);
 545
 546         }
 547     }
 548     push (@LINE, @new_array);
 549     return 1;
 550 }
 551
 552 # Multiply the number in the specified column by the given amount.
 553 #
 554 # It uses check_columns for pattern matching, and if it matches,
 555 # then the column is replaced.
 556 # The number to be multiplied may have units at the end.
 557 #
 558 # Returns -1 if error, 0 if not match, 1 if match and changed.
 559 #
 560 # Example: multiply 3, 2.5, 4, 'R[0-9]+' ;
 561 #    if the text in column number 4 is R followed by a number, then multiply
 562 #    the value in column 3 by 2.5.
 563 #    Note: Value in column 3 may have units or not. For example: '640mil'.
 564
 565 sub mul_col_val {
 566     my($string_format)='^([+-]??[0-9]*(\.[0-9]*)*)([a-zA-Z]*)$';
 567     my($column, $factor, @checklist) = @_;
 568     my $rc;
 569
 570
 571     if (! (check_column_number("mul_col_val", $column, 0, scalar(@LINE)))) {
 572         return -1;
 573     }
 574
 575     if ($factor !~ /^[+-]??[0-9]*(\.[0-9]*)*$/) {
 576         print STDERR "Error: mul_col_val: Multiplying factor is not a number.\n";
 577         return -1;
 578     }
 579
 580     $rc = check_columns (@checklist);
 581
 582     if ($rc < 0) {
 583         return $rc;
 584     }
 585     if ($rc) {
 586         if ($LINE[$column-1] =~ /$string_format/) {
 587             return translate_col_val $column, $string_format,'sprintf("%f%s", $1*'.($factor).',$3)';
 588         }
 589         else {
 590             print STDERR "Error: mul_col_val: bad number parameter ($LINE[$column-1]) passed to multiply function.\n";
 591             return -1;
 592         }
 593     }
 594
 595     return 0;
 596 }
 597
 598 # Swap two columns
 599 #
 600 # Given two column numbers, this function swaps the contents of the columns.
 601 #
 602 # Returns -1 if error, 0 if not match, 1 if match and changed.
 603 #
 604 # Example: swap_columns 3, 4, 4, 'R[0-9]+' ;
 605 #    if the text in column number 4 is R followed by a number, then
 606 #    swap columns 3 and 4.
 607 sub swap_columns {
 608     my($column1, $column2, @checklist) = @_;
 609     my $rc;
 610
 611     if (! (check_column_number("swap_columns", $column1, 0, scalar(@LINE)))) {
 612         return -1;
 613     }
 614     if (! (check_column_number("swap_columns", $column2, 0, scalar(@LINE)))) {
 615         return -1;
 616     }
 617     $rc = check_columns (@checklist);
 618
 619     if ($rc < 0) {
 620         return $rc;
 621     }
 622     if ($rc) {
 623         my $temp;
 624
 625         $temp = $LINE[$column1-1];
 626         $LINE[$column1-1]=$LINE[$column2-1];
 627         $LINE[$column2-1]=$temp;
 628
 629         return 1;
 630     }
 631
 632     return 0;
 633 }
 634
 635 # Insert a column with the given text in the given position
 636 #
 637 # Insert a column in the given position (0 if it's going to be the
 638 # first column), with the given value.
 639 #
 640 # Returns -1 if error, 0 if not match, 1 if match and changed.
 641 #
 642 # Example: insert_column 0, 'new_column_value';
 643 #    insert a column in the first position. Column value is 'new_column_value'
 644 sub insert_column {
 645     my($column1, $value) = @_;
 646
 647     if (! (check_column_number("insert_column", $column1, 0, scalar(@LINE)))) {
 648         return -1;
 649     }
 650
 651     splice @LINE,$column1,$#LINE-$column1,($value,@LINE[$column1..($#LINE+-1)]);
 652
 653     return 1;
 654 }
 655
 656 END { }
 657
 658 1;