File Coverage

lib/PostScript/Simple/EPS.pm
Criterion Covered Total %
statement 15 148 10.1
branch 0 50 0.0
condition 0 21 0.0
subroutine 5 20 25.0
pod 10 11 90.9
total 30 250 12.0


line stmt bran cond sub pod time code
1             #! /usr/bin/perl
2              
3             package PostScript::Simple::EPS;
4              
5 7     7   40 use strict;
  7         12  
  7         253  
6 7     7   38 use Exporter;
  7         11  
  7         464  
7 7     7   36 use Carp;
  7         16  
  7         497  
8 7     7   46 use PostScript::Simple;
  7         14  
  7         378  
9              
10 7     7   50 use vars qw($VERSION @ISA @EXPORT);
  7         38  
  7         18575  
11              
12             @ISA = qw(Exporter);
13             @EXPORT = qw();
14             $VERSION = "0.02";
15              
16              
17             #-------------------------------------------------------------------------------
18              
19             =head1 NAME
20              
21             PostScript::Simple::EPS - EPS support for PostScript::Simple
22              
23             =head1 SYNOPSIS
24              
25             use PostScript::Simple;
26            
27             # create a new PostScript object
28             $p = new PostScript::Simple(papersize => "A4",
29             colour => 1,
30             units => "in");
31            
32             # create a new page
33             $p->newpage;
34            
35             # add an eps file
36             $p->add_eps({xsize => 3}, "test.eps", 1,1);
37             $p->add_eps({yscale => 1.1, xscale => 1.8}, "test.eps", 4,8);
38              
39             # create an eps object
40             $e = new PostScript::Simple::EPS(file => "test.eps");
41             $e->rotate(90);
42             $e->xscale(0.5);
43             $p->add_eps($e, 3, 3); # add eps object to postscript object
44             $e->xscale(2);
45             $p->add_eps($e, 2, 5); # add eps object to postscript object again
46            
47             # write the output to a file
48             $p->output("file.ps");
49              
50              
51             =head1 DESCRIPTION
52              
53             PostScript::Simple::EPS allows you to add EPS files into PostScript::Simple
54             objects. Included EPS files can be scaled and rotated, and placed anywhere
55             inside a PostScript::Simple page.
56              
57             Remember when using translate/scale/rotate that you will normally need to do
58             the operations in the reverse order to that which you expect.
59              
60             =head1 PREREQUISITES
61              
62             This module requires C, C, C and C.
63              
64             =head2 EXPORT
65              
66             None.
67              
68             =cut
69              
70             =head1 CONSTRUCTOR
71              
72             =over 4
73              
74             =item C
75              
76             Create a new PostScript::Simple::EPS object. The options
77             that can be set are:
78              
79             =over 4
80              
81             =item file
82              
83             EPS file to be included. This or C must exist when the C method is
84             called.
85              
86             =item source
87              
88             PostScript code for the EPS document. Either this or C must be set when
89             C is called.
90              
91             =item clip
92              
93             Set to 0 to disable clipping to the EPS bounding box. Default is to clip.
94              
95             =back
96              
97             Example:
98              
99             $ps = new PostScript::Simple(landscape => 1,
100             eps => 0,
101             xsize => 4,
102             ysize => 3,
103             units => "in");
104              
105             $eps = new PostScript::Simple::EPS(file => "test.eps");
106              
107             $eps->scale(0.5);
108              
109             Scale the EPS file by x0.5 in both directions.
110              
111             $ps->newpage();
112             $ps->importeps($eps, 1, 1);
113              
114             Add the EPS file to the PostScript document at coords (1,1).
115              
116             $ps->importepsfile("another.eps", 1, 2, 4, 4);
117              
118             Easily add an EPS file to the PostScript document using bounding box (1,2),(4,4).
119              
120             The methods C and C are described in the documentation
121             of C.
122              
123             =back
124              
125             =cut
126              
127             sub new
128             {
129 0     0 1   my ($class, %data) = @_;
130 0           my $self = {
131             file => undef, # filename of the eps file
132             xsize => undef,
133             ysize => undef,
134             units => "bp", # measuring units (see below)
135             clip => 1, # clip to the bounding box
136              
137             bbx1 => 0, # Bounding Box definitions
138             bby1 => 0,
139             bbx2 => 0,
140             bby2 => 0,
141              
142             epsprefix => [],
143             epsfile => undef,
144             epspostfix => [],
145             };
146              
147 0           foreach (keys %data)
148             {
149 0           $self->{$_} = $data{$_};
150             }
151              
152 0 0 0       if ((!defined $self->{"file"}) && (!defined $self->{"source"})) {
153 0           croak "must provide file or source";
154             }
155 0 0 0       if ((defined $self->{"file"}) && (defined $self->{"source"})) {
156 0           croak "cannot provide both file and source";
157             }
158              
159 0           bless $self, $class;
160 0           $self->init();
161              
162 0           return $self;
163             }
164              
165              
166             #-------------------------------------------------------------------------------
167              
168             sub init
169             {
170 0     0 0   my $self = shift;
171 0           my $foundbbx = 0;
172              
173 0 0         if (defined($$self{source})) {
174 0 0         croak "EPS file must contain a BoundingBox" if (!$self->_getsourcebbox());
175             } else {
176 0 0         croak "EPS file must contain a BoundingBox" if (!_getfilebbox($self));
177             }
178              
179 0 0 0       if (($$self{bbx2} - $$self{bbx1} == 0) ||
180             ($$self{bby2} - $$self{bby1} == 0)) {
181 0           $self->_error("PostScript::Simple::EPS: Bounding Box has zero dimension");
182 0           return 0;
183             }
184              
185 0           $self->reset();
186              
187 0           return 1;
188             }
189              
190              
191             #-------------------------------------------------------------------------------
192              
193             =head1 OBJECT METHODS
194              
195             All object methods return 1 for success or 0 in some error condition
196             (e.g. insufficient arguments). Error message text is also drawn on
197             the page.
198              
199             =over 4
200              
201             =item C
202              
203             Returns the EPS bounding box, as specified on the %%BoundingBox line
204             of the EPS file. Units are standard PostScript points.
205              
206             Example:
207              
208             ($x1, $y1, $x2, $y2) = $eps->get_bbox();
209              
210             =cut
211              
212             sub get_bbox
213             {
214 0     0 1   my $self = shift;
215              
216 0           return ($$self{bbx1}, $$self{bby1}, $$self{bbx2}, $$self{bby2});
217             }
218              
219              
220             #-------------------------------------------------------------------------------
221              
222             =item C
223              
224             Returns the EPS width, in PostScript points.
225              
226             Example:
227              
228             print "EPS width is " . abs($eps->width()) . "\n";
229              
230             =cut
231              
232             sub width
233             {
234 0     0 1   my $self = shift;
235              
236 0           return ($$self{bbx2} - $$self{bbx1});
237             }
238              
239              
240             #-------------------------------------------------------------------------------
241              
242             =item C
243              
244             Returns the EPS height, in PostScript points.
245              
246             Example:
247              
248             To scale $eps to 72 points high, do:
249              
250             $eps->scale(1, 72/$eps->height());
251              
252             =cut
253              
254             sub height
255             {
256 0     0 1   my $self = shift;
257              
258 0           return ($$self{bby2} - $$self{bby1});
259             }
260              
261              
262             #-------------------------------------------------------------------------------
263              
264             =item C
265              
266             Scales the EPS file. To scale in one direction only, specify 1 as the
267             other scale. To scale the EPS file the same in both directions, you
268             may use the shortcut of just specifying the one value.
269              
270             Example:
271              
272             $eps->scale(1.2, 0.8); # make wider and shorter
273             $eps->scale(0.5); # shrink to half size
274              
275             =cut
276              
277             sub scale
278             {
279 0     0 1   my $self = shift;
280 0           my ($x, $y) = @_;
281              
282 0 0         $y = $x if (!defined $y);
283 0 0         croak "bad arguments to scale" if (!defined $x);
284              
285 0           push @{$$self{epsprefix}}, "$x $y scale";
  0            
286              
287 0           return 1;
288             }
289              
290              
291             #-------------------------------------------------------------------------------
292              
293             =item C
294              
295             Rotates the EPS file by C degrees anti-clockwise. The EPS file is rotated
296             about it's own origin (as defined by it's bounding box). To rotate by a particular
297             co-ordinate (again, relative to the EPS file, not the main PostScript document),
298             use translate, too.
299              
300             Example:
301              
302             $eps->rotate(180); # turn upside-down
303              
304             To rotate 30 degrees about point (50,50):
305              
306             $eps->translate(50, 50);
307             $eps->rotate(30);
308             $eps->translate(-50, -50);
309            
310             =cut
311              
312             sub rotate
313             {
314 0     0 1   my $self = shift;
315 0           my ($d) = @_;
316              
317 0 0         croak "bad arguments to rotate" if (!defined $d);
318              
319 0           push @{$$self{epsprefix}}, "$d rotate";
  0            
320              
321 0           return 1;
322             }
323              
324              
325             #-------------------------------------------------------------------------------
326              
327             =item C
328              
329             Move the EPS file by C,C PostScript points.
330              
331             Example:
332              
333             $eps->translate(10, 10); # move 10 points in both directions
334              
335             =cut
336              
337             sub translate
338             {
339 0     0 1   my $self = shift;
340 0           my ($x, $y) = @_;
341              
342 0 0         croak "bad arguments to translate" if (!defined $y);
343              
344 0           push @{$$self{epsprefix}}, "$x $y translate";
  0            
345              
346 0           return 1;
347             }
348              
349              
350             #-------------------------------------------------------------------------------
351              
352             =item C
353              
354             Clear all translate, rotate and scale operations.
355              
356             Example:
357              
358             $eps->reset();
359              
360             =cut
361              
362             sub reset
363             {
364 0     0 1   my $self = shift;
365              
366 0           @{$$self{"epsprefix"}} = ();
  0            
367              
368 0           return 1;
369             }
370              
371              
372             #-------------------------------------------------------------------------------
373              
374             =item C
375              
376             Reads the EPS file into memory, to save reading it from file each time if
377             inserted many times into a document. Can not be used with C.
378              
379             =cut
380              
381             sub load
382             {
383 0     0 1   my $self = shift;
384 0           local *EPS;
385              
386 0 0         return 1 if (defined $$self{"epsfile"});
387 0 0         return 1 if (defined $$self{"source"});
388              
389 0           $$self{"epsfile"} = "\%\%BeginDocument: ($$self{file})\n";
390 0   0       open EPS, "< $$self{file}" || croak "can't open eps file $$self{file}";
391 0           while ()
392             {
393 0           $$self{"epsfile"} .= $_;
394             }
395 0           close EPS;
396 0           $$self{"epsfile"} .= "\%\%EndDocument\n";
397              
398 0           return 1;
399             }
400              
401              
402             #-------------------------------------------------------------------------------
403              
404             =item C
405              
406             Experimental: defines the EPS at in the document prolog, and just runs a
407             command to insert it each time it is used. C is a PostScript::Simple
408             object. If the EPS file is included more than once in the PostScript file then
409             this will probably shrink the filesize quite a lot.
410              
411             Can not be used at the same time as C, or when using EPS objects defined
412             from PostScript source.
413              
414             Example:
415              
416             $p = new PostScript::Simple();
417             $e = new PostScript::Simple::EPS(file => "test.eps");
418             $e->preload($p);
419              
420             =cut
421              
422             sub preload
423             {
424 0     0 1   my $self = shift;
425 0           my $ps = shift;
426 0           my $randcode = "";
427              
428 0 0         croak "already loaded" if (defined $$self{"epsfile"});
429 0 0         croak "can't preload when using source" if (defined $$self{"source"});
430              
431 0 0         croak "no PostScript::Simple module provided" if (!defined $ps);
432              
433 0           for my $i (0..7)
434             {
435 0           $randcode .= chr(int(rand()*26)+65); # yuk
436             }
437              
438 0           $$self{"epsfile"} = "eps$randcode\n";
439              
440 0           $$ps{"psprolog"} .= "/eps$randcode {\n";
441 0           $$ps{"psprolog"} .= "\%\%BeginDocument: ($$self{file})\n";
442 0   0       open EPS, "< $$self{file}" || croak "can't open eps file $$self{file}";
443 0           while ()
444             {
445 0           $$ps{"psprolog"} .= $_;
446             }
447 0           close EPS;
448 0           $$ps{"psprolog"} .= "\%\%EndDocument\n";
449 0           $$ps{"psprolog"} .= "} def\n";
450              
451 0           return 1;
452             }
453              
454              
455             ################################################################################
456             # PRIVATE methods
457              
458             sub _getfilebbox
459             {
460 0     0     my $self = shift;
461 0           my $foundbbx = 0;
462              
463 0 0         return 0 if (!defined $$self{file});
464 0   0       open EPS, "< $$self{file}" || croak "can't open eps file $$self{file}";
465 0           SCAN: while ()
466             {
467 0           s/[\r\n]*$//; #ultimate chomp
468 0 0         if (/^\%\%BoundingBox:\s+(-?\d+)\s+(-?\d+)\s+(-?\d+)\s+(-?\d+)\s*$/)
469             {
470 0           $$self{bbx1} = $1;
471 0           $$self{bby1} = $2;
472 0           $$self{bbx2} = $3;
473 0           $$self{bby2} = $4;
474 0           $foundbbx = 1;
475 0           last SCAN;
476             }
477             }
478 0           close EPS;
479              
480 0           return $foundbbx;
481             }
482              
483              
484             #-------------------------------------------------------------------------------
485              
486             sub _getsourcebbox
487             {
488 0     0     my $self = shift;
489              
490 0           my $ref;
491              
492 0 0         $ref = \$self->{epsfile} if defined $self->{epsfile};
493 0 0         $ref = \$self->{source} if defined $self->{source};
494              
495 0 0         return 0 unless defined $$ref;
496              
497 0 0         if ($$ref =~
498             /^\%\%BoundingBox:\s+(-?\d+)\s+(-?\d+)\s+(-?\d+)\s+(-?\d+)$/m)
499             {
500 0           $$self{bbx1} = $1;
501 0           $$self{bby1} = $2;
502 0           $$self{bbx2} = $3;
503 0           $$self{bby2} = $4;
504 0           return 1;
505             }
506              
507 0           return 0;
508             }
509              
510              
511             #-------------------------------------------------------------------------------
512              
513             sub _get_include_data
514             {
515 0     0     my $self = shift;
516 0           my ($x, $y) = @_;
517 0           my $data = "";
518              
519 0 0         croak "argh... internal error (incorrect arguments)" if (scalar @_ != 2);
520              
521 0           foreach my $line (@{$$self{"epsprefix"}}) {
  0            
522 0           $data .= "$line\n";
523             }
524              
525 0 0         if ($$self{"clip"}) {
526 0           $data .= "newpath $$self{bbx1} $$self{bby1} moveto
527             $$self{bbx2} $$self{bby1} lineto $$self{bbx2} $$self{bby2} lineto
528             $$self{bbx1} $$self{bby2} lineto closepath clip newpath\n";
529             }
530              
531 0 0         if (defined $$self{"epsfile"}) {
    0          
532 0           $data .= $$self{"epsfile"};
533             } elsif (defined $$self{"source"}) {
534 0           $data .= "\%\%BeginDocument: (undef)\n";
535 0           $data .= $$self{"source"};
536 0           $data .= "\%\%EndDocument\n";
537             } else {
538 0           $data .= "\%\%BeginDocument: ($$self{file})\n";
539 0   0       open EPS, "< $$self{file}" || croak "can't open eps file $$self{file}";
540 0           while () {
541 0           $data .= $_;
542             }
543 0           close EPS;
544 0           $data .= "\%\%EndDocument\n";
545             }
546              
547 0           foreach my $line (@{$$self{"epspostfix"}}) {
  0            
548 0           $data .= "$line\n";
549             }
550              
551 0           return $data;
552             }
553              
554             sub _error
555             {
556 0     0     my $self = shift;
557 0           my $msg = shift;
558 0           $self->{pspages} .= "(error: $msg\n) print flush\n";
559             }
560              
561              
562             =back
563              
564             =head1 BUGS
565              
566             This is software in development; some current functionality may not be as
567             expected, and/or may not work correctly.
568              
569             =head1 AUTHOR
570              
571             The PostScript::Simple::EPS module was written by Matthew Newton, after prods
572             for such a feature from several people around the world. A useful importeps
573             function that provides scaling and aspect ratio operations was gratefully
574             received from Glen Harris, and merged into this module.
575              
576             Copyright (C) 2002-2014 Matthew C. Newton
577              
578             This program is free software; you can redistribute it and/or modify it under
579             the terms of the GNU General Public License as published by the Free Software
580             Foundation, version 2.
581              
582             This program is distributed in the hope that it will be useful, but WITHOUT ANY
583             WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A
584             PARTICULAR PURPOSE. See the GNU General Public License for more details,
585             available at http://www.gnu.org/licenses/gpl.html.
586              
587             =head1 SEE ALSO
588              
589             L
590              
591             =cut
592              
593             1;
594              
595             # vim:foldmethod=marker: