File Coverage

blib/lib/GDS2.pm
Criterion Covered Total %
statement 829 1859 44.5
branch 263 856 30.7
condition 76 228 33.3
subroutine 106 253 41.9
pod 130 172 75.5
total 1404 3368 41.6


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