File Coverage

blib/lib/PDF/Create/Page.pm
Criterion Covered Total %
statement 180 328 54.8
branch 29 116 25.0
condition 17 54 31.4
subroutine 33 43 76.7
pod 31 33 93.9
total 290 574 50.5


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