File Coverage

blib/lib/PDF/Create/Page.pm
Criterion Covered Total %
statement 180 328 54.8
branch 29 116 25.0
condition 16 51 31.3
subroutine 33 43 76.7
pod 31 33 93.9
total 289 571 50.6


line stmt bran cond sub pod time code
1             package PDF::Create::Page;
2              
3             our $VERSION = '1.41';
4              
5             =encoding utf8
6              
7             =head1 NAME
8              
9             PDF::Create::Page - PDF pages tree for PDF::Create
10              
11             =head1 VERSION
12              
13             Version 1.41
14              
15             =cut
16              
17 18     18   233 use 5.006;
  18         35  
18 18     18   56 use strict; use warnings;
  18     18   18  
  18         301  
  18         47  
  18         19  
  18         417  
19              
20 18     18   51 use Carp;
  18         24  
  18         809  
21 18     18   66 use FileHandle;
  18         18  
  18         71  
22 18     18   3762 use Data::Dumper;
  18         19  
  18         701  
23 18     18   7488 use POSIX qw(setlocale LC_NUMERIC);
  18         86231  
  18         72  
24 18     18   14751 use Scalar::Util qw(weaken);
  18         22  
  18         608  
25 18     18   7309 use PDF::Font;
  18         44  
  18         49750  
26              
27             our $DEBUG = 0;
28              
29             my $font_widths = &init_widths;
30             # Global variable for text function
31             my $ptext = '';
32              
33             =head1 DESCRIPTION
34              
35             B
36              
37             =cut
38              
39             sub new {
40 82     82 0 9435 my ($this) = @_;
41              
42 82   33     9965 my $class = ref($this) || $this;
43 82         9469 my $self = {};
44 82         9497 bless $self, $class;
45 82         9570 $self->{'Kids'} = [];
46 82         9496 $self->{'Content'} = [];
47              
48 82         18889 return $self;
49             }
50              
51             =head1 METHODS
52              
53             =head2 add($id, $name)
54              
55             Adds a page to the PDF document.
56              
57             =cut
58              
59             sub add {
60 50     50 1 5715 my ($self, $id, $name) = @_;
61              
62 50         5748 my $page = PDF::Create::Page->new();
63 50         5701 $page->{'pdf'} = $self->{'pdf'};
64 50         6037 weaken $page->{pdf};
65 50         5674 $page->{'Parent'} = $self;
66 50         5767 weaken $page->{Parent};
67 50         5715 $page->{'id'} = $id;
68 50         5710 $page->{'name'} = $name;
69 50         5656 push @{$self->{'Kids'}}, $page;
  50         11408  
70              
71 50         11320 return $page;
72             }
73              
74             =head2 count()
75              
76             Returns page count.
77              
78             =cut
79              
80             sub count {
81 90     90 1 7170 my ($self) = @_;
82              
83 90         7191 my $c = 0;
84 90 100       7196 $c++ unless scalar @{$self->{'Kids'}};
  90         14691  
85 90         7157 foreach my $page (@{$self->{'Kids'}}) {
  90         14358  
86 61         3174 $c += $page->count;
87             }
88              
89 90         17496 return $c;
90             }
91              
92             =head2 kids()
93              
94             Returns ref to a list of page ids.
95              
96             =cut
97              
98             sub kids {
99 29     29 1 2071 my ($self) = @_;
100              
101 29         2064 my $t = [];
102 29         2071 map { push @$t, $_->{'id'} } @{$self->{'Kids'}};
  38         6214  
  29         4104  
103              
104 29         5142 return $t;
105             }
106              
107             =head2 list()
108              
109             Returns page list.
110              
111             =cut
112              
113             sub list {
114 53     53 1 4120 my ($self) = @_;
115              
116 53         4143 my @l;
117 53         4116 foreach my $e (@{$self->{'Kids'}}) {
  53         8261  
118 38         3431 my @t = $e->list;
119 38         3130 push @l, $e;
120 38 100       5180 push @l, @t if scalar @t;
121             }
122              
123 53         8269 return @l;
124             }
125              
126             =head2 new_page()
127              
128             Return new page.
129              
130             =cut
131              
132             sub new_page {
133 27     27 1 7082 my ($self, @params) = @_;
134              
135 27         2937 return $self->{'pdf'}->new_page('Parent' => $self, @params);
136             }
137              
138             #
139             #
140             # Drawing functions
141              
142             =head2 moveto($x, $y)
143              
144             Moves the current point to (x, y), omitting any connecting line segment.
145              
146              
147             =cut
148              
149             sub moveto {
150 6     6 1 19 my ($self, $x, $y) = @_;
151              
152 6         26 $self->{'pdf'}->page_stream($self);
153 6         22 $self->{'pdf'}->add("$x $y m");
154             }
155              
156             =head2 lineto($x, $y)
157              
158             Appends a straight line segment from the current point to (x, y).
159              
160             =cut
161              
162             sub lineto {
163 366     366 1 1363 my ($self, $x, $y) = @_;
164              
165 366         521 $self->{'pdf'}->page_stream($self);
166 366         1638 $self->{'pdf'}->add("$x $y l");
167             }
168              
169             =head2 curveto($x1, $y1, $x2, $y2, $x3, $y3)
170              
171             Appends a Bezier curve to the path. The curve extends from the current point to
172             (x3 ,y3) using (x1 ,y1) and (x2 ,y2) as the Bezier control points.The new current
173             point is (x3 ,y3).
174              
175             =cut
176              
177             sub curveto {
178 4     4 1 23 my ($self, $x1, $y1, $x2, $y2, $x3, $y3) = @_;
179              
180 4         7 $self->{'pdf'}->page_stream($self);
181 4         24 $self->{'pdf'}->add("$x1 $y1 $x2 $y2 $x3 $y3 c");
182             }
183              
184             =head2 rectangle($x, $y, $w, $h)
185              
186             Adds a rectangle to the current path.
187              
188             =cut
189              
190             sub rectangle {
191 0     0 1 0 my ($self, $x, $y, $w, $h) = @_;
192              
193 0         0 $self->{'pdf'}->page_stream($self);
194 0         0 $self->{'pdf'}->add("$x $y $w $h re");
195             }
196              
197             =head2 closepath()
198              
199             Closes the current subpath by appending a straight line segment from the current
200             point to the starting point of the subpath.
201              
202             =cut
203              
204             sub closepath {
205 0     0 1 0 my ($self) = @_;
206              
207 0         0 $self->{'pdf'}->page_stream($self);
208 0         0 $self->{'pdf'}->add("h");
209             }
210              
211             =head2 newpath()
212              
213             Ends the path without filling or stroking it.
214              
215             =cut
216              
217             sub newpath {
218 5     5 1 16 my ($self) = @_;
219              
220 5         9 $self->{'pdf'}->page_stream($self);
221 5         8 $self->{'pdf'}->add("n");
222             }
223              
224             =head2 stroke()
225              
226             Strokes the path.
227              
228             =cut
229              
230             sub stroke {
231 6     6 1 20 my ($self) = @_;
232              
233 6         15 $self->{'pdf'}->page_stream($self);
234 6         12 $self->{'pdf'}->add("S");
235             }
236              
237             =head2 closestroke()
238              
239             Closes and strokes the path.
240              
241             =cut
242              
243             sub closestroke {
244 0     0 1 0 my ($self) = @_;
245              
246 0         0 $self->{'pdf'}->page_stream($self);
247 0         0 $self->{'pdf'}->add("s");
248             }
249              
250             =head2 fill()
251              
252             Fills the path using the non-zero winding number rule.
253              
254             =cut
255              
256             sub fill {
257 1     1 1 2 my ($self) = @_;
258              
259 1         3 $self->{'pdf'}->page_stream($self);
260 1         4 $self->{'pdf'}->add("f");
261             }
262              
263             =head2 fill2()
264              
265             Fills the path using the even-odd rule.
266              
267             =cut
268              
269             sub fill2 {
270 0     0 1 0 my ($self) = @_;
271              
272 0         0 $self->{'pdf'}->page_stream($self);
273 0         0 $self->{'pdf'}->add("f*");
274             }
275              
276             =head2 line($x1, $y1, $x2, $y2)
277              
278             Draw a line between ($x1, $y1) and ($x2, $y2). Combined moveto / lineto / stroke
279             command.
280              
281             =cut
282              
283             sub line {
284 60     60 1 3870 my ($self, $x1, $y1, $x2, $y2) = @_;
285              
286 60         1988 $self->{'pdf'}->page_stream($self);
287 60         2104 $self->{'pdf'}->add("$x1 $y1 m $x2 $y2 l S");
288             }
289              
290             =head2 set_width($w)
291              
292             Set the width of subsequent lines to C points.
293              
294             =cut
295              
296             sub set_width {
297 6     6 1 13 my ($self, $w) = @_;
298              
299 6         13 $self->{'pdf'}->page_stream($self);
300 6         20 $self->{'pdf'}->add("$w w");
301             }
302              
303             #
304             #
305             # Color functions
306              
307             =head2 setgray($value)
308              
309             Sets the color space to DeviceGray and sets the gray tint to use for filling paths.
310              
311             =cut
312              
313             sub setgray {
314 0     0 1 0 my ($self, $val) = @_;
315              
316 0         0 $self->{'pdf'}->page_stream($self);
317 0         0 $self->{'pdf'}->add("$val g");
318             }
319              
320             =head2 setgraystroke($value)
321              
322             Sets the color space to DeviceGray and sets the gray tint to use for stroking paths.
323              
324             =cut
325              
326             sub setgraystroke {
327 0     0 1 0 my ($self, $val) = @_;
328              
329 0         0 $self->{'pdf'}->page_stream($self);
330 0         0 $self->{'pdf'}->add("$val G");
331             }
332              
333             =head2 setrgbcolor($r, $g, $b)
334              
335             Sets the fill colors used for normal text or filled objects.
336              
337             =cut
338              
339             sub setrgbcolor {
340 1     1 1 6 my ($self, $r, $g, $b) = @_;
341              
342 1         3 $self->{'pdf'}->page_stream($self);
343 1         11 $self->{'pdf'}->add("$r $g $b rg");
344             }
345              
346             =head2 setrgbcolorstroke($r, $g, $b)
347              
348             Set the color of the subsequent drawing operations. Valid r, g, and b values are
349             each between 0.0 and 1.0, inclusive.
350              
351             Each color ranges from 0.0 to 1.0, i.e., darkest red (0.0) to brightest red(1.0).
352             The same holds for green and blue. These three colors mix additively to produce
353             the colors between black (0.0, 0.0, 0.0) and white (1.0, 1.0, 1.0).
354              
355             PDF distinguishes between the stroke and fill operations and provides separate
356             color settings for each.
357              
358             =cut
359              
360             sub setrgbcolorstroke {
361 4     4 1 11 my ($self, $r, $g, $b) = @_;
362              
363 4 50       8 croak "Error setting colors, need three values" if !defined $b;
364 4         8 $self->{'pdf'}->page_stream($self);
365 4         24 $self->{'pdf'}->add("$r $g $b RG");
366             }
367              
368             #
369             #
370             # Text functions
371              
372             =head2 text(%params)
373              
374             Renders the text. Parameters are explained as below:
375              
376             +--------+------------------------------------------------------------------+
377             | Key | Description |
378             +--------+------------------------------------------------------------------+
379             | start | The start marker, add directive BT |
380             | end | The end marker, add directive ET |
381             | text | Text to add to the pdf |
382             | F | Font index to be used, add directive /F |
383             | Tf | Font size for the text, add directive Tf |
384             | Ts | Text rise (super/subscript), add directive Ts |
385             | Tr | Text rendering mode, add directive Tr |
386             | TL | Text leading, add directive TL |
387             | Tc | Character spacing, add directive Tc |
388             | Tw | Word spacing, add directive Tw |
389             | Tz | Horizontal scaling, add directive Tz |
390             | Td | Move to, add directive Td |
391             | TD | Move to and set TL, add directive TD |
392             | rot | Move to and rotate ( ), add directive |
393             | | , , , , , Tm |
394             | T* | Add new line. |
395             +--------+------------------------------------------------------------------+
396              
397             =cut
398              
399             sub text {
400 0     0 1 0 my ($self, %params) = @_;
401              
402 0         0 PDF::Create::debug( 2, "text(%params):" );
403              
404 0         0 my @directives = ();
405              
406 0 0       0 if (defined $params{'start'}) { push @directives, "BT"; }
  0         0  
407              
408             # Font index
409 0 0       0 if (defined $params{'F'}) {
410 0         0 push @directives, "/F$params{'F'}";
411 0         0 $self->{'pdf'}->uses_font($self, $params{'F'});
412             }
413             # Font size
414 0 0       0 if (defined $params{'Tf'}) { push @directives, "$params{'Tf'} Tf"; }
  0         0  
415             # Text Rise (Super/Subscript)
416 0 0       0 if (defined $params{'Ts'}) { push @directives, "$params{'Ts'} Ts"; }
  0         0  
417             # Rendering Mode
418 0 0       0 if (defined $params{'Tr'}) { push @directives, "$params{'Tr'} Tr"; }
  0         0  
419             # Text Leading
420 0 0       0 if (defined $params{'TL'}) { push @directives, "$params{'TL'} TL"; }
  0         0  
421             # Character spacing
422 0 0       0 if (defined $params{'Tc'}) { push @directives, "$params{'Tc'} Tc"; }
  0         0  
423             # Word Spacing
424 0 0       0 if (defined $params{'Tw'}) { push @directives, "$params{'Tw'} Tw"; } else { push @directives, "0 Tw"; }
  0         0  
  0         0  
425             # Horizontal Scaling
426 0 0       0 if (defined $params{'Tz'}) { push @directives, "$params{'Tz'} Tz"; }
  0         0  
427             # Moveto
428 0 0       0 if (defined $params{'Td'}) { push @directives, "$params{'Td'} Td"; }
  0         0  
429             # Moveto and set TL
430 0 0       0 if (defined $params{'TD'}) { push @directives, "$params{'TD'} TD"; }
  0         0  
431              
432             # Moveto and rotateOA
433 0         0 my $pi = atan2(1, 1) * 4;
434 0         0 my $piover180 = $pi / 180;
435 0 0       0 if (defined $params{'rot'}) {
436 0         0 my ($r, $x, $y) = split( /\s+/, $params{'rot'}, 3 );
437 0 0       0 $x = 0 unless ($x > 0);
438 0 0       0 $y = 0 unless ($y > 0);
439 0         0 my $cos = cos($r * $piover180);
440 0         0 my $sin = sin($r * $piover180);
441 0         0 push @directives, sprintf("%.5f %.5f -%.5f %.5f %s %s Tm", $cos, $sin, $sin, $cos, $x, $y);
442             }
443              
444             # New line
445 0 0       0 if (defined $params{'T*'}) { push @directives, "T*"; }
  0         0  
446              
447 0 0       0 if (defined $params{'text'}) {
448 0         0 $params{'text'} =~ s|([()])|\\$1|g;
449 0         0 push @directives, "($params{'text'}) Tj";
450             }
451              
452 0 0       0 if (defined $params{'end'}) {
453 0         0 push @directives, "ET";
454 0         0 $ptext = join(' ', @directives);
455 0         0 $self->{'pdf'}->page_stream($self);
456 0         0 $self->{'pdf'}->add($ptext);
457             }
458              
459 0         0 PDF::Create::debug( 3, "text(): $ptext" );
460              
461 0         0 1;
462             }
463              
464             =head2 string($font, $size, $x, $y, $text $alignment)
465              
466             Add text to the current page using the font object at the given size and position.
467             The point (x, y) is the bottom left corner of the rectangle containing the text.
468              
469             The optional alignment can be 'r' for right-alignment and 'c' for centered.
470              
471             Example :
472              
473             my $f1 = $pdf->font(
474             'Subtype' => 'Type1',
475             'Encoding' => 'WinAnsiEncoding',
476             'BaseFont' => 'Helvetica'
477             );
478              
479             $page->string($f1, 20, 306, 396, "some text");
480              
481             =cut
482              
483             sub string {
484 10     10 1 31 my ($self, $font, $size, $x, $y, $string, $align,
485             $char_spacing, $word_spacing) = @_;
486              
487 10 100       23 $align = 'L' unless defined $align;
488              
489 10 100       33 if (uc($align) eq "R") {
    100          
490 1         3 $x -= $size * $self->string_width($font, $string);
491             } elsif (uc($align) eq "C") {
492 2         6 $x -= $size * $self->string_width($font, $string) / 2;
493             }
494              
495 10         26 my @directives = (
496             'BT',
497             "/F$font",
498             "$size Tf",
499             );
500              
501 10 50 33     20 if (defined $char_spacing && $char_spacing =~ m/[0-9]+\.?[0-9]*/) {
502 0         0 push @directives, sprintf("%s Tc", $char_spacing);
503             }
504              
505 10 50 33     24 if (defined $word_spacing && $word_spacing =~ m/[0-9]+\.?[0-9]*/) {
506 0         0 push @directives, sprintf("%s Tw", $word_spacing);
507             }
508              
509 10         14 $string =~ s|([()])|\\$1|g;
510              
511 10         52 push @directives,
512             "$x $y Td",
513             "($string) Tj",
514             'ET';
515              
516 10         27 $self->{'pdf'}->page_stream($self);
517 10         19 $self->{'pdf'}->uses_font($self, $font);
518 10         34 $self->{'pdf'}->add(join(' ', @directives));
519             }
520              
521             =head2 string_underline($font, $size, $x, $y, $text, $alignment)
522              
523             Draw a line for underlining.The parameters are the same as for the string function
524             but only the line is drawn. To draw an underlined string you must call both,string
525             and string_underline. To change the color of your text use the C.
526             It returns the length of the string. So its return value can be used directly for
527             the bounding box of an annotation.
528              
529             Example :
530              
531             $page->string($f1, 20, 306, 396, "some underlined text");
532              
533             $page->string_underline($f1, 20, 306, 396, "some underlined text");
534              
535             =cut
536              
537             sub string_underline {
538 6     6 1 10 my ($self, $font, $size, $x, $y, $string, $align) = @_;
539              
540 6 100       14 $align = 'L' unless defined $align;
541 6         13 my $len1 = $self->string_width($font, $string) * $size;
542 6         8 my $len2 = $len1 / 2;
543 6 100       18 if (uc($align) eq "R") {
    100          
544 1         4 $self->line($x - $len1, $y - 1, $x, $y - 1);
545             } elsif (uc($align) eq "C") {
546 2         7 $self->line($x - $len2, $y - 1, $x + $len2, $y - 1);
547             } else {
548 3         11 $self->line($x, $y - 1, $x + $len1, $y - 1);
549             }
550              
551 6         18 return $len1;
552             }
553              
554             =head2 stringl($font, $size, $x, $y $text)
555              
556             Same as C.
557              
558             =cut
559              
560             sub stringl {
561 11     11 1 39 my ($self, $font, $size, $x, $y, $string) = @_;
562              
563 11         19 $self->{'pdf'}->page_stream($self);
564 11         26 $self->{'pdf'}->uses_font($self, $font);
565 11         33 $string =~ s|([()])|\\$1|g;
566 11         33 $self->{'pdf'}->add("BT /F$font $size Tf $x $y Td ($string) Tj ET");
567             }
568              
569             =head2 stringr($font, $size, $x, $y, $text)
570              
571             Same as C but right aligned (alignment 'r').
572              
573             =cut
574              
575             sub stringr {
576 1     1 1 2 my ($self, $font, $size, $x, $y, $string) = @_;
577              
578 1         3 $self->{'pdf'}->page_stream($self);
579 1         2 $self->{'pdf'}->uses_font($self, $font);
580 1         2 $x -= $size * $self->string_width($font, $string);
581 1         8 $string =~ s|([()])|\\$1|g;
582 1         11 $self->{'pdf'}->add(" BT /F$font $size Tf $x $y Td ($string) Tj ET");
583             }
584              
585             =head2 stringc($font, $size, $x, $y, $text)
586              
587             Same as C but centered (alignment 'c').
588              
589             =cut
590              
591             sub stringc {
592 64     64 1 7162 my ($self, $font, $size, $x, $y, $string) = @_;
593              
594 64         2952 $self->{'pdf'}->page_stream($self);
595 64         2955 $self->{'pdf'}->uses_font($self, $font);
596 64         2927 $x -= $size * $self->string_width($font, $string) / 2;
597 64         2997 $string =~ s|([()])|\\$1|g;
598 64         3407 $self->{'pdf'}->add(" BT /F$font $size Tf $x $y Td ($string) Tj ET");
599             }
600              
601             =head2 string_width($font, $text)
602              
603             Return the size of the text using the given font in default user space units.This
604             does not contain the size of the font yet, to get the length you must multiply by
605             the font size.
606              
607             =cut
608              
609             sub string_width {
610 74     74 1 2922 my ($self, $font, $string) = @_;
611              
612 74 50       2952 croak 'No string given' unless defined $string;
613              
614 74         2911 my $fname = $self->{'pdf'}{'fonts'}{$font}{'BaseFont'}[1];
615 74 50       2967 croak('Unknown font: ' . $fname) unless defined $$font_widths{$fname}[ ord "M" ];
616              
617 74         2931 my $w = 0;
618 74         3080 for my $c ( split '', $string ) {
619 1433         6831 $w += $$font_widths{$fname}[ ord $c ];
620             }
621              
622 74         5886 return $w / 1000;
623             }
624              
625             =head2 printnl($text, $font, $size, $x, $y)
626              
627             Similar to C but parses the string for newline and prints each part on
628             a separate line. Lines spacing is the same as the font-size.Returns the number of
629             lines.
630              
631             Note the different parameter sequence.The first call should specify all parameters,
632             font is the absolute minimum, a warning will be given for the missing y position
633             and 800 will be assumed. All subsequent invocations can omit all but the string
634             parameters.
635              
636             ATTENTION:There is no provision for changing pages.If you run out of space on the
637             current page this will draw the string(s) outside the page and it will be invisible.
638              
639             =cut
640              
641             sub printnl {
642 0     0 1 0 my ($self, $s, $font, $size, $x, $y) = @_;
643              
644 0 0       0 $self->{'current_font'} = $font if defined $font;
645 0 0       0 croak 'No font found !' if !defined $self->{'current_font'};
646              
647             # set up current_x/y used in stringml
648 0 0       0 $self->{'current_y'} = $y if defined $y;
649 0 0       0 carp 'No starting position given, using 800' if !defined $self->{'current_y'};
650 0 0       0 $self->{'current_y'} = 800 if !defined $self->{'current_y'};
651 0 0       0 $self->{'current_x'} = $x if defined $x;
652 0 0       0 $self->{'current_x'} = 20 if !defined $self->{'current_x'};
653 0 0       0 $self->{'current_size'} = $size if defined $size;
654 0 0       0 $self->{'current_size'} = 12 if !defined $self->{'current_size'};
655              
656             # print the line(s)
657 0         0 my $n = 0;
658 0         0 for my $line ( split '\n', $s ) {
659 0         0 $n++;
660 0         0 $self->string($self->{'current_font'}, $self->{'current_size'}, $self->{'current_x'}, $self->{'current_y'}, $line);
661 0         0 $self->{'current_y'} = $self->{'current_y'} - $self->{'current_size'};
662             }
663              
664 0         0 return $n;
665             }
666              
667             =head2 block_text(\%params)
668              
669             Add block of text to the page. Parameters are explained as below:
670              
671             +------------+--------------------------------------------------------------+
672             | Key | Description |
673             +------------+--------------------------------------------------------------+
674             | page | Object of type PDF::Create::Page |
675             | font | Font index to be used. |
676             | text | Text block to be used. |
677             | font_size | Font size for the text. |
678             | text_color | Text color as arrayref i.e. [r, g, b] |
679             | line_width | Line width (in points) |
680             | start_y | First row number (in points) when adding new page. |
681             | end_y | Last row number (in points) when to add new page. |
682             | x | x co-ordinate to start the text. |
683             | y | y co-ordinate to start the text. |
684             +------------+--------------------------------------------------------------+
685              
686             use strict; use warnings;
687             use PDF::Create;
688              
689             my $pdf = PDF::Create->new('filename'=>"$0.pdf", 'Author'=>'MANWAR', 'Title'=>'Create::PDF');
690             my $root = $pdf->new_page('MediaBox' => $pdf->get_page_size('A4'));
691             my $page = $root->new_page;
692             my $font = $pdf->font('BaseFont' => 'Helvetica');
693              
694             $page->rectangle(30, 780, 535, 40);
695             $page->setrgbcolor(0,1,0);
696             $page->fill;
697              
698             $page->setrgbcolorstroke(1,0,0);
699             $page->line(30, 778, 565, 778);
700              
701             $page->setrgbcolor(0,0,1);
702             $page->string($font, 15, 102, 792, 'MANWAR - PDF::Create');
703              
704             my $text = qq{
705             Lorem Ipsum is simply dummy text of the printing and typesetting industry. Lorem Ipsum has been the industry's standard dummy text ever since the 1500s, when an unknown printer took a galley of type and scrambled it to make a type specimen book. It has survived not only five centuries, but also the leap into ele-It has survived not only five centuries, but also the leap into electronic typesetting, remaining essentially unchanged. It was popularised in the 1960s with the release of Letraset sheets containing Lorem Ipsum passages, and more recently with desktop publishing software like Aldus PageMaker including versions
706             };
707              
708             $page->block_text({
709             page => $page,
710             font => $font,
711             text => $text,
712             font_size => 6,
713             text_color => [0,0,1],
714             line_width => 535,
715             start_y => 780,
716             end_y => 60,
717             'x' => 30,
718             'y' => 770,
719             });
720              
721             $pdf->close;
722              
723             =cut
724              
725             sub block_text {
726 0     0 1 0 my ($self, $params) = @_;
727              
728 0 0 0     0 croak "ERROR: parameters to method block_text() should be hashref.\n"
729             unless (defined $params && (ref($params) eq 'HASH'));
730              
731 0         0 my $page = $params->{page};
732 0         0 my $font = $params->{font};
733 0         0 my $text = $params->{text};
734 0         0 my $font_size = $params->{font_size};
735 0         0 my $text_color = $params->{text_color};
736 0         0 my $line_width = $params->{line_width};
737 0   0     0 my $start_y = $params->{start_y} || 0;
738 0   0     0 my $end_y = $params->{end_y} || 0;
739 0         0 my $x = $params->{x};
740 0         0 my $y = $params->{y};
741 0         0 my $one_space = $page->string_width($font, ' ') * $font_size;
742              
743 0         0 my $para_space_factor = 1.5;
744             $para_space_factor = $params->{para_space_factor}
745             if (exists $params->{para_space_factor}
746 0 0 0     0 && defined $params->{para_space_factor});
747              
748 0         0 my @lines = ();
749 0         0 foreach my $block (split /\n/, $text) {
750 0         0 my @words = split(/ /, $block);
751 0         0 my $para_last_line = 0;
752              
753 0         0 while (@words) {
754 0         0 my $num_words = 1;
755 0         0 my $string_width = 0;
756 0         0 my $space_width = undef;
757              
758 0         0 while (1) {
759 0         0 $string_width = $font_size * $page->string_width(
760             $font, _get_text(\@words, $num_words));
761              
762             # Shorter, try one more word
763 0 0       0 if ($string_width + $one_space < $line_width) {
764 0 0       0 if (scalar(@words) > $num_words) {
765 0         0 $num_words++;
766 0         0 next;
767             }
768             }
769              
770 0 0       0 last if ($num_words == 1);
771              
772             # Longer, chop a word off, then space accordingly
773 0         0 $para_last_line = scalar(@words) == $num_words;
774 0 0 0     0 if ($string_width + $one_space > $line_width || $para_last_line) {
775 0 0       0 unless ($para_last_line) {
776 0         0 $num_words--;
777             }
778              
779 0         0 $string_width = $font_size * $page->string_width(
780             $font, _get_text(\@words, $num_words));
781              
782 0         0 $space_width = ($line_width - $string_width) / $num_words;
783 0         0 last;
784             }
785             }
786              
787 0         0 my %text_param = (
788             start => 1,
789             Tw => $space_width,
790             F => $font,
791             Tf => $font_size,
792             Td => "$x $y",
793             text => _get_text(\@words, $num_words),
794             end => 1,
795             );
796              
797 0 0       0 if ($para_last_line) {
798 0         0 delete $text_param{Tw};
799             }
800              
801 0         0 $page->text(%text_param);
802              
803 0 0       0 if ($y <= $end_y) {
804 0         0 $y = $start_y;
805 0         0 $page = $page->{'Parent'}->new_page();
806 0         0 $page->setrgbcolor(@$text_color);
807             }
808             else {
809 0         0 $y -= int($font_size * $para_space_factor);
810 0 0       0 if ($para_last_line) {
811 0         0 $y -= int($font_size * $para_space_factor);
812             }
813             }
814              
815 0         0 splice(@words, 0, $num_words);
816             }
817             }
818             }
819              
820             =head2 image(%params)
821              
822             Inserts an image. Parameters can be:
823              
824             +----------------+----------------------------------------------------------+
825             | Key | Description |
826             +----------------+----------------------------------------------------------+
827             | | |
828             | image | Image id returned by PDF::image (required). |
829             | | |
830             | xpos, ypos | Position of image (required). |
831             | | |
832             | xalign, yalign | Alignment of image.0 is left/bottom, 1 is centered and 2 |
833             | | is right, top. |
834             | | |
835             | xscale, yscale | Scaling of image. 1.0 is original size. |
836             | | |
837             | rotate | Rotation of image.0 is no rotation,2*pi is 360° rotation.|
838             | | |
839             | xskew, yskew | Skew of image. |
840             | | |
841             +----------------+----------------------------------------------------------+
842              
843             Example jpeg image:
844              
845             # include a jpeg image with scaling to 20% size
846             my $jpg = $pdf->image("image.jpg");
847              
848             $page->image(
849             'image' => $jpg,
850             'xscale' => 0.2,
851             'yscale' => 0.2,
852             'xpos' => 350,
853             'ypos' => 400
854             );
855              
856             =cut
857              
858             sub image {
859 2     2 1 25 my ($self, %params) = @_;
860              
861             # Switch to the 'C' locale, we need printf floats with a '.', not a ','
862 2         11 my $savedLocale = setlocale(LC_NUMERIC);
863 2         14 setlocale(LC_NUMERIC,'C');
864              
865 2   50     7 my $img = $params{'image'} || "1.2";
866 2         4 my $image = $img->{num};
867 2   50     6 my $xpos = $params{'xpos'} || 0;
868 2   50     7 my $ypos = $params{'ypos'} || 0;
869 2   50     10 my $xalign = $params{'xalign'} || 0;
870 2   50     6 my $yalign = $params{'yalign'} || 0;
871 2   50     6 my $xscale = $params{'xscale'} || 1;
872 2   50     3 my $yscale = $params{'yscale'} || 1;
873 2   50     7 my $rotate = $params{'rotate'} || 0;
874 2   50     6 my $xskew = $params{'xskew'} || 0;
875 2   50     9 my $yskew = $params{'yskew'} || 0;
876              
877 2         5 $xscale *= $img->{width};
878 2         3 $yscale *= $img->{height};
879              
880 2 50       14 if ($xalign == 1) {
    50          
881 0         0 $xpos -= $xscale / 2;
882             } elsif ($xalign == 2) {
883 0         0 $xpos -= $xscale;
884             }
885              
886 2 50       7 if ($yalign == 1) {
    50          
887 0         0 $ypos -= $yscale / 2;
888             } elsif ($yalign == 2) {
889 0         0 $ypos -= $yscale;
890             }
891              
892 2         9 $self->{'pdf'}->page_stream($self);
893 2         9 $self->{'pdf'}->uses_xobject( $self, $image );
894 2         9 $self->{'pdf'}->add("q\n");
895              
896             # TODO: image: Merge position with rotate
897 2 50 33     14 $self->{'pdf'}->add("1 0 0 1 $xpos $ypos cm\n")
898             if ($xpos || $ypos);
899              
900 2 50       6 if ($rotate) {
901 0         0 my $sinth = sin($rotate);
902 0         0 my $costh = cos($rotate);
903 0         0 $self->{'pdf'}->add("$costh $sinth -$sinth $costh 0 0 cm\n");
904             }
905 2 50 33     4 if ($xscale || $yscale) {
906 2         26 $self->{'pdf'}->add("$xscale 0 0 $yscale 0 0 cm\n");
907             }
908 2 50 33     9 if ($xskew || $yskew) {
909 0         0 my $tana = sin($xskew) / cos($xskew);
910 0         0 my $tanb = sin($yskew) / cos($xskew);
911 0         0 $self->{'pdf'}->add("1 $tana $tanb 1 0 0 cm\n");
912             }
913 2         7 $self->{'pdf'}->add("/Image$image Do\n");
914 2         6 $self->{'pdf'}->add("Q\n");
915              
916             # Switch to the 'C' locale, we need printf floats with a '.', not a ','
917 2         17 setlocale(LC_NUMERIC,$savedLocale);
918             }
919              
920             # Table with font widths for the supported fonts.
921             sub init_widths
922             {
923 18     18 0 24 my $font_widths = {};
924 18         23 foreach my $name (keys %{$PDF::Font::SUPPORTED_FONTS}) {
  18         82  
925 234         916 $font_widths->{$name} = PDF::Font->new($name)->char_width;
926             }
927              
928 18         63 return $font_widths;
929             }
930              
931             #
932             #
933             # PRIVATE METHODS
934              
935             sub _get_text ($$) {
936 0     0     my ($words, $num_words) = @_;
937              
938 0 0         if (scalar @$words < $num_words) { die @_ };
  0            
939              
940 0           return join(' ', map { $$words[$_] } (0..($num_words-1)));
  0            
941             }
942              
943             =head1 AUTHORS
944              
945             Fabien Tassin
946              
947             GIF and JPEG-support: Michael Gross (info@mdgrosse.net)
948              
949             Maintenance since 2007: Markus Baertschi (markus@markus.org)
950              
951             Currently maintained by Mohammad S Anwar (MANWAR) C<< >>
952              
953             =head1 REPOSITORY
954              
955             L
956              
957             =head1 COPYRIGHT
958              
959             Copyright 1999-2001,Fabien Tassin.All rights reserved.It may be used and modified
960             freely, but I do request that this copyright notice remain attached to the file.
961             You may modify this module as you wish,but if you redistribute a modified version,
962             please attach a note listing the modifications you have made.
963              
964             Copyright 2007 Markus Baertschi
965              
966             Copyright 2010 Gary Lieberman
967              
968             =head1 LICENSE
969              
970             This is free software; you can redistribute it and / or modify it under the same
971             terms as Perl 5.6.0.
972              
973             =cut
974              
975             1;