File Coverage

lib/PostScript/Simple.pm
Criterion Covered Total %
statement 374 539 69.3
branch 149 226 65.9
condition 29 59 49.1
subroutine 28 35 80.0
pod 22 23 95.6
total 602 882 68.2


line stmt bran cond sub pod time code
1             #! /usr/bin/perl -w
2              
3             package PostScript::Simple;
4              
5 7     7   175343 use strict;
  7         18  
  7         563  
6 7     7   41 use vars qw($VERSION @ISA @EXPORT);
  7         108  
  7         668  
7 7     7   39 use Carp;
  7         15  
  7         728  
8 7     7   35 use Exporter;
  7         11  
  7         335  
9 7     7   13878 use PostScript::Simple::EPS;
  7         32  
  7         83471  
10              
11             @ISA = qw(Exporter);
12             @EXPORT = qw();
13             $VERSION = '0.08';
14              
15              
16             #-------------------------------------------------------------------------------
17              
18             =head1 NAME
19              
20             PostScript::Simple - Produce PostScript files from Perl
21              
22             =head1 SYNOPSIS
23              
24             use PostScript::Simple;
25            
26             # create a new PostScript object
27             $p = new PostScript::Simple(papersize => "A4",
28             colour => 1,
29             eps => 0,
30             units => "in");
31            
32             # create a new page
33             $p->newpage;
34            
35             # draw some lines and other shapes
36             $p->line(1,1, 1,4);
37             $p->linextend(2,4);
38             $p->box(1.5,1, 2,3.5);
39             $p->circle(2,2, 1);
40             $p->setlinewidth( 0.01 );
41             $p->curve(1,5, 1,7, 3,7, 3,5);
42             $p->curvextend(3,3, 5,3, 5,5);
43            
44             # draw a rotated polygon in a different colour
45             $p->setcolour(0,100,200);
46             $p->polygon({rotate=>45}, 1,1, 1,2, 2,2, 2,1, 1,1);
47            
48             # add some text in red
49             $p->setcolour("red");
50             $p->setfont("Times-Roman", 20);
51             $p->text(1,1, "Hello");
52            
53             # write the output to a file
54             $p->output("file.ps");
55              
56              
57             =head1 DESCRIPTION
58              
59             PostScript::Simple allows you to have a simple method of writing PostScript
60             files from Perl. It has graphics primitives that allow lines, curves, circles,
61             polygons and boxes to be drawn. Text can be added to the page using standard
62             PostScript fonts.
63              
64             The images can be single page EPS files, or multipage PostScript files. The
65             image size can be set by using a recognised paper size ("C", for example) or
66             by giving dimensions. The units used can be specified ("C" or "C", etc)
67             and are the same as those used in TeX. The default unit is a bp, or a PostScript
68             point, unlike TeX.
69              
70             =head1 PREREQUISITES
71              
72             This module requires C and C.
73              
74             =head2 EXPORT
75              
76             None.
77              
78             =cut
79              
80              
81             #-------------------------------------------------------------------------------
82              
83             # Define some colour names
84             my %pscolours = (
85             # Original colours from PostScript::Simple
86             brightred => [255, 0, 0], brightgreen => [0, 255, 0], brightblue => [0, 0, 1],
87             red => [204, 0, 0], green => [0, 204, 0], blue => [0, 0, 204],
88             darkred => [127, 0, 0], darkgreen => [0, 127, 0], darkblue => [0, 0, 127],
89             grey10 => [25, 25, 25], grey20 => [51, 51, 51], grey30 => [76, 76, 76],
90             grey40 => [102, 102, 102], grey50 => [127, 127, 127], grey60 => [153, 153, 153],
91             grey70 => [178, 178, 178], grey80 => [204, 204, 204], grey90 => [229, 229, 229],
92             black => [0, 0, 0], white => [255, 255, 255],
93              
94             # X-Windows colours, unless they clash with the above (only /(dark)?(red|green|blue)/ )
95             aliceblue => [240, 248, 255], antiquewhite => [250, 235, 215], aqua => [0, 255, 255],
96             aquamarine => [127, 255, 212], azure => [240, 255, 255], beige => [245, 245, 220],
97             bisque => [255, 228, 196], blanchedalmond => [255, 255, 205], blueviolet => [138, 43, 226],
98             brown => [165, 42, 42], burlywood => [222, 184, 135], cadetblue => [95, 158, 160],
99             chartreuse => [127, 255, 0], chocolate => [210, 105, 30], coral => [255, 127, 80],
100             cornflowerblue => [100, 149, 237], cornsilk => [255, 248, 220], crimson => [220, 20, 60],
101             cyan => [0, 255, 255], darkcyan => [0, 139, 139], darkgoldenrod => [184, 134, 11],
102             darkgray => [169, 169, 169], darkgrey => [169, 169, 169], darkkhaki => [189, 183, 107],
103             darkmagenta => [139, 0, 139], darkolivegreen => [85, 107, 47], darkorange => [255, 140, 0],
104             darkorchid => [153, 50, 204], darksalmon => [233, 150, 122], darkseagreen => [143, 188, 143],
105             darkslateblue => [72, 61, 139], darkslategray => [47, 79, 79], darkslategrey => [47, 79, 79],
106             darkturquoise => [0, 206, 209], darkviolet => [148, 0, 211], deeppink => [255, 20, 147],
107             deepskyblue => [0, 191, 255], dimgray => [105, 105, 105], dimgrey => [105, 105, 105],
108             dodgerblue => [30, 144, 255], firebrick => [178, 34, 34], floralwhite => [255, 250, 240],
109             forestgreen => [34, 139, 34], fuchsia => [255, 0, 255], gainsboro => [220, 220, 220],
110             ghostwhite => [248, 248, 255], gold => [255, 215, 0], goldenrod => [218, 165, 32],
111             gray => [128, 128, 128], grey => [128, 128, 128], greenyellow => [173, 255, 47],
112             honeydew => [240, 255, 240], hotpink => [255, 105, 180], indianred => [205, 92, 92],
113             indigo => [75, 0, 130], ivory => [255, 240, 240], khaki => [240, 230, 140],
114             lavender => [230, 230, 250], lavenderblush => [255, 240, 245], lawngreen => [124, 252, 0],
115             lemonchiffon => [255, 250, 205], lightblue => [173, 216, 230], lightcoral => [240, 128, 128],
116             lightcyan => [224, 255, 255], lightgoldenrodyellow => [250, 250, 210], lightgray => [211, 211, 211],
117             lightgreen => [144, 238, 144], lightgrey => [211, 211, 211], lightpink => [255, 182, 193],
118             lightsalmon => [255, 160, 122], lightseagreen => [32, 178, 170], lightskyblue => [135, 206, 250],
119             lightslategray => [119, 136, 153], lightslategrey => [119, 136, 153], lightsteelblue => [176, 196, 222],
120             lightyellow => [255, 255, 224], lime => [0, 255, 0], limegreen => [50, 205, 50],
121             linen => [250, 240, 230], magenta => [255, 0, 255], maroon => [128, 0, 0],
122             mediumaquamarine => [102, 205, 170], mediumblue => [0, 0, 205], mediumorchid => [186, 85, 211],
123             mediumpurple => [147, 112, 219], mediumseagreen => [60, 179, 113], mediumslateblue => [123, 104, 238],
124             mediumspringgreen => [0, 250, 154], mediumturquoise => [72, 209, 204], mediumvioletred => [199, 21, 133],
125             midnightblue => [25, 25, 112], mintcream => [245, 255, 250], mistyrose => [255, 228, 225],
126             moccasin => [255, 228, 181], navajowhite => [255, 222, 173], navy => [0, 0, 128],
127             oldlace => [253, 245, 230], olive => [128, 128, 0], olivedrab => [107, 142, 35],
128             orange => [255, 165, 0], orangered => [255, 69, 0], orchid => [218, 112, 214],
129             palegoldenrod => [238, 232, 170], palegreen => [152, 251, 152], paleturquoise => [175, 238, 238],
130             palevioletred => [219, 112, 147], papayawhip => [255, 239, 213], peachpuff => [255, 218, 185],
131             peru => [205, 133, 63], pink => [255, 192, 203], plum => [221, 160, 221],
132             powderblue => [176, 224, 230], purple => [128, 0, 128], rosybrown => [188, 143, 143],
133             royalblue => [65, 105, 225], saddlebrown => [139, 69, 19], salmon => [250, 128, 114],
134             sandybrown => [244, 164, 96], seagreen => [46, 139, 87], seashell => [255, 245, 238],
135             sienna => [160, 82, 45], silver => [192, 192, 192], skyblue => [135, 206, 235],
136             slateblue => [106, 90, 205], slategray => [112, 128, 144], slategrey => [112, 128, 144],
137             snow => [255, 250, 250], springgreen => [0, 255, 127], steelblue => [70, 130, 180],
138             tan => [210, 180, 140], teal => [0, 128, 128], thistle => [216, 191, 216],
139             tomato => [253, 99, 71], turquoise => [64, 224, 208], violet => [238, 130, 238],
140             wheat => [245, 222, 179], whitesmoke => [245, 245, 245], yellow => [255, 255, 0],
141             yellowgreen => [154, 205, 50],
142             );
143              
144              
145             # define page sizes here (a4, letter, etc)
146             # should be Properly Cased
147             my %pspaper = (
148             A0 => [2384, 3370],
149             A1 => [1684, 2384],
150             A2 => [1191, 1684],
151             A3 => [841.88976, 1190.5512],
152             A4 => [595.27559, 841.88976],
153             A5 => [420.94488, 595.27559],
154             A6 => [297, 420],
155             A7 => [210, 297],
156             A8 => [148, 210],
157             A9 => [105, 148],
158              
159             B0 => [2920, 4127],
160             B1 => [2064, 2920],
161             B2 => [1460, 2064],
162             B3 => [1032, 1460],
163             B4 => [729, 1032],
164             B5 => [516, 729],
165             B6 => [363, 516],
166             B7 => [258, 363],
167             B8 => [181, 258],
168             B9 => [127, 181 ],
169             B10 => [91, 127],
170              
171             Executive => [522, 756],
172             Folio => [595, 935],
173             'Half-Letter' => [612, 397],
174             Letter => [612, 792],
175             'US-Letter' => [612, 792],
176             Legal => [612, 1008],
177             'US-Legal' => [612, 1008],
178             Tabloid => [792, 1224],
179             'SuperB' => [843, 1227],
180             Ledger => [1224, 792],
181              
182             'Comm #10 Envelope' => [297, 684],
183             'Envelope-Monarch' => [280, 542],
184             'Envelope-DL' => [312, 624],
185             'Envelope-C5' => [461, 648],
186              
187             'EuroPostcard' => [298, 420],
188             );
189              
190              
191             # The 13 standard fonts that are available on all PS 1 implementations:
192             my @fonts = (
193             'Courier', 'Courier-Bold', 'Courier-BoldOblique', 'Courier-Oblique',
194             'Helvetica', 'Helvetica-Bold', 'Helvetica-BoldOblique', 'Helvetica-Oblique',
195             'Times-Roman', 'Times-Bold', 'Times-BoldItalic', 'Times-Italic',
196             'Symbol');
197              
198             # define the origins for the page a document can have
199             # (default is "LeftBottom")
200             my %psorigin = (
201             'LeftBottom' => [ 0, 0],
202             'LeftTop' => [ 0, -1],
203             'RightBottom' => [-1, 0],
204             'RightTop' => [-1, -1],
205             );
206              
207             # define the co-ordinate direction (default is 'RightUp')
208             my %psdirs = (
209             'RightUp' => [ 1, 1],
210             'RightDown' => [ 1, -1],
211             'LeftUp' => [-1, 1],
212             'LeftDown' => [-1, -1],
213             );
214              
215              
216             # measuring units are two-letter acronyms as used in TeX:
217             # bp: postscript point (72 per inch)
218             # in: inch (72 postscript points)
219             # pt: printer's point (72.27 per inch)
220             # mm: millimetre (25.4 per inch)
221             # cm: centimetre (2.54 per inch)
222             # pi: pica (12 printer's points)
223             # dd: didot point (67.567. per inch)
224             # cc: cicero (12 didot points)
225              
226             # set up the others here (sp) XXXXX
227              
228             my %psunits = (
229             pt => [72, 72.27],
230             pc => [72, 6.0225],
231             in => [72, 1],
232             bp => [1, 1],
233             cm => [72, 2.54],
234             mm => [72, 25.4],
235             dd => [72, 67.567],
236             cc => [72, 810.804],
237             );
238              
239              
240             #-------------------------------------------------------------------------------
241              
242             =head1 CONSTRUCTOR
243              
244             =over 4
245              
246             =item C
247              
248             Create a new PostScript::Simple object. The different options that can be set are:
249              
250             =over 4
251              
252             =item units
253              
254             Units that are to be used in the file. Common units would be C, C,
255             C, C, and C. Others are as used in TeX. (Default: C)
256              
257             =item xsize
258              
259             Specifies the width of the drawing area in units.
260              
261             =item ysize
262              
263             Specifies the height of the drawing area in units.
264              
265             =item papersize
266              
267             The size of paper to use, if C or C are not defined. This allows
268             a document to easily be created using a standard paper size without having to
269             remember the size of paper using PostScript points. Valid choices are currently
270             "C", "C", "C", and "C".
271              
272             =item landscape
273              
274             Use the landscape option to rotate the page by 90 degrees. The paper dimensions
275             are also rotated, so that clipping will still work. (Note that the printer will
276             still think that the paper is portrait.) (Default: 0)
277              
278             =item copies
279              
280             Set the number of copies that should be printed. (Default: 1)
281              
282             =item clip
283              
284             If set to 1, the image will be clipped to the xsize and ysize. This is most
285             useful for an EPS image. (Default: 0)
286              
287             =item colour
288              
289             Specifies whether the image should be rendered in colour or not. If set to 0
290             (default) all requests for a colour are mapped to a greyscale. Otherwise the
291             colour requested with C or C is used. This option is present
292             because most modern laser printers are only black and white. (Default: 0)
293              
294             =item eps
295              
296             Generate an EPS file, rather than a standard PostScript file. If set to 1, no
297             newpage methods will actually create a new page. This option is probably the
298             most useful for generating images to be imported into other applications, such
299             as TeX. (Default: 1)
300              
301             =item page
302              
303             Specifies the initial page number of the (multi page) document. The page number
304             is set with the Adobe DSC comments, and is used nowhere else. It only makes
305             finding your pages easier. See also the C method. (Default: 1)
306              
307             =item coordorigin
308              
309             Defines the co-ordinate origin for each page produced. Valid arguments are
310             C, C, C and C. The default is
311             C.
312              
313             =item direction
314              
315             The direction the co-ordinates go from the origin. Values can be C,
316             C, C and C. The default value is C.
317              
318             =item reencode
319              
320             Requests that a font re-encode function be added and that the 13 standard
321             PostScript fonts get re-encoded in the specified encoding. The most popular
322             choice (other than undef) is 'ISOLatin1Encoding' which selects the iso8859-1
323             encoding and fits most of western Europe, including the Scandinavia. Refer to
324             Adobes Postscript documentation for other encodings.
325              
326             The output file is, by default, re-encoded to ISOLatin1Encoding. To stop this
327             happening, use 'reencode => undef'. To use the re-encoded font, '-iso' must be
328             appended to the names of the fonts used, e.g. 'Helvetica-iso'.
329              
330             =back
331              
332             Example:
333              
334             $ref = new PostScript::Simple(landscape => 1,
335             eps => 0,
336             xsize => 4,
337             ysize => 3,
338             units => "in");
339              
340             Create a document that is 4 by 3 inches and prints landscape on a page. It is
341             not an EPS file, and must therefore use the C method.
342              
343             $ref = new PostScript::Simple(eps => 1,
344             colour => 1,
345             xsize => 12,
346             ysize => 12,
347             units => "cm",
348             reencode => "ISOLatin1Encoding");
349              
350             Create a 12 by 12 cm EPS image that is in colour. Note that "C 1>"
351             did not have to be specified because this is the default. Re-encode the
352             standard fonts into the iso8859-1 encoding, providing all the special characters
353             used in Western Europe. The C method should not be used.
354              
355             =back
356              
357             =cut
358              
359             sub new
360             {
361 9     9 1 492 my ($class, %data) = @_;
362 9         223 my $self = {
363             xsize => undef,
364             ysize => undef,
365             papersize => undef,
366             units => "bp", # measuring units (see below)
367             landscape => 0, # rotate the page 90 degrees
368             copies => 1, # number of copies
369             colour => 0, # use colour
370             clip => 0, # clip to the bounding box
371             eps => 1, # create eps file
372             page => 1, # page number to start at
373             reencode => "ISOLatin1Encoding", # Re-encode the 13 standard
374             # fonts in this encoding
375              
376             bbx1 => 0, # Bounding Box definitions
377             bby1 => 0,
378             bbx2 => 0,
379             bby2 => 0,
380              
381             pscomments => "", # the following entries store data
382             psprolog => "", # for the same DSC areas of the
383             psfunctions => "", # postscript file.
384             pssetup => "",
385             pspages => "",
386             pstrailer => "",
387             usedunits => {}, # units that have been used
388              
389             lastfontsize => 0,
390             pspagecount => 0,
391             usedcircle => 0,
392             usedcircletext => 0,
393             usedbox => 0,
394             usedrotabout => 0,
395             usedimporteps => 0,
396              
397             coordorigin => 'LeftBottom',
398             direction => 'RightUp',
399             };
400              
401 9         43 foreach (keys %data) {
402 26         58 $self->{$_} = $data{$_};
403             }
404              
405 9         28 bless $self, $class;
406 9         44 $self->init();
407              
408 9         41 return $self;
409             }
410              
411              
412             #-------------------------------------------------------------------------------
413              
414             sub _u
415             {
416 515     515   10341 my ($self, $u, $rev) = @_;
417              
418 515         768 my $val;
419             my $unit;
420              
421             # $u may be...
422             # a simple number, in which case the current units are used
423             # a listref of [number, "unit"], to force the unit
424             # a string "number unit", e.g. "4 mm" or "2.4in"
425              
426 515 100       946 if (ref($u) eq "ARRAY") {
427 5         10 $val = $$u[0];
428 5         10 $unit = $$u[1];
429 5 100       524 confess "Invalid array" if @$u != 2;
430             } else {
431 510 100       2586 if ($u =~ /^\s*(\d+(?:\.\d+)?)\s*([a-z][a-z])?\s*$/) {
432 508         949 $val = $1;
433 508   66     2319 $unit = $2 || $self->{units};
434             }
435             }
436              
437 513 100       1329 confess "Cannot determine length" unless defined $val;
438 511 50       853 confess "Cannot determine unit (invalid array?)" unless defined $unit;
439              
440 511 100       1282 croak "Invalid unit '$unit'" unless defined $psunits{$unit};
441              
442 510 100       1117 unless (defined $self->{usedunits}{$unit}) {
443 15         22 my ($m, $d) = @{$psunits{$unit}};
  15         39  
444              
445 15         35 my $c = "{";
446 15 100       73 $c .= "$m mul " unless $m == 1;
447 15 100       111 $c .= "$d div " unless $d == 1;
448 15         57 $c =~ s/ $//;
449 15         29 $c .="}";
450 15         67 $self->{usedunits}{$unit} = "/u$unit $c def";
451             }
452              
453 510 100       1127 $val = $rev * $val if defined $rev;
454              
455 510         2152 return "$val u$unit ";
456             }
457              
458             sub _ux
459             {
460 249     249   2103 my ($self, $d) = @_;
461              
462 249         657 return $self->_u($d, $psdirs{$self->{direction}}[0]);
463             }
464              
465             sub _uy
466             {
467 248     248   297 my ($self, $d) = @_;
468              
469 248         846 return $self->_u($d, $psdirs{$self->{direction}}[1]);
470             }
471              
472             sub _uxy
473             {
474 247     247   476 my ($self, $x, $y) = @_;
475              
476 247         1509 return $self->_ux($x) . $self->_uy($y);
477             }
478              
479              
480             sub init
481             {
482 9     9 0 19 my $self = shift;
483              
484 9         21 my ($m, $d) = (1, 1);
485 9         15 my ($u, $mm);
486              
487             # Units
488 9         73 $self->{units} = lc $self->{units};
489              
490 9 50       41 if (defined($psunits{$self->{units}})) {
491 9         17 ($m, $d) = @{$psunits{$self->{units}}};
  9         36  
492             } else {
493 0         0 $self->_error( "unit '$self->{units}' undefined" );
494             }
495              
496              
497             # Paper size
498 9 100       37 if (defined $self->{papersize}) {
499 3         51 $self->{papersize} = ucfirst lc $self->{papersize};
500             }
501              
502 9 100 66     133 if (!defined $self->{xsize} || !defined $self->{ysize}) {
503 6 100 66     76 if (defined $self->{papersize} && defined $pspaper{$self->{papersize}}) {
504 3         6 ($self->{xsize}, $self->{ysize}) = @{$pspaper{$self->{papersize}}};
  3         12  
505 3         26 $self->{bbx2} = int($self->{xsize});
506 3         9 $self->{bby2} = int($self->{ysize});
507 3         53 $self->{pscomments} .= "\%\%DocumentMedia: $self->{papersize} $self->{xsize} ";
508 3         16 $self->{pscomments} .= "$self->{ysize} 0 ( ) ( )\n";
509             } else {
510 3         1146 ($self->{xsize}, $self->{ysize}) = (100,100);
511 3         16 $self->_error( "page size undefined" );
512             }
513             } else {
514 3         18 $self->{bbx2} = int(($self->{xsize} * $m) / $d);
515 3         12 $self->{bby2} = int(($self->{ysize} * $m) / $d);
516             }
517              
518 9 100       46 if (!$self->{eps}) {
519 2         20 $self->{pssetup} .= "ll 2 ge { << /PageSize [ $self->{xsize} " .
520             "$self->{ysize} ] /ImagingBBox null >>" .
521             " setpagedevice } if\n";
522             }
523              
524             # Landscape
525 9 50       36 if ($self->{landscape}) {
526 0         0 my $swap;
527              
528 0         0 $self->{psfunctions} .= "/landscape {
529             $self->{bbx2} 0 translate
530             90 rotate
531             } bind def
532             ";
533             # I now think that Portrait is the correct thing here, as the page is
534             # rotated.
535 0         0 $self->{pscomments} .= "\%\%Orientation: Portrait\n";
536             # $self->{pscomments} .= "\%\%Orientation: Landscape\n";
537 0         0 $swap = $self->{bbx2};
538 0         0 $self->{bbx2} = $self->{bby2};
539 0         0 $self->{bby2} = $swap;
540              
541             # for EPS files, change to landscape here, as there are no pages
542 0 0       0 if ($self->{eps}) { $self->{pssetup} .= "landscape\n" }
  0         0  
543             } else {
544 9         26 $self->{pscomments} .= "\%\%Orientation: Portrait\n";
545             }
546            
547             # Clipping
548 9 50       73 if ($self->{clip}) {
549 0         0 $self->{psfunctions} .= "/pageclip {newpath $self->{bbx1} $self->{bby1} moveto
550             $self->{bbx1} $self->{bby2} lineto
551             $self->{bbx2} $self->{bby2} lineto
552             $self->{bbx2} $self->{bby1} lineto
553             $self->{bbx1} $self->{bby1} lineto
554             closepath clip} bind def
555             ";
556 0 0       0 if ($self->{eps}) { $self->{pssetup} .= "pageclip\n" }
  0         0  
557             }
558              
559             # Font reencoding
560 9 100       57 if ($self->{reencode}) {
561 8         20 my $encoding; # The name of the encoding
562             my $ext; # The extention to tack onto the std fontnames
563              
564 8 50       33 if (ref $self->{reencode} eq 'ARRAY') {
565 0         0 die "Custom reencoding of fonts not really implemented yet, sorry...";
566 0         0 $encoding = shift @{$self->{reencode}};
  0         0  
567 0         0 $ext = shift @{$self->{reencode}};
  0         0  
568             # TODO: Do something to add the actual encoding to the postscript code.
569             } else {
570 8         24 $encoding = $self->{reencode};
571 8         16 $ext = '-iso';
572             }
573              
574 8         55 $self->{psfunctions} .= <<'EOP';
575             /STARTDIFFENC { mark } bind def
576             /ENDDIFFENC {
577              
578             % /NewEnc BaseEnc STARTDIFFENC number or glyphname ... ENDDIFFENC -
579             counttomark 2 add -1 roll 256 array copy
580             /TempEncode exch def
581              
582             % pointer for sequential encodings
583             /EncodePointer 0 def
584             {
585             % Get the bottom object
586             counttomark -1 roll
587             % Is it a mark?
588             dup type dup /marktype eq {
589             % End of encoding
590             pop pop exit
591             } {
592             /nametype eq {
593             % Insert the name at EncodePointer
594              
595             % and increment the pointer.
596             TempEncode EncodePointer 3 -1 roll put
597             /EncodePointer EncodePointer 1 add def
598             } {
599             % Set the EncodePointer to the number
600             /EncodePointer exch def
601             } ifelse
602             } ifelse
603             } loop
604              
605             TempEncode def
606             } bind def
607              
608             % Define ISO Latin1 encoding if it doesnt exist
609             /ISOLatin1Encoding where {
610             % (ISOLatin1 exists!) =
611             pop
612             } {
613             (ISOLatin1 does not exist, creating...) =
614             /ISOLatin1Encoding StandardEncoding STARTDIFFENC
615             144 /dotlessi /grave /acute /circumflex /tilde
616             /macron /breve /dotaccent /dieresis /.notdef /ring
617             /cedilla /.notdef /hungarumlaut /ogonek /caron /space
618             /exclamdown /cent /sterling /currency /yen /brokenbar
619             /section /dieresis /copyright /ordfeminine
620             /guillemotleft /logicalnot /hyphen /registered
621             /macron /degree /plusminus /twosuperior
622             /threesuperior /acute /mu /paragraph /periodcentered
623             /cedilla /onesuperior /ordmasculine /guillemotright
624             /onequarter /onehalf /threequarters /questiondown
625             /Agrave /Aacute /Acircumflex /Atilde /Adieresis
626             /Aring /AE /Ccedilla /Egrave /Eacute /Ecircumflex
627             /Edieresis /Igrave /Iacute /Icircumflex /Idieresis
628             /Eth /Ntilde /Ograve /Oacute /Ocircumflex /Otilde
629             /Odieresis /multiply /Oslash /Ugrave /Uacute
630             /Ucircumflex /Udieresis /Yacute /Thorn /germandbls
631             /agrave /aacute /acircumflex /atilde /adieresis
632             /aring /ae /ccedilla /egrave /eacute /ecircumflex
633             /edieresis /igrave /iacute /icircumflex /idieresis
634             /eth /ntilde /ograve /oacute /ocircumflex /otilde
635             /odieresis /divide /oslash /ugrave /uacute
636             /ucircumflex /udieresis /yacute /thorn /ydieresis
637             ENDDIFFENC
638             } ifelse
639              
640             % Name: Re-encode Font
641             % Description: Creates a new font using the named encoding.
642              
643             /REENCODEFONT { % /Newfont NewEncoding /Oldfont
644             findfont dup length 4 add dict
645             begin
646             { % forall
647             1 index /FID ne
648             2 index /UniqueID ne and
649             2 index /XUID ne and
650             { def } { pop pop } ifelse
651             } forall
652             /Encoding exch def
653             % defs for DPS
654             /BitmapWidths false def
655             /ExactSize 0 def
656             /InBetweenSize 0 def
657             /TransformedChar 0 def
658             currentdict
659             end
660             definefont pop
661             } bind def
662              
663             % Reencode the std fonts:
664             EOP
665            
666 8         24 for my $font (@fonts) {
667 104         396 $self->{psfunctions} .= "/${font}$ext $encoding /$font REENCODEFONT\n";
668             }
669             }
670             }
671              
672              
673             #-------------------------------------------------------------------------------
674              
675             =head1 OBJECT METHODS
676              
677             All object methods return 1 for success or 0 in some error condition (e.g.
678             insufficient arguments). Error message text is also drawn on the page.
679              
680             =over 4
681              
682             =item C
683              
684             Generates a new page on a PostScript file. If specified, C gives the
685             number (or name) of the page. This method should not be used for EPS files.
686              
687             The page number is automatically incremented each time this is called without
688             a new page number, or decremented if the current page number is negative.
689              
690             Example:
691              
692             $p->newpage(1);
693             $p->newpage;
694             $p->newpage("hello");
695             $p->newpage(-6);
696             $p->newpage;
697              
698             will generate five pages, numbered: 1, 2, "hello", -6, -7.
699              
700             =cut
701              
702             sub newpage
703             {
704 5     5 1 2409 my $self = shift;
705 5         10 my $nextpage = shift;
706 5         5 my ($x, $y);
707            
708 5 100       17 if (defined($nextpage)) { $self->{page} = $nextpage; }
  2         5  
709              
710 5 100       14 if ($self->{eps}) {
711             # Cannot have multiple pages in an EPS file
712 1         5 $self->_error("Do not use newpage for eps files!");
713 1         5 return 0;
714             }
715              
716 4 100       13 if ($self->{pspagecount} != 0) {
717 2         4 $self->{pspages} .= "\%\%PageTrailer\npagelevel restore\nshowpage\n";
718             }
719              
720 4         14 $self->{pspagecount} ++;
721 4         17 $self->{pspages} .= "\%\%Page: $self->{page} $self->{pspagecount}\n";
722 4 100       11 if ($self->{page} >= 0) {
723 2         3 $self->{page} ++;
724             } else {
725 2         4 $self->{page} --;
726             }
727              
728 4         22 $self->{pspages} .= "\%\%BeginPageSetup\n";
729 4         9 $self->{pspages} .= "/pagelevel save def\n";
730 4 50       18 if ($self->{landscape}) { $self->{pspages} .= "landscape\n" }
  0         0  
731 4 50       11 if ($self->{clip}) { $self->{pspages} .= "pageclip\n" }
  0         0  
732 4         5 ($x, $y) = @{$psorigin{$self->{coordorigin}}};
  4         16  
733 4 50       12 $x = $self->{xsize} if ($x < 0);
734 4 50       9 $y = $self->{ysize} if ($y < 0);
735 4 50 33     29 $self->{pspages} .= "$x $y translate\n" if (($x != 0) || ($y != 0));
736 4         8 $self->{pspages} .= "\%\%EndPageSetup\n";
737              
738 4         10 return 1;
739             }
740              
741              
742             #-------------------------------------------------------------------------------
743              
744             =item C
745              
746             Writes the current PostScript out to the file named C. Will destroy
747             any existing file of the same name.
748              
749             Use this method whenever output is required to disk. The current PostScript
750             document in memory is not cleared, and can still be extended.
751              
752             =cut
753              
754             sub _builddocument
755             {
756 4     4   8 my $self = shift;
757 4         10 my $title = shift;
758            
759 4         7 my $page;
760 4         913 my $date = scalar localtime;
761 4         16 my $user;
762              
763 4 50       23 $title = 'undefined' unless $title;
764              
765 4         12 $page = [];
766              
767             # getlogin is unimplemented on some systems
768 4         9 eval { $user = getlogin; };
  4         768665  
769 4 50       41 $user = 'Console' unless $user;
770              
771             # Comments Section
772 4         15 push @$page, "%!PS-Adobe-3.0";
773 4 100       31 push @$page, " EPSF-1.2" if ($self->{eps});
774 4         12 push @$page, "\n";
775 4         22 push @$page, "\%\%Title: ($title)\n";
776 4         10 push @$page, "\%\%LanguageLevel: 1\n";
777 4         20 push @$page, "\%\%Creator: PostScript::Simple perl module version $VERSION\n";
778 4         17 push @$page, "\%\%CreationDate: $date\n";
779 4         15 push @$page, "\%\%For: $user\n";
780 4         39 push @$page, \$self->{pscomments};
781             # push @$page, "\%\%DocumentFonts: \n";
782 4 100       37 if ($self->{eps}) {
783 2         24 push @$page, "\%\%BoundingBox: $self->{bbx1} $self->{bby1} $self->{bbx2} $self->{bby2}\n";
784             } else {
785 2         20 push @$page, "\%\%Pages: $self->{pspagecount}\n";
786             }
787 4         20 push @$page, "\%\%EndComments\n";
788            
789             # Prolog Section
790 4         12 push @$page, "\%\%BeginProlog\n";
791 4         10 push @$page, "/ll 1 def systemdict /languagelevel known {\n";
792 4         12 push @$page, "/ll languagelevel def } if\n";
793 4         12 push @$page, \$self->{psprolog};
794 4         12 push @$page, "\%\%BeginResource: PostScript::Simple\n";
795 4         18 push @$page, \$self->{psfunctions};
796 4         12 foreach my $un (sort keys %{$self->{usedunits}}) {
  4         36  
797 5         32 push @$page, $self->{usedunits}{$un} . "\n";
798             }
799 4         14 push @$page, "\%\%EndResource\n";
800 4         11 push @$page, "\%\%EndProlog\n";
801              
802             # Setup Section
803 4 100 66     38 if (length($self->{pssetup}) || ($self->{copies} > 1)) {
804 2         6 push @$page, "\%\%BeginSetup\n";
805 2 50       10 if ($self->{copies} > 1) {
806 0         0 push @$page, "/#copies " . $self->{copies} . " def\n";
807             }
808 2         7 push @$page, \$self->{pssetup};
809 2         5 push @$page, "\%\%EndSetup\n";
810             }
811              
812             # Pages
813 4         13 push @$page, \$self->{pspages};
814 4 100 66     46 if ((!$self->{eps}) && ($self->{pspagecount} > 0)) {
815 2         14 push @$page, "\%\%PageTrailer\n";
816 2         4 push @$page, "pagelevel restore\n";
817 2         6 push @$page, "showpage\n";
818             }
819              
820             # Trailer Section
821 4 50       21 if (length($self->{pstrailer})) {
822 0         0 push @$page, "\%\%Trailer\n";
823 0         0 push @$page, \$self->{pstrailer};
824             }
825 4         14 push @$page, "\%\%EOF\n";
826            
827 4         18 return $page;
828             }
829              
830              
831             #- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
832              
833             sub output
834             {
835 5     5 1 26 my $self = shift;
836 5   100     41 my $file = shift || die("Must supply a filename for output");
837 4         8 my $page;
838             my $i;
839            
840 4         16 $page = _builddocument($self, $file);
841              
842 4         19 local *OUT;
843 4 50       791 open(OUT, '>', $file) or die("Cannot write to file $file: $!");
844              
845 4         18 foreach $i (@$page) {
846 99 100       243 if (ref($i) eq "SCALAR") {
847 18         101 print OUT $$i;
848             } else {
849 81         259 print OUT $i;
850             }
851             }
852              
853 4         657 close OUT;
854            
855 4         46 return 1;
856             }
857              
858              
859             #-------------------------------------------------------------------------------
860              
861             =item C
862              
863             Returns the current document.
864              
865             Use this method whenever output is required as a scalar. The current PostScript
866             document in memory is not cleared, and can still be extended.
867              
868             =cut
869              
870             sub get
871             {
872 0     0 1 0 my $self = shift;
873 0         0 my $page;
874             my $i;
875 0         0 my $doc;
876            
877 0         0 $page = _builddocument($self, "PostScript::Simple generated page");
878 0         0 $doc = "";
879 0         0 foreach $i (@$page) {
880 0 0       0 if (ref($i) eq "SCALAR") {
881 0         0 $doc .= $$i;
882             } else {
883 0         0 $doc .= $i;
884             }
885             }
886 0         0 return $doc;
887             }
888              
889              
890             #-------------------------------------------------------------------------------
891              
892             =item C
893              
894             Returns the current document as a PostScript::Simple::EPS object. Only works if
895             the current document is EPS.
896              
897             This method calls new PostScript::Simple::EPS with all the default options. To
898             change these, call it yourself as below, rather than using this method.
899              
900             $eps = new PostScript::Simple::EPS(source => $ps->get);
901              
902             =cut
903              
904             sub geteps
905             {
906 0     0 1 0 my $self = shift;
907 0         0 my $page;
908             my $i;
909 0         0 my $doc;
910 0         0 my $eps;
911            
912 0 0       0 croak "document is not EPS" unless ($$self{eps} == 1);
913              
914 0         0 $eps = new PostScript::Simple::EPS(source => $self->get);
915 0         0 return $eps;
916             }
917              
918              
919             #-------------------------------------------------------------------------------
920              
921             =item C
922              
923             Sets the new drawing colour to the RGB values specified in C, C and
924             C. The values range from 0 to 255.
925              
926             Alternatively, a colour name may be specified. Those currently defined are
927             listed at the top of the PostScript::Simple module in the C<%pscolours> hash
928             and include the standard X-Windows colour names.
929              
930             Example:
931              
932             # set new colour to brown
933             $p->setcolour(200,100,0);
934             # set new colour to black
935             $p->setcolour("black");
936              
937             =cut
938              
939             sub setcolour
940             {
941 52     52 1 659 my $self = shift;
942 52         69 my ($r, $g, $b) = @_;
943              
944 52 100       113 if ( @_ == 1 ) {
945 10         19 $r = lc $r;
946 10 100       28 if (defined $pscolours{$r}) {
947 9         11 ($r, $g, $b) = @{$pscolours{$r}};
  9         29  
948             } else {
949 1         23 $self->_error( "bad colour name '$r'" );
950 1         5 return 0;
951             }
952             }
953              
954 51         78 my $bad = 0;
955 51 50       100 if (not defined $r) { $r = 'undef'; $bad = 1; }
  0         0  
  0         0  
956 51 50       93 if (not defined $g) { $g = 'undef'; $bad = 1; }
  0         0  
  0         0  
957 51 100       105 if (not defined $b) { $b = 'undef'; $bad = 1; }
  2         4  
  2         3  
958              
959 51 100       96 if ($bad) {
960 2         11 $self->_error( "setcolour given invalid arguments: $r, $g, $b" );
961 2         7 return 0;
962             }
963              
964             # make sure floats aren't too long, and means the tests pass when
965             # using a system with long doubles enabled by default
966 49         300 $r = 0 + sprintf("%0.5f", $r / 255);
967 49         165 $g = 0 + sprintf("%0.5f", $g / 255);
968 49         289 $b = 0 + sprintf("%0.5f", $b / 255);
969              
970 49 50       99 if ($self->{colour}) {
971 49         244 $self->{pspages} .= "$r $g $b setrgbcolor\n";
972             } else {
973             # Better colour->grey conversion than just 0.33 of each:
974 0         0 $r = 0.3*$r + 0.59*$g + 0.11*$b;
975 0         0 $r = 0 + sprintf("%0.5f", $r / 255);
976 0         0 $self->{pspages} .= "$r setgray\n";
977             }
978            
979 49         950 return 1;
980             }
981              
982              
983             #-------------------------------------------------------------------------------
984              
985             =item C
986              
987             Sets the new line width to C units.
988              
989             Example:
990              
991             # draw a line 10mm long and 4mm wide
992             $p = new PostScript::Simple(units => "mm");
993             $p->setlinewidth(4);
994             $p->line(10,10, 20,10);
995              
996             =cut
997              
998             sub setlinewidth
999             {
1000 5     5 1 27 my $self = shift;
1001 5   66     18 my $width = shift || do {
1002             $self->_error( "setlinewidth not given a width" ); return 0;
1003             };
1004              
1005 4 100       16 $width = "0.4 bp" if $width eq "thin";
1006              
1007 4         13 $self->{pspages} .= $self->_u($width) . "setlinewidth\n";
1008            
1009 4         11 return 1;
1010             }
1011              
1012              
1013             #-------------------------------------------------------------------------------
1014              
1015             =item C
1016              
1017             Draws a line from the co-ordinates (x1,x2) to (x2,y2). If values are specified
1018             for C, C and C, then the colour is set before the line is drawn.
1019              
1020             Example:
1021              
1022             # set the colour to black
1023             $p->setcolour("black");
1024              
1025             # draw a line in the current colour (black)
1026             $p->line(10,10, 10,20);
1027            
1028             # draw a line in red
1029             $p->line(20,10, 20,20, 255,0,0);
1030              
1031             # draw another line in red
1032             $p->line(30,10, 30,20);
1033              
1034             =cut
1035              
1036             sub line
1037             {
1038 12     12 1 49 my $self = shift;
1039 12         24 my ($x1, $y1, $x2, $y2, $r, $g, $b) = @_;
1040              
1041 12 50 66     52 if ((!$self->{pspagecount}) and (!$self->{eps})) {
1042             # Cannot draw on to non-page when not an eps file
1043 0         0 return 0;
1044             }
1045              
1046 12 100       48 if ( @_ == 7 ) {
    100          
1047 3         10 $self->setcolour($r, $g, $b);
1048             } elsif ( @_ != 4 ) {
1049 2         7 $self->_error( "wrong number of args for line" );
1050 2         10 return 0;
1051             }
1052            
1053 10         25 $self->newpath;
1054 10         44 $self->moveto($x1, $y1);
1055 10         29 $self->{pspages} .= $self->_uxy($x2, $y2) . "lineto stroke\n";
1056            
1057 10         35 return 1;
1058             }
1059              
1060              
1061             #-------------------------------------------------------------------------------
1062              
1063             =item C
1064              
1065             Assuming the previous command was C, C, C or
1066             C, extend that line to include another segment to the co-ordinates
1067             (x,y). Behaviour after any other method is unspecified.
1068              
1069             Example:
1070              
1071             $p->line(10,10, 10,20);
1072             $p->linextend(20,20);
1073             $p->linextend(20,10);
1074             $p->linextend(10,10);
1075              
1076             Notes
1077              
1078             The C method may be more appropriate.
1079              
1080             =cut
1081              
1082             sub linextend
1083             {
1084 6     6 1 22 my $self = shift;
1085 6         9 my ($x, $y) = @_;
1086            
1087 6 100       24 unless ( @_ == 2 ) {
1088 1         3 $self->_error( "wrong number of args for linextend" );
1089 1         4 return 0;
1090             }
1091            
1092 5         16 my $out = $self->_uxy($x, $y) . "lineto stroke\n";
1093 5         74 $self->{pspages} =~ s/eto stroke\n$/eto\n$out/;
1094            
1095             # perhaps we need something like $self->{_lastcommand} to know if operations
1096             # are valid, rather than using a regexp?
1097            
1098 5         16 return 1;
1099             }
1100              
1101              
1102             #-------------------------------------------------------------------------------
1103              
1104             =item C
1105              
1106             Draws an arc on the circle of radius C with centre (C,C). The arc
1107             starts at angle C and finishes at C. Angles are specified
1108             in degrees, where 0 is at 3 o'clock, and the direction of travel is anti-clockwise.
1109              
1110             Any options are passed in a hash reference as the first parameter. The available
1111             option is:
1112              
1113             =over 4
1114              
1115             =item filled => 1
1116              
1117             If C is 1 then the arc will be filled in.
1118              
1119             =back
1120              
1121             Example:
1122              
1123             # semi-circle
1124             $p->arc(10, 10, 5, 0, 180);
1125              
1126             # complete filled circle
1127             $p->arc({filled=>1}, 30, 30, 10, 0, 360);
1128              
1129             =cut
1130              
1131             sub arc
1132             {
1133 0     0 1 0 my $self = shift;
1134 0         0 my %opt = ();
1135              
1136 0 0       0 if (ref($_[0])) {
1137 0         0 %opt = %{; shift};
  0         0  
1138             }
1139              
1140 0 0 0     0 if ((!$self->{pspagecount}) and (!$self->{eps})) {
1141             # Cannot draw on to non-page when not an eps file
1142 0         0 return 0;
1143             }
1144              
1145 0         0 my ($x, $y, $r, $sa, $ea) = @_;
1146              
1147 0 0       0 unless (@_ == 5) {
1148 0         0 $self->_error("arc: wrong number of arguments");
1149 0         0 return 0;
1150             }
1151              
1152 0         0 $self->newpath;
1153 0         0 $self->{pspages} .= $self->_uxy($x, $y) . $self->_u($r) . "$sa $ea arc ";
1154 0 0       0 if ($opt{'filled'}) {
1155 0         0 $self->{pspages} .= "fill\n"
1156             } else {
1157 0         0 $self->{pspages} .= "stroke\n"
1158             }
1159            
1160 0         0 return 1;
1161             }
1162              
1163              
1164             #-------------------------------------------------------------------------------
1165              
1166             =item C
1167              
1168             The C method is multi-function, allowing many shapes to be created and
1169             manipulated. Polygon draws lines from (x1,y1) to (x2,y2) and then from (x2,y2) to
1170             (x3,y3) up to (xn-1,yn-1) to (xn,yn).
1171              
1172             Any options are passed in a hash reference as the first parameter. The available
1173             options are as follows:
1174              
1175             =over 4
1176              
1177             =item rotate => angle
1178             =item rotate => [angle,x,y]
1179              
1180             Rotate the polygon by C degrees anti-clockwise. If x and y are specified
1181             then use the co-ordinate (x,y) as the centre of rotation, otherwise use the
1182             co-ordinate (x1,y1) from the main polygon.
1183              
1184             =item filled => 1
1185              
1186             If C is 1 then the PostScript output is set to fill the object rather
1187             than just draw the lines.
1188              
1189             =item offset => [x,y]
1190              
1191             Displace the object by the vector (x,y).
1192              
1193             =back
1194              
1195             Example:
1196              
1197             # draw a square with lower left point at (10,10)
1198             $p->polygon(10,10, 10,20, 20,20, 20,10, 10,10);
1199              
1200             # draw a filled square with lower left point at (20,20)
1201             $p->polygon( {offset => [10,10], filled => 1},
1202             10,10, 10,20, 20,20, 20,10, 10,10);
1203              
1204             # draw a filled square with lower left point at (10,10)
1205             # rotated 45 degrees (about the point (10,10))
1206             $p->polygon( {rotate => 45, filled => 1},
1207             10,10, 10,20, 20,20, 20,10, 10,10);
1208              
1209             =cut
1210              
1211             sub polygon
1212             {
1213 27     27 1 158 my $self = shift;
1214              
1215 27         44 my %opt = ();
1216 27         81 my ($xoffset, $yoffset) = (0,0);
1217 27         68 my ($rotate, $rotatex, $rotatey) = (0,0,0);
1218              
1219 27 100       74 if ($#_ < 3) {
1220             # cannot have polygon with just one point...
1221 1         4 $self->_error( "bad polygon - not enough points" );
1222 1         4 return 0;
1223             }
1224              
1225 26 100       62 if (ref($_[0])) {
1226 24         23 %opt = %{; shift};
  24         94  
1227             }
1228              
1229 26         40 my $x = shift;
1230 26         28 my $y = shift;
1231              
1232 26 100       56 if (defined $opt{'rotate'}) {
1233 22 100       54 if (ref($opt{'rotate'})) {
1234 20         19 ($rotate, $rotatex, $rotatey) = @{$opt{'rotate'}};
  20         39  
1235             } else {
1236 2         6 ($rotate, $rotatex, $rotatey) = ($opt{'rotate'}, $x, $y);
1237             }
1238             }
1239              
1240 26 100       58 if (defined $opt{'offset'}) {
1241 21 50       39 if (ref($opt{'offset'})) {
1242 21         22 ($xoffset, $yoffset) = @{$opt{'offset'}};
  21         41  
1243             } else {
1244 0         0 $self->_error("polygon: bad offset option" );
1245 0         0 return 0;
1246             }
1247             }
1248              
1249 26 100       56 if (!defined $opt{'filled'}) {
1250 6         18 $opt{'filled'} = 0;
1251             }
1252            
1253 26 50 33     133 unless (defined($x) && defined($y)) {
1254 0         0 $self->_error("polygon: no start point");
1255 0         0 return 0;
1256             }
1257              
1258 26 100 100     141 my $savestate = ($xoffset || $yoffset || $rotate) ? 1 : 0 ;
1259            
1260 26 100       52 if ( $savestate ) {
1261 23         39 $self->{pspages} .= "gsave ";
1262             }
1263              
1264 26 100 66     113 if ($xoffset || $yoffset) {
1265 3         10 $self->{pspages} .= $self->_uxy($xoffset, $yoffset) . "translate\n";
1266             }
1267              
1268 26 100       51 if ($rotate) {
1269 21 100       46 if (!$self->{usedrotabout}) {
1270 3         7 $self->{psfunctions} .= "/rotabout {3 copy pop translate rotate exch ";
1271 3         7 $self->{psfunctions} .= "0 exch sub exch 0 exch sub translate} def\n";
1272 3         7 $self->{usedrotabout} = 1;
1273             }
1274              
1275 21         44 $self->{pspages} .= $self->_uxy($rotatex, $rotatey) . "$rotate rotabout\n";
1276             }
1277            
1278 26         63 $self->newpath;
1279 26         51 $self->moveto($x, $y);
1280            
1281 26         68 while ($#_ > 0) {
1282 63         79 my $x = shift;
1283 63         67 my $y = shift;
1284            
1285 63         127 $self->{pspages} .= $self->_uxy($x, $y) . "lineto ";
1286             }
1287              
1288 26 100       64 if ($opt{'filled'}) {
1289 2         6 $self->{pspages} .= "fill\n";
1290             } else {
1291 24         39 $self->{pspages} .= "stroke\n";
1292             }
1293              
1294 26 100       49 if ( $savestate ) {
1295 23         53 $self->{pspages} .= "grestore\n";
1296             }
1297            
1298 26         120 return 1;
1299             }
1300              
1301              
1302             #-------------------------------------------------------------------------------
1303              
1304             =item C
1305              
1306             Plot a circle with centre at (x,y) and radius of r.
1307              
1308             There is only one option.
1309              
1310             =over 4
1311              
1312             =item filled => 1
1313              
1314             If C is 1 then the PostScript output is set to fill the object rather
1315             than just draw the lines.
1316              
1317             =back
1318              
1319             Example:
1320              
1321             $p->circle(40,40, 20);
1322             $p->circle( {filled => 1}, 62,31, 15);
1323              
1324             =cut
1325              
1326             sub circle
1327             {
1328 6     6 1 20 my $self = shift;
1329 6         12 my %opt = ();
1330              
1331 6 100       33 if (ref($_[0])) {
1332 2         4 %opt = %{; shift};
  2         10  
1333             }
1334              
1335 6         11 my ($x, $y, $r) = @_;
1336              
1337 6 100       18 unless (@_ == 3) {
1338 2         5 $self->_error("circle: wrong number of arguments");
1339 2         10 return 0;
1340             }
1341              
1342 4 100       13 if (!$self->{usedcircle}) {
1343 3         9 $self->{psfunctions} .= "/circle {newpath 0 360 arc closepath} bind def\n";
1344 3         5 $self->{usedcircle} = 1;
1345             }
1346              
1347 4         14 $self->{pspages} .= $self->_uxy($x, $y) . $self->_u($r) . "circle ";
1348 4 100       15 if ($opt{'filled'}) { $self->{pspages} .= "fill\n" }
  2         5  
  2         9  
1349             else {$self->{pspages} .= "stroke\n" }
1350            
1351 4         68 return 1;
1352             }
1353              
1354              
1355             #-------------------------------------------------------------------------------
1356              
1357             =item C
1358              
1359             Draw text in an arc centered about angle C with circle midpoint (C,C)
1360             and radius C.
1361              
1362             There is only one option.
1363              
1364             =over 4
1365              
1366             =item align => "alignment"
1367              
1368             C can be 'inside' or 'outside'. The default is 'inside'.
1369              
1370             =back
1371              
1372             Example:
1373              
1374             # outside the radius, centered at 90 degrees from the origin
1375             $p->circletext(40, 40, 20, 90, "Hello, Outside World!");
1376             # inside the radius centered at 270 degrees from the origin
1377             $p->circletext( {align => "inside"}, 40, 40, 20, 270, "Hello, Inside World!");
1378              
1379             =cut
1380              
1381             sub circletext
1382             {
1383 0     0 1 0 my $self = shift;
1384 0         0 my %opt = ();
1385              
1386 0 0       0 if (ref($_[0])) {
1387 0         0 %opt = %{; shift};
  0         0  
1388             }
1389              
1390 0         0 my ($x, $y, $r, $a, $text) = @_;
1391              
1392 0 0       0 unless (@_ == 5) {
1393 0         0 $self->_error("circletext: wrong number of arguments");
1394 0         0 return 0;
1395             }
1396              
1397 0 0       0 unless (defined $self->{lastfontsize}) {
1398 0         0 $self->_error("circletext: must set font first");
1399 0         0 return 0;
1400             }
1401              
1402 0 0       0 if (!$self->{usedcircletext}) {
1403 0         0 $self->{psfunctions} .= <<'EOCT';
1404             /outsidecircletext
1405             { $circtextdict begin
1406             /radius exch def
1407             /centerangle exch def
1408             /ptsize exch def
1409             /str exch def
1410             /xradius radius ptsize 4 div add def
1411             gsave
1412             centerangle str findhalfangle add rotate
1413             str { /charcode exch def ( ) dup 0 charcode put outsideshowcharandrotate } forall
1414             grestore
1415             end
1416             } def
1417            
1418             /insidecircletext
1419             { $circtextdict begin
1420             /radius exch def
1421             /centerangle exch def
1422             /ptsize exch def
1423             /str exch def
1424             /xradius radius ptsize 3 div sub def
1425             gsave
1426             centerangle str findhalfangle sub rotate
1427             str { /charcode exch def ( ) dup 0 charcode put insideshowcharandrotate } forall
1428             grestore
1429             end
1430             } def
1431             /$circtextdict 16 dict def
1432             $circtextdict begin
1433             /findhalfangle
1434             { stringwidth pop 2 div 2 xradius mul pi mul div 360 mul
1435             } def
1436             /outsideshowcharandrotate
1437             { /char exch def
1438             /halfangle char findhalfangle def
1439             gsave
1440             halfangle neg rotate radius 0 translate -90 rotate
1441             char stringwidth pop 2 div neg 0 moveto char show
1442             grestore
1443             halfangle 2 mul neg rotate
1444             } def
1445             /insideshowcharandrotate
1446             { /char exch def
1447             /halfangle char findhalfangle def
1448             gsave
1449             halfangle rotate radius 0 translate 90 rotate
1450             char stringwidth pop 2 div neg 0 moveto char show
1451             grestore
1452             halfangle 2 mul rotate
1453             } def
1454             /pi 3.1415926 def
1455             end
1456             EOCT
1457 0         0 $self->{usedcircletext} = 1;
1458             }
1459              
1460 0         0 $self->{pspages} .= "gsave\n";
1461 0         0 $self->{pspages} .= " " . $self->_uxy($x, $y) . "translate\n";
1462 0         0 $self->{pspages} .= " ($text) $self->{lastfontsize} $a " . $self->_u($r);
1463 0 0 0     0 if ($opt{'align'} && ($opt{'align'} eq "outside")) {
1464 0         0 $self->{pspages} .= "outsidecircletext\n";
1465             } else {
1466 0         0 $self->{pspages} .= "insidecircletext\n";
1467             }
1468 0         0 $self->{pspages} .= "grestore\n";
1469            
1470 0         0 return 1;
1471             }
1472              
1473              
1474             #-------------------------------------------------------------------------------
1475              
1476             =item C
1477              
1478             Draw a rectangle from lower left co-ordinates (x1,y1) to upper right
1479             co-ordinates (y1,y2).
1480              
1481             Options are:
1482              
1483             =over 4
1484              
1485             =item filled => 1
1486              
1487             If C is 1 then fill the rectangle.
1488              
1489             =back
1490              
1491             Example:
1492              
1493             $p->box(10,10, 20,30);
1494             $p->box( {filled => 1}, 10,10, 20,30);
1495              
1496             Notes
1497              
1498             The C method is far more flexible, but this method is quicker!
1499              
1500             =cut
1501              
1502             sub box
1503             {
1504 41     41 1 178 my $self = shift;
1505              
1506 41         64 my %opt = ();
1507              
1508 41 100       100 if (ref($_[0])) {
1509 36         45 %opt = %{; shift};
  36         106  
1510             }
1511              
1512 41         80 my ($x1, $y1, $x2, $y2) = @_;
1513              
1514 41 100       95 unless (@_ == 4) {
1515 1         4 $self->_error("box: wrong number of arguments");
1516 1         4 return 0;
1517             }
1518              
1519 40 100       90 if (!defined($opt{'filled'})) {
1520 4         12 $opt{'filled'} = 0;
1521             }
1522            
1523 40 100       102 unless ($self->{usedbox}) {
1524 4         11 $self->{psfunctions} .= "/box {
1525             newpath 3 copy pop exch 4 copy pop pop
1526             8 copy pop pop pop pop exch pop exch
1527             3 copy pop pop exch moveto lineto
1528             lineto lineto pop pop pop pop closepath
1529             } bind def
1530             ";
1531 4         14 $self->{usedbox} = 1;
1532             }
1533              
1534 40         89 $self->{pspages} .= $self->_uxy($x1, $y1);
1535 40         326 $self->{pspages} .= $self->_uxy($x2, $y2) . "box ";
1536 40 100       380 if ($opt{'filled'}) { $self->{pspages} .= "fill\n" }
  36         789  
  4         12  
1537             else {$self->{pspages} .= "stroke\n" }
1538              
1539 40         143 return 1;
1540             }
1541              
1542              
1543             #-------------------------------------------------------------------------------
1544              
1545             =item C
1546              
1547             Set the current font to the PostScript font C. Set the size in PostScript
1548             points to C.
1549              
1550             Notes
1551              
1552             This method must be called on every page before the C method is used.
1553              
1554             =cut
1555              
1556             sub setfont
1557             {
1558 4     4 1 15 my $self = shift;
1559 4         9 my ($name, $size, $ysize) = @_;
1560              
1561 4 100       18 unless (@_ == 2) {
1562 1         3 $self->_error( "wrong number of arguments for setfont" );
1563 1         4 return 0;
1564             }
1565              
1566             # set font y size XXXXX
1567 3         22 $self->{pspages} .= "/$name findfont $size scalefont setfont\n";
1568              
1569 3         7 $self->{lastfontsize} = $size;
1570              
1571 3         11 return 1;
1572             }
1573              
1574              
1575             #-------------------------------------------------------------------------------
1576              
1577             =item C
1578              
1579             Plot text on the current page with the lower left co-ordinates at (x,y) and
1580             using the current font. The text is specified in C.
1581              
1582             Options are:
1583              
1584             =over 4
1585              
1586             =item align => "alignment"
1587              
1588             alignment can be 'left', 'centre' or 'right'. The default is 'left'.
1589              
1590             =item rotate => angle
1591              
1592             "rotate" degrees of rotation, defaults to 0 (i.e. no rotation).
1593             The angle to rotate the text, in degrees. Centres about (x,y) and rotates
1594             clockwise. (?). Default 0 degrees.
1595              
1596             =back
1597              
1598             Example:
1599              
1600             $p->setfont("Times-Roman", 12);
1601             $p->text(40,40, "The frog sat on the leaf in the pond.");
1602             $p->text( {align => 'centre'}, 140,40, "This is centered.");
1603             $p->text( {rotate => 90}, 140,40, "This is rotated.");
1604             $p->text( {rotate => 90, align => 'centre'}, 140,40, "This is both.");
1605              
1606             =cut
1607              
1608             sub text
1609             {
1610 19     19 1 173 my $self = shift;
1611              
1612 19         26 my $rot = "";
1613 19         43 my $rot_m = "";
1614 19         21 my $align = "";
1615 19         30 my %opt = ();
1616              
1617 19 100       47 if (ref($_[0])) {
1618 5         12 %opt = %{; shift};
  5         28  
1619             }
1620            
1621 19 100       46 unless ( @_ == 3 )
1622             { # check required params first
1623 2         14 $self->_error("text: wrong number of arguments");
1624 2         9 return 0;
1625             }
1626            
1627 17         29 my ($x, $y, $text) = @_;
1628              
1629 17 100 33     115 unless (defined($x) && defined($y) && defined($text)) {
      66        
1630 1         6 $self->_error("text: wrong number of arguments");
1631 1         3 return 0;
1632             }
1633            
1634             # Escape text to allow parentheses
1635 16         51 $text =~ s|([\\\(\)])|\\$1|g;
1636 16         34 $text =~ s/([\x00-\x1f\x7f-\xff])/sprintf('\\%03o',ord($1))/ge;
  66         192  
1637              
1638 16         40 $self->newpath;
1639 16         35 $self->moveto($x, $y);
1640              
1641             # rotation
1642              
1643 16 100       53 if (defined $opt{'rotate'}) {
1644 3         7 my $rot_a = $opt{ 'rotate' };
1645 3 50       14 if( $rot_a != 0 ) {
1646 3         17 $rot = " $rot_a rotate ";
1647 3         7 $rot_a = -$rot_a;
1648 3         12 $rot_m = " $rot_a rotate ";
1649             };
1650             }
1651              
1652             # alignment
1653              
1654 16         24 $align = " show stroke";
1655 16 100       46 if (defined $opt{'align'}) {
1656 3 100       17 $align = " dup stringwidth pop neg 0 rmoveto show"
1657             if $opt{ 'align' } eq 'right';
1658 3 100 66     24 $align = " dup stringwidth pop 2 div neg 0 rmoveto show"
1659             if $opt{ 'align' } eq 'center' or $opt{ 'align' } eq 'centre';
1660             }
1661            
1662 16         54 $self->{pspages} .= "($text) $rot $align $rot_m\n";
1663              
1664 16         52 return 1;
1665             }
1666              
1667              
1668             #-------------------------------------------------------------------------------
1669              
1670             =item curve( x1, y1, x2, y2, x3, y3, x4, y4 )
1671              
1672             Create a curve from (x1, y1) to (x4, y4). (x2, y2) and (x3, y3) are the
1673             control points for the start- and end-points respectively.
1674              
1675             =cut
1676              
1677             sub curve
1678             {
1679 2     2 1 5 my $self = shift;
1680 2         3 my ($x1, $y1, $x2, $y2, $x3, $y3, $x4, $y4) = @_;
1681              
1682 2 100       8 unless ( @_ == 8 ) {
1683 1         3 $self->_error( "bad curve definition, wrong number of args" );
1684 1         5 return 0;
1685             }
1686            
1687 1 50 33     9 if ((!$self->{pspagecount}) and (!$self->{eps})) {
1688             # Cannot draw on to non-page when not an eps file
1689 0         0 return 0;
1690             }
1691              
1692 1         13 $self->newpath;
1693 1         11 $self->moveto($x1, $y1);
1694 1         3 $self->{pspages} .= $self->_uxy($x2, $y2);
1695 1         6 $self->{pspages} .= $self->_uxy($x3, $y3);
1696 1         6 $self->{pspages} .= $self->_uxy($x4, $y4) . "curveto stroke\n";
1697              
1698 1         6 return 1;
1699             }
1700              
1701              
1702             #-------------------------------------------------------------------------------
1703              
1704             =item curvextend( x1, y1, x2, y2, x3, y3 )
1705              
1706             Assuming the previous command was C, C, C or
1707             C, extend that path with another curve segment to the co-ordinates
1708             (x3, y3). (x1, y1) and (x2, y2) are the control points. Behaviour after any
1709             other method is unspecified.
1710              
1711             =cut
1712              
1713             sub curvextend
1714             {
1715 2     2 1 5 my $self = shift;
1716 2         5 my ($x1, $y1, $x2, $y2, $x3, $y3) = @_;
1717              
1718 2 100       7 unless ( @_ == 6 ) {
1719 1         3 $self->_error( "bad curvextend definition, wrong number of args" );
1720 1         5 return 0;
1721             }
1722            
1723 1         13 my $out = $self->_uxy($x1, $y1);
1724 1         4 $out .= $self->_uxy($x2, $y2);
1725 1         3 $out .= $self->_uxy($x3, $y3) . "curveto stroke\n";
1726              
1727             # curveto may follow a lineto etc...
1728 1         27 $self->{pspages} =~ s/eto stroke\n$/eto\n$out/;
1729            
1730 1         7 return 1;
1731             }
1732              
1733              
1734             #-------------------------------------------------------------------------------
1735              
1736             =item newpath
1737              
1738             This method is used internally to begin a new drawing path - you should
1739             generally NEVER use it.
1740              
1741             =cut
1742              
1743             sub newpath
1744             {
1745 53     53 1 89 my $self = shift;
1746              
1747 53         139 $self->{pspages} .= "newpath\n";
1748              
1749 53         76 return 1;
1750             }
1751              
1752              
1753             #-------------------------------------------------------------------------------
1754              
1755             =item moveto( x, y )
1756              
1757             This method is used internally to move the cursor to a new point at (x, y) -
1758             you will generally NEVER use this method.
1759              
1760             =cut
1761              
1762             sub moveto
1763             {
1764 53     53 1 56 my $self = shift;
1765 53         68 my ($x, $y) = @_;
1766              
1767 53         135 $self->{pspages} .= $self->_uxy($x, $y) . "moveto\n";
1768              
1769 53         101 return 1;
1770             }
1771              
1772              
1773             #-------------------------------------------------------------------------------
1774              
1775             =item C
1776              
1777             Imports an EPS file and scales/translates its bounding box to fill
1778             the area defined by lower left co-ordinates (x1,y1) and upper right
1779             co-ordinates (x2,y2). By default, if the co-ordinates have a different
1780             aspect ratio from the bounding box, the scaling is constrained on the
1781             greater dimension to keep the EPS fully inside the area.
1782              
1783             Options are:
1784              
1785             =over 4
1786              
1787             =item overlap => 1
1788              
1789             If C is 1 then the scaling is calculated on the lesser dimension
1790             and the EPS can overlap the area.
1791              
1792             =item stretch => 1
1793              
1794             If C is 1 then fill the entire area, ignoring the aspect ratio.
1795             This option overrides C if both are given.
1796              
1797             =back
1798              
1799             Example:
1800              
1801             # Assume smiley.eps is a round smiley face in a square bounding box
1802              
1803             # Scale it to a (10,10)(20,20) box
1804             $p->importepsfile("smiley.eps", 10,10, 20,20);
1805              
1806             # Keeps aspect ratio, constrained to smallest fit
1807             $p->importepsfile("smiley.eps", 10,10, 30,20);
1808              
1809             # Keeps aspect ratio, allowed to overlap for largest fit
1810             $p->importepsfile( {overlap => 1}, "smiley.eps", 10,10, 30,20);
1811              
1812             # Aspect ratio is changed to give exact fit
1813             $p->importepsfile( {stretch => 1}, "smiley.eps", 10,10, 30,20);
1814              
1815             =cut
1816              
1817             sub importepsfile
1818             {
1819 0     0 1 0 my $self = shift;
1820              
1821 0         0 my $bbllx;
1822             my $bblly;
1823 0         0 my $bburx;
1824 0         0 my $bbury;
1825 0         0 my $bbw;
1826 0         0 my $bbh;
1827 0         0 my $pagew;
1828 0         0 my $pageh;
1829 0         0 my $scalex;
1830 0         0 my $scaley;
1831 0         0 my $line;
1832 0         0 my $eps;
1833              
1834 0         0 my %opt = ();
1835              
1836 0 0       0 if (ref($_[0])) {
1837 0         0 %opt = %{; shift};
  0         0  
1838             }
1839              
1840 0         0 my ($file, $x1, $y1, $x2, $y2) = @_;
1841              
1842 0 0       0 unless (@_ == 5) {
1843 0         0 $self->_error("importepsfile: wrong number of arguments");
1844 0         0 return 0;
1845             }
1846              
1847 0 0       0 $opt{'overlap'} = 0 if (!defined($opt{'overlap'}));
1848 0 0       0 $opt{'stretch'} = 0 if (!defined($opt{'stretch'}));
1849            
1850 0         0 $eps = new PostScript::Simple::EPS(file => $file);
1851 0         0 ($bbllx, $bblly, $bburx, $bbury) = $eps->get_bbox();
1852              
1853 0         0 $pagew = $x2 - $x1;
1854 0         0 $pageh = $y2 - $y1;
1855              
1856 0         0 $bbw = $bburx - $bbllx;
1857 0         0 $bbh = $bbury - $bblly;
1858              
1859 0 0 0     0 if (($bbw == 0) || ($bbh == 0)) {
1860 0         0 $self->_error("importeps: Bounding Box has zero dimension");
1861 0         0 return 0;
1862             }
1863              
1864 0         0 $scalex = $pagew / $bbw;
1865 0         0 $scaley = $pageh / $bbh;
1866              
1867 0 0       0 if ($opt{'stretch'} == 0) {
1868 0 0       0 if ($opt{'overlap'} == 0) {
1869 0 0       0 if ($scalex > $scaley) {
1870 0         0 $scalex = $scaley;
1871             } else {
1872 0         0 $scaley = $scalex;
1873             }
1874             } else {
1875 0 0       0 if ($scalex > $scaley) {
1876 0         0 $scaley = $scalex;
1877             } else {
1878 0         0 $scalex = $scaley;
1879             }
1880             }
1881             }
1882              
1883 0         0 $eps->scale($scalex, $scaley);
1884 0         0 $eps->translate(-$bbllx, -$bblly);
1885 0         0 $self->_add_eps($eps, $x1, $y1);
1886              
1887 0         0 return 1;
1888             }
1889              
1890              
1891             #-------------------------------------------------------------------------------
1892              
1893             =item C
1894              
1895             Imports a PostScript::Simple::EPS object into the current document at position
1896             C<(x,y)>.
1897              
1898             Example:
1899              
1900             use PostScript::Simple;
1901            
1902             # create a new PostScript object
1903             $p = new PostScript::Simple(papersize => "A4",
1904             colour => 1,
1905             units => "in");
1906            
1907             # create a new page
1908             $p->newpage;
1909            
1910             # create an eps object
1911             $e = new PostScript::Simple::EPS(file => "test.eps");
1912             $e->rotate(90);
1913             $e->scale(0.5);
1914              
1915             # add eps to the current page
1916             $p->importeps($e, 10,50);
1917              
1918             =cut
1919              
1920             sub importeps
1921             {
1922 0     0 1 0 my $self = shift;
1923 0         0 my ($epsobj, $xpos, $ypos) = @_;
1924              
1925 0 0       0 unless (@_ == 3) {
1926 0         0 $self->_error("importeps: wrong number of arguments");
1927 0         0 return 0;
1928             }
1929              
1930 0         0 $self->_add_eps($epsobj, $xpos, $ypos);
1931              
1932 0         0 return 1;
1933             }
1934              
1935              
1936             ################################################################################
1937             # PRIVATE methods
1938              
1939             sub _add_eps
1940             {
1941 0     0   0 my $self = shift;
1942 0         0 my $epsobj;
1943             my $xpos;
1944 0         0 my $ypos;
1945              
1946 0 0       0 if (ref($_[0]) ne "PostScript::Simple::EPS") {
1947 0         0 croak "internal error: _add_eps[0] must be eps object";
1948             }
1949              
1950 0 0 0     0 if ((!$self->{pspagecount}) and (!$self->{eps})) {
1951             # Cannot draw on to non-page when not an eps file
1952 0         0 $self->_error("importeps: no current page");
1953 0         0 return 0;
1954             }
1955              
1956 0 0       0 if ( @_ != 3 ) {
1957 0         0 croak "internal error: wrong number of arguments for _add_eps";
1958 0         0 return 0;
1959             }
1960              
1961 0 0       0 unless ($self->{usedimporteps}) {
1962 0         0 $self->{psfunctions} .= <<'EOEPS';
1963             /BeginEPSF { /b4_Inc_state save def /dict_count countdictstack def
1964             /op_count count 1 sub def userdict begin /showpage { } def 0 setgray
1965             0 setlinecap 1 setlinewidth 0 setlinejoin 10 setmiterlimit [ ]
1966             0 setdash newpath /languagelevel where { pop languagelevel 1 ne {
1967             false setstrokeadjust false setoverprint } if } if } bind def
1968             /EndEPSF { count op_count sub {pop} repeat countdictstack dict_count
1969             sub {end} repeat b4_Inc_state restore } bind def
1970             EOEPS
1971 0         0 $self->{usedimporteps} = 1;
1972             }
1973              
1974 0         0 ($epsobj, $xpos, $ypos) = @_;
1975              
1976 0         0 $self->{pspages} .= "BeginEPSF\n";
1977 0         0 $self->{pspages} .= $self->_uxy($xpos, $ypos) . "translate\n";
1978 0         0 $self->{pspages} .= $self->_uxy(1, 1) . "scale\n";
1979 0         0 $self->{pspages} .= $epsobj->_get_include_data($xpos, $ypos);
1980 0         0 $self->{pspages} .= "EndEPSF\n";
1981            
1982 0         0 return 1;
1983             }
1984              
1985              
1986             #-------------------------------------------------------------------------------
1987              
1988             sub _error {
1989 21     21   37 my $self = shift;
1990 21         29 my $msg = shift;
1991              
1992 21         89 $self->{pspages} .= "(error: $msg\n) print flush\n";
1993             }
1994              
1995              
1996             #-------------------------------------------------------------------------------
1997              
1998             # Display method for debugging internal variables
1999             #
2000             #sub display {
2001             # my $self = shift;
2002             # my $i;
2003             #
2004             # foreach $i (keys(%{$self}))
2005             # {
2006             # print "$i = $self->{$i}\n";
2007             # }
2008             #}
2009              
2010             =back
2011              
2012             =head1 BUGS
2013              
2014             Some current functionality may not be as expected, and/or may not work correctly.
2015             That's the fun with using code in development!
2016              
2017             =head1 AUTHOR
2018              
2019             The PostScript::Simple module was created by Matthew Newton, with ideas
2020             and suggestions from Mark Withall and many other people from around the world.
2021             Thanks!
2022              
2023             Please see the README file in the distribution for more information about
2024             contributors.
2025              
2026             Copyright (C) 2002-2014 Matthew C. Newton
2027              
2028             This program is free software; you can redistribute it and/or modify it under
2029             the terms of the GNU General Public License as published by the Free Software
2030             Foundation, version 2.
2031              
2032             This program is distributed in the hope that it will be useful, but WITHOUT ANY
2033             WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A
2034             PARTICULAR PURPOSE. See the GNU General Public License for more details,
2035             available at http://www.gnu.org/licenses/gpl.html.
2036              
2037             =head1 SEE ALSO
2038              
2039             L
2040              
2041             =cut
2042              
2043             1;
2044              
2045             # vim:foldmethod=marker: