File Coverage

blib/lib/GDS2.pm
Criterion Covered Total %
statement 834 1866 44.6
branch 267 864 30.9
condition 78 234 33.3
subroutine 106 253 41.9
pod 130 172 75.5
total 1415 3389 41.7


line stmt bran cond sub pod time code
1             package GDS2;
2             {
3             require 5.008001;
4             $GDS2::VERSION = '3.33';
5             ## Note: '@ ( # )' used by the what command E.g. what GDS2.pm
6             $GDS2::revision = '@(#) $Id: GDS2.pm,v $ $Revision: 3.33 $ $Date: 2014-09-15 03:27:57-06 $';
7             #
8              
9             =pod
10              
11             =head1 NAME
12              
13             GDS2 - GDS2 stream module
14              
15             =head1 SYNOPSIS
16              
17             This is GDS2, a module for creating programs to read and/or write GDS2 files.
18              
19             Send feedback/suggestions to
20             perl -le '$_=q(Zpbhgnpe@pvnt.uxa);$_=~tr/n-sa-gt-zh-mZ/a-zS/;print;'
21              
22             =head1 COPYRIGHT
23              
24             Author: Ken Schumack (c) 1999-2014. All rights reserved.
25             This module is free software. It may be used, redistributed
26             and/or modified under the terms of the Perl Artistic License.
27             ( see http://www.perl.com/pub/a/language/misc/Artistic.html )
28             Have fun, Ken
29              
30             =head1 DESCRIPTION
31              
32             GDS2 allows you to read and write GDS2 files record by record in a
33             stream fashion which inherently uses little memory. It is capable but
34             not fast. If you have large files you may be happier using
35             http://sourceforge.net/projects/gds2/
36              
37             =cut
38              
39             #
40             # Contributor Modification: Toby Schaffer 2004-01-21
41             # returnUnitsAsArray() added which returns user units and database
42             # units as a 2 element array.
43             #
44             # Contributor Modification: Peter Baumbach 2002-01-11
45             # returnRecordAsPerl() was created to facilitate the creation of
46             # parameterized gds2 data with perl. -Years later Andreas Pawlak
47             # pointed out a endian problem that needed to be addressed.
48             #
49             # POD documentation is sprinkled throughout the file in an
50             # attempt at Literate Programming style (which Perl partly supports ...
51             # see http://www.literateprogramming.com/ )
52             # Search for the strings '=head' or run perldoc on this file.
53              
54             # You can run this file through either pod2man or pod2html to produce
55             # documentation in manual or html file format
56              
57 6     6   6632 use strict;
  6         8  
  6         231  
58 6     6   24 use warnings;
  6         9  
  6         191  
59             BEGIN
60 6     6   164 {
61 6     6   30 use constant TRUE => 1;
  6         18  
  6         450  
62 6     6   39 use constant FALSE => 0;
  6         7  
  6         279  
63 6     6   23 use constant UNKNOWN => -1;
  6         5  
  6         269  
64              
65 6     6   20 use constant HAVE_FLOCK => TRUE; ## some systems still may not have this...manually change
  6         7  
  6         211  
66 6     6   24 use Config;
  6         6  
  6         238  
67 6     6   3068 use IO::File;
  6         47167  
  6         533  
68             }
69              
70             if (HAVE_FLOCK)
71             {
72 6     6   79 use Fcntl q(:flock); # import LOCK_* constants
  6         10  
  6         775  
73             }
74              
75 6     6   27 no strict qw( refs );
  6         7  
  6         415  
76              
77             my $isLittleEndian = FALSE; #default - was developed on a BigEndian machine
78             $isLittleEndian = TRUE if ($Config{'byteorder'} =~ m/^1/); ## Linux mswin32 cygwin vms
79              
80             ################################################################################
81             ## GDS2 STREAM RECORD DATATYPES
82 6     6   26 use constant NO_REC_DATA => 0;
  6         7  
  6         315  
83 6     6   23 use constant BIT_ARRAY => 1;
  6         6  
  6         239  
84 6     6   21 use constant INTEGER_2 => 2;
  6         8  
  6         212  
85 6     6   25 use constant INTEGER_4 => 3;
  6         6  
  6         215  
86 6     6   22 use constant REAL_4 => 4; ## NOT supported, should not be found in any GDS2
  6         6  
  6         189  
87 6     6   18 use constant REAL_8 => 5;
  6         7  
  6         173  
88 6     6   20 use constant ACSII_STRING => 6;
  6         4  
  6         185  
89             ################################################################################
90              
91             ################################################################################
92             ## GDS2 STREAM RECORD TYPES
93 6     6   19 use constant HEADER => 0; ## 2-byte Signed Integer
  6         6  
  6         164  
94 6     6   19 use constant BGNLIB => 1; ## 2-byte Signed Integer
  6         6  
  6         190  
95 6     6   21 use constant LIBNAME => 2; ## ASCII String
  6         9  
  6         229  
96 6     6   26 use constant UNITS => 3; ## 8-byte Real
  6         9  
  6         223  
97 6     6   21 use constant ENDLIB => 4; ## no data present
  6         8  
  6         185  
98 6     6   18 use constant BGNSTR => 5; ## 2-byte Signed Integer
  6         9  
  6         226  
99 6     6   22 use constant STRNAME => 6; ## ASCII String
  6         8  
  6         241  
100 6     6   24 use constant ENDSTR => 7; ## no data present
  6         4  
  6         201  
101 6     6   22 use constant BOUNDARY => 8; ## no data present
  6         7  
  6         184  
102 6     6   20 use constant PATH => 9; ## no data present
  6         6  
  6         185  
103 6     6   18 use constant SREF => 10; ## no data present
  6         6  
  6         213  
104 6     6   30 use constant AREF => 11; ## no data present
  6         16  
  6         196  
105 6     6   20 use constant TEXT => 12; ## no data present
  6         6  
  6         169  
106 6     6   80 use constant LAYER => 13; ## 2-byte Signed Integer
  6         8  
  6         191  
107 6     6   20 use constant DATATYPE => 14; ## 2-byte Signed Integer
  6         7  
  6         178  
108 6     6   19 use constant WIDTH => 15; ## 4-byte Signed Integer
  6         3  
  6         191  
109 6     6   24 use constant XY => 16; ## 2-byte Signed Integer
  6         8  
  6         222  
110 6     6   25 use constant ENDEL => 17; ## no data present
  6         6  
  6         258  
111 6     6   22 use constant SNAME => 18; ## ASCII String
  6         7  
  6         230  
112 6     6   28 use constant COLROW => 19; ## 2 2-byte Signed Integer
  6         10  
  6         199  
113 6     6   19 use constant TEXTNODE => 20; ## no data present
  6         6  
  6         192  
114 6     6   22 use constant NODE => 21; ## no data present
  6         13  
  6         214  
115 6     6   24 use constant TEXTTYPE => 22; ## 2-byte Signed Integer
  6         16  
  6         249  
116 6     6   22 use constant PRESENTATION => 23; ## Bit Array
  6         8  
  6         242  
117 6     6   21 use constant SPACING => 24; ## discontinued
  6         7  
  6         187  
118 6     6   22 use constant STRING => 25; ## ASCII String
  6         8  
  6         235  
119 6     6   20 use constant STRANS => 26; ## Bit Array
  6         7  
  6         204  
120 6     6   19 use constant MAG => 27; ## 8-byte Real
  6         6  
  6         202  
121 6     6   20 use constant ANGLE => 28; ## 8-byte Real
  6         6  
  6         170  
122 6     6   17 use constant UINTEGER => 29; ## UNKNOWN User int, used only in Calma V2.0
  6         6  
  6         186  
123 6     6   19 use constant USTRING => 30; ## UNKNOWN User string, used only in Calma V2.0
  6         8  
  6         183  
124 6     6   24 use constant REFLIBS => 31; ## ASCII String
  6         6  
  6         219  
125 6     6   21 use constant FONTS => 32; ## ASCII String
  6         6  
  6         202  
126 6     6   23 use constant PATHTYPE => 33; ## 2-byte Signed Integer
  6         10  
  6         214  
127 6     6   30 use constant GENERATIONS => 34; ## 2-byte Signed Integer
  6         12  
  6         204  
128 6     6   19 use constant ATTRTABLE => 35; ## ASCII String
  6         6  
  6         178  
129 6     6   19 use constant STYPTABLE => 36; ## ASCII String "Unreleased feature"
  6         6  
  6         172  
130 6     6   19 use constant STRTYPE => 37; ## 2-byte Signed Integer "Unreleased feature"
  6         5  
  6         185  
131 6     6   19 use constant EFLAGS => 38; ## BIT_ARRAY Flags for template and exterior data. bits 15 to 0, l to r 0=template,
  6         5  
  6         230  
132             ## 1=external data, others unused
133 6     6   20 use constant ELKEY => 39; ## INTEGER_4 "Unreleased feature"
  6         7  
  6         216  
134 6     6   20 use constant LINKTYPE => 40; ## UNKNOWN "Unreleased feature"
  6         6  
  6         214  
135 6     6   23 use constant LINKKEYS => 41; ## UNKNOWN "Unreleased feature"
  6         14  
  6         326  
136 6     6   27 use constant NODETYPE => 42; ## INTEGER_2 Nodetype specification. On Calma this could be 0 to 63, GDSII allows 0 to 255.
  6         7  
  6         260  
137             ## Of course a 2 byte integer allows up to 65535...
138 6     6   25 use constant PROPATTR => 43; ## INTEGER_2 Property number.
  6         5  
  6         229  
139 6     6   22 use constant PROPVALUE => 44; ## STRING Property value. On GDSII, 128 characters max, unless an SREF, AREF, or NODE,
  6         6  
  6         180  
140             ## which may have 512 characters.
141 6     6   25 use constant BOX => 45; ## NO_DATA The beginning of a BOX element.
  6         4  
  6         205  
142 6     6   22 use constant BOXTYPE => 46; ## INTEGER_2 Boxtype specification.
  6         8  
  6         194  
143 6     6   25 use constant PLEX => 47; ## INTEGER_4 Plex number and plexhead flag. The least significant bit of the most significant
  6         9  
  6         224  
144             ## byte is the plexhead flag.
145 6     6   22 use constant BGNEXTN => 48; ## INTEGER_4 Path extension beginning for pathtype 4 in Calma CustomPlus. In database units,
  6         5  
  6         213  
146             ## may be negative.
147 6     6   23 use constant ENDEXTN => 49; ## INTEGER_4 Path extension end for pathtype 4 in Calma CustomPlus. In database units, may be negative.
  6         7  
  6         275  
148 6     6   24 use constant TAPENUM => 50; ## INTEGER_2 Tape number for multi-reel stream file.
  6         7  
  6         205  
149 6     6   20 use constant TAPECODE => 51; ## INTEGER_2 Tape code to verify that the reel is from the proper set. 12 bytes that are
  6         6  
  6         186  
150             ## supposed to form a unique tape code.
151 6     6   18 use constant STRCLASS => 52; ## BIT_ARRAY Calma use only.
  6         6  
  6         172  
152 6     6   21 use constant RESERVED => 53; ## INTEGER_4 Used to be NUMTYPES per Calma GDSII Stream Format Manual, v6.0.
  6         5  
  6         225  
153 6     6   23 use constant FORMAT => 54; ## INTEGER_2 Archive or Filtered flag. 0: Archive 1: filtered
  6         10  
  6         186  
154 6     6   19 use constant MASK => 55; ## STRING Only in filtered streams. Layers and datatypes used for mask in a filtered
  6         6  
  6         364  
155             ## stream file. A string giving ranges of layers and datatypes separated by a semicolon.
156             ## There may be more than one mask in a stream file.
157 6     6   23 use constant ENDMASKS => 56; ## NO_DATA The end of mask descriptions.
  6         6  
  6         188  
158 6     6   23 use constant LIBDIRSIZE => 57; ## INTEGER_2 Number of pages in library director, a GDSII thing, it seems to have only been
  6         14  
  6         205  
159             ## used when Calma INFORM was creating a new library.
160 6     6   18 use constant SRFNAME => 58; ## STRING Calma "Sticks"(c) rule file name.
  6         6  
  6         210  
161 6     6   22 use constant LIBSECUR => 59; ## INTEGER_2 Access control list stuff for CalmaDOS, ancient. INFORM used this when creating
  6         6  
  6         372  
162             ## a new library. Had 1 to 32 entries with group numbers, user numbers and access rights.
163             #################################################################################################
164 6     6   35 use vars '$StrSpace';
  6         29  
  6         297  
165 6     6   26 use vars '$ElmSpace';
  6         7  
  6         101519  
166             $StrSpace='';
167             $ElmSpace='';
168              
169             my %RecordTypeNumbers=(
170             'HEADER' => HEADER,
171             'BGNLIB' => BGNLIB,
172             'LIBNAME' => LIBNAME,
173             'UNITS' => UNITS,
174             'ENDLIB' => ENDLIB,
175             'BGNSTR' => BGNSTR,
176             'STRNAME' => STRNAME,
177             'ENDSTR' => ENDSTR,
178             'BOUNDARY' => BOUNDARY,
179             'PATH' => PATH,
180             'SREF' => SREF,
181             'AREF' => AREF,
182             'TEXT' => TEXT,
183             'LAYER' => LAYER,
184             'DATATYPE' => DATATYPE,
185             'WIDTH' => WIDTH,
186             'XY' => XY,
187             'ENDEL' => ENDEL,
188             'SNAME' => SNAME,
189             'COLROW' => COLROW,
190             'TEXTNODE' => TEXTNODE,
191             'NODE' => NODE,
192             'TEXTTYPE' => TEXTTYPE,
193             'PRESENTATION'=> PRESENTATION,
194             'SPACING' => SPACING,
195             'STRING' => STRING,
196             'STRANS' => STRANS,
197             'MAG' => MAG,
198             'ANGLE' => ANGLE,
199             'UINTEGER' => UINTEGER,
200             'USTRING' => USTRING,
201             'REFLIBS' => REFLIBS,
202             'FONTS' => FONTS,
203             'PATHTYPE' => PATHTYPE,
204             'GENERATIONS' => GENERATIONS,
205             'ATTRTABLE' => ATTRTABLE,
206             'STYPTABLE' => STYPTABLE,
207             'STRTYPE' => STRTYPE,
208             'EFLAGS' => EFLAGS,
209             'ELKEY' => ELKEY,
210             'LINKTYPE' => LINKTYPE,
211             'LINKKEYS' => LINKKEYS,
212             'NODETYPE' => NODETYPE,
213             'PROPATTR' => PROPATTR,
214             'PROPVALUE' => PROPVALUE,
215             'BOX' => BOX,
216             'BOXTYPE' => BOXTYPE,
217             'PLEX' => PLEX,
218             'BGNEXTN' => BGNEXTN,
219             'ENDEXTN' => ENDEXTN,
220             'TAPENUM' => TAPENUM,
221             'TAPECODE' => TAPECODE,
222             'STRCLASS' => STRCLASS,
223             'RESERVED' => RESERVED,
224             'FORMAT' => FORMAT,
225             'MASK' => MASK,
226             'ENDMASKS' => ENDMASKS,
227             'LIBDIRSIZE' => LIBDIRSIZE,
228             'SRFNAME' => SRFNAME,
229             'LIBSECUR' => LIBSECUR,
230             );
231              
232             my @RecordTypeStrings=( ## for ascii print of GDS
233             'HEADER',
234             'BGNLIB',
235             'LIBNAME',
236             'UNITS',
237             'ENDLIB',
238             'BGNSTR',
239             'STRNAME',
240             'ENDSTR',
241             'BOUNDARY',
242             'PATH',
243             'SREF',
244             'AREF',
245             'TEXT',
246             'LAYER',
247             'DATATYPE',
248             'WIDTH',
249             'XY',
250             'ENDEL',
251             'SNAME',
252             'COLROW',
253             'TEXTNODE',
254             'NODE',
255             'TEXTTYPE',
256             'PRESENTATION',
257             'SPACING',
258             'STRING',
259             'STRANS',
260             'MAG',
261             'ANGLE',
262             'UINTEGER',
263             'USTRING',
264             'REFLIBS',
265             'FONTS',
266             'PATHTYPE',
267             'GENERATIONS',
268             'ATTRTABLE',
269             'STYPTABLE',
270             'STRTYPE',
271             'EFLAGS',
272             'ELKEY',
273             'LINKTYPE',
274             'LINKKEYS',
275             'NODETYPE',
276             'PROPATTR',
277             'PROPVALUE',
278             'BOX',
279             'BOXTYPE',
280             'PLEX',
281             'BGNEXTN',
282             'ENDEXTN',
283             'TAPENUM',
284             'TAPECODE',
285             'STRCLASS',
286             'RESERVED',
287             'FORMAT',
288             'MASK',
289             'ENDMASKS',
290             'LIBDIRSIZE',
291             'SRFNAME',
292             'LIBSECUR',
293             );
294             my @CompactRecordTypeStrings=( ## for compact ascii print of GDS (GDT format) see http://sourceforge.net/projects/gds2/
295             'gds2{', #HEADER
296             '', #BGNLIB
297             'lib', #LIBNAME
298             '', #UNITS
299             '}', #ENDLIB
300             'cell{', #BGNSTR
301             '', #STRNAME
302             '}', #ENDSTR
303             'b{', #BOUNDARY
304             'p{', #PATH
305             's{', #SREF
306             'a{', #AREF
307             't{', #TEXT
308             '', #LAYER
309             ' dt', #DATATYPE
310             ' w', #WIDTH
311             ' xy(', #XY #)
312             '}', #ENDEL
313             '', #SNAME
314             ' cr', #COLROW
315             ' tn', #TEXTNODE
316             ' no', #NODE
317             ' tt', #TEXTTYPE
318             '', #PRESENTATION'
319             ' sp', #SPACING
320             '', #STRING
321             '', #STRANS
322             ' m', #MAG
323             ' a', #ANGLE
324             ' ui', #UINTEGER
325             ' us', #USTRING
326             ' rl', #REFLIBS
327             ' f', #FONTS
328             ' pt', #PATHTYPE
329             ' gen', #GENERATIONS
330             ' at', #ATTRTABLE
331             ' st', #STYPTABLE
332             ' strt', #STRTYPE
333             ' ef', #EFLAGS
334             ' ek', #ELKEY
335             ' lt', #LINKTYPE
336             ' lk', #LINKKEYS
337             ' nt', #NODETYPE
338             ' ptr', #PROPATTR
339             ' pv', #PROPVALUE
340             ' bx', #BOX
341             ' bt', #BOXTYPE
342             ' px', #PLEX
343             ' bx', #BGNEXTN
344             ' ex', #ENDEXTN
345             ' tnum', #TAPENUM
346             ' tcode', #TAPECODE
347             ' strc', #STRCLASS
348             ' resv', #RESERVED
349             ' fmt', #FORMAT
350             ' msk', #MASK
351             ' emsk', #ENDMASKS
352             ' lds', #LIBDIRSIZE
353             ' srfn', #SRFNAME
354             ' libs', #LIBSECUR
355             );
356              
357             ###################################################
358             my %RecordTypeData=(
359             'HEADER' => INTEGER_2,
360             'BGNLIB' => INTEGER_2,
361             'LIBNAME' => ACSII_STRING,
362             'UNITS' => REAL_8,
363             'ENDLIB' => NO_REC_DATA,
364             'BGNSTR' => INTEGER_2,
365             'STRNAME' => ACSII_STRING,
366             'ENDSTR' => NO_REC_DATA,
367             'BOUNDARY' => NO_REC_DATA,
368             'PATH' => NO_REC_DATA,
369             'SREF' => NO_REC_DATA,
370             'AREF' => NO_REC_DATA,
371             'TEXT' => NO_REC_DATA,
372             'LAYER' => INTEGER_2,
373             'DATATYPE' => INTEGER_2,
374             'WIDTH' => INTEGER_4,
375             'XY' => INTEGER_4,
376             'ENDEL' => NO_REC_DATA,
377             'SNAME' => ACSII_STRING,
378             'COLROW' => INTEGER_2,
379             'TEXTNODE' => NO_REC_DATA,
380             'NODE' => NO_REC_DATA,
381             'TEXTTYPE' => INTEGER_2,
382             'PRESENTATION' => BIT_ARRAY,
383             'SPACING' => UNKNOWN, #INTEGER_4, discontinued
384             'STRING' => ACSII_STRING,
385             'STRANS' => BIT_ARRAY,
386             'MAG' => REAL_8,
387             'ANGLE' => REAL_8,
388             'UINTEGER' => UNKNOWN, #INTEGER_4, no longer used
389             'USTRING' => UNKNOWN, #ACSII_STRING, no longer used
390             'REFLIBS' => ACSII_STRING,
391             'FONTS' => ACSII_STRING,
392             'PATHTYPE' => INTEGER_2,
393             'GENERATIONS' => INTEGER_2,
394             'ATTRTABLE' => ACSII_STRING,
395             'STYPTABLE' => ACSII_STRING, # unreleased feature
396             'STRTYPE' => INTEGER_2, #INTEGER_2, unreleased feature
397             'EFLAGS' => BIT_ARRAY,
398             'ELKEY' => INTEGER_4, #INTEGER_4, unreleased feature
399             'LINKTYPE' => INTEGER_2, #unreleased feature
400             'LINKKEYS' => INTEGER_4, #unreleased feature
401             'NODETYPE' => INTEGER_2,
402             'PROPATTR' => INTEGER_2,
403             'PROPVALUE' => ACSII_STRING,
404             'BOX' => NO_REC_DATA,
405             'BOXTYPE' => INTEGER_2,
406             'PLEX' => INTEGER_4,
407             'BGNEXTN' => INTEGER_4,
408             'ENDEXTN' => INTEGER_4,
409             'TAPENUM' => INTEGER_2,
410             'TAPECODE' => INTEGER_2,
411             'STRCLASS' => UNKNOWN,
412             'RESERVED' => INTEGER_4,
413             'FORMAT' => INTEGER_2,
414             'MASK' => ACSII_STRING,
415             'ENDMASKS' => NO_REC_DATA,
416             'LIBDIRSIZE' => UNKNOWN, #INTEGER_2
417             'SRFNAME' => ACSII_STRING,
418             'LIBSECUR' => UNKNOWN, #INTEGER_2,
419             );
420              
421             # This is the default class for the GDS2 object to use when all else fails.
422             $GDS2::DefaultClass = 'GDS2' unless defined $GDS2::DefaultClass;
423              
424             my $G_gdtString="";
425             my $G_epsilon="0.001"; ## to take care of floating point representation problems
426             my $G_fltLen=3;
427             { #it's own name space...
428             my $fltLenTmp = sprintf("%0.99f",(1.0/3.0)); $fltLenTmp=~s/^0.(3+).*/$1/; $fltLenTmp = length($fltLenTmp) - 10;
429             if ($fltLenTmp > length($G_epsilon)) # try to make smaller if we can...
430             {
431             $G_epsilon = sprintf("%0.${fltLenTmp}f1",0);
432             $G_fltLen = $fltLenTmp;
433             }
434             }
435             $G_epsilon *= 1; #ensure it's a number
436              
437             ################################################################################
438              
439             =head1 Examples
440              
441             Layer change:
442             here's a bare bones script to change all layer 59 to 66 given a file to
443             read and a new file to create.
444             #!/usr/bin/perl -w
445             use strict;
446             use GDS2;
447             my $fileName1 = $ARGV[0];
448             my $fileName2 = $ARGV[1];
449             my $gds2File1 = new GDS2(-fileName => $fileName1);
450             my $gds2File2 = new GDS2(-fileName => ">$fileName2");
451             while (my $record = $gds2File1 -> readGds2Record)
452             {
453             if ($gds2File1 -> returnLayer == 59)
454             {
455             $gds2File2 -> printLayer(-num=>66);
456             }
457             else
458             {
459             $gds2File2 -> printRecord(-data=>$record);
460             }
461             }
462              
463              
464             Gds2 dump:
465             here's a complete program to dump the contents of a stream file.
466             #!/usr/bin/perl -w
467             use GDS2;
468             $\="\n";
469             my $gds2File = new GDS2(-fileName=>$ARGV[0]);
470             while ($gds2File -> readGds2Record)
471             {
472             print $gds2File -> returnRecordAsString;
473             }
474              
475              
476             Gds2 dump in GDT format: which is smaller and easier to parse - http://sourceforge.net/projects/gds2/
477             #!/usr/bin/perl -w
478             use GDS2;
479             my $gds2File = new GDS2(-fileName=>$ARGV[0]);
480             while ($gds2File -> readGds2Record)
481             {
482             print $gds2File -> returnRecordAsString(-compact=>1);
483             }
484              
485             Dump from the command line of a bzip2 compressed file:
486             perl -MGDS2 -MFileHandle -MIPC::Open3 -e '$f1=new FileHandle;$f0=new FileHandle;open3($f0,$f1,$f1,"bzcat test.gds.bz2");$gds=new GDS2(-fileHandle=>$f1);while($gds->readGds2Record){print $gds->returnRecordAsString(-compact=>1)}'
487              
488             Create a complete GDS2 stream file from scratch:
489             #!/usr/bin/perl -w
490             use GDS2;
491             my $gds2File = new GDS2(-fileName=>'>test.gds');
492             $gds2File -> printInitLib(-name=>'testlib');
493             $gds2File -> printBgnstr(-name=>'test');
494             $gds2File -> printPath(
495             -layer=>6,
496             -pathType=>0,
497             -width=>2.4,
498             -xy=>[0,0, 10.5,0, 10.5,3.3],
499             );
500             $gds2File -> printSref(
501             -name=>'contact',
502             -xy=>[4,5.5],
503             );
504             $gds2File -> printAref(
505             -name=>'contact',
506             -columns=>2,
507             -rows=>3,
508             -xy=>[0,0, 10,0, 0,15],
509             );
510             $gds2File -> printEndstr;
511             $gds2File -> printBgnstr(-name => 'contact');
512             $gds2File -> printBoundary(
513             -layer=>10,
514             -xy=>[0,0, 1,0, 1,1, 0,1],
515             );
516             $gds2File -> printEndstr;
517             $gds2File -> printEndlib();
518              
519             ################################################################################
520              
521             =head1 METHODS
522              
523             =head2 new - open gds2 file
524              
525             usage:
526             my $gds2File = new GDS2(-fileName => "filename.gds2"); ## to read
527             my $gds2File2 = new GDS2(-fileName => ">filename.gds2"); ## to write
528              
529             -or- provide your own fileHandle:
530              
531             my $gds2File = new GDS2(-fileHandle => $fh); ## e.g. to attach to a compression/decompression pipe
532              
533             =cut
534              
535             sub new
536             {
537 8     8 1 1800 my($class,%arg) = @_;
538 8         27 my $self = {};
539 8   33     45 bless $self,$class || ref $class || $GDS2::DefaultClass;
540              
541 8         20 my $fileName = $arg{'-fileName'};
542 8 50       22 $fileName = "" unless (defined $fileName);
543              
544 8         15 my $fileHandle = $arg{'-fileHandle'};
545 8 50       28 $fileHandle = "" unless (defined $fileHandle);
546            
547 8 50 33     48 if ($fileName && $fileHandle)
548             {
549 0         0 die "new expects a gds2 file name -OR- a file handle. Do not give both.";
550             }
551 8 50 33     30 unless ($fileName || $fileHandle)
552             {
553 0         0 die "new expects a -fileName => 'name' OR and -fileHandle => fh $!";
554             }
555 8         15 my $lockMode = LOCK_SH; ## default
556 8 50       25 if ($fileName)
557             {
558 8         21 my $openModStr = substr($fileName,0,2); ### looking for > or >>
559 8         32 $openModStr =~ s|^\s+||;
560 8         38 $openModStr =~ s|[^\+>]+||g;
561 8         16 my $openModeNum = O_RDONLY;
562 8 50       31 if ($openModStr =~ m|^\+|)
563             {
564 0         0 warn("Ignoring '+' in open mode"); ## not handling this yet...
565 0         0 $openModStr =~ s|\++||;
566             }
567 8 100       34 if ($openModStr eq '>')
    50          
568             {
569 5         8 $openModeNum = O_WRONLY|O_CREAT;
570 5         8 $lockMode = LOCK_EX;
571 5         65 $fileName =~ s|^$openModStr||;
572             }
573             elsif ($openModStr eq '>>')
574             {
575 0         0 $openModeNum = O_WRONLY|O_APPEND;
576 0         0 $lockMode = LOCK_EX;
577 0         0 $fileName =~ s|^$openModStr||;
578             }
579 8         73 $fileHandle = new IO::File;
580 8 50       377 $fileHandle -> open("$fileName",$openModeNum) or die "Unable to open $fileName because $!";
581 8         28450 if (HAVE_FLOCK)
582             {
583 8 50       64 flock($fileHandle,$lockMode) or die "File lock on $fileName failed because $!";
584             }
585             }
586 8         21 my $resolution = $arg{'-resolution'};
587 8 50       24 unless (defined $resolution)
588             {
589 8         16 $resolution=1000;
590             }
591 8 50 33     106 die "new expects a positive integer resolution. ($resolution) $!" if (($resolution <= 0) || ($resolution !~ m|^\d+$|));
592 8         42 binmode $fileHandle,':raw';
593 8         71 $self -> {'Fd'} = $fileHandle -> fileno;
594 8         79 $self -> {'FileHandle'} = $fileHandle;
595 8         21 $self -> {'FileName'} = $fileName; ## the gds2 filename
596 8         34 $self -> {'BytesDone'} = 0; ## total file size so far
597 8         16 $self -> {'EOLIB'} = FALSE; ## end of library flag
598 8         16 $self -> {'INHEADER'} = UNKNOWN; ## in header? flag TRUE | FALSE | UNKNOWN
599 8         16 $self -> {'INDATA'} = FALSE; ## in data? flag TRUE | FALSE
600 8         22 $self -> {'Length'} = 0; ## length of data
601 8         15 $self -> {'DataType'} = UNKNOWN; ## one of 7 gds datatypes
602 8         16 $self -> {'UUnits'} = -1.0; ## for gds2 file e.g. 0.001
603 8         16 $self -> {'DBUnits'} = -1.0; ## for gds2 file e.g. 1e-9
604 8         22 $self -> {'Record'} = ''; ## the whole record as found in gds2 file
605 8         14 $self -> {'RecordType'} = UNKNOWN;
606 8         16 $self -> {'DataIndex'} = 0;
607 8         16 $self -> {'RecordData'} = ();
608 8         22 $self -> {'CurrentDataList'} = '';
609 8         17 $self -> {'InBoundary'} = FALSE; ##
610 8         18 $self -> {'InTxt'} = FALSE; ##
611 8         14 $self -> {'DateFld'} = 0; ##
612 8         16 $self -> {'Resolution'} = $resolution;
613 8         13 $self -> {'UsingPrettyPrint'} = FALSE; ## print as string ...
614 8         29 $self;
615             }
616             ################################################################################
617              
618             #######
619             #private method to check how accurately users perl can do math
620             sub getG_epsilon
621             {
622 4     4 0 23 my($self,%arg) = @_;
623 4         11 $G_epsilon;
624             }
625             ################################################################################
626              
627             #######
628             #private method to check how accurately users perl can do math
629             sub getG_fltLen
630             {
631 4     4 0 20 my($self,%arg) = @_;
632 4         12 $G_fltLen;
633             }
634             ################################################################################
635              
636             #######
637             #private method to report Endianness
638             sub endianness
639             {
640 2     2 0 151 my($self,%arg) = @_;
641 2         5 $isLittleEndian;
642             }
643             ################################################################################
644              
645             #######
646             #private method to clean up number
647             sub cleanExpNum($)
648             {
649 3     3 0 11 my $num = shift;
650 3         25 $num = sprintf("%0.${G_fltLen}e",$num);
651 3         10 $num =~ s/([1-9])0+e/$1e/;
652 3         25 $num =~ s/(\d)\.0+e/$1e/;
653 3         10 $num;
654             }
655             ################################################################################
656              
657             #######
658             #private method to clean up number
659             sub cleanFloatNum($)
660             {
661 189     189 0 176 my $num = shift;
662 189         942 $num = sprintf("%0.${G_fltLen}f",$num);
663 189         763 $num =~ s/([1-9])0+$/$1/;
664 189         308 $num =~ s/(\d)\.0+$/$1/;
665 189         327 $num;
666             }
667             ################################################################################
668              
669             =head2 fileNum - file number...
670              
671             usage:
672              
673             =cut
674              
675             sub fileNum
676             {
677 0     0 1 0 my($self,%arg) = @_;
678 0         0 int($self -> {'Fd'});
679             }
680             ################################################################################
681              
682             =head2 close - close gds2 file
683              
684             usage:
685             $gds2File -> close;
686             -or-
687             $gds2File -> close(-markEnd=>1); ## -- some systems have trouble closing files
688             $gds2File -> close(-pad=>2048); ## -- pad end with \0's till file size is a
689             ## multiple of number. Note: old reel to reel tapes on Calma
690             ## systems used 2048 byte blocks
691              
692             =cut
693              
694             sub close
695             {
696 5     5 1 38 my($self,%arg) = @_;
697 5         18 my $markEnd = $arg{'-markEnd'};
698 5         12 my $pad = $arg{'-pad'};
699 5 50 33     25 if ((defined $markEnd)&&($markEnd))
700             {
701 0         0 my $fh = $self -> {'FileHandle'};
702 0         0 print $fh "\x1a\x04"; # a ^Z and a ^D
703 0         0 $self -> {'BytesDone'} += 2;
704             }
705 5 100 66     40 if ((defined $pad)&&($pad > 0))
706             {
707 1         1 my $fh = $self -> {'FileHandle'};
708 1         54 $fh -> flush;
709 1         4 seek($fh,0,SEEK_END);
710 1         1 my $fileSize = tell($fh);
711 1         3 my $padSize = $pad - ($fileSize % $pad);
712 1 50       3 $padSize=0 if ($padSize == $pad);
713 1         6 for (my $i=0; $i < $padSize; $i++)
714             {
715 1702         2126 print $fh "\0"; ## a null
716             }
717             }
718 5         61 $self -> {'FileHandle'} -> close;
719             }
720             ################################################################################
721              
722             ################################################################################
723              
724             =head1 High Level Write Methods
725              
726             =cut
727              
728             ################################################################################
729              
730             =head2 printInitLib() - Does all the things needed to start a library, writes HEADER,BGNLIB,LIBNAME,and UNITS records
731              
732             The default is to create a library with a default unit of 1 micron that has a resolution of 1000. To get this set uUnit to 0.001 (1/1000) and the dbUnit to 1/1000th of a micron (1e-9).
733             usage:
734             $gds2File -> printInitLib(-name => "testlib", ## required
735             -isoDate => 0|1 ## (optional) use ISO 4 digit date 2001 vs 101
736             -uUnit => real number ## (optional) default is 0.001
737             -dbUnit => real number ## (optional) default is 1e-9
738             );
739              
740             ## defaults to current date for library date
741              
742             note:
743             remember to close library with printEndlib()
744              
745             =cut
746              
747             sub printInitLib
748             {
749 2     2 1 90 my($self,%arg) = @_;
750 2         6 my $libName = $arg{'-name'};
751 2 50       25 unless (defined $libName)
752             {
753 0         0 die "printInitLib expects a library name. Missing -name => 'name' $!";
754             }
755             #################################################
756 2         5 my $isoDate = $arg{'-isoDate'};
757 2 50       7 if (! defined $isoDate)
    0          
758             {
759 2         3 $isoDate = FALSE;
760             }
761             elsif ($isoDate != 0)
762             {
763 0         0 $isoDate = TRUE;
764             }
765              
766             #################################################
767 2         5 my $uUnit = $arg{'-uUnit'};
768 2 50       12 if (! defined $uUnit)
769             {
770 2         2 $uUnit = 0.001;
771             }
772             else
773             {
774 0         0 $self -> {'Resolution'} = cleanFloatNum(1 / $uUnit); ## default is 1000 - already set in new()
775             }
776 2         11 $self -> {'UUnits'} = $uUnit;
777              
778             #################################################
779 2         4 my $dbUnit = $arg{'-dbUnit'};
780 2 50       27 $dbUnit = 1e-9 unless (defined $dbUnit);
781 2         4 $self -> {'DBUnits'} = $dbUnit;
782             #################################################
783              
784 2         219 my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = localtime(time);
785 2         6 $mon++;
786 2 50       6 $year += 1900 if ($isoDate); ## Cadence likes year left "as is". GDS format supports year number up to 65535 -- 101 vs 2001
787 2         17 $self -> printGds2Record(-type => 'HEADER',-data => 3); ## GDS2 HEADER
788 2         18 $self -> printGds2Record(-type => 'BGNLIB',-data => [$year,$mon,$mday,$hour,$min,$sec,$year,$mon,$mday,$hour,$min,$sec]);
789 2         10 $self -> printGds2Record(-type => 'LIBNAME',-data => $libName);
790 2         10 $self -> printGds2Record(-type => 'UNITS',-data => [$uUnit,$dbUnit]);
791             }
792             ################################################################################
793              
794             =head2 printBgnstr - Does all the things needed to start a structure definition
795              
796             usage:
797             $gds2File -> printBgnstr(-name => "nand3" ## writes BGNSTR and STRNAME records
798             -isoDate => 1|0 ## (optional) use ISO 4 digit date 2001 vs 101
799             );
800              
801             note:
802             remember to close with printEndstr()
803              
804             =cut
805              
806             sub printBgnstr
807             {
808 4     4 1 23 my($self,%arg) = @_;
809              
810 4         7 my $strName = $arg{'-name'};
811 4 50       10 unless (defined $strName)
812             {
813 0         0 die "bgnStr expects a structure name. Missing -name => 'name' $!";
814             }
815 4         4 my $createTime = $arg{'-createTime'};
816 4         5 my $isoDate = $arg{'-isoDate'};
817 4 50       8 if (! defined $isoDate)
    0          
818             {
819 4         5 $isoDate = FALSE;
820             }
821             elsif ($isoDate != 0)
822             {
823 0         0 $isoDate = TRUE;
824             }
825 4         3 my ($csec,$cmin,$chour,$cmday,$cmon,$cyear,$cwday,$cyday,$cisdst);
826 4 50       11 if (defined $createTime)
827             {
828 0         0 ($csec,$cmin,$chour,$cmday,$cmon,$cyear,$cwday,$cyday,$cisdst) = localtime($createTime);
829             }
830             else
831             {
832 4         70 ($csec,$cmin,$chour,$cmday,$cmon,$cyear,$cwday,$cyday,$cisdst) = localtime(time);
833             }
834 4         9 $cmon++;
835              
836 4         5 my $modTime = $arg{'-modTime'};
837 4         4 my ($msec,$mmin,$mhour,$mmday,$mmon,$myear,$mwday,$myday,$misdst);
838 4 50       10 if (defined $modTime)
839             {
840 0         0 ($msec,$mmin,$mhour,$mmday,$mmon,$myear,$mwday,$myday,$misdst) = localtime($modTime);
841             }
842             else
843             {
844 4         32 ($msec,$mmin,$mhour,$mmday,$mmon,$myear,$mwday,$myday,$misdst) = localtime(time);
845             }
846 4         5 $mmon++;
847              
848 4 50       9 if ($isoDate)
849             {
850 0         0 $cyear += 1900; ## 2001 vs 101
851 0         0 $myear += 1900;
852             }
853 4         22 $self -> printGds2Record(-type => 'BGNSTR',-data => [$cyear,$cmon,$cmday,$chour,$cmin,$csec,$myear,$mmon,$mmday,$mhour,$mmin,$msec]);
854 4         17 $self -> printGds2Record(-type => 'STRNAME',-data => $strName);
855             }
856             ################################################################################
857              
858             =head2 printPath - prints a gds2 path
859              
860             usage:
861             $gds2File -> printPath(
862             -layer=>#,
863             -dataType=>#, ##optional
864             -pathType=>#,
865             -width=>#.#,
866             -unitWidth=>#, ## (optional) directly specify width in data base units (vs -width which is multipled by resolution)
867              
868             -xy=>\@array, ## array of reals
869             # -or-
870             -xyInt=>\@array, ## array of internal ints (optional -wks better if you are modifying an existing GDS2 file)
871             );
872              
873             note:
874             layer defaults to 0 if -layer not used
875             pathType defaults to 0 if -pathType not used
876             pathType 0 = square end
877             1 = round end
878             2 = square - extended 1/2 width
879             4 = custom plus variable path extension...
880             width defaults to 0.0 if -width not used
881              
882             =cut
883              
884             # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # #
885             # ::= PATH [ELFLAGS] [PLEX] LAYER DATATYPE [PATHTYPE] [WIDTH] XY
886             sub printPath
887             {
888 2     2 1 93 my($self,%arg) = @_;
889 2         5 my $resolution = $self -> {'Resolution'};
890 2         3 my $layer = $arg{'-layer'};
891 2 50       10 $layer=0 unless ( defined $layer);
892              
893 2         4 my $dataType = $arg{'-dataType'};
894 2 50       6 $dataType=0 unless (defined $dataType);
895              
896 2         59 my $pathType = $arg{'-pathType'};
897 2 50       6 $pathType=0 unless (defined $pathType);
898              
899 2         4 my $bgnExtn = $arg{'-bgnExtn'};
900 2 50       4 $bgnExtn=0 unless (defined $bgnExtn);
901              
902 2         3 my $endExtn = $arg{'-endExtn'};
903 2 50       4 $endExtn=0 unless (defined $endExtn);
904              
905 2         4 my $unitWidth = $arg{'-unitWidth'};
906 2         2 my $widthReal = $arg{'-width'};
907 2         5 my $width = 0;
908 2 50 33     8 if ((defined $unitWidth)&&($unitWidth >= 0))
909             {
910 0         0 $width=int($unitWidth);
911             }
912 2 50 33     18 if ((defined $widthReal)&&($widthReal >= 0.0))
913             {
914 2         7 $width = int(($widthReal*$resolution)+$G_epsilon);
915             }
916             #### -xyInt most useful if reading and modifying... -xy if creating from scratch
917 2         4 my $xyInt = $arg{'-xyInt'}; ## $xyInt should be a reference to an array of internal GDS2 format integers
918 2         3 my $xy = $arg{'-xy'}; ## $xy should be a reference to an array of reals
919 2         5 my @xyTmp=(); ##don't pollute array passed in
920 2 50 33     9 if (! ((defined $xy) || (defined $xyInt)))
921             {
922 0         0 die "printPath expects an xy array reference. Missing -xy => \\\@array $!";
923             }
924 2 50       5 if (defined $xyInt)
925             {
926 0         0 $xy = $xyInt;
927 0         0 $resolution=1;
928             }
929 2         8 $self -> printGds2Record(-type => 'PATH');
930 2         11 $self -> printGds2Record(-type => 'LAYER',-data => $layer);
931 2         9 $self -> printGds2Record(-type => 'DATATYPE',-data => $dataType);
932 2 50       6 $self -> printGds2Record(-type => 'PATHTYPE',-data => $pathType) if ($pathType);
933 2 50       13 $self -> printGds2Record(-type => 'WIDTH',-data => $width) if ($width);
934 2 50       6 if ($pathType == 4)
935             {
936 0         0 $self -> printGds2Record(-type => 'BGNEXTN',-data => $bgnExtn); ## int used with resolution
937 0         0 $self -> printGds2Record(-type => 'ENDEXTN',-data => $endExtn); ## int used with resolution
938             }
939 2         8 for(my $i=0;$i<=$#$xy;$i++) ## e.g. 3.4 in -> 3400 out
940             {
941 12 50       15 if ($xy -> [$i] >= 0) { push @xyTmp,int((($xy -> [$i])*$resolution)+$G_epsilon);}
  12         33  
942 0         0 else { push @xyTmp,int((($xy -> [$i])*$resolution)-$G_epsilon);}
943             }
944 2 50 33     11 if ($bgnExtn || $endExtn) ## we have to convert
945             {
946 0         0 my $bgnX1 = $xyTmp[0];
947 0         0 my $bgnY1 = $xyTmp[1];
948 0         0 my $bgnX2 = $xyTmp[2];
949 0         0 my $bgnY2 = $xyTmp[3];
950 0         0 my $endX1 = $xyTmp[$#xyTmp - 1];
951 0         0 my $endY1 = $xyTmp[$#xyTmp];
952 0         0 my $endX2 = $xyTmp[$#xyTmp - 3];
953 0         0 my $endY2 = $xyTmp[$#xyTmp - 2];
954 0 0       0 if ($bgnExtn)
955             {
956 0 0       0 if ($bgnX1 == $bgnX2) #vertical ...modify 1st Y
    0          
957             {
958 0 0       0 if ($bgnY1 < $bgnY2) ## points down
959             {
960 0         0 $xyTmp[1] -= $bgnExtn;
961 0 0       0 $xyTmp[1] += int($width/2) if ($pathType != 0);
962             }
963             else ## points up
964             {
965 0         0 $xyTmp[1] += $bgnExtn;
966 0 0       0 $xyTmp[1] -= int($width/2) if ($pathType != 0);
967             }
968             }
969             elsif ($bgnY1 == $bgnY2) #horizontal ...modify 1st X
970             {
971 0 0       0 if ($bgnX1 < $bgnX2) ## points left
972             {
973 0         0 $xyTmp[0] -= $bgnExtn;
974 0 0       0 $xyTmp[0] += int($width/2) if ($pathType != 0);
975             }
976             else ## points up
977             {
978 0         0 $xyTmp[0] += $bgnExtn;
979 0 0       0 $xyTmp[0] -= int($width/2) if ($pathType != 0);
980             }
981             }
982             }
983              
984 0 0       0 if ($endExtn)
985             {
986 0 0       0 if ($endX1 == $endX2) #vertical ...modify last Y
    0          
987             {
988 0 0       0 if ($endY1 < $endY2) ## points down
989             {
990 0         0 $xyTmp[$#xyTmp] -= $endExtn;
991 0 0       0 $xyTmp[$#xyTmp] += int($width/2) if ($pathType != 0);
992             }
993             else ## points up
994             {
995 0         0 $xyTmp[$#xyTmp] += $endExtn;
996 0 0       0 $xyTmp[$#xyTmp] -= int($width/2) if ($pathType != 0);
997             }
998             }
999             elsif ($endY1 == $endY2) #horizontal ...modify last X
1000             {
1001 0 0       0 if ($endX1 < $endX2) ## points left
1002             {
1003 0         0 $xyTmp[$#xyTmp - 1] -= $endExtn;
1004 0 0       0 $xyTmp[$#xyTmp - 1] += int($width/2) if ($pathType != 0);
1005             }
1006             else ## points up
1007             {
1008 0         0 $xyTmp[$#xyTmp - 1] += $endExtn;
1009 0 0       0 $xyTmp[$#xyTmp - 1] -= int($width/2) if ($pathType != 0);
1010             }
1011             }
1012             }
1013             }
1014 2         9 $self -> printGds2Record(-type => 'XY',-data => \@xyTmp);
1015 2         7 $self -> printGds2Record(-type => 'ENDEL');
1016             }
1017             ################################################################################
1018              
1019             =head2 printBoundary - prints a gds2 boundary
1020              
1021             usage:
1022             $gds2File -> printBoundary(
1023             -layer=>#,
1024             -dataType=>#,
1025              
1026             -xy=>\@array, ## ref to array of reals
1027             # -or-
1028             -xyInt=>\@array, ## ref to array of internal ints (optional -wks better if you are modifying an existing GDS2 file)
1029             );
1030              
1031             note:
1032             layer defaults to 0 if -layer not used
1033             dataType defaults to 0 if -dataType not used
1034              
1035             =cut
1036              
1037             # ::= BOUNDARY [ELFLAGS] [PLEX] LAYER DATATYPE XY
1038             # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # #
1039             sub printBoundary
1040             {
1041 2     2 1 22 my($self,%arg) = @_;
1042 2         6 my $resolution = $self -> {'Resolution'};
1043 2         2 my $layer = $arg{'-layer'};
1044 2 50       7 $layer=0 unless (defined $layer);
1045 2         4 my $dataType = $arg{'-dataType'};
1046 2 50       5 $dataType=0 unless (defined $dataType);
1047             #### -xyInt most useful if reading and modifying... -xy if creating from scratch
1048 2         4 my $xyInt = $arg{'-xyInt'}; ## $xyInt should be a reference to an array of internal GDS2 format integers
1049 2         3 my $xy = $arg{'-xy'}; ## $xy should be a reference to an array of reals
1050 2         3 my @xyTmp=(); ##don't pollute array passed in
1051 2 50 33     12 unless (defined($xy) || defined($xyInt))
1052             {
1053 0         0 die "printBoundary expects an xy array reference. Missing -xy => \\\@array $!";
1054             }
1055 2 50       5 if (defined $xyInt)
1056             {
1057 0         0 $xy = $xyInt;
1058 0         0 $resolution=1;
1059             }
1060 2         6 $self -> printGds2Record(-type => 'BOUNDARY');
1061 2         8 $self -> printGds2Record(-type => 'LAYER',-data => $layer);
1062 2         7 $self -> printGds2Record(-type => 'DATATYPE',-data => $dataType);
1063 2 50       11 if (my $numPoints=$#$xy+1 < 6)
1064             {
1065 0         0 die "printBoundary expects an xy array of at leasts 3 coordinates $!";
1066             }
1067 2         8 for(my $i=0;$i<=$#$xy;$i++) ## e.g. 3.4 in -> 3400 out
1068             {
1069 16 50       28 if ($xy -> [$i] >= 0) {push @xyTmp,int((($xy -> [$i])*$resolution)+$G_epsilon);}
  16         35  
  0         0  
1070             else {push @xyTmp,int((($xy -> [$i])*$resolution)-$G_epsilon);}
1071             }
1072             ## gds expects square to have 5 coords (closure)
1073 2 50 33     22 if (($xy -> [0] != ($xy -> [($#$xy - 1)])) || ($xy -> [1] != ($xy -> [$#$xy])))
1074             {
1075 2 50       6 if ($xy -> [0] >= 0) {push @xyTmp,int((($xy -> [0])*$resolution)+$G_epsilon);}
  2         9  
  0         0  
1076             else {push @xyTmp,int((($xy -> [0])*$resolution)-$G_epsilon);}
1077 2 50       6 if ($xy -> [1] >= 0) {push @xyTmp,int((($xy -> [1])*$resolution)+$G_epsilon);}
  2         5  
  0         0  
1078             else {push @xyTmp,int((($xy -> [1])*$resolution)-$G_epsilon);}
1079             }
1080 2         11 $self -> printGds2Record(-type => 'XY',-data => \@xyTmp);
1081 2         6 $self -> printGds2Record(-type => 'ENDEL');
1082             }
1083             ################################################################################
1084              
1085             =head2 printSref - prints a gds2 Structure REFerence
1086              
1087             usage:
1088             $gds2File -> printSref(
1089             -name=>string, ## Name of structure
1090              
1091             -xy=>\@array, ## ref to array of reals
1092             # -or-
1093             -xyInt=>\@array, ## ref to array of internal ints (optional -wks better than -xy if you are modifying an existing GDS2 file)
1094              
1095             -angle=>#.#, ## (optional) Default is 0.0
1096             -mag=>#.#, ## (optional) Default is 1.0
1097             -reflect=>0|1 ## (optional)
1098             );
1099              
1100             note:
1101             best not to specify angle or mag if not needed
1102              
1103             =cut
1104              
1105             #::= SREF [ELFLAGS] [PLEX] SNAME [] XY
1106             # ::= STRANS [MAG] [ANGLE]
1107             # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # #
1108             sub printSref
1109             {
1110 2     2 1 22 my($self,%arg) = @_;
1111 2         2 my $useSTRANS=FALSE;
1112 2         4 my $resolution = $self -> {'Resolution'};
1113 2         3 my $sname = $arg{'-name'};
1114 2 50       6 unless (defined $sname)
1115             {
1116 0         0 die "printSref expects a name string. Missing -name => 'text' $!";
1117             }
1118             #### -xyInt most useful if reading and modifying... -xy if creating from scratch
1119 2         4 my $xyInt = $arg{'-xyInt'}; ## $xyInt should be a reference to an array of internal GDS2 format integers
1120 2         2 my $xy = $arg{'-xy'}; ## $xy should be a reference to an array of reals
1121 2 50 33     7 unless (defined($xy) || defined($xyInt))
1122             {
1123 0         0 die "printSref expects an xy array reference. Missing -xy => \\\@array $!";
1124             }
1125 2 50       4 if (defined $xyInt)
1126             {
1127 0         0 $xy = $xyInt;
1128 0         0 $resolution=1;
1129             }
1130 2         8 $self -> printGds2Record(-type => 'SREF');
1131 2         7 $self -> printGds2Record(-type => 'SNAME',-data => $sname);
1132 2         4 my $reflect = $arg{'-reflect'};
1133 2 50 33     11 if ((! defined $reflect)||($reflect <= 0))
1134             {
1135 2         2 $reflect=0;
1136             }
1137             else
1138             {
1139 0         0 $reflect=1;
1140 0         0 $useSTRANS=TRUE;
1141             }
1142 2         4 my $mag = $arg{'-mag'};
1143 2 50 33     13 if ((! defined $mag)||($mag <= 0))
1144             {
1145 2         4 $mag=0;
1146             }
1147             else
1148             {
1149 0         0 $mag = cleanFloatNum($mag);
1150 0         0 $useSTRANS=TRUE;
1151             }
1152 2         5 my $angle = $arg{'-angle'};
1153 2 50       11 if (! defined $angle)
1154             {
1155 2         3 $angle = -1; #not really... just means not specified
1156             }
1157             else
1158             {
1159 0         0 $angle=posAngle($angle);
1160 0         0 $useSTRANS=TRUE;
1161             }
1162 2 50       7 if ($useSTRANS)
1163             {
1164 0         0 my $data=$reflect.'0'x15; ## 16 'bit' string
1165 0         0 $self -> printGds2Record(-type => 'STRANS',-data => $data);
1166 0 0       0 $self -> printGds2Record(-type => 'MAG',-data => $mag) if ($mag);
1167 0 0       0 $self -> printGds2Record(-type => 'ANGLE',-data => $angle) if ($angle >= 0);
1168             }
1169 2         4 my @xyTmp=(); ##don't pollute array passed in
1170 2         13 for(my $i=0;$i<=$#$xy;$i++) ## e.g. 3.4 in -> 3400 out
1171             {
1172 4 50       11 if ($xy -> [$i] >= 0) {push @xyTmp,int((($xy -> [$i])*$resolution)+$G_epsilon);}
  4         20  
  0         0  
1173             else {push @xyTmp,int((($xy -> [$i])*$resolution)-$G_epsilon);}
1174             }
1175 2         12 $self -> printGds2Record(-type => 'XY',-data => \@xyTmp);
1176 2         8 $self -> printGds2Record(-type => 'ENDEL');
1177             }
1178             ################################################################################
1179              
1180             =head2 printAref - prints a gds2 Array REFerence
1181              
1182             usage:
1183             $gds2File -> printAref(
1184             -name=>string, ## Name of structure
1185             -columns=>#, ## Default is 1
1186             -rows=>#, ## Default is 1
1187              
1188             -xy=>\@array, ## ref to array of reals
1189             # -or-
1190             -xyInt=>\@array, ## ref to array of internal ints (optional -wks better if you are modifying an existing GDS2 file)
1191              
1192             -angle=>#.#, ## (optional) Default is 0.0
1193             -mag=>#.#, ## (optional) Default is 1.0
1194             -reflect=>0|1 ## (optional)
1195             );
1196              
1197             note:
1198             best not to specify angle or mag if not needed
1199             xyList: 1st coord: origin, 2nd coord: X of col * xSpacing + origin, 3rd coord: Y of row * ySpacing + origin
1200              
1201             =cut
1202              
1203             #::= AREF [ELFLAGS] [PLEX] SNAME [] COLROW XY
1204             # ::= STRANS [MAG] [ANGLE]
1205             # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # #
1206             sub printAref
1207             {
1208 2     2 1 22 my($self,%arg) = @_;
1209 2         2 my $useSTRANS=FALSE;
1210 2         4 my $resolution = $self -> {'Resolution'};
1211 2         7 my $sname = $arg{'-name'};
1212 2 50       11 unless (defined $sname)
1213             {
1214 0         0 die "printAref expects a sname string. Missing -name => 'text' $!";
1215             }
1216             #### -xyInt most useful if reading and modifying... -xy if creating from scratch
1217 2         2 my $xyInt = $arg{'-xyInt'}; ## $xyInt should be a reference to an array of internal GDS2 format integers
1218 2         4 my $xy = $arg{'-xy'}; ## $xy should be a reference to an array of reals
1219 2 50 33     6 unless (defined($xy) || defined($xyInt))
1220             {
1221 0         0 die "printAref expects an xy array reference. Missing -xy => \\\@array $!";
1222             }
1223 2 50       4 if (defined $xyInt)
1224             {
1225 0         0 $xy = $xyInt;
1226 0         0 $resolution=1;
1227             }
1228 2         7 $self -> printGds2Record(-type => 'AREF');
1229 2         8 $self -> printGds2Record(-type => 'SNAME',-data => $sname);
1230 2         4 my $reflect = $arg{'-reflect'};
1231 2 50 33     39 if ((! defined $reflect)||($reflect <= 0))
1232             {
1233 2         4 $reflect=0;
1234             }
1235             else
1236             {
1237 0         0 $reflect=1;
1238 0         0 $useSTRANS=TRUE;
1239             }
1240 2         4 my $mag = $arg{'-mag'};
1241 2 50 33     7 if ((! defined $mag)||($mag <= 0))
1242             {
1243 2         3 $mag=0;
1244             }
1245             else
1246             {
1247 0         0 $mag = cleanFloatNum($mag);
1248 0         0 $useSTRANS=TRUE;
1249             }
1250 2         4 my $angle = $arg{'-angle'};
1251 2 50       4 if (! defined $angle)
1252             {
1253 2         2 $angle = -1; #not really... just means not specified
1254             }
1255             else
1256             {
1257 0         0 $angle=posAngle($angle);
1258 0         0 $useSTRANS=TRUE;
1259             }
1260 2 50       5 if ($useSTRANS)
1261             {
1262 0         0 my $data=$reflect.'0'x15; ## 16 'bit' string
1263 0         0 $self -> printGds2Record(-type => 'STRANS',-data => $data);
1264 0 0       0 $self -> printGds2Record(-type => 'MAG',-data => $mag) if ($mag);
1265 0 0       0 $self -> printGds2Record(-type => 'ANGLE',-data => $angle) if ($angle >= 0);
1266             }
1267 2         4 my $columns = $arg{'-columns'};
1268 2 50 33     17 if ((! defined $columns)||($columns <= 0))
1269             {
1270 0         0 $columns=1;
1271             }
1272             else
1273             {
1274 2         3 $columns = int($columns);
1275             }
1276 2         3 my $rows = $arg{'-rows'};
1277 2 50 33     20 if ((! defined $rows)||($rows <= 0))
1278             {
1279 0         0 $rows=1;
1280             }
1281             else
1282             {
1283 2         3 $rows = int($rows);
1284             }
1285 2         9 $self -> printGds2Record(-type => 'COLROW',-data => [$columns,$rows]);
1286 2         5 my @xyTmp=(); ##don't pollute array passed in
1287 2         20 for(my $i=0;$i<=$#$xy;$i++) ## e.g. 3.4 in -> 3400 out
1288             {
1289 8 50       14 if ($xy -> [$i] >= 0) {push @xyTmp,int((($xy -> [$i])*$resolution)+$G_epsilon);}
  8         27  
  0         0  
1290             else {push @xyTmp,int((($xy -> [$i])*$resolution)-$G_epsilon);}
1291             }
1292 2         22 $self -> printGds2Record(-type => 'XY',-data => \@xyTmp);
1293 2         6 $self -> printGds2Record(-type => 'ENDEL');
1294             }
1295             ################################################################################
1296              
1297             =head2 printText - prints a gds2 Text
1298              
1299             usage:
1300             $gds2File -> printText(
1301             -string=>string,
1302             -layer=>#, ## Default is 0
1303             -textType=>#, ## Default is 0
1304             -font=>#, ## 0-3
1305             -top, or -middle, -bottom, ##optional vertical presentation
1306             -left, or -center, or -right, ##optional horizontal presentation
1307              
1308             -xy=>\@array, ## ref to array of reals
1309             # -or-
1310             -xyInt=>\@array, ## ref to array of internal ints (optional -wks better if you are modifying an existing GDS2 file)
1311              
1312             -x=>#.#, ## optional way of passing in x value
1313             -y=>#.#, ## optional way of passing in y value
1314             -angle=>#.#, ## (optional) Default is 0.0
1315             -mag=>#.#, ## (optional) Default is 1.0
1316             -reflect=>#, ## (optional) Default is 0
1317             );
1318              
1319             note:
1320             best not to specify reflect, angle or mag if not needed
1321              
1322             =cut
1323              
1324             #::= TEXT [ELFLAGS] [PLEX] LAYER
1325             # ::= TEXTTYPE [PRESENTATION] [PATHTYPE] [WIDTH] [] XY STRING
1326             # ::= STRANS [MAG] [ANGLE]
1327             ################################################################################
1328             sub printText
1329             {
1330 0     0 1 0 my($self,%arg) = @_;
1331 0         0 my $useSTRANS=FALSE;
1332 0         0 my $string = $arg{'-string'};
1333 0 0       0 unless (defined $string)
1334             {
1335 0         0 die "printText expects a string. Missing -string => 'text' $!";
1336             }
1337 0         0 my $resolution = $self -> {'Resolution'};
1338 0         0 my $x = $arg{'-x'};
1339 0         0 my $y = $arg{'-y'};
1340             #### -xyInt most useful if reading and modifying... -xy if creating from scratch
1341 0         0 my $xyInt = $arg{'-xyInt'}; ## $xyInt should be a reference to an array of internal GDS2 format integers
1342 0         0 my $xy = $arg{'-xy'}; ## $xy should be a reference to an array of reals
1343 0 0       0 if (defined $xyInt)
1344             {
1345 0         0 $xy = $xyInt;
1346 0         0 $resolution=1;
1347             }
1348 0 0       0 if (defined $xy)
1349             {
1350 0         0 $x = $xy -> [0];
1351 0         0 $y = $xy -> [1];
1352             }
1353              
1354 0         0 my $x2 = $arg{'-x'};
1355 0 0       0 if (defined $x2)
1356             {
1357 0         0 $x = $x2;
1358             }
1359 0 0       0 unless (defined $x)
1360             {
1361 0         0 die "printText expects a x coord. Missing -xy=>\@array or -x => 'num' $!";
1362             }
1363 0 0       0 if ($x>=0) {$x = int(($x*$resolution)+$G_epsilon);}
  0         0  
  0         0  
1364             else {$x = int(($x*$resolution)-$G_epsilon);}
1365              
1366 0         0 my $y2 = $arg{'-y'};
1367 0 0       0 if (defined $y2)
1368             {
1369 0         0 $y = $y2;
1370             }
1371 0 0       0 unless (defined $y)
1372             {
1373 0         0 die "printText expects a y coord. Missing -xy=>\@array or -y => 'num' $!";
1374             }
1375 0 0       0 if ($y>=0) {$y = int(($y*$resolution)+$G_epsilon);}
  0         0  
  0         0  
1376             else {$y = int(($y*$resolution)-$G_epsilon);}
1377              
1378 0         0 my $layer = $arg{'-layer'};
1379 0 0       0 $layer=0 unless (defined $layer);
1380 0         0 my $textType = $arg{'-textType'};
1381 0 0       0 $textType=0 unless (defined $textType);
1382 0         0 my $reflect = $arg{'-reflect'};
1383 0 0 0     0 if ((! defined $reflect)||($reflect <= 0))
1384             {
1385 0         0 $reflect=0;
1386             }
1387             else
1388             {
1389 0         0 $reflect=1;
1390 0         0 $useSTRANS=TRUE;
1391             }
1392              
1393 0         0 my $font = $arg{'-font'};
1394 0 0 0     0 if ((! defined $font) || ($font < 0) || ($font > 3))
      0        
1395             {
1396 0         0 $font=0;
1397             }
1398 0         0 $font = sprintf("%02d",$font);
1399              
1400 0         0 my $vertical;
1401 0         0 my $top = $arg{'-top'};
1402 0         0 my $middle = $arg{'-middle'};
1403 0         0 my $bottom = $arg{'-bottom'};
1404 0 0       0 if (defined $top) {$vertical = '00';}
  0 0       0  
  0         0  
1405 0         0 elsif (defined $bottom) {$vertical = '10';}
1406             else {$vertical = '01';} ## middle
1407 0         0 my $horizontal;
1408 0         0 my $left = $arg{'-left'};
1409 0         0 my $center = $arg{'-center'};
1410 0         0 my $right = $arg{'-right'};
1411 0 0       0 if (defined $left) {$horizontal = '00';}
  0 0       0  
  0         0  
1412 0         0 elsif (defined $right) {$horizontal = '10';}
1413             else {$horizontal = '01';} ## center
1414 0         0 my $presString = '0'x10;
1415 0         0 $presString .= "$font$vertical$horizontal";
1416              
1417 0         0 my $mag = $arg{'-mag'};
1418 0 0 0     0 if ((! defined $mag)||($mag <= 0))
1419             {
1420 0         0 $mag=0;
1421             }
1422             else
1423             {
1424 0         0 $mag = cleanFloatNum($mag);
1425             }
1426 0         0 my $angle = $arg{'-angle'};
1427 0 0       0 if (! defined $angle)
1428             {
1429 0         0 $angle = -1; #not really... just means not specified
1430             }
1431             else
1432             {
1433 0         0 $angle=posAngle($angle);
1434             }
1435 0         0 $self -> printGds2Record(-type=>'TEXT');
1436 0         0 $self -> printGds2Record(-type=>'LAYER',-data=>$layer);
1437 0         0 $self -> printGds2Record(-type=>'TEXTTYPE',-data=>$textType);
1438 0 0 0     0 $self -> printGds2Record(-type => 'PRESENTATION',-data => $presString) if (defined $font || defined $top || defined $middle || defined $bottom || defined $bottom || defined $left || defined $center || defined $right);
      0        
      0        
      0        
      0        
      0        
      0        
1439 0 0       0 if ($useSTRANS)
1440             {
1441 0         0 my $data=$reflect.'0'x15; ## 16 'bit' string
1442 0         0 $self -> printGds2Record(-type=>'STRANS',-data=>$data);
1443             }
1444 0 0       0 $self -> printGds2Record(-type=>'MAG',-data=>$mag) if ($mag);
1445 0 0       0 $self -> printGds2Record(-type=>'ANGLE',-data=>$angle) if ($angle >= 0);
1446 0         0 $self -> printGds2Record(-type=>'XY',-data=>[$x,$y]);
1447 0         0 $self -> printGds2Record(-type=>'STRING',-data=>$string);
1448 0         0 $self -> printGds2Record(-type=>'ENDEL');
1449             }
1450             ################################################################################
1451              
1452             =head1 Low Level Generic Write Methods
1453              
1454             =cut
1455              
1456             ################################################################################
1457              
1458             =head2 saveGds2Record() - low level method to create a gds2 record given record type
1459             and data (if required). Data of more than one item should be given as a list.
1460              
1461             NOTE: THIS ONLY USES GDS2 OBJECT TO GET RESOLUTION
1462              
1463             usage:
1464             saveGds2Record(
1465             -type=>string,
1466             -data=>data_If_Needed, ##optional for some types
1467             -scale=>#.#, ##optional number to scale data to. I.E -scale=>0.5 #default is NOT to scale
1468             -snap=>#.#, ##optional number to snap data to I.E. -snap=>0.005 #default is 1 resolution unit, typically 0.001
1469             );
1470              
1471             examples:
1472             my $gds2File = new GDS2(-fileName => ">$fileName");
1473             my $record = $gds2File -> saveGds2Record(-type=>'header',-data=>3);
1474             $gds2FileOut -> printGds2Record(-type=>'record',-data=>$record);
1475              
1476              
1477             =cut
1478              
1479             sub saveGds2Record
1480             {
1481 0     0 1 0 my ($self,%arg) = @_;
1482 0         0 my $record='';
1483              
1484 0         0 my $type = $arg{'-type'};
1485 0 0       0 if (! defined $type)
1486             {
1487 0         0 die "saveGds2Record expects a type name. Missing -type => 'name' $!";
1488             }
1489             else
1490             {
1491 0         0 $type = uc $type;
1492             }
1493              
1494 0         0 my $saveEnd=$\;
1495 0         0 $\='';
1496              
1497 0         0 my @data = $arg{'-data'};
1498 0         0 my $dataString = $arg{'-asciiData'};
1499 0 0 0     0 die "saveGds2Record can not handle both -data and -asciiData options $!" if ((defined $dataString)&&((defined $data[0])&&($data[0] ne '')));
      0        
1500              
1501 0         0 my $data = '';
1502 0 0       0 if ($type eq 'RECORD') ## special case...
1503             {
1504 0         0 return $data[0];
1505             }
1506             else
1507             {
1508 0         0 my $numDataElements = 0;
1509 0         0 my $resolution = $self -> {'Resolution'};
1510              
1511 0         0 my $scale = $arg{'-scale'};
1512 0 0       0 if (! defined $scale)
1513             {
1514 0         0 $scale=1;
1515             }
1516 0 0       0 if ($scale <= 0)
1517             {
1518 0         0 die "saveGds2Record expects a positive scale -scale => $scale $!";
1519             }
1520              
1521 0         0 my $snap = $arg{'-snap'};
1522 0 0       0 if (! defined $snap) ## default is one resolution unit
1523             {
1524 0         0 $snap = 1;
1525             }
1526             else
1527             {
1528 0         0 $snap = $snap*$resolution; ## i.e. 0.001 -> 1
1529             }
1530 0 0       0 if ($snap < 1)
1531             {
1532 0         0 die "saveGds2Record expects a snap >= 1/resolution -snap => $snap $!";
1533             }
1534              
1535 0 0 0     0 if ((defined $data[0])&&($data[0] ne ''))
1536             {
1537 0         0 $data = $data[0];
1538 0         0 $numDataElements = @$data;
1539 0 0       0 if ($numDataElements) ## passed in anonymous array
1540             {
1541 0         0 @data = @$data; ## deref
1542             }
1543             else
1544             {
1545 0         0 $numDataElements = @data;
1546             }
1547             }
1548              
1549 0         0 my $recordDataType = $RecordTypeData{$type};
1550 0 0       0 if (defined $dataString)
1551             {
1552 0         0 $dataString=~s|^\s+||; ## clean-up
1553 0         0 $dataString=~s|\s+$||;
1554 0 0       0 $dataString=~s|\s+| |g if ($dataString !~ m|'|); ## don't compress spaces in strings...
1555 0         0 $dataString=~s|'$||; #'for strings
1556 0         0 $dataString=~s|^'||; #'for strings
1557 0 0 0     0 if (($recordDataType == BIT_ARRAY)||($recordDataType == ACSII_STRING))
1558             {
1559 0         0 $data = $dataString;
1560             }
1561             else
1562             {
1563 0         0 $dataString=~s|\s*[\s,;:/\\]+\s*| |g; ## incase commas etc... (non-std) were added by hand
1564 0         0 @data = split(' ',$dataString);
1565 0         0 $numDataElements = @data;
1566 0 0       0 if ($recordDataType == INTEGER_4)
1567             {
1568 0         0 my @xyTmp=();
1569 0         0 for(my $i=0;$i<$numDataElements;$i++) ## e.g. 3.4 in -> 3400 out
1570             {
1571 0 0       0 if ($data[$i]>=0) {push @xyTmp,int((($data[$i])*$resolution)+$G_epsilon);}
  0         0  
  0         0  
1572             else {push @xyTmp,int((($data[$i])*$resolution)-$G_epsilon);}
1573             }
1574 0         0 @data=@xyTmp;
1575             }
1576             }
1577             }
1578 0         0 my $byte;
1579 0         0 my $length = 0;
1580 0 0       0 if ($recordDataType == BIT_ARRAY)
    0          
    0          
    0          
    0          
1581             {
1582 0         0 $length = 2;
1583             }
1584             elsif ($recordDataType == INTEGER_2)
1585             {
1586 0         0 $length = 2 * $numDataElements;
1587             }
1588             elsif ($recordDataType == INTEGER_4)
1589             {
1590 0         0 $length = 4 * $numDataElements;
1591             }
1592             elsif ($recordDataType == REAL_8)
1593             {
1594 0         0 $length = 8 * $numDataElements;
1595             }
1596             elsif ($recordDataType == ACSII_STRING)
1597             {
1598 0         0 my $slen = length $data;
1599 0         0 $length = $slen + ($slen % 2); ## needs to be an even number
1600             }
1601              
1602 0         0 my $recordLength = pack 'S',($length + 4); #1 2 bytes for length 3rd for recordType 4th for dataType
1603 0         0 $record .= $recordLength;
1604 0         0 my $recordType = pack 'C',$RecordTypeNumbers{$type};
1605 0         0 $record .= $recordType;
1606              
1607 0         0 my $dataType = pack 'C',$RecordTypeData{$type};
1608 0         0 $record .= $dataType;
1609              
1610 0 0       0 if ($recordDataType == BIT_ARRAY) ## bit array
    0          
    0          
    0          
    0          
1611             {
1612 0         0 my $bitLength = $length * 8;
1613 0         0 $record .= pack("B$bitLength",$data);
1614             }
1615             elsif ($recordDataType == INTEGER_2) ## 2 byte signed integer
1616             {
1617 0         0 foreach my $num (@data)
1618             {
1619 0         0 $record .= pack('s',$num);
1620             }
1621             }
1622             elsif ($recordDataType == INTEGER_4) ## 4 byte signed integer
1623             {
1624 0         0 foreach my $num (@data)
1625             {
1626 0 0       0 $num = scaleNum($num,$scale) if ($scale != 1);
1627 0 0       0 $num = snapNum($num,$snap) if ($snap != 1);
1628 0         0 $record .= pack('i',$num);
1629             }
1630             }
1631             elsif ($recordDataType == REAL_8) ## 8 byte real
1632             {
1633 0         0 foreach my $num (@data)
1634             {
1635 0         0 my $real = $num;
1636 0         0 my $negative = FALSE;
1637 0 0       0 if($num < 0.0)
1638             {
1639 0         0 $negative = TRUE;
1640 0         0 $real = 0 - $num;
1641             }
1642              
1643 0         0 my $exponent = 0;
1644 0         0 while($real >= 1.0)
1645             {
1646 0         0 $exponent++;
1647 0         0 $real = ($real / 16.0);
1648             }
1649              
1650 0 0       0 if ($real != 0)
1651             {
1652 0         0 while($real < 0.0625)
1653             {
1654 0         0 --$exponent;
1655 0         0 $real = ($real * 16.0);
1656             }
1657             }
1658              
1659 0 0       0 if($negative) { $exponent += 192; }
  0         0  
1660 0         0 else { $exponent += 64; }
1661 0         0 $record .= pack('C',$exponent);
1662              
1663 0         0 for (my $i=1; $i<=7; $i++)
1664             {
1665 0 0       0 if ($real>=0) {$byte = int(($real*256.0)+$G_epsilon);}
  0         0  
  0         0  
1666             else {$byte = int(($real*256.0)-$G_epsilon);}
1667 0         0 $record .= pack('C',$byte);
1668 0         0 $real = $real * 256.0 - ($byte + 0.0);
1669             }
1670             }
1671             }
1672             elsif ($recordDataType == ACSII_STRING) ## ascii string (null padded)
1673             {
1674 0         0 $record .= pack("a$length",$data);
1675             }
1676             }
1677 0         0 $\=$saveEnd;
1678 0         0 $record;
1679             }
1680             ################################################################################
1681              
1682             =head2 printGds2Record() - low level method to print a gds2 record given record type
1683             and data (if required). Data of more than one item should be given as a list.
1684              
1685             usage:
1686             printGds2Record(
1687             -type=>string,
1688             -data=>data_If_Needed, ##optional for some types
1689             -scale=>#.#, ##optional number to scale data to. I.E -scale=>0.5 #default is NOT to scale
1690             -snap=>#.#, ##optional number to snap data to I.E. -snap=>0.005 #default is 1 resolution unit, typically 0.001
1691             );
1692              
1693             examples:
1694             my $gds2File = new GDS2(-fileName => ">$fileName");
1695              
1696             $gds2File -> printGds2Record(-type=>'header',-data=>3);
1697             $gds2File -> printGds2Record(-type=>'bgnlib',-data=>[99,12,1,22,33,0,99,12,1,22,33,9]);
1698             $gds2File -> printGds2Record(-type=>'libname',-data=>"testlib");
1699             $gds2File -> printGds2Record(-type=>'units',-data=>[0.001, 1e-9]);
1700             $gds2File -> printGds2Record(-type=>'bgnstr',-data=>[99,12,1,22,33,0,99,12,1,22,33,9]);
1701             ...
1702             $gds2File -> printGds2Record(-type=>'endstr');
1703             $gds2File -> printGds2Record(-type=>'endlib');
1704              
1705             Note: the special record type of 'record' can be used to copy a complete record
1706             just read in:
1707             while (my $record = $gds2FileIn -> readGds2Record())
1708             {
1709             $gds2FileOut -> printGds2Record(-type=>'record',-data=>$record);
1710             }
1711              
1712             =cut
1713              
1714             sub printGds2Record
1715             {
1716 317     317 1 5285 my ($self,%arg) = @_;
1717              
1718 317         378 my $type = $arg{'-type'};
1719 317 50       469 unless (defined $type)
1720             {
1721 0         0 die "printGds2Record expects a type name. Missing -type => 'name' $!";
1722             }
1723             else
1724             {
1725 317         371 $type = uc $type;
1726             }
1727 317         427 my @data = $arg{'-data'};
1728 317         341 my $dataString = $arg{'-asciiData'};
1729 317 50 33     1021 die "printGds2Record can not handle both -data and -asciiData options $!" if ((defined $dataString)&&((defined $data[0])&&($data[0] ne '')));
      66        
1730              
1731 317         398 my $fh = $self -> {'FileHandle'};
1732 317         408 my $saveEnd=$\;
1733 317         388 $\='';
1734              
1735 317         302 my $data = '';
1736 317 100       620 @data = () unless (defined $data[0]);
1737 317         246 my $recordLength; ## 1st 2 bytes for length 3rd for recordType 4th for dataType
1738 317 50       448 if ($type eq 'RECORD') ## special case...
1739             {
1740 0 0       0 if ($isLittleEndian)
1741             {
1742 0         0 my $length = substr($data[0],0,2);
1743 0         0 $recordLength = unpack 'v',$length;
1744 0         0 $self -> {'BytesDone'} += $recordLength;
1745 0         0 $length = reverse $length;
1746 0         0 print($fh $length);
1747              
1748 0         0 my $recordType = substr($data[0],2,1);
1749 0         0 print($fh $recordType);
1750 0         0 $recordType = unpack 'C',$recordType;
1751 0         0 $type = $RecordTypeStrings[$recordType]; ## will use code below.....
1752              
1753 0         0 my $dataType = substr($data[0],3,1);
1754 0         0 print($fh $dataType);
1755 0         0 $dataType = unpack 'C',$dataType;
1756 0 0       0 if ($recordLength > 4)
1757             {
1758 0         0 my $lengthLeft = $recordLength - 4; ## length left
1759 0         0 my $recordDataType = $RecordTypeData{$type};
1760              
1761 0 0 0     0 if (($recordDataType == INTEGER_2) || ($recordDataType == BIT_ARRAY))
    0          
    0          
    0          
    0          
1762             {
1763 0         0 my $binData = unpack 'b*',$data[0];
1764 0         0 my $intData = substr($binData,32); #skip 1st 4 bytes (length, recordType dataType)
1765              
1766 0         0 my ($byteInt2String,$byte2);
1767 0         0 for(my $i=0; $i<($lengthLeft/2); $i++)
1768             {
1769 0         0 $byteInt2String = reverse(substr($intData,0,16,''));
1770 0         0 $byte2=pack 'B16',reverse($byteInt2String);
1771 0         0 print($fh $byte2);
1772             }
1773             }
1774             elsif ($recordDataType == INTEGER_4)
1775             {
1776 0         0 my $binData = unpack 'b*',$data[0];
1777 0         0 my $intData = substr($binData,32); #skip 1st 4 bytes (length, recordType dataType)
1778 0         0 my ($byteInt4String,$byte4);
1779 0         0 for(my $i=0; $i<($lengthLeft/4); $i++)
1780             {
1781 0         0 $byteInt4String = reverse(substr($intData,0,32,''));
1782 0         0 $byte4=pack 'B32',reverse($byteInt4String);
1783 0         0 print($fh $byte4);
1784             }
1785             }
1786             elsif ($recordDataType == REAL_8)
1787             {
1788 0         0 my $binData = unpack 'b*',$data[0];
1789 0         0 my $realData = substr($binData,32); #skip 1st 4 bytes (length, recordType dataType)
1790 0         0 my ($bit64String,$mantissa,$byteString,$byte);
1791 0         0 for(my $i=0; $i<($lengthLeft/8); $i++)
1792             {
1793 0         0 $bit64String = substr($realData,($i*64),64);
1794 0         0 print($fh pack 'b8',$bit64String);
1795 0         0 $mantissa = substr($bit64String,8,56);
1796 0         0 for(my $j=0; $j<7; $j++)
1797             {
1798 0         0 $byteString = substr($mantissa,($j*8),8);
1799 0         0 $byte=pack 'b8',$byteString;
1800 0         0 print($fh $byte);
1801             }
1802             }
1803             }
1804             elsif ($recordDataType == ACSII_STRING) ## ascii string (null padded)
1805             {
1806 0         0 print($fh pack("a$lengthLeft",substr($data[0],4)));
1807             }
1808             elsif ($recordDataType == REAL_4) ## 4 byte real
1809             {
1810 0         0 die "4-byte reals are not supported $!";
1811             }
1812             }
1813             }
1814             else
1815             {
1816 0         0 print($fh $data[0]);
1817 0         0 $recordLength = length $data[0];
1818 0         0 $self -> {'BytesDone'} += $recordLength;
1819             }
1820             }
1821             else #if ($type ne 'RECORD')
1822             {
1823 317         261 my $numDataElements = 0;
1824 317         398 my $resolution = $self -> {'Resolution'};
1825 317         290 my $uUnits = $self -> {'UUnits'};
1826              
1827 317         323 my $scale = $arg{'-scale'};
1828 317 50       469 if (! defined $scale)
1829             {
1830 317         322 $scale=1;
1831             }
1832 317 50       555 if ($scale <= 0)
1833             {
1834 0         0 die "printGds2Record expects a positive scale -scale => $scale $!";
1835             }
1836              
1837 317         287 my $snap = $arg{'-snap'};
1838 317 50       425 if (! defined $snap) ## default is one resolution unit
1839             {
1840 317         266 $snap = 1;
1841             }
1842             else
1843             {
1844 0         0 $snap = int(($snap*$resolution)+$G_epsilon); ## i.e. 0.001 -> 1
1845             }
1846 317 50       473 if ($snap < 1)
1847             {
1848 0         0 die "printGds2Record expects a snap >= 1/resolution -snap => $snap $!";
1849             }
1850              
1851 317 100 66     631 if ((defined $data[0])&&($data[0] ne ''))
1852             {
1853 40         44 $data = $data[0];
1854 40         90 $numDataElements = @$data;
1855 40 100       51 if ($numDataElements) ## passed in anonymous array
1856             {
1857 18         46 @data = @$data; ## deref
1858             }
1859             else
1860             {
1861 22         22 $numDataElements = @data;
1862             }
1863             }
1864              
1865 317         403 my $recordDataType = $RecordTypeData{$type};
1866              
1867 317 100       541 if (defined $dataString)
1868             {
1869 255         705 $dataString=~s|^\s+||; ## clean-up
1870 255         647 $dataString=~s|\s+$||;
1871 255 100       771 $dataString=~s|\s+| |g if ($dataString !~ m|'|); ## don't compress spaces in strings...
1872 255         287 $dataString=~s|'$||; #'# for strings
1873 255         245 $dataString=~s|^'||; #'# for strings
1874 255 100 100     844 if (($recordDataType == BIT_ARRAY)||($recordDataType == ACSII_STRING))
1875             {
1876 57         80 $data = $dataString;
1877             }
1878             else
1879             {
1880 198         667 $dataString=~s|\s*[\s,;:/\\]+\s*| |g; ## in case commas etc... (non-std) were added by hand
1881 198         471 @data = split(' ',$dataString);
1882 198         205 $numDataElements = @data;
1883 198 100       355 if ($recordDataType == INTEGER_4)
1884             {
1885 33         39 my @xyTmp=();
1886 33         72 for(my $i=0;$i<$numDataElements;$i++) ## e.g. 3.4 in -> 3400 out
1887             {
1888 165 100       298 if ($data[$i]>=0) {push @xyTmp,int((($data[$i])*$resolution)+$G_epsilon);}
  126         277  
  39         78  
1889             else {push @xyTmp,int((($data[$i])*$resolution)-$G_epsilon);}
1890             }
1891 33         78 @data=@xyTmp;
1892             }
1893             }
1894             }
1895 317         258 my $byte;
1896 317         261 my $length = 0;
1897 317 100       788 if ($recordDataType == BIT_ARRAY)
    100          
    100          
    100          
    100          
1898             {
1899 27         28 $length = 2;
1900             }
1901             elsif ($recordDataType == INTEGER_2)
1902             {
1903 87         114 $length = 2 * $numDataElements;
1904             }
1905             elsif ($recordDataType == INTEGER_4)
1906             {
1907 43         39 $length = 4 * $numDataElements;
1908             }
1909             elsif ($recordDataType == REAL_8)
1910             {
1911 26         39 $length = 8 * $numDataElements;
1912             }
1913             elsif ($recordDataType == ACSII_STRING)
1914             {
1915 40         50 my $slen = length $data;
1916 40         56 $length = $slen + ($slen % 2); ## needs to be an even number
1917             }
1918 317         411 $self -> {'BytesDone'} += $length;
1919 317 50       398 if ($isLittleEndian)
1920             {
1921 317         578 $recordLength = pack 'v',($length + 4);
1922 317         358 $recordLength = reverse $recordLength;
1923             }
1924             else
1925             {
1926 0         0 $recordLength = pack 'S',($length + 4);
1927             }
1928 317         532 print($fh $recordLength);
1929              
1930 317         529 my $recordType = pack 'C',$RecordTypeNumbers{$type};
1931 317 50       564 $recordType = reverse $recordType if ($isLittleEndian);
1932 317         299 print($fh $recordType);
1933              
1934 317         405 my $dataType = pack 'C',$RecordTypeData{$type};
1935 317 50       537 $dataType = reverse $dataType if ($isLittleEndian);
1936 317         294 print($fh $dataType);
1937              
1938 317 100       846 if ($recordDataType == BIT_ARRAY) ## bit array
    100          
    100          
    100          
    100          
1939             {
1940 27         35 my $bitLength = $length * 8;
1941 27         59 my $value = pack("B$bitLength",$data);
1942 27         50 print($fh $value);
1943             }
1944             elsif ($recordDataType == INTEGER_2) ## 2 byte signed integer
1945             {
1946 87         68 my $value;
1947 87         115 foreach my $num (@data)
1948             {
1949 287         359 $value = pack('s',$num);
1950 287 50       414 $value = reverse $value if ($isLittleEndian);
1951 287         458 print($fh $value);
1952             }
1953             }
1954             elsif ($recordDataType == INTEGER_4) ## 4 byte signed integer
1955             {
1956 43         39 my $value;
1957 43         65 foreach my $num (@data)
1958             {
1959 211 50       269 $num = scaleNum($num,$scale) if ($scale != 1);
1960 211 50       271 $num = snapNum($num,$snap) if ($snap != 1);
1961 211         288 $value = pack('i',$num);
1962 211 50       320 $value = reverse $value if ($isLittleEndian);
1963 211         278 print($fh $value);
1964             }
1965             }
1966             elsif ($recordDataType == REAL_8) ## 8 byte real
1967             {
1968 26         27 my ($real,$negative,$exponent,$value);
1969 26         42 foreach my $num (@data)
1970             {
1971 31         34 $real = $num;
1972 31         32 $negative = FALSE;
1973 31 50       87 if($num < 0.0)
1974             {
1975 0         0 $negative = TRUE;
1976 0         0 $real = 0 - $num;
1977             }
1978              
1979 31         30 $exponent = 0;
1980 31         70 while($real >= 1.0)
1981             {
1982 15         14 $exponent++;
1983 15         32 $real = ($real / 16.0);
1984             }
1985              
1986 31 50       65 if ($real != 0)
1987             {
1988 31         58 while($real < 0.0625)
1989             {
1990 45         34 --$exponent;
1991 45         70 $real = ($real * 16.0);
1992             }
1993             }
1994 31 50       72 if($negative) { $exponent += 192; }
  0         0  
1995 31         36 else { $exponent += 64; }
1996 31         51 $value = pack('C',$exponent);
1997 31 50       59 $value = reverse $value if ($isLittleEndian);
1998 31         41 print($fh $value);
1999              
2000 31         70 for (my $i=1; $i<=7; $i++)
2001             {
2002 217 50       261 if ($real>=0) {$byte = int(($real*256.0)+$G_epsilon);}
  217         210  
  0         0  
2003             else {$byte = int(($real*256.0)-$G_epsilon);}
2004 217         248 my $value = pack('C',$byte);
2005 217 50       346 $value = reverse $value if ($isLittleEndian);
2006 217         216 print($fh $value);
2007 217         456 $real = $real * 256.0 - ($byte + 0.0);
2008             }
2009             }
2010             }
2011             elsif ($recordDataType == ACSII_STRING) ## ascii string (null padded)
2012             {
2013 40         144 print($fh pack("a$length",$data));
2014             }
2015             }
2016 317         1495 $\=$saveEnd;
2017             }
2018             ################################################################################
2019              
2020             =head2 printRecord - prints a record just read
2021              
2022             usage:
2023             $gds2File -> printRecord(
2024             -data => $record
2025             );
2026              
2027             =cut
2028              
2029             sub printRecord
2030             {
2031 0     0 1 0 my ($self,%arg) = @_;
2032 0         0 my $record = $arg{'-data'};
2033 0 0       0 if (! defined $record)
2034             {
2035 0         0 die "printGds2Record expects a data record. Missing -data => \$record $!";
2036             }
2037 0         0 my $type = $arg{'-type'};
2038 0 0       0 if (defined $type)
2039             {
2040 0         0 die "printRecord does not take -type. Perhaps you meant to use printGds2Record? $!";
2041             }
2042 0         0 $self -> printGds2Record(-type=>'record',-data=>$record);
2043             }
2044             ################################################################################
2045              
2046             ################################################################################
2047              
2048             =head1 Low Level Generic Read Methods
2049              
2050             =cut
2051              
2052             ################################################################################
2053              
2054             =head2 readGds2Record - reads record header and data section
2055              
2056             usage:
2057             while ($gds2File -> readGds2Record)
2058             {
2059             if ($gds2File -> returnRecordTypeString eq 'LAYER')
2060             {
2061             $layersFound[$gds2File -> layer] = 1;
2062             }
2063             }
2064              
2065             =cut
2066              
2067             sub readGds2Record
2068             {
2069 172     172 1 742 my $self = shift;
2070 172 100       345 return "" if ($self -> {'EOLIB'});
2071 170         276 $self -> readGds2RecordHeader();
2072 170         345 $self -> readGds2RecordData();
2073 170         202 $self -> {'INHEADER'} = FALSE;
2074 170         180 $self -> {'INDATA'} = TRUE; ## actually just done w/ it
2075 170         387 $self -> {'Record'};
2076             }
2077             ################################################################################
2078              
2079             =head2 readGds2RecordHeader - only reads gds2 record header section (2 bytes)
2080              
2081             slightly faster if you just want a certain thing...
2082             usage:
2083             while ($gds2File -> readGds2RecordHeader)
2084             {
2085             if ($gds2File -> returnRecordTypeString eq 'LAYER')
2086             {
2087             $gds2File -> readGds2RecordData;
2088             $layersFound[$gds2File -> returnLayer] = 1;
2089             }
2090             }
2091              
2092             =cut
2093              
2094             sub readGds2RecordHeader
2095             {
2096 256     256 1 291 my $self = shift;
2097              
2098 256 100 100     633 $self -> skipGds2RecordData() if ((! $self -> {'INDATA'}) && ($self -> {'INHEADER'} != UNKNOWN)) ; # need to read record data before header unless 1st time
2099 256         294 $self -> {'Record'} = '';
2100 256         303 $self -> {'RecordType'} = UNKNOWN;
2101 256         245 $self -> {'INHEADER'} = TRUE; ## will actually be just just done with it by the time we can check this ...
2102 256         236 $self -> {'INDATA'} = FALSE;
2103 256 100       593 return '' if ($self -> {'EOLIB'}); ## no sense reading null padding..
2104              
2105 255         305 my $buffer = '';
2106 255 50       782 return 0 if (! read($self -> {'FileHandle'},$buffer,4));
2107 255         215 my $data;
2108             #if (read($self -> {'FileHandle'},$data,2)) ### length
2109 255         334 $data = substr($buffer,0,2);
2110             {
2111 255 50       210 $data = reverse $data if ($isLittleEndian);
  255         462  
2112 255         269 $self -> {'Record'} = $data;
2113 255         516 $self -> {'Length'} = unpack 'S',$data;
2114 255         384 $self -> {'BytesDone'} += $self -> {'Length'};
2115             }
2116              
2117             #if (read($self -> {'FileHandle'},$data,1)) ## record type
2118 255         271 $data = substr($buffer,2,1);
2119             {
2120 255 50       204 $data = reverse $data if ($isLittleEndian);
  255         538  
2121 255         285 $self -> {'Record'} .= $data;
2122 255         351 $self -> {'RecordType'} = unpack 'C',$data;
2123 255 100       431 $self -> {'EOLIB'} = TRUE if (($self -> {'RecordType'}) == ENDLIB);
2124              
2125 255 100       418 if ($self -> {'UsingPrettyPrint'})
2126             {
2127 252 100       438 putStrSpace('') if (($self -> {'RecordType'}) == ENDSTR);
2128 252 100       422 putStrSpace(' ') if (($self -> {'RecordType'}) == BGNSTR);
2129              
2130 252 100 100     2285 putElmSpace(' ') if ((($self -> {'RecordType'}) == TEXT) || (($self -> {'RecordType'}) == PATH) ||
      100        
      100        
      66        
2131             (($self -> {'RecordType'}) == BOUNDARY) || (($self -> {'RecordType'}) == SREF) ||
2132             (($self -> {'RecordType'}) == AREF));
2133 252 100       443 if (($self -> {'RecordType'}) == ENDEL)
2134             {
2135 30         76 putElmSpace('');
2136 30         60 $self -> {'InTxt'} = FALSE;
2137 30         42 $self -> {'InBoundary'} = FALSE;
2138             }
2139 252 100       429 $self -> {'InTxt'} = TRUE if (($self -> {'RecordType'}) == TEXT);
2140 252 100       403 $self -> {'InBoundary'} = TRUE if (($self -> {'RecordType'}) == BOUNDARY);
2141 252 100 100     896 if ((($self -> {'RecordType'}) == LIBNAME) || (($self -> {'RecordType'}) == STRNAME))
2142              
2143             {
2144 12         19 $self -> {'DateFld'} = 0;
2145             }
2146 252 100 100     1010 $self -> {'DateFld'} = 1 if ((($self -> {'RecordType'}) == BGNLIB) || (($self -> {'RecordType'}) == BGNSTR));
2147             }
2148             }
2149              
2150             #if (read($self -> {'FileHandle'},$data,1)) ## data type
2151 255         316 $data = substr($buffer,3,1);
2152             {
2153 255 50       204 $data = reverse $data if ($isLittleEndian);
  255         474  
2154 255         293 $self -> {'Record'} .= $data;
2155 255         405 $self -> {'DataType'} = unpack 'C',$data;
2156             }
2157             #printf("P:Length=%-5d RecordType=%-2d DataType=%-2d\n",$self -> {'Length'},$self -> {'RecordType'},$self -> {'DataType'}); ##DEBUG
2158 255         367 return 1;
2159             }
2160             ################################################################################
2161              
2162             =head2 readGds2RecordData - only reads record data section
2163              
2164             slightly faster if you just want a certain thing...
2165             usage:
2166             while ($gds2File -> readGds2RecordHeader)
2167             {
2168             if ($gds2File -> returnRecordTypeString eq 'LAYER')
2169             {
2170             $gds2File -> readGds2RecordData;
2171             $layersFound[$gds2File -> returnLayer] = 1;
2172             }
2173             }
2174              
2175             =cut
2176              
2177             sub readGds2RecordData
2178             {
2179 255     255 1 246 my $self = shift;
2180              
2181 255 50       485 $self -> readGds2RecordHeader() if ($self -> {'INHEADER'} != TRUE); # program did not read HEADER - needs to...
2182 255 100       446 return $self -> {'Record'} if ($self -> {'DataType'} == NO_REC_DATA); # no sense going on...
2183 183         190 $self -> {'INHEADER'} = FALSE; # not in HEADER - need to read HEADER next time around...
2184 183         176 $self -> {'INDATA'} = TRUE; # rather in DATA - actually will be at the end of data by the time we test this...
2185 183         214 $self -> {'RecordData'} = '';
2186 183         287 $self -> {'RecordData'} = ();
2187 183         176 $self -> {'CurrentDataList'} = '';
2188 183         239 my $bytesLeft = $self -> {'Length'} - 4; ## 4 should have been just read by readGds2RecordHeader
2189 183         127 my $data;
2190 183 100       572 if ($self -> {'DataType'} == BIT_ARRAY) ## bit array
    100          
    100          
    50          
    100          
    50          
2191             {
2192 27         27 $self -> {'DataIndex'}=0;
2193 27         52 read($self -> {'FileHandle'},$data,$bytesLeft);
2194 27 50       54 $data = reverse $data if ($isLittleEndian);
2195 27         35 my $bitsLeft = $bytesLeft * 8;
2196 27         34 $self -> {'Record'} .= $data;
2197 27         82 $self -> {'RecordData'}[0] = unpack "B$bitsLeft",$data;
2198 27         51 $self -> {'CurrentDataList'} = ($self -> {'RecordData'}[0]);
2199             }
2200             elsif ($self -> {'DataType'} == INTEGER_2) ## 2 byte signed integer
2201             {
2202 69         66 my $tmpListString = '';
2203 69         63 my $i = 0;
2204 69         110 while ($bytesLeft)
2205             {
2206 201         298 read($self -> {'FileHandle'},$data,2);
2207 201 50       338 $data = reverse $data if ($isLittleEndian);
2208 201         191 $self -> {'Record'} .= $data;
2209 201         377 $self -> {'RecordData'}[$i] = unpack 's',$data;
2210 201         178 $tmpListString .= ',';
2211 201         258 $tmpListString .= $self -> {'RecordData'}[$i];
2212 201         153 $i++;
2213 201         407 $bytesLeft -= 2;
2214             }
2215 69         88 $self -> {'DataIndex'} = $i - 1;
2216 69         93 $self -> {'CurrentDataList'} = $tmpListString;
2217             }
2218             elsif ($self -> {'DataType'} == INTEGER_4) ## 4 byte signed integer
2219             {
2220 33         37 my $tmpListString = '';
2221 33         36 my $i = 0;
2222 33         30 my $buffer = '';
2223 33         67 read($self -> {'FileHandle'},$buffer,$bytesLeft); ## try fewer reads
2224 33         101 for(my $start=0; $start < $bytesLeft; $start += 4)
2225             {
2226 165         168 $data = substr($buffer,$start,4);
2227 165 50       252 $data = reverse $data if ($isLittleEndian);
2228 165         163 $self -> {'Record'} .= $data;
2229 165         438 $self -> {'RecordData'}[$i] = unpack 'i',$data;
2230 165         152 $tmpListString .= ',';
2231 165         215 $tmpListString .= $self -> {'RecordData'}[$i];
2232 165         288 $i++;
2233             }
2234 33         43 $self -> {'DataIndex'} = $i - 1;
2235 33         49 $self -> {'CurrentDataList'} = $tmpListString;
2236             }
2237             elsif ($self -> {'DataType'} == REAL_4) ## 4 byte real
2238             {
2239 0         0 die "4-byte reals are not supported $!";
2240             }
2241             elsif ($self -> {'DataType'} == REAL_8) ## 8 byte real - UNITS, MAG, ANGLE
2242             {
2243 24         32 my $resolution = $self -> {'Resolution'};
2244 24         31 my $tmpListString = '';
2245 24         23 my $i = 0;
2246 24         27 my ($negative,$exponent,$mantdata,$byteString,$byte,$mantissa,$real);
2247 24         49 while ($bytesLeft)
2248             {
2249 27         54 read($self -> {'FileHandle'},$data,1); ## sign bit and 7 exponent bits
2250 27         32 $self -> {'Record'} .= $data;
2251 27         54 $negative = unpack 'B',$data; ## sign bit
2252 27         42 $exponent = unpack 'C',$data;
2253 27 50       38 if ($negative)
2254             {
2255 0         0 $exponent -= 192; ## 128 + 64
2256             }
2257             else
2258             {
2259 27         32 $exponent -= 64;
2260             }
2261 27         38 read($self -> {'FileHandle'},$data,7); ## mantissa bits
2262 27         52 $mantdata = unpack 'b*',$data;
2263 27         34 $self -> {'Record'} .= $data;
2264 27         29 $mantissa = 0.0;
2265 27         59 for(my $j=0; $j<7; $j++)
2266             {
2267 189         203 $byteString = substr($mantdata,0,8,'');
2268 189         250 $byte = pack 'b*',$byteString;
2269 189         169 $byte = unpack 'C',$byte;
2270 189         403 $mantissa += $byte / (256.0**($j+1));
2271             }
2272 27         76 $real = $mantissa * (16**$exponent);
2273 27 50       50 $real = (0 - $real) if ($negative);
2274 27 100       65 if ($RecordTypeStrings[$self -> {'RecordType'}] eq 'UNITS')
2275             {
2276 6 100       30 if ($self -> {'UUnits'} == -1.0)
    50          
2277             {
2278 3         7 $self -> {'UUnits'} = $real;
2279             }
2280             elsif ($self -> {'DBUnits'} == -1.0)
2281             {
2282 3         4 $self -> {'DBUnits'} = $real;
2283             }
2284             }
2285             else
2286             {
2287             ### this works because UUnits and DBUnits are 1st reals in GDS2 file
2288 21 50       87 $real = int(($real+($self -> {'UUnits'}/$resolution))/$self -> {'UUnits'})*$self -> {'UUnits'} if ($self -> {'UUnits'} != 0); ## "rounds" off
2289             }
2290 27         61 $self -> {'RecordData'}[$i] = $real;
2291 27         29 $tmpListString .= ',';
2292 27         163 $tmpListString .= $self -> {'RecordData'}[$i];
2293 27         24 $i++;
2294 27         64 $bytesLeft -= 8;
2295             }
2296 24         38 $self -> {'DataIndex'} = $i - 1;
2297 24         36 $self -> {'CurrentDataList'} = $tmpListString;
2298             }
2299             elsif ($self -> {'DataType'} == ACSII_STRING) ## ascii string (null padded)
2300             {
2301 30         30 $self -> {'DataIndex'} = 0;
2302 30         74 read($self -> {'FileHandle'},$data,$bytesLeft);
2303 30         37 $self -> {'Record'} .= $data;
2304 30         115 $self -> {'RecordData'}[0] = unpack "a$bytesLeft",$data;
2305 30         94 $self -> {'RecordData'}[0] =~ s|\0||g; ## take off ending nulls
2306 30         52 $self -> {'CurrentDataList'} = ($self -> {'RecordData'}[0]);
2307             }
2308 183         250 return 1;
2309             }
2310             ################################################################################
2311              
2312             =head1 Low Level Generic Evaluation Methods
2313              
2314             =cut
2315              
2316             ################################################################################
2317              
2318             =head2 returnRecordType - returns current (read) record type as integer
2319              
2320             usage:
2321             if ($gds2File -> returnRecordType == 6)
2322             {
2323             print "found STRNAME";
2324             }
2325              
2326             =cut
2327              
2328             sub returnRecordType
2329             {
2330 0     0 1 0 my $self = shift;
2331 0         0 $self -> {'RecordType'};
2332             }
2333             ################################################################################
2334              
2335             =head2 returnRecordTypeString - returns current (read) record type as string
2336              
2337             usage:
2338             if ($gds2File -> returnRecordTypeString eq 'LAYER')
2339             {
2340             code goes here...
2341             }
2342              
2343             =cut
2344              
2345             sub returnRecordTypeString
2346             {
2347 0     0 1 0 my $self = shift;
2348 0         0 $RecordTypeStrings[($self -> {'RecordType'})];
2349             }
2350             ################################################################################
2351              
2352             =head2 returnRecordAsString - returns current (read) record as a string
2353              
2354             usage:
2355             while ($gds2File -> readGds2Record)
2356             {
2357             print $gds2File -> returnRecordAsString(-compact=>1);
2358             }
2359              
2360             =cut
2361              
2362             sub returnRecordAsString()
2363             {
2364 255     255 1 767 my($self,%arg) = @_;
2365 255         276 my $compact = $arg{'-compact'};
2366 255 100       435 $compact = FALSE if (! defined $compact);
2367 255         240 my $string = '';
2368 255         245 $self -> {'UsingPrettyPrint'} = TRUE;
2369 255         238 my $inText = $self -> {'InTxt'};
2370 255         248 my $inBoundary = $self -> {'InBoundary'};
2371 255         257 my $dateFld = $self -> {'DateFld'};
2372 255 100       386 if (! $compact)
2373             {
2374 170 100       357 $string .= getStrSpace() if ($self -> {'RecordType'} != BGNSTR);
2375 170 100 100     1505 $string .= getElmSpace() if (!(
      100        
      100        
      66        
2376             ($self -> {'RecordType'} == BOUNDARY) ||
2377             ($self -> {'RecordType'} == PATH) ||
2378             ($self -> {'RecordType'} == TEXT) ||
2379             ($self -> {'RecordType'} == SREF) ||
2380             ($self -> {'RecordType'} == AREF)
2381             ));
2382             }
2383 255         372 my $recordType = $RecordTypeStrings[$self -> {'RecordType'}];
2384 255 100       377 if ($compact)
2385             {
2386 85         138 $string .= $CompactRecordTypeStrings[$self -> {'RecordType'}];
2387             }
2388             else
2389             {
2390 170         161 $string .= $recordType;
2391             }
2392 255         243 my $i = 0;
2393 255         498 while ($i <= $self -> {'DataIndex'})
2394             {
2395 716 100       2077 if ($self -> {'DataType'} == BIT_ARRAY)
    100          
    100          
    100          
    100          
2396             {
2397 27         35 my $bitString = $self -> {'RecordData'}[$i];
2398 27 50       66 if ($isLittleEndian)
2399             {
2400 27         104 $bitString =~ m|(........)(........)|;
2401 27         72 $bitString = "$2$1";
2402             }
2403 27 100       40 if ($compact)
2404             {
2405 9 100       33 $string .= ' fx' if($bitString =~ m/^1/);
2406 9 100 100     41 if ($inText && ($self -> {'RecordType'} != STRANS))
2407             {
2408 3         5 $string .= ' f';
2409 3 50       23 $string .= '0' if ($bitString =~ m/00....$/);
2410 3 50       10 $string .= '1' if ($bitString =~ m/01....$/);
2411 3 50       16 $string .= '2' if ($bitString =~ m/10....$/);
2412 3 50       9 $string .= '3' if ($bitString =~ m/11....$/);
2413 3 50       17 $string .= ' t' if ($bitString =~ m/00..$/);
2414 3 50       11 $string .= ' m' if ($bitString =~ m/01..$/);
2415 3 50       12 $string .= ' b' if ($bitString =~ m/10..$/);
2416 3 100       19 $string .= 'l' if ($bitString =~ m/00$/);
2417 3 50       10 $string .= 'c' if ($bitString =~ m/01$/);
2418 3 100       10 $string .= 'r' if ($bitString =~ m/10$/);
2419             }
2420             }
2421             else
2422             {
2423 18         29 $string .= ' '.$bitString;
2424             }
2425             }
2426             elsif ($self -> {'DataType'} == INTEGER_2)
2427             {
2428 201 100       227 if ($compact)
2429             {
2430 67 100       95 if ($dateFld)
2431             {
2432 48         72 my $num = $self -> {'RecordData'}[$i];
2433 48 100       131 if ($dateFld =~ m/^[17]$/)
2434             {
2435 8 100       22 if ($dateFld eq '1')
    50          
2436             {
2437 4 100       14 if ($recordType eq 'BGNLIB')
2438             {
2439 1         6 $string .= 'm=';
2440             }
2441             else
2442             {
2443 3         6 $string .= 'c=';
2444             }
2445             }
2446             elsif ($dateFld eq '7')
2447             {
2448 4 100       9 if ($recordType eq 'BGNLIB')
2449             {
2450 1         3 $string .= ' a=';
2451             }
2452             else
2453             {
2454 3         5 $string .= ' m=';
2455             }
2456             }
2457 8 50       19 $num += 1900 if ($num < 1900);
2458             }
2459 48         99 $num = sprintf("%02d",$num);
2460 48 100       122 $string .= '-' if ($dateFld =~ m/^[2389]/);
2461 48 100       107 $string .= ':' if ($dateFld =~ m/^[56]/);
2462 48 100       97 $string .= ':' if ($dateFld =~ m/^1[12]/);
2463 48 100 100     186 $string .= ' ' if (($dateFld eq '4') || ($dateFld eq '10'));
2464 48         67 $string .= $num;
2465             }
2466             else
2467             {
2468 19 100       98 $string .= ' ' unless ($string =~ m/ (a|m|pt|dt|tt)$/i);
2469 19         36 $string .= $self -> {'RecordData'}[$i];
2470             }
2471             }
2472             else
2473             {
2474 134         106 $string .= ' ';
2475 134         135 $string .= $self -> {'RecordData'}[$i];
2476             }
2477 201 50       317 if ($recordType eq 'UNITS')
2478             {
2479 0         0 $string =~ s|(\d)\.e|$1e|; ## perl on Cygwin prints "1.e-9" others "1e-9"
2480 0         0 $string =~ s|(\d)e\-0+|$1e-|; ## different perls print 1e-9 1e-09 1e-009 etc... standardize to 1e-9
2481             }
2482             }
2483             elsif ($self -> {'DataType'} == INTEGER_4)
2484             {
2485 165 100       208 if ($compact)
2486             {
2487 55 100       114 $string .= ' ' if ($i);
2488             }
2489             else
2490             {
2491 110         111 $string .= ' ';
2492             }
2493 165         360 $string .= cleanFloatNum($self -> {'RecordData'}[$i]*($self -> {'UUnits'}));
2494 165 100 100     492 if ($compact && $i && ($i == $#{$self -> {'RecordData'}}))
  44   100     168  
2495             {
2496 10 100       48 $string =~ s/ +[\d\.\-]+ +[\d\.\-]+$// if ($inBoundary); #remove last point
2497 10         18 $string .= ')';
2498             }
2499             }
2500             elsif ($self -> {'DataType'} == REAL_8)
2501             {
2502 27 100       37 if ($compact)
2503             {
2504 9 100       64 $string .= ' ' unless ($string =~ m/ (a|m|pt|dt|tt)$/i);
2505             }
2506             else
2507             {
2508 18         18 $string .= ' ';
2509             }
2510 27         39 my $num = $self -> {'RecordData'}[$i];
2511 27 100       156 if ($num =~ m/e/i)
2512             {
2513 3         9 $num = cleanExpNum($num);
2514             }
2515             else
2516             {
2517 24         55 $num = cleanFloatNum($num);
2518             }
2519 27         42 $string .= $num;
2520 27 100       61 if ($recordType eq 'UNITS')
2521             {
2522 6         14 $string =~ s|(\d)\.e|$1e|; ## perl on Cygwin prints "1.e-9" others "1e-9"
2523 6         28 $string =~ s|(\d)e\-0+|$1e-|; ## different perls print 1e-9 1e-09 1e-009 etc... standardize to shorter 1e-9
2524             }
2525             }
2526             elsif ($self -> {'DataType'} == ACSII_STRING)
2527             {
2528 30 100       54 $string .= ' ' if (! $compact);
2529 30         58 $string .= " '".$self -> {'RecordData'}[$i]."'";
2530             }
2531 716         571 $i++;
2532 716 100       1739 $dateFld++ if ($dateFld);
2533             }
2534              
2535 255 100       398 if ($compact)
2536             {
2537 85         121 $G_gdtString .= $string;
2538 85 100 100     705 if (($G_gdtString =~ m/}$/ || $G_gdtString =~ m/^(gds2|lib|m).*\d$/) || ($G_gdtString =~ m/^cell.*'$/))
      100        
2539             {
2540 20         33 $string = "$G_gdtString\n";
2541 20         48 $string =~ s/{ /{/; #a little more compact
2542 20         102 $string =~ s/(dt0|pt0|tt0|m1|w0|f0) //g; #these are all default in true GDT format
2543 20         36 $G_gdtString = "";
2544             }
2545             else
2546             {
2547 65         98 $string = "";
2548             }
2549             }
2550              
2551 255         939 $string;
2552             }
2553             ################################################################################
2554              
2555             =head2 returnXyAsArray - returns current (read) XY record as an array
2556              
2557             usage:
2558             $gds2File -> returnXyAsArray(
2559             -asInteger => 0|1 ## (optional) default is true. Return integer
2560             ## array or if false return array of reals.
2561             -withClosure => 0|1 ## (optional) default is true. Whether to
2562             ##return a rectangle with 5 or 4 points.
2563             );
2564              
2565             example:
2566             while ($gds2File -> readGds2Record)
2567             {
2568             my @xy = $gds2File -> returnXyAsArray if ($gds2File -> isXy);
2569             }
2570              
2571             =cut
2572              
2573             sub returnXyAsArray()
2574             {
2575 0     0 1 0 my($self,%arg) = @_;
2576 0         0 my $asInteger = $arg{'-asInteger'};
2577 0 0       0 $asInteger = TRUE unless (defined $asInteger);
2578 0         0 my $withClosure = $arg{'-withClosure'};
2579 0 0       0 $withClosure = TRUE unless (defined $withClosure);
2580 0         0 my @xys=();
2581 0 0       0 if ($self -> isXy)
2582             {
2583 0         0 my $i = 0;
2584 0         0 my $stopPoint = $self -> {'DataIndex'};
2585 0 0       0 if ($withClosure)
2586             {
2587 0 0       0 return @{$self -> {'RecordData'}} if ($asInteger);
  0         0  
2588             }
2589             else
2590             {
2591 0         0 $stopPoint -= 2;
2592             }
2593 0         0 my $num=0;
2594 0         0 while ($i <= $stopPoint)
2595             {
2596 0 0       0 if ($asInteger)
2597             {
2598 0         0 $num = $self -> {'RecordData'}[$i];
2599             }
2600             else
2601             {
2602 0         0 $num = cleanFloatNum($self -> {'RecordData'}[$i]*($self -> {'UUnits'}));
2603             }
2604 0         0 push @xys,$num;
2605 0         0 $i++;
2606             }
2607             }
2608 0         0 @xys;
2609             }
2610             ################################################################################
2611              
2612              
2613             =head2 returnRecordAsPerl - returns current (read) record as a perl command to facilitate the creation of parameterized gds2 data with perl.
2614              
2615             usage:
2616             #!/usr/local/bin/perl
2617             use GDS2;
2618             my $gds2File = new GDS2(-fileName=>"test.gds");
2619             while ($gds2File -> readGds2Record)
2620             {
2621             print $gds2File -> returnRecordAsPerl;
2622             }
2623              
2624             =cut
2625              
2626             sub returnRecordAsPerl()
2627             {
2628 0     0 1 0 my($self,%arg) = @_;
2629              
2630 0         0 my $gds2File = $arg{'-gds2File'};
2631 0 0       0 $gds2File = '$gds2File' unless (defined $gds2File);
2632              
2633 0         0 my $PGR = $arg{'-printGds2Record'};
2634 0 0       0 $PGR = 'printGds2Record' unless (defined $PGR);
2635              
2636 0         0 my $string = '';
2637 0         0 $self -> {'UsingPrettyPrint'} = TRUE;
2638 0 0       0 $string .= getStrSpace() if ($self -> {'RecordType'} != BGNSTR);
2639 0 0 0     0 $string .= getElmSpace() if (!(
      0        
      0        
      0        
2640             ($self -> {'RecordType'} == TEXT) ||
2641             ($self -> {'RecordType'} == PATH) ||
2642             ($self -> {'RecordType'} == BOUNDARY) ||
2643             ($self -> {'RecordType'} == SREF) ||
2644             ($self -> {'RecordType'} == AREF)
2645             ));
2646 0 0 0     0 if (
      0        
      0        
      0        
      0        
      0        
      0        
2647             ($self -> {'RecordType'} == TEXT) ||
2648             ($self -> {'RecordType'} == PATH) ||
2649             ($self -> {'RecordType'} == BOUNDARY) ||
2650             ($self -> {'RecordType'} == SREF) ||
2651             ($self -> {'RecordType'} == AREF) ||
2652             ($self -> {'RecordType'} == ENDEL) ||
2653             ($self -> {'RecordType'} == ENDSTR) ||
2654             ($self -> {'RecordType'} == ENDLIB)
2655             )
2656             {
2657 0         0 $string .= $gds2File.'->'.$PGR.'(-type=>'."'".$RecordTypeStrings[$self -> {'RecordType'}]."'".');';
2658             }
2659             else
2660             {
2661 0         0 $string .= $gds2File.'->'.$PGR.'(-type=>'."'".$RecordTypeStrings[$self -> {'RecordType'}]."',-data=>";
2662 0         0 my $i = 0;
2663 0         0 my $maxi = $self -> {'DataIndex'};
2664 0 0       0 if ($maxi >= 1) {$string .= '['}
  0         0  
2665 0         0 while ($i <= $maxi)
2666             {
2667 0 0       0 if ($self -> {'DataType'} == BIT_ARRAY)
    0          
    0          
    0          
    0          
2668             {
2669 0         0 my $bitString = $self -> {'RecordData'}[$i];
2670 0 0       0 if ($isLittleEndian)
2671             {
2672 0         0 $bitString =~ m|(........)(........)|;
2673 0         0 $bitString = "$2$1";
2674             }
2675 0         0 $string .= "'$bitString'";
2676             }
2677             elsif ($self -> {'DataType'} == INTEGER_2)
2678             {
2679 0         0 $string .= $self -> {'RecordData'}[$i];
2680             }
2681             elsif ($self -> {'DataType'} == INTEGER_4)
2682             {
2683 0         0 $string .= $self -> {'RecordData'}[$i];
2684             }
2685             elsif ($self -> {'DataType'} == REAL_8)
2686             {
2687 0         0 $string .= $self -> {'RecordData'}[$i];
2688             }
2689             elsif ($self -> {'DataType'} == ACSII_STRING)
2690             {
2691 0         0 $string .= "'".$self -> {'RecordData'}[$i]."'";
2692             }
2693 0 0       0 if ($i < $maxi) {$string .= ', '}
  0         0  
2694 0         0 $i++;
2695             }
2696 0 0       0 if ($maxi >= 1) {$string .= ']'}
  0         0  
2697 0         0 $string .= ');';
2698             }
2699 0         0 $string;
2700             }
2701             ################################################################################
2702              
2703              
2704             =head1 Low Level Specific Write Methods
2705              
2706             =cut
2707              
2708             ################################################################################
2709              
2710             =head2 printAngle - prints ANGLE record
2711              
2712             usage:
2713             $gds2File -> printAngle(-num=>#.#);
2714              
2715             =cut
2716              
2717             sub printAngle
2718             {
2719 0     0 1 0 my($self,%arg) = @_;
2720 0         0 my $angle = $arg{'-num'};
2721 0 0       0 if (defined $angle)
2722             {
2723 0         0 $angle=posAngle($angle);
2724             }
2725             else
2726             {
2727 0         0 $angle = -1; #not really... just means not specified
2728             }
2729 0 0       0 $self -> printGds2Record(-type => 'ANGLE',-data => $angle) if ($angle >= 0);
2730             }
2731             ################################################################################
2732              
2733             =head2 printAttrtable - prints ATTRTABLE record
2734              
2735             usage:
2736             $gds2File -> printAttrtable(-string=>$string);
2737              
2738             =cut
2739              
2740             sub printAttrtable
2741             {
2742 0     0 1 0 my($self,%arg) = @_;
2743 0         0 my $string = $arg{'-string'};
2744 0 0       0 unless (defined $string)
2745             {
2746 0         0 die "printAttrtable expects a string. Missing -string => 'text' $!";
2747             }
2748 0         0 $self -> printGds2Record(-type => 'ATTRTABLE',-data => $string);
2749             }
2750             ################################################################################
2751              
2752             =head2 printBgnextn - prints BGNEXTN record
2753              
2754             usage:
2755             $gds2File -> printBgnextn(-num=>#.#);
2756              
2757             =cut
2758              
2759             sub printBgnextn
2760             {
2761 0     0 1 0 my($self,%arg) = @_;
2762 0         0 my $num = $arg{'-num'};
2763 0 0       0 unless (defined $num)
2764             {
2765 0         0 die "printBgnextn expects a extension number. Missing -num => #.# $!";
2766             }
2767 0         0 my $resolution = $self -> {'Resolution'};
2768 0 0       0 if ($num >= 0) {$num = int(($num*$resolution)+$G_epsilon);}
  0         0  
  0         0  
2769             else {$num = int(($num*$resolution)-$G_epsilon);}
2770 0         0 $self -> printGds2Record(-type => 'BGNEXTN',-data => $num);
2771             }
2772             ################################################################################
2773              
2774             =head2 printBgnlib - prints BGNLIB record
2775              
2776             usage:
2777             $gds2File -> printBgnlib(
2778             -isoDate => 0|1 ## (optional) use ISO 4 digit date 2001 vs 101
2779             );
2780              
2781             =cut
2782              
2783             sub printBgnlib
2784             {
2785 0     0 1 0 my($self,%arg) = @_;
2786 0         0 my $isoDate = $arg{'-isoDate'};
2787 0 0       0 if (! defined $isoDate)
    0          
2788             {
2789 0         0 $isoDate = 0;
2790             }
2791             elsif ($isoDate != 0)
2792             {
2793 0         0 $isoDate = 1;
2794             }
2795 0         0 my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = localtime(time);
2796 0         0 $mon++;
2797 0 0       0 $year += 1900 if ($isoDate); ## Cadence likes year left "as is". GDS format supports year number up to 65535 -- 101 vs 2001
2798 0         0 $self -> printGds2Record(-type=>'BGNLIB',-data=>[$year,$mon,$mday,$hour,$min,$sec,$year,$mon,$mday,$hour,$min,$sec]);
2799             }
2800             ################################################################################
2801              
2802             =head2 printBox - prints BOX record
2803              
2804             usage:
2805             $gds2File -> printBox;
2806              
2807             =cut
2808              
2809             sub printBox
2810             {
2811 0     0 1 0 my $self = shift;
2812 0         0 $self -> printGds2Record(-type => 'BOX');
2813             }
2814             ################################################################################
2815              
2816             =head2 printBoxtype - prints BOXTYPE record
2817              
2818             usage:
2819             $gds2File -> printBoxtype(-num=>#);
2820              
2821             =cut
2822              
2823             sub printBoxtype
2824             {
2825 0     0 1 0 my($self,%arg) = @_;
2826 0         0 my $num = $arg{'-num'};
2827 0 0       0 unless (defined $num)
2828             {
2829 0         0 die "printBoxtype expects a number. Missing -num => # $!";
2830             }
2831 0         0 $self -> printGds2Record(-type => 'BOXTYPE',-data => $num);
2832             }
2833             ################################################################################
2834              
2835             =head2 printColrow - prints COLROW record
2836              
2837             usage:
2838             $gds2File -> printBoxtype(-columns=>#, -rows=>#);
2839              
2840             =cut
2841              
2842             sub printColrow
2843             {
2844 0     0 1 0 my($self,%arg) = @_;
2845 0         0 my $columns = $arg{'-columns'};
2846 0 0 0     0 if ((! defined $columns)||($columns <= 0))
2847             {
2848 0         0 $columns=1;
2849             }
2850             else
2851             {
2852 0         0 $columns=int($columns);
2853             }
2854 0         0 my $rows = $arg{'-rows'};
2855 0 0 0     0 if ((! defined $rows)||($rows <= 0))
2856             {
2857 0         0 $rows=1;
2858             }
2859             else
2860             {
2861 0         0 $rows=int($rows);
2862             }
2863 0         0 $self -> printGds2Record(-type => 'COLROW',-data => [$columns,$rows]);
2864             }
2865             ################################################################################
2866              
2867             =head2 printDatatype - prints DATATYPE record
2868              
2869             usage:
2870             $gds2File -> printDatatype(-num=>#);
2871              
2872             =cut
2873              
2874             sub printDatatype
2875             {
2876 0     0 1 0 my($self,%arg) = @_;
2877 0         0 my $dataType = $arg{'-num'};
2878 0 0       0 $dataType=0 unless (defined $dataType);
2879 0         0 $self -> printGds2Record(-type => 'DATATYPE',-data => $dataType);
2880             }
2881             ################################################################################
2882              
2883             sub printEflags
2884             {
2885 0     0 0 0 my $self = shift;
2886 0         0 die "EFLAGS type not supported $!";
2887             }
2888             ################################################################################
2889              
2890             =head2 printElkey - prints ELKEY record
2891              
2892             usage:
2893             $gds2File -> printElkey(-num=>#);
2894              
2895             =cut
2896              
2897             sub printElkey
2898             {
2899 0     0 1 0 my($self,%arg) = @_;
2900 0         0 my $num = $arg{'-num'};
2901 0 0       0 unless (defined $num)
2902             {
2903 0         0 die "printElkey expects a number. Missing -num => #.# $!";
2904             }
2905 0         0 $self -> printGds2Record(-type => 'ELKEY',-data => $num);
2906             }
2907             ################################################################################
2908              
2909             =head2 printEndel - closes an element definition
2910              
2911             =cut
2912              
2913             sub printEndel
2914             {
2915 0     0 1 0 my $self = shift;
2916 0         0 $self -> printGds2Record(-type => 'ENDEL');
2917             }
2918             ################################################################################
2919              
2920             =head2 printEndextn - prints path end extension record
2921              
2922             usage:
2923             $gds2File printEndextn -> (-num=>#.#);
2924              
2925             =cut
2926              
2927             sub printEndextn
2928             {
2929 0     0 1 0 my($self,%arg) = @_;
2930 0         0 my $num = $arg{'-num'};
2931 0 0       0 unless (defined $num)
2932             {
2933 0         0 die "printEndextn expects a extension number. Missing -num => #.# $!";
2934             }
2935 0         0 my $resolution = $self -> {'Resolution'};
2936 0 0       0 if ($num >= 0) {$num = int(($num*$resolution)+$G_epsilon);}
  0         0  
  0         0  
2937             else {$num = int(($num*$resolution)-$G_epsilon);}
2938 0         0 $self -> printGds2Record(-type => 'ENDEXTN',-data => $num);
2939             }
2940             ################################################################################
2941              
2942             =head2 printEndlib - closes a library definition
2943              
2944             =cut
2945              
2946             sub printEndlib
2947             {
2948 2     2 1 13 my $self = shift;
2949 2         9 $self -> printGds2Record(-type => 'ENDLIB');
2950             }
2951             ################################################################################
2952              
2953             =head2 printEndstr - closes a structure definition
2954              
2955             =cut
2956              
2957             sub printEndstr
2958             {
2959 4     4 1 16 my $self = shift;
2960 4         10 $self -> printGds2Record(-type => 'ENDSTR');
2961             }
2962             ################################################################################
2963              
2964             =head2 printEndmasks - prints a ENDMASKS
2965              
2966             =cut
2967              
2968             sub printEndmasks
2969             {
2970 0     0 1 0 my $self = shift;
2971 0         0 $self -> printGds2Record(-type => 'ENDMASKS');
2972             }
2973             ################################################################################
2974              
2975             =head2 printFonts - prints a FONTS record
2976              
2977             usage:
2978             $gds2File -> printFonts(-string=>'names_of_font_files');
2979              
2980             =cut
2981              
2982             sub printFonts
2983             {
2984 0     0 1 0 my($self,%arg) = @_;
2985 0         0 my $string = $arg{'-string'};
2986 0 0       0 unless (defined $string)
2987             {
2988 0         0 die "printFonts expects a string. Missing -string => 'text' $!";
2989             }
2990 0         0 $self -> printGds2Record(-type => 'FONTS',-data => $string);
2991             }
2992             ################################################################################
2993              
2994             sub printFormat
2995             {
2996 0     0 0 0 my($self,%arg) = @_;
2997 0         0 my $num = $arg{'-num'};
2998 0 0       0 unless (defined $num)
2999             {
3000 0         0 die "printFormat expects a number. Missing -num => #.# $!";
3001             }
3002 0         0 $self -> printGds2Record(-type => 'FORMAT',-data => $num);
3003             }
3004             ################################################################################
3005              
3006             sub printGenerations
3007             {
3008 0     0 0 0 my $self = shift;
3009 0         0 $self -> printGds2Record(-type => 'GENERATIONS');
3010             }
3011             ################################################################################
3012              
3013             =head2 printHeader - Prints a rev 3 header
3014              
3015             usage:
3016             $gds2File -> printHeader(
3017             -num => # ## optional, defaults to 3. valid revs are 0,3,4,5,and 600
3018             );
3019              
3020             =cut
3021              
3022             sub printHeader
3023             {
3024 0     0 1 0 my($self,%arg) = @_;
3025 0         0 my $rev = $arg{'-num'};
3026 0 0       0 unless (defined $rev)
3027             {
3028 0         0 $rev=3;
3029             }
3030 0         0 $self -> printGds2Record(-type=>'HEADER',-data=>$rev);
3031             }
3032             ################################################################################
3033              
3034             =head2 printLayer - prints a LAYER number
3035              
3036             usage:
3037             $gds2File -> printLayer(
3038             -num => # ## optional, defaults to 0.
3039             );
3040              
3041             =cut
3042              
3043             sub printLayer
3044             {
3045 0     0 1 0 my($self,%arg) = @_;
3046 0         0 my $layer = $arg{'-num'};
3047 0 0       0 $layer = 0 unless (defined $layer);
3048 0         0 $self -> printGds2Record(-type => 'LAYER',-data => $layer);
3049             }
3050             ################################################################################
3051              
3052             sub printLibdirsize
3053             {
3054 0     0 0 0 my $self = shift;
3055 0         0 $self -> printGds2Record(-type => 'LIBDIRSIZE');
3056             }
3057             ################################################################################
3058              
3059             =head2 printLibname - Prints library name
3060              
3061             usage:
3062             printLibname(-name=>$name);
3063              
3064             =cut
3065              
3066             sub printLibname
3067             {
3068 0     0 1 0 my($self,%arg) = @_;
3069 0         0 my $libName = $arg{'-name'};
3070 0 0       0 unless (defined $libName)
3071             {
3072 0         0 die "printLibname expects a library name. Missing -name => 'name' $!";
3073             }
3074 0         0 $self -> printGds2Record(-type => 'LIBNAME',-data => $libName);
3075             }
3076             ################################################################################
3077              
3078             sub printLibsecur
3079             {
3080 0     0 0 0 my $self = shift;
3081 0         0 $self -> printGds2Record(-type => 'LIBSECUR');
3082             }
3083             ################################################################################
3084              
3085             sub printLinkkeys
3086             {
3087 0     0 0 0 my($self,%arg) = @_;
3088 0         0 my $num = $arg{'-num'};
3089 0 0       0 unless (defined $num)
3090             {
3091 0         0 die "printLinkkeys expects a number. Missing -num => #.# $!";
3092             }
3093 0         0 $self -> printGds2Record(-type => 'LINKKEYS',-data => $num);
3094             }
3095             ################################################################################
3096              
3097             sub printLinktype
3098             {
3099 0     0 0 0 my($self,%arg) = @_;
3100 0         0 my $num = $arg{'-num'};
3101 0 0       0 unless (defined $num)
3102             {
3103 0         0 die "printLinktype expects a number. Missing -num => #.# $!";
3104             }
3105 0         0 $self -> printGds2Record(-type => 'LINKTYPE',-data => $num);
3106             }
3107             ################################################################################
3108              
3109             =head2 printPathtype - prints a PATHTYPE number
3110              
3111             usage:
3112             $gds2File -> printPathtype(
3113             -num => # ## optional, defaults to 0.
3114             );
3115              
3116             =cut
3117              
3118             sub printPathtype
3119             {
3120 0     0 1 0 my($self,%arg) = @_;
3121 0         0 my $pathType = $arg{'-num'};
3122 0 0       0 $pathType=0 if (! defined $pathType);
3123 0 0       0 $self -> printGds2Record(-type => 'PATHTYPE',-data => $pathType) if ($pathType);
3124             }
3125             ################################################################################
3126              
3127             =head2 printMag - prints a MAG number
3128              
3129             usage:
3130             $gds2File -> printMag(
3131             -num => #.# ## optional, defaults to 0.0
3132             );
3133              
3134             =cut
3135              
3136             sub printMag
3137             {
3138 0     0 1 0 my($self,%arg) = @_;
3139 0         0 my $mag = $arg{'-num'};
3140 0 0 0     0 $mag=0 if ((! defined $mag)||($mag <= 0));
3141 0         0 $mag = cleanFloatNum($mag);
3142 0 0       0 $self -> printGds2Record(-type => 'MAG',-data => $mag) if ($mag);
3143             }
3144             ################################################################################
3145              
3146             sub printMask
3147             {
3148 0     0 0 0 my($self,%arg) = @_;
3149 0         0 my $string = $arg{'-string'};
3150 0 0       0 unless (defined $string)
3151             {
3152 0         0 die "printMask expects a string. Missing -string => 'text' $!";
3153             }
3154 0         0 $self -> printGds2Record(-type => 'MASK',-data => $string);
3155             }
3156             ################################################################################
3157              
3158             sub printNode
3159             {
3160 0     0 0 0 my $self = shift;
3161 0         0 $self -> printGds2Record(-type => 'NODE');
3162             }
3163             ################################################################################
3164              
3165             =head2 printNodetype - prints a NODETYPE number
3166              
3167             usage:
3168             $gds2File -> printNodetype(
3169             -num => #
3170             );
3171              
3172             =cut
3173              
3174             sub printNodetype
3175             {
3176 0     0 1 0 my($self,%arg) = @_;
3177 0         0 my $num = $arg{'-num'};
3178 0 0       0 unless (defined $num)
3179             {
3180 0         0 die "printNodetype expects a number. Missing -num => # $!";
3181             }
3182 0         0 $self -> printGds2Record(-type => 'NODETYPE',-data => $num);
3183             }
3184             ################################################################################
3185              
3186             sub printPlex
3187             {
3188 0     0 0 0 my($self,%arg) = @_;
3189 0         0 my $num = $arg{'-num'};
3190 0 0       0 unless (defined $num)
3191             {
3192 0         0 die "printPlex expects a number. Missing -num => #.# $!";
3193             }
3194 0         0 $self -> printGds2Record(-type => 'PLEX',-data => $num);
3195             }
3196             ################################################################################
3197              
3198             =head2 printPresentation - prints a text presentation record
3199              
3200             usage:
3201             $gds2File -> printPresentation(
3202             -font => #, ##optional, defaults to 0, valid numbers are 0-3
3203             -top, ||-middle, || -bottom, ## vertical justification
3204             -left, ||-center, || -right, ## horizontal justification
3205             );
3206              
3207             example:
3208             gds2File -> printPresentation(-font=>0,-top,-left);
3209              
3210             =cut
3211              
3212             sub printPresentation
3213             {
3214 0     0 1 0 my($self,%arg) = @_;
3215 0         0 my $font = $arg{'-font'};
3216 0 0 0     0 if ((! defined $font) || ($font < 0) || ($font > 3))
      0        
3217             {
3218 0         0 $font=0;
3219             }
3220 0         0 $font = sprintf("%02d",$font);
3221              
3222 0         0 my $vertical;
3223 0         0 my $top = $arg{'-top'};
3224 0         0 my $middle = $arg{'-middle'};
3225 0         0 my $bottom = $arg{'-bottom'};
3226 0 0       0 if (defined $top) {$vertical = '00';}
  0 0       0  
  0         0  
3227 0         0 elsif (defined $bottom) {$vertical = '10';}
3228             else {$vertical = '01';} ## middle
3229 0         0 my $horizontal;
3230 0         0 my $left = $arg{'-left'};
3231 0         0 my $center = $arg{'-center'};
3232 0         0 my $right = $arg{'-right'};
3233 0 0       0 if (defined $left) {$horizontal = '00';}
  0 0       0  
  0         0  
3234 0         0 elsif (defined $right) {$horizontal = '10';}
3235             else {$horizontal = '01';} ## center
3236              
3237 0         0 my $bitstring = '0'x10;
3238 0         0 $bitstring .= "$font$vertical$horizontal";
3239 0         0 $self -> printGds2Record(-type => 'PRESENTATION',-data => $bitstring);
3240             }
3241             ################################################################################
3242              
3243             =head2 printPropattr - prints a property id number
3244              
3245             usage:
3246             $gds2File -> printPropattr( -num => # );
3247              
3248             =cut
3249              
3250             sub printPropattr
3251             {
3252 0     0 1 0 my($self,%arg) = @_;
3253 0         0 my $num = $arg{'-num'};
3254 0 0       0 unless (defined $num)
3255             {
3256 0         0 die "printPropattr expects a number. Missing -num => # $!";
3257             }
3258 0         0 $self -> printGds2Record(-type => 'PROPATTR',-data => $num);
3259             }
3260             ################################################################################
3261              
3262             =head2 printPropvalue - prints a property value string
3263              
3264             usage:
3265             $gds2File -> printPropvalue( -string => $string );
3266              
3267             =cut
3268              
3269             sub printPropvalue
3270             {
3271 0     0 1 0 my($self,%arg) = @_;
3272 0         0 my $string = $arg{'-string'};
3273 0 0       0 unless (defined $string)
3274             {
3275 0         0 die "printPropvalue expects a string. Missing -string => 'text' $!";
3276             }
3277 0         0 $self -> printGds2Record(-type => 'PROPVALUE',-data => $string);
3278             }
3279             ################################################################################
3280              
3281             sub printReflibs
3282             {
3283 0     0 0 0 my($self,%arg) = @_;
3284 0         0 my $string = $arg{'-string'};
3285 0 0       0 unless (defined $string)
3286             {
3287 0         0 die "printReflibs expects a string. Missing -string => 'text' $!";
3288             }
3289 0         0 $self -> printGds2Record(-type => 'REFLIBS',-data => $string);
3290             }
3291             ################################################################################
3292              
3293             sub printReserved
3294             {
3295 0     0 0 0 my($self,%arg) = @_;
3296 0         0 my $num = $arg{'-num'};
3297 0 0       0 unless (defined $num)
3298             {
3299 0         0 die "printReserved expects a number. Missing -num => #.# $!";
3300             }
3301 0         0 $self -> printGds2Record(-type => 'RESERVED',-data => $num);
3302             }
3303             ################################################################################
3304              
3305             =head2 printSname - prints a SNAME string
3306              
3307             usage:
3308             $gds2File -> printSname( -name => $cellName );
3309              
3310             =cut
3311              
3312             sub printSname
3313             {
3314 0     0 1 0 my($self,%arg) = @_;
3315 0         0 my $string = $arg{'-name'};
3316 0 0       0 if (! defined $string)
3317             {
3318 0         0 die "printSname expects a cell name. Missing -name => 'text' $!";
3319             }
3320 0         0 $self -> printGds2Record(-type => 'SNAME',-data => $string);
3321             }
3322             ################################################################################
3323              
3324             sub printSpacing
3325             {
3326 0     0 0 0 my $self = shift;
3327 0         0 die "SPACING type not supported $!";
3328             }
3329             ################################################################################
3330              
3331             sub printSrfname
3332             {
3333 0     0 0 0 my $self = shift;
3334 0         0 $self -> printGds2Record(-type => 'SRFNAME');
3335             }
3336             ################################################################################
3337              
3338             =head2 printStrans - prints a STRANS record
3339              
3340             usage:
3341             $gds2File -> printStrans( -reflect );
3342              
3343             =cut
3344              
3345             sub printStrans
3346             {
3347 0     0 1 0 my($self,%arg) = @_;
3348 0         0 my $reflect = $arg{'-reflect'};
3349 0 0 0     0 if ((! defined $reflect)||($reflect <= 0))
3350             {
3351 0         0 $reflect=0;
3352             }
3353             else
3354             {
3355 0         0 $reflect=1;
3356             }
3357 0         0 my $data=$reflect.'0'x15; ## 16 'bit' string
3358 0         0 $self -> printGds2Record(-type => 'STRANS',-data => $data);
3359             }
3360             ################################################################################
3361              
3362             sub printStrclass
3363             {
3364 0     0 0 0 my $self = shift;
3365 0         0 $self -> printGds2Record(-type => 'STRCLASS');
3366             }
3367             ################################################################################
3368              
3369             =head2 printString - prints a STRING record
3370              
3371             usage:
3372             $gds2File -> printSname( -string => $text );
3373              
3374             =cut
3375              
3376             sub printString
3377             {
3378 0     0 1 0 my($self,%arg) = @_;
3379 0         0 my $string = $arg{'-string'};
3380 0 0       0 unless (defined $string)
3381             {
3382 0         0 die "printString expects a string. Missing -string => 'text' $!";
3383             }
3384 0         0 $self -> printGds2Record(-type => 'STRING',-data => $string);
3385             }
3386             ################################################################################
3387              
3388             =head2 printStrname - prints a structure name string
3389              
3390             usage:
3391             $gds2File -> printStrname( -name => $cellName );
3392              
3393             =cut
3394              
3395             sub printStrname
3396             {
3397 0     0 1 0 my($self,%arg) = @_;
3398 0         0 my $strName = $arg{'-name'};
3399 0 0       0 unless (defined $strName)
3400             {
3401 0         0 die "printStrname expects a structure name. Missing -name => 'name' $!";
3402             }
3403 0         0 $self -> printGds2Record(-type => 'STRNAME',-data => $strName);
3404             }
3405             ################################################################################
3406              
3407             sub printStrtype
3408             {
3409 0     0 0 0 my $self = shift;
3410 0         0 die "STRTYPE type not supported $!";
3411             }
3412             ################################################################################
3413              
3414             sub printStyptable
3415             {
3416 0     0 0 0 my($self,%arg) = @_;
3417 0         0 my $string = $arg{'-string'};
3418 0 0       0 unless (defined $string)
3419             {
3420 0         0 die "printStyptable expects a string. Missing -string => 'text' $!";
3421             }
3422 0         0 $self -> printGds2Record(-type => 'STYPTABLE',-data => $string);
3423             }
3424             ################################################################################
3425              
3426             sub printTapecode
3427             {
3428 0     0 0 0 my($self,%arg) = @_;
3429 0         0 my $num = $arg{'-num'};
3430 0 0       0 unless (defined $num)
3431             {
3432 0         0 die "printTapecode expects a number. Missing -num => #.# $!";
3433             }
3434 0         0 $self -> printGds2Record(-type => 'TAPECODE',-data => $num);
3435             }
3436             ################################################################################
3437              
3438             sub printTapenum
3439             {
3440 0     0 0 0 my($self,%arg) = @_;
3441 0         0 my $num = $arg{'-num'};
3442 0 0       0 unless (defined $num)
3443             {
3444 0         0 die "printTapenum expects a number. Missing -num => #.# $!";
3445             }
3446 0         0 $self -> printGds2Record(-type => 'TAPENUM',-data => $num);
3447             }
3448             ################################################################################
3449              
3450             sub printTextnode
3451             {
3452 0     0 0 0 my $self = shift;
3453 0         0 $self -> printGds2Record(-type => 'TEXTNODE');
3454             }
3455             ################################################################################
3456              
3457             =head2 printTexttype - prints a text type number
3458              
3459             usage:
3460             $gds2File -> printTexttype( -num => # );
3461              
3462             =cut
3463              
3464             sub printTexttype
3465             {
3466 0     0 1 0 my($self,%arg) = @_;
3467 0         0 my $num = $arg{'-num'};
3468 0 0       0 unless (defined $num)
3469             {
3470 0         0 die "printTexttype expects a number. Missing -num => # $!";
3471             }
3472 0 0       0 $num = 0 if ($num < 0);
3473 0         0 $self -> printGds2Record(-type => 'TEXTTYPE',-data => $num);
3474             }
3475             ################################################################################
3476              
3477             sub printUinteger
3478             {
3479 0     0 0 0 my $self = shift;
3480 0         0 die "UINTEGER type not supported $!";
3481             }
3482             ################################################################################
3483              
3484             =head2 printUnits - Prints units record.
3485              
3486             options:
3487             -uUnit => real number ## (optional) default is 0.001
3488             -dbUnit => real number ## (optional) default is 1e-9
3489              
3490             =cut
3491              
3492             sub printUnits
3493             {
3494 0     0 1 0 my($self,%arg) = @_;
3495              
3496 0         0 my $uUnit = $arg{'-uUnit'};
3497 0 0       0 if (! defined $uUnit)
3498             {
3499 0         0 $uUnit = 0.001;
3500             }
3501             else
3502             {
3503 0         0 $self -> {'Resolution'} = (1 / $uUnit); ## default is 1000 - already set in new()
3504             }
3505 0         0 $self -> {'UUnits'} = $uUnit;
3506             #################################################
3507 0         0 my $dbUnit = $arg{'-dbUnit'};
3508 0 0       0 unless (defined $dbUnit)
3509             {
3510 0         0 $dbUnit = 1e-9;
3511             }
3512 0         0 $self -> {'DBUnits'} = $dbUnit;
3513             #################################################
3514              
3515 0         0 $self -> printGds2Record(-type => 'UNITS',-data => [$uUnit,$dbUnit]);
3516             }
3517             ################################################################################
3518              
3519             sub printUstring
3520             {
3521 0     0 0 0 my $self = shift;
3522 0         0 die "USTRING type not supported $!";
3523             }
3524             ################################################################################
3525              
3526             =head2 printWidth - prints a width number
3527              
3528             usage:
3529             $gds2File -> printWidth( -num => # );
3530              
3531             =cut
3532              
3533             sub printWidth
3534             {
3535 0     0 1 0 my($self,%arg) = @_;
3536 0         0 my $width = $arg{'-num'};
3537 0 0 0     0 if ((! defined $width)||($width <= 0))
3538             {
3539 0         0 $width=0;
3540             }
3541 0 0       0 $self -> printGds2Record(-type => 'WIDTH',-data => $width) if ($width);
3542             }
3543             ################################################################################
3544              
3545             =head2 printXy - prints an XY array
3546              
3547             usage:
3548             $gds2File -> printXy( -xyInt => \@arrayGds2Ints );
3549             -or-
3550             $gds2File -> printXy( -xy => \@arrayReals );
3551              
3552             -xyInt most useful if reading and modifying... -xy if creating from scratch
3553              
3554             =cut
3555              
3556             sub printXy
3557             {
3558 0     0 1 0 my($self,%arg) = @_;
3559             #### -xyInt most useful if reading and modifying... -xy if creating from scratch
3560 0         0 my $xyInt = $arg{'-xyInt'}; ## $xyInt should be a reference to an array of internal GDS2 format integers
3561 0         0 my $xy = $arg{'-xy'}; ## $xy should be a reference to an array of reals
3562 0         0 my $resolution = $self -> {'Resolution'};
3563 0 0 0     0 if (! ((defined $xy) || (defined $xyInt)))
3564             {
3565 0         0 die "printXy expects an xy array reference. Missing -xy => \\\@array $!";
3566             }
3567 0 0       0 if (defined $xyInt)
3568             {
3569 0         0 $xy = $xyInt;
3570 0         0 $resolution=1;
3571             }
3572 0         0 my @xyTmp=(); ##don't pollute array passed in
3573 0         0 for(my $i=0;$i<=$#$xy;$i++) ## e.g. 3.4 in -> 3400 out
3574             {
3575 0 0       0 if ($xy -> [$i] >= 0) {push @xyTmp,int((($xy -> [$i])*$resolution)+$G_epsilon);}
  0         0  
  0         0  
3576             else {push @xyTmp,int((($xy -> [$i])*$resolution)-$G_epsilon);}
3577             }
3578 0         0 $self -> printGds2Record(-type => 'XY',-data => \@xyTmp);
3579             }
3580             ################################################################################
3581              
3582              
3583             =head1 Low Level Specific Evaluation Methods
3584              
3585             =cut
3586              
3587             =head2 returnFilePosition - return current byte position (NOT zero based)
3588              
3589             usage:
3590             my $position = $gds2File -> returnFilePosition;
3591              
3592             =cut
3593              
3594             sub returnFilePosition()
3595             {
3596 0     0 1 0 my $self = shift;
3597 0         0 $self -> {'BytesDone'};
3598             }
3599             ################################################################################
3600              
3601             sub tellSize() ## old name
3602             {
3603 0     0 0 0 my $self = shift;
3604 0         0 $self -> {'BytesDone'};
3605             }
3606             ################################################################################
3607              
3608              
3609             =head2 returnBgnextn - returns bgnextn if record is BGNEXTN else returns 0
3610              
3611             usage:
3612              
3613             =cut
3614              
3615             sub returnBgnextn
3616             {
3617 0     0 1 0 my $self = shift;
3618             ## 2 byte signed integer
3619 0 0       0 if ($self -> isBgnextn) { $self -> {'RecordData'}[0]; }
  0         0  
3620 0         0 else { 0; }
3621             }
3622             ################################################################################
3623              
3624             =head2 returnDatatype - returns datatype # if record is DATATYPE else returns -1
3625              
3626             usage:
3627             $dataTypesFound[$gds2File -> returnDatatype] = 1;
3628              
3629             =cut
3630              
3631             sub returnDatatype
3632             {
3633 0     0 1 0 my $self = shift;
3634             ## 2 byte signed integer
3635 0 0       0 if ($self -> isDatatype) { $self -> {'RecordData'}[0]; }
  0         0  
3636 0         0 else { UNKNOWN; }
3637             }
3638             ################################################################################
3639              
3640             =head2 returnEndextn- returns endextn if record is ENDEXTN else returns 0
3641              
3642             usage:
3643              
3644             =cut
3645              
3646             sub returnEndextn
3647             {
3648 0     0 0 0 my $self = shift;
3649             ## 2 byte signed integer
3650 0 0       0 if ($self -> isEndextn) { $self -> {'RecordData'}[0]; }
  0         0  
3651 0         0 else { 0; }
3652             }
3653             ################################################################################
3654              
3655              
3656             =head2 returnLayer - returns layer # if record is LAYER else returns -1
3657              
3658             usage:
3659             $layersFound[$gds2File -> returnLayer] = 1;
3660              
3661             =cut
3662              
3663             sub returnLayer
3664             {
3665 0     0 1 0 my $self = shift;
3666             ## 2 byte signed integer
3667 0 0       0 if ($self -> isLayer) { $self -> {'RecordData'}[0]; }
  0         0  
3668 0         0 else { UNKNOWN; }
3669             }
3670             ################################################################################
3671              
3672             =head2 returnPathtype - returns pathtype # if record is PATHTYPE else returns -1
3673              
3674             usage:
3675              
3676             =cut
3677              
3678             sub returnPathtype
3679             {
3680 0     0 1 0 my $self = shift;
3681             ## 2 byte signed integer
3682 0 0       0 if ($self -> isPathtype) { $self -> {'RecordData'}[0]; }
  0         0  
3683 0         0 else { UNKNOWN; }
3684             }
3685             ################################################################################
3686              
3687             =head2 returnPropattr - returns propattr # if record is PROPATTR else returns -1
3688              
3689             usage:
3690              
3691             =cut
3692              
3693             sub returnPropattr
3694             {
3695 0     0 1 0 my $self = shift;
3696             ## 2 byte signed integer
3697 0 0       0 if ($self -> isPropattr) { $self -> {'RecordData'}[0]; }
  0         0  
3698 0         0 else { UNKNOWN; }
3699             }
3700             ################################################################################
3701              
3702             =head2 returnPropvalue - returns propvalue string if record is PROPVALUE else returns ''
3703              
3704             usage:
3705              
3706             =cut
3707              
3708             sub returnPropvalue
3709             {
3710 0     0 1 0 my $self = shift;
3711 0 0       0 if ($self -> isPropvalue) { $self -> {'RecordData'}[0]; }
  0         0  
3712 0         0 else { ''; }
3713             }
3714             ################################################################################
3715              
3716             =head2 returnSname - return string if record type is SNAME else ''
3717              
3718             =cut
3719              
3720             sub returnSname
3721             {
3722 0     0 1 0 my $self = shift;
3723 0 0       0 if ($self -> isSname) { $self -> {'RecordData'}[0]; }
  0         0  
3724 0         0 else { ''; }
3725             }
3726             ################################################################################
3727              
3728             =head2 returnString - return string if record type is STRING else ''
3729              
3730             =cut
3731              
3732             sub returnString
3733             {
3734 0     0 1 0 my $self = shift;
3735 0 0       0 if ($self -> isString) { $self -> {'RecordData'}[0]; }
  0         0  
3736 0         0 else { ''; }
3737             }
3738             ################################################################################
3739              
3740             =head2 returnStrname - return string if record type is STRNAME else ''
3741              
3742             =cut
3743              
3744             sub returnStrname
3745             {
3746 0     0 1 0 my $self = shift;
3747 0 0       0 if ($self -> isStrname) { $self -> {'RecordData'}[0]; }
  0         0  
3748 0         0 else { ''; }
3749             }
3750             ################################################################################
3751              
3752             =head2 returnTexttype - returns texttype # if record is TEXTTYPE else returns -1
3753              
3754             usage:
3755             $TextTypesFound[$gds2File -> returnTexttype] = 1;
3756              
3757             =cut
3758              
3759             sub returnTexttype
3760             {
3761 0     0 1 0 my $self = shift;
3762             ## 2 byte signed integer
3763 0 0       0 if ($self -> isTexttype) { $self -> {'RecordData'}[0]; }
  0         0  
3764 0         0 else { UNKNOWN; }
3765             }
3766             ################################################################################
3767              
3768             =head2 returnWidth - returns width # if record is WIDTH else returns -1
3769              
3770             usage:
3771              
3772             =cut
3773              
3774             sub returnWidth
3775             {
3776 0     0 1 0 my $self = shift;
3777             ## 4 byte signed integer
3778 0 0       0 if ($self -> isWidth) { $self -> {'RecordData'}[0]; }
  0         0  
3779 0         0 else { UNKNOWN; }
3780             }
3781             ################################################################################
3782              
3783             ################################################################################
3784              
3785             =head1 Low Level Specific Boolean Methods
3786              
3787             =cut
3788              
3789             ################################################################################
3790              
3791             =head2 isAref - return 0 or 1 depending on whether current record is an aref
3792              
3793             =cut
3794              
3795             sub isAref
3796             {
3797 0     0 1 0 my $self = shift;
3798 0 0       0 if ($self -> {'RecordType'} == AREF) { 1; }
  0         0  
3799 0         0 else { 0; }
3800             }
3801             ################################################################################
3802              
3803             =head2 isBgnlib - return 0 or 1 depending on whether current record is a bgnlib
3804              
3805             =cut
3806              
3807             sub isBgnlib
3808             {
3809 0     0 1 0 my $self = shift;
3810 0 0       0 if ($self -> {'RecordType'} == BGNLIB) { 1; }
  0         0  
3811 0         0 else { 0; }
3812             }
3813             ################################################################################
3814              
3815             =head2 isBgnstr - return 0 or 1 depending on whether current record is a bgnstr
3816              
3817             =cut
3818              
3819             sub isBgnstr
3820             {
3821 0     0 1 0 my $self = shift;
3822 0 0       0 if ($self -> {'RecordType'} == BGNSTR) { 1; }
  0         0  
3823 0         0 else { 0; }
3824             }
3825             ################################################################################
3826              
3827             =head2 isBoundary - return 0 or 1 depending on whether current record is a boundary
3828              
3829             =cut
3830              
3831             sub isBoundary
3832             {
3833 0     0 1 0 my $self = shift;
3834 0 0       0 if ($self -> {'RecordType'} == BOUNDARY) { 1; }
  0         0  
3835 0         0 else { 0; }
3836             }
3837             ################################################################################
3838              
3839             =head2 isDatatype - return 0 or 1 depending on whether current record is datatype
3840              
3841             =cut
3842              
3843             sub isDatatype
3844             {
3845 0     0 1 0 my $self = shift;
3846 0 0       0 if ($self -> {'RecordType'} == DATATYPE) { 1; }
  0         0  
3847 0         0 else { 0; }
3848             }
3849             ################################################################################
3850              
3851             =head2 isEndlib - return 0 or 1 depending on whether current record is endlib
3852              
3853             =cut
3854              
3855             sub isEndlib
3856             {
3857 0     0 1 0 my $self = shift;
3858 0 0       0 if ($self -> {'RecordType'} == ENDLIB) { 1; }
  0         0  
3859 0         0 else { 0; }
3860             }
3861             ################################################################################
3862              
3863             =head2 isEndel - return 0 or 1 depending on whether current record is endel
3864              
3865             =cut
3866              
3867             sub isEndel
3868             {
3869 0     0 1 0 my $self = shift;
3870 0 0       0 if ($self -> {'RecordType'} == ENDEL) { 1; }
  0         0  
3871 0         0 else { 0; }
3872             }
3873             ################################################################################
3874              
3875             =head2 isEndstr - return 0 or 1 depending on whether current record is endstr
3876              
3877             =cut
3878              
3879             sub isEndstr
3880             {
3881 0     0 1 0 my $self = shift;
3882 0 0       0 if ($self -> {'RecordType'} == ENDSTR) { 1; }
  0         0  
3883 0         0 else { 0; }
3884             }
3885             ################################################################################
3886              
3887              
3888             =head2 isHeader - return 0 or 1 depending on whether current record is a header
3889              
3890             =cut
3891              
3892             sub isHeader
3893             {
3894 0     0 1 0 my $self = shift;
3895 0 0       0 if ($self -> {'RecordType'} == HEADER) { 1; }
  0         0  
3896 0         0 else { 0; }
3897             }
3898             ################################################################################
3899              
3900             =head2 isLibname - return 0 or 1 depending on whether current record is a libname
3901              
3902             =cut
3903              
3904             sub isLibname
3905             {
3906 0     0 1 0 my $self = shift;
3907 0 0       0 if ($self -> {'RecordType'} == LIBNAME) { 1; }
  0         0  
3908 0         0 else { 0; }
3909             }
3910             ################################################################################
3911              
3912             =head2 isPath - return 0 or 1 depending on whether current record is a path
3913              
3914             =cut
3915              
3916             sub isPath
3917             {
3918 0     0 1 0 my $self = shift;
3919 0 0       0 if ($self -> {'RecordType'} == PATH) { 1; }
  0         0  
3920 0         0 else { 0; }
3921             }
3922             ################################################################################
3923              
3924             =head2 isSref - return 0 or 1 depending on whether current record is an sref
3925              
3926             =cut
3927              
3928             sub isSref
3929             {
3930 0     0 1 0 my $self = shift;
3931 0 0       0 if ($self -> {'RecordType'} == SREF) { 1; }
  0         0  
3932 0         0 else { 0; }
3933             }
3934             ################################################################################
3935              
3936             =head2 isSrfname - return 0 or 1 depending on whether current record is an srfname
3937              
3938             =cut
3939              
3940             sub isSrfname
3941             {
3942 0     0 1 0 my $self = shift;
3943 0 0       0 if ($self -> {'RecordType'} == SRFNAME) { 1; }
  0         0  
3944 0         0 else { 0; }
3945             }
3946             ################################################################################
3947              
3948             =head2 isText - return 0 or 1 depending on whether current record is a text
3949              
3950             =cut
3951              
3952             sub isText
3953             {
3954 0     0 1 0 my $self = shift;
3955 0 0       0 if ($self -> {'RecordType'} == TEXT) { 1; }
  0         0  
3956 0         0 else { 0; }
3957             }
3958             ################################################################################
3959              
3960             =head2 isUnits - return 0 or 1 depending on whether current record is units
3961              
3962             =cut
3963              
3964             sub isUnits
3965             {
3966 0     0 1 0 my $self = shift;
3967 0 0       0 if ($self -> {'RecordType'} == UNITS) { 1; }
  0         0  
3968 0         0 else { 0; }
3969             }
3970             ################################################################################
3971              
3972             =head2 isLayer - return 0 or 1 depending on whether current record is layer
3973              
3974             =cut
3975              
3976             sub isLayer
3977             {
3978 0     0 1 0 my $self = shift;
3979 0 0       0 if ($self -> {'RecordType'} == LAYER) { 1; }
  0         0  
3980 0         0 else { 0; }
3981             }
3982             ################################################################################
3983              
3984             =head2 isStrname - return 0 or 1 depending on whether current record is strname
3985              
3986             =cut
3987              
3988             sub isStrname
3989             {
3990 0     0 1 0 my $self = shift;
3991 0 0       0 if ($self -> {'RecordType'} == STRNAME) { 1; }
  0         0  
3992 0         0 else { 0; }
3993             }
3994             ################################################################################
3995              
3996             =head2 isWidth - return 0 or 1 depending on whether current record is width
3997              
3998             =cut
3999              
4000             sub isWidth
4001             {
4002 0     0 1 0 my $self = shift;
4003 0 0       0 if ($self -> {'RecordType'} == WIDTH) { 1; }
  0         0  
4004 0         0 else { 0; }
4005             }
4006             ################################################################################
4007              
4008             =head2 isXy - return 0 or 1 depending on whether current record is xy
4009              
4010             =cut
4011              
4012             sub isXy
4013             {
4014 0     0 1 0 my $self = shift;
4015 0 0       0 if ($self -> {'RecordType'} == XY) { 1; }
  0         0  
4016 0         0 else { 0; }
4017             }
4018             ################################################################################
4019              
4020             =head2 isSname - return 0 or 1 depending on whether current record is sname
4021              
4022             =cut
4023              
4024             sub isSname
4025             {
4026 0     0 1 0 my $self = shift;
4027 0 0       0 if ($self -> {'RecordType'} == SNAME) { 1; }
  0         0  
4028 0         0 else { 0; }
4029             }
4030             ################################################################################
4031              
4032             =head2 isColrow - return 0 or 1 depending on whether current record is colrow
4033              
4034             =cut
4035              
4036             sub isColrow
4037             {
4038 0     0 1 0 my $self = shift;
4039 0 0       0 if ($self -> {'RecordType'} == COLROW) { 1; }
  0         0  
4040 0         0 else { 0; }
4041             }
4042             ################################################################################
4043              
4044             =head2 isTextnode - return 0 or 1 depending on whether current record is a textnode
4045              
4046             =cut
4047              
4048             sub isTextnode
4049             {
4050 0     0 1 0 my $self = shift;
4051 0 0       0 if ($self -> {'RecordType'} == TEXTNODE) { 1; }
  0         0  
4052 0         0 else { 0; }
4053             }
4054             ################################################################################
4055              
4056             =head2 isNode - return 0 or 1 depending on whether current record is a node
4057              
4058             =cut
4059              
4060             sub isNode
4061             {
4062 0     0 1 0 my $self = shift;
4063 0 0       0 if ($self -> {'RecordType'} == NODE) { 1; }
  0         0  
4064 0         0 else { 0; }
4065             }
4066             ################################################################################
4067              
4068             =head2 isTexttype - return 0 or 1 depending on whether current record is a texttype
4069              
4070             =cut
4071              
4072             sub isTexttype
4073             {
4074 0     0 1 0 my $self = shift;
4075 0 0       0 if ($self -> {'RecordType'} == TEXTTYPE) { 1; }
  0         0  
4076 0         0 else { 0; }
4077             }
4078             ################################################################################
4079              
4080             =head2 isPresentation - return 0 or 1 depending on whether current record is a presentation
4081              
4082             =cut
4083              
4084             sub isPresentation
4085             {
4086 0     0 1 0 my $self = shift;
4087 0 0       0 if ($self -> {'RecordType'} == PRESENTATION) { 1; }
  0         0  
4088 0         0 else { 0; }
4089             }
4090             ################################################################################
4091              
4092             =head2 isSpacing - return 0 or 1 depending on whether current record is a spacing
4093              
4094             =cut
4095              
4096             sub isSpacing
4097             {
4098 0     0 1 0 my $self = shift;
4099 0 0       0 if ($self -> {'RecordType'} == SPACING) { 1; }
  0         0  
4100 0         0 else { 0; }
4101             }
4102             ################################################################################
4103              
4104             =head2 isString - return 0 or 1 depending on whether current record is a string
4105              
4106             =cut
4107              
4108             sub isString
4109             {
4110 0     0 1 0 my $self = shift;
4111 0 0       0 if ($self -> {'RecordType'} == STRING) { 1; }
  0         0  
4112 0         0 else { 0; }
4113             }
4114             ################################################################################
4115              
4116             =head2 isStrans - return 0 or 1 depending on whether current record is a strans
4117              
4118             =cut
4119              
4120             sub isStrans
4121             {
4122 0     0 1 0 my $self = shift;
4123 0 0       0 if ($self -> {'RecordType'} == STRANS) { 1; }
  0         0  
4124 0         0 else { 0; }
4125             }
4126             ################################################################################
4127              
4128             =head2 isMag - return 0 or 1 depending on whether current record is a mag
4129              
4130             =cut
4131              
4132             sub isMag
4133             {
4134 0     0 1 0 my $self = shift;
4135 0 0       0 if ($self -> {'RecordType'} == MAG) { 1; }
  0         0  
4136 0         0 else { 0; }
4137             }
4138             ################################################################################
4139              
4140             =head2 isAngle - return 0 or 1 depending on whether current record is a angle
4141              
4142             =cut
4143              
4144             sub isAngle
4145             {
4146 0     0 1 0 my $self = shift;
4147 0 0       0 if ($self -> {'RecordType'} == ANGLE) { 1; }
  0         0  
4148 0         0 else { 0; }
4149             }
4150             ################################################################################
4151              
4152             =head2 isUinteger - return 0 or 1 depending on whether current record is a uinteger
4153              
4154             =cut
4155              
4156             sub isUinteger
4157             {
4158 0     0 1 0 my $self = shift;
4159 0 0       0 if ($self -> {'RecordType'} == UINTEGER) { 1; }
  0         0  
4160 0         0 else { 0; }
4161             }
4162             ################################################################################
4163              
4164             =head2 isUstring - return 0 or 1 depending on whether current record is a ustring
4165              
4166             =cut
4167              
4168             sub isUstring
4169             {
4170 0     0 1 0 my $self = shift;
4171 0 0       0 if ($self -> {'RecordType'} == USTRING) { 1; }
  0         0  
4172 0         0 else { 0; }
4173             }
4174             ################################################################################
4175              
4176             =head2 isReflibs - return 0 or 1 depending on whether current record is a reflibs
4177              
4178             =cut
4179              
4180             sub isReflibs
4181             {
4182 0     0 1 0 my $self = shift;
4183 0 0       0 if ($self -> {'RecordType'} == REFLIBS) { 1; }
  0         0  
4184 0         0 else { 0; }
4185             }
4186             ################################################################################
4187              
4188             =head2 isFonts - return 0 or 1 depending on whether current record is a fonts
4189              
4190             =cut
4191              
4192             sub isFonts
4193             {
4194 0     0 1 0 my $self = shift;
4195 0 0       0 if ($self -> {'RecordType'} == FONTS) { 1; }
  0         0  
4196 0         0 else { 0; }
4197             }
4198             ################################################################################
4199              
4200             =head2 isPathtype - return 0 or 1 depending on whether current record is a pathtype
4201              
4202             =cut
4203              
4204             sub isPathtype
4205             {
4206 0     0 1 0 my $self = shift;
4207 0 0       0 if ($self -> {'RecordType'} == PATHTYPE) { 1; }
  0         0  
4208 0         0 else { 0; }
4209             }
4210             ################################################################################
4211              
4212             =head2 isGenerations - return 0 or 1 depending on whether current record is a generations
4213              
4214             =cut
4215              
4216             sub isGenerations
4217             {
4218 0     0 1 0 my $self = shift;
4219 0 0       0 if ($self -> {'RecordType'} == GENERATIONS) { 1; }
  0         0  
4220 0         0 else { 0; }
4221             }
4222             ################################################################################
4223              
4224             =head2 isAttrtable - return 0 or 1 depending on whether current record is a attrtable
4225              
4226             =cut
4227              
4228             sub isAttrtable
4229             {
4230 0     0 1 0 my $self = shift;
4231 0 0       0 if ($self -> {'RecordType'} == ATTRTABLE) { 1; }
  0         0  
4232 0         0 else { 0; }
4233             }
4234             ################################################################################
4235              
4236             =head2 isStyptable - return 0 or 1 depending on whether current record is a styptable
4237              
4238             =cut
4239              
4240             sub isStyptable
4241             {
4242 0     0 1 0 my $self = shift;
4243 0 0       0 if ($self -> {'RecordType'} == STYPTABLE) { 1; }
  0         0  
4244 0         0 else { 0; }
4245             }
4246             ################################################################################
4247              
4248             =head2 isStrtype - return 0 or 1 depending on whether current record is a strtype
4249              
4250             =cut
4251              
4252             sub isStrtype
4253             {
4254 0     0 1 0 my $self = shift;
4255 0 0       0 if ($self -> {'RecordType'} == STRTYPE) { 1; }
  0         0  
4256 0         0 else { 0; }
4257             }
4258             ################################################################################
4259              
4260             =head2 isEflags - return 0 or 1 depending on whether current record is a eflags
4261              
4262             =cut
4263              
4264             sub isEflags
4265             {
4266 0     0 1 0 my $self = shift;
4267 0 0       0 if ($self -> {'RecordType'} == EFLAGS) { 1; }
  0         0  
4268 0         0 else { 0; }
4269             }
4270             ################################################################################
4271              
4272             =head2 isElkey - return 0 or 1 depending on whether current record is a elkey
4273              
4274             =cut
4275              
4276             sub isElkey
4277             {
4278 0     0 1 0 my $self = shift;
4279 0 0       0 if ($self -> {'RecordType'} == ELKEY) { 1; }
  0         0  
4280 0         0 else { 0; }
4281             }
4282             ################################################################################
4283              
4284             =head2 isLinktype - return 0 or 1 depending on whether current record is a linktype
4285              
4286             =cut
4287              
4288             sub isLinktype
4289             {
4290 0     0 1 0 my $self = shift;
4291 0 0       0 if ($self -> {'RecordType'} == LINKTYPE) { 1; }
  0         0  
4292 0         0 else { 0; }
4293             }
4294             ################################################################################
4295              
4296             =head2 isLinkkeys - return 0 or 1 depending on whether current record is a linkkeys
4297              
4298             =cut
4299              
4300             sub isLinkkeys
4301             {
4302 0     0 1 0 my $self = shift;
4303 0 0       0 if ($self -> {'RecordType'} == LINKKEYS) { 1; }
  0         0  
4304 0         0 else { 0; }
4305             }
4306             ################################################################################
4307              
4308             =head2 isNodetype - return 0 or 1 depending on whether current record is a nodetype
4309              
4310             =cut
4311              
4312             sub isNodetype
4313             {
4314 0     0 1 0 my $self = shift;
4315 0 0       0 if ($self -> {'RecordType'} == NODETYPE) { 1; }
  0         0  
4316 0         0 else { 0; }
4317             }
4318             ################################################################################
4319              
4320             =head2 isPropattr - return 0 or 1 depending on whether current record is a propattr
4321              
4322             =cut
4323              
4324             sub isPropattr
4325             {
4326 0     0 1 0 my $self = shift;
4327 0 0       0 if ($self -> {'RecordType'} == PROPATTR) { 1; }
  0         0  
4328 0         0 else { 0; }
4329             }
4330             ################################################################################
4331              
4332             =head2 isPropvalue - return 0 or 1 depending on whether current record is a propvalue
4333              
4334             =cut
4335              
4336             sub isPropvalue
4337             {
4338 0     0 1 0 my $self = shift;
4339 0 0       0 if ($self -> {'RecordType'} == PROPVALUE) { 1; }
  0         0  
4340 0         0 else { 0; }
4341             }
4342             ################################################################################
4343              
4344             =head2 isBox - return 0 or 1 depending on whether current record is a box
4345              
4346             =cut
4347              
4348             sub isBox
4349             {
4350 0     0 1 0 my $self = shift;
4351 0 0       0 if ($self -> {'RecordType'} == BOX) { 1; }
  0         0  
4352 0         0 else { 0; }
4353             }
4354             ################################################################################
4355              
4356             =head2 isBoxtype - return 0 or 1 depending on whether current record is a boxtype
4357              
4358             =cut
4359              
4360             sub isBoxtype
4361             {
4362 0     0 1 0 my $self = shift;
4363 0 0       0 if ($self -> {'RecordType'} == BOXTYPE) { 1; }
  0         0  
4364 0         0 else { 0; }
4365             }
4366             ################################################################################
4367              
4368             =head2 isPlex - return 0 or 1 depending on whether current record is a plex
4369              
4370             =cut
4371              
4372             sub isPlex
4373             {
4374 0     0 1 0 my $self = shift;
4375 0 0       0 if ($self -> {'RecordType'} == PLEX) { 1; }
  0         0  
4376 0         0 else { 0; }
4377             }
4378             ################################################################################
4379              
4380             =head2 isBgnextn - return 0 or 1 depending on whether current record is a bgnextn
4381              
4382             =cut
4383              
4384             sub isBgnextn
4385             {
4386 0     0 1 0 my $self = shift;
4387 0 0       0 if ($self -> {'RecordType'} == BGNEXTN) { 1; }
  0         0  
4388 0         0 else { 0; }
4389             }
4390             ################################################################################
4391              
4392             =head2 isEndextn - return 0 or 1 depending on whether current record is a endextn
4393              
4394             =cut
4395              
4396             sub isEndextn
4397             {
4398 0     0 1 0 my $self = shift;
4399 0 0       0 if ($self -> {'RecordType'} == ENDEXTN) { 1; }
  0         0  
4400 0         0 else { 0; }
4401             }
4402             ################################################################################
4403              
4404             =head2 isTapenum - return 0 or 1 depending on whether current record is a tapenum
4405              
4406             =cut
4407              
4408             sub isTapenum
4409             {
4410 0     0 1 0 my $self = shift;
4411 0 0       0 if ($self -> {'RecordType'} == TAPENUM) { 1; }
  0         0  
4412 0         0 else { 0; }
4413             }
4414             ################################################################################
4415              
4416             =head2 isTapecode - return 0 or 1 depending on whether current record is a tapecode
4417              
4418             =cut
4419              
4420             sub isTapecode
4421             {
4422 0     0 1 0 my $self = shift;
4423 0 0       0 if ($self -> {'RecordType'} == TAPECODE) { 1; }
  0         0  
4424 0         0 else { 0; }
4425             }
4426             ################################################################################
4427              
4428             =head2 isStrclass - return 0 or 1 depending on whether current record is a strclass
4429              
4430             =cut
4431              
4432             sub isStrclass
4433             {
4434 0     0 1 0 my $self = shift;
4435 0 0       0 if ($self -> {'RecordType'} == STRCLASS) { 1; }
  0         0  
4436 0         0 else { 0; }
4437             }
4438             ################################################################################
4439              
4440             =head2 isReserved - return 0 or 1 depending on whether current record is a reserved
4441              
4442             =cut
4443              
4444             sub isReserved
4445             {
4446 0     0 1 0 my $self = shift;
4447 0 0       0 if ($self -> {'RecordType'} == RESERVED) { 1; }
  0         0  
4448 0         0 else { 0; }
4449             }
4450             ################################################################################
4451              
4452             =head2 isFormat - return 0 or 1 depending on whether current record is a format
4453              
4454             =cut
4455              
4456             sub isFormat
4457             {
4458 0     0 1 0 my $self = shift;
4459 0 0       0 if ($self -> {'RecordType'} == FORMAT) { 1; }
  0         0  
4460 0         0 else { 0; }
4461             }
4462             ################################################################################
4463              
4464             =head2 isMask - return 0 or 1 depending on whether current record is a mask
4465              
4466             =cut
4467              
4468             sub isMask
4469             {
4470 0     0 1 0 my $self = shift;
4471 0 0       0 if ($self -> {'RecordType'} == MASK) { 1; }
  0         0  
4472 0         0 else { 0; }
4473             }
4474             ################################################################################
4475              
4476             =head2 isEndmasks - return 0 or 1 depending on whether current record is a endmasks
4477              
4478             =cut
4479              
4480             sub isEndmasks
4481             {
4482 0     0 1 0 my $self = shift;
4483 0 0       0 if ($self -> {'RecordType'} == ENDMASKS) { 1; }
  0         0  
4484 0         0 else { 0; }
4485             }
4486             ################################################################################
4487              
4488             =head2 isLibdirsize - return 0 or 1 depending on whether current record is a libdirsize
4489              
4490             =cut
4491              
4492             sub isLibdirsize
4493             {
4494 0     0 1 0 my $self = shift;
4495 0 0       0 if ($self -> {'RecordType'} == LIBDIRSIZE) { 1; }
  0         0  
4496 0         0 else { 0; }
4497             }
4498             ################################################################################
4499              
4500             =head2 isLibsecur - return 0 or 1 depending on whether current record is a libsecur
4501              
4502             =cut
4503              
4504             sub isLibsecur
4505             {
4506 0     0 1 0 my $self = shift;
4507 0 0       0 if ($self -> {'RecordType'} == LIBSECUR) { 1; }
  0         0  
4508 0         0 else { 0; }
4509             }
4510             ################################################################################
4511              
4512             ################################################################################
4513             ## support functions
4514              
4515             sub getRecordData
4516             {
4517 0     0 0 0 my $self = shift;
4518 0         0 my $dt = $self -> {'DataType'};
4519 0 0 0     0 if ($dt==NO_REC_DATA)
    0 0        
    0          
4520             {
4521 0         0 return '';
4522             }
4523             elsif ($dt==INTEGER_2 || $dt==INTEGER_4 || $dt==REAL_8)
4524             {
4525 0         0 my $stuff = $self -> {'CurrentDataList'};
4526 0         0 $stuff =~ s|^,||;
4527 0         0 return(split(/,/,$stuff));
4528             }
4529             elsif ($dt==ACSII_STRING)
4530             {
4531 0         0 my $stuff = $self -> {'CurrentDataList'};
4532 0         0 $stuff =~ s|\0||g;
4533 0         0 return($stuff);
4534             }
4535             else ## bit_array
4536             {
4537 0         0 return ($self -> {'CurrentDataList'});
4538             }
4539             }
4540             ################################################################################
4541              
4542             sub readRecordTypeAndData
4543             {
4544 0     0 0 0 my $self = shift;
4545 0         0 return ($RecordTypeStrings[$self -> {'RecordType'}],$self -> {'RecordData'});
4546             }
4547             ################################################################################
4548              
4549             sub skipGds2RecordData
4550             {
4551 24     24 0 20 my $self = shift;
4552 24 50       39 $self -> readGds2RecordHeader() if ($self -> {'INHEADER'} != TRUE); ## safety - need to read HEADER if INHEADER == UNKNOWN or FALSE
4553 24         22 $self -> {'INHEADER'} = FALSE;
4554 24         23 $self -> {'INDATA'} = TRUE; # in DATA - actually will be at the end of data by the time we test this...
4555             ## 4 should have been just read by readGds2RecordHeader
4556 24         67 seek($self -> {'FileHandle'},$self -> {'Length'} - 4,SEEK_CUR); ## seek seems to run a little faster than read
4557 24         21 $self -> {'DataIndex'} = UNKNOWN;
4558 24         18 return 1;
4559             }
4560             ################################################################################
4561              
4562             ### return number of XY coords if XY record
4563             sub returnNumCoords
4564             {
4565 0     0 0 0 my $self = shift;
4566 0 0       0 if ($self -> {'RecordType'} == XY) ## 4 byte signed integer
4567             {
4568 0         0 int(($self -> {'Length'} - 4) / 8);
4569             }
4570             else
4571             {
4572 0         0 0;
4573             }
4574             }
4575             ################################################################################
4576              
4577             sub roundNum
4578             {
4579 0     0 0 0 my $self = shift;
4580 0         0 my $num = shift;
4581 0         0 my $places = shift;
4582 0         0 sprintf("%.${places}f",$num);
4583             }
4584             ################################################################################
4585              
4586             sub scaleNum($$)
4587             {
4588 0     0 0 0 my $num=shift;
4589 0         0 my $scale=shift;
4590 0 0       0 die "1st number passed into scaleNum() must be an integer $!" if ($num !~ m|^-?\d+|);
4591 0         0 $num = $num * $scale;
4592 0 0       0 $num = int($num+0.5) if ($num =~ m|\.|);
4593 0         0 $num;
4594             }
4595             ################################################################################
4596              
4597             sub snapNum($$)
4598             {
4599 0     0 0 0 my $num=shift;
4600 0 0       0 die "1st number passed into snapNum() must be an integer $!" if ($num !~ m|^-?\d+$|);
4601 0         0 my $snap=shift;
4602 0         0 my $snapLength = length("$snap");
4603 0         0 my $lean=1; ##init
4604 0 0       0 $lean = -1 if($num < 0);
4605             ## snap to grid..
4606 0         0 my $littlePart=substr($num,-$snapLength,$snapLength);
4607 0 0       0 if($num<0)
4608             {
4609 0         0 $littlePart = -$littlePart;
4610             }
4611 0         0 $littlePart = int(($littlePart/$snap)+(0.5*$lean))*$snap;
4612 0         0 my $bigPart=substr($num,0,-$snapLength);
4613 0 0       0 if ($bigPart =~ m|^[-]?$|)
4614             {
4615 0         0 $bigPart=0;
4616             }
4617             else
4618             {
4619 0         0 $bigPart *= 10**$snapLength;
4620             }
4621 0         0 $num = $bigPart + $littlePart;
4622 0         0 $num;
4623             }
4624             ################################################################################
4625              
4626             sub DESTROY
4627             {
4628 8     8   1519 my $self = shift;
4629             #warn "DESTROYing $self";
4630             }
4631             ################################################################################
4632              
4633             ################################################################################
4634             ## some vendor tools have trouble w/ negative angles and angles >= 360
4635             ## so we normalize to positive equivalent
4636             ################################################################################
4637             sub posAngle($)
4638             {
4639 0     0 0 0 my $angle = shift;
4640 0         0 $angle += 360.0 while ($angle < 0.0);
4641 0         0 $angle -= 360.0 while ($angle >= 360.0);
4642 0         0 $angle = cleanFloatNum($angle);
4643 0         0 $angle;
4644             }
4645             ################################################################################
4646              
4647             =head2 recordSize - return current record size
4648              
4649             usage:
4650             my $len = $gds2File -> recordSize;
4651              
4652              
4653             =cut
4654              
4655             sub recordSize()
4656             {
4657 0     0 1 0 my $self = shift;
4658 0         0 $self -> {'Length'};
4659             }
4660             ################################################################################
4661              
4662             =head2 dataSize - return current record size - 4 (length of data)
4663              
4664             usage:
4665             my $dataLen = $gds2File -> dataSize;
4666              
4667              
4668             =cut
4669              
4670             sub dataSize()
4671             {
4672 0     0 1 0 my $self = shift;
4673 0         0 $self -> {'Length'} - 4;
4674             }
4675             ################################################################################
4676              
4677             =head2 returnUnitsAsArray - return user units and database units as a 2 element array
4678              
4679             usage:
4680             my ($uu,$dbu) = $gds2File -> returnUnitsAsArray;
4681              
4682              
4683             =cut
4684              
4685             sub returnUnitsAsArray
4686             {
4687 0     0 1 0 my $self = shift;
4688 0 0       0 if ($self -> isUnits) { ($self -> {'UUnits'}, $self -> {'DBUnits'}); }
  0         0  
4689 0         0 else { () }
4690             }
4691             ################################################################################
4692              
4693             #######
4694             sub subbyte() ## GDS2::version();
4695             {
4696 0     0 0 0 my($what,$where,$howmuch) = @_;
4697 0         0 unpack("x$where C$howmuch", $what);
4698             }
4699             ################################################################################
4700              
4701             =head2 version - return GDS2 module version string
4702              
4703             =cut
4704              
4705             #######
4706             sub version() ## GDS2::version();
4707             {
4708 0     0 1 0 return $GDS2::VERSION;
4709             }
4710             ################################################################################
4711              
4712             =head2 version - return GDS2 module revision string
4713              
4714             =cut
4715              
4716             #######
4717             sub revision() ## GDS2::revision();
4718             {
4719 0     0 1 0 return $GDS2::revision;
4720             }
4721             ################################################################################
4722              
4723             sub getElmSpace
4724             {
4725 150     150 0 213 return $ElmSpace;
4726             }
4727             ################################################################################
4728              
4729             sub putElmSpace
4730             {
4731 60     60 0 86 $ElmSpace = shift;
4732             }
4733             ################################################################################
4734              
4735             sub getStrSpace
4736             {
4737 164     164 0 237 return $StrSpace;
4738             }
4739             ################################################################################
4740              
4741             sub putStrSpace
4742             {
4743 18     18 0 24 $StrSpace = shift;
4744             }
4745             ################################################################################
4746              
4747             1;
4748             }
4749              
4750             __END__