File Coverage

blib/lib/PDF/Builder/Content/Text.pm
Criterion Covered Total %
statement 200 340 58.8
branch 87 214 40.6
condition 44 189 23.2
subroutine 16 19 84.2
pod 13 14 92.8
total 360 776 46.3


line stmt bran cond sub pod time code
1             package PDF::Builder::Content::Text;
2              
3 38     38   245 use base 'PDF::Builder::Content';
  38         69  
  38         3787  
4              
5 38     38   248 use strict;
  38         73  
  38         655  
6 38     38   150 use warnings;
  38         110  
  38         117753  
7              
8             our $VERSION = '3.024'; # VERSION
9             our $LAST_UPDATE = '3.024'; # manually update whenever code is changed
10              
11             =head1 NAME
12              
13             PDF::Builder::Content::Text - additional specialized text-related formatting methods. Inherits from L
14              
15             B If you have used some of these methods in PDF::API2 with a I
16             type object (e.g., $page->gfx()->method()), you may have to change to a I
17             type object (e.g., $page->text()->method()).
18              
19             =head1 METHODS
20              
21             =cut
22              
23             sub new {
24 20     20 1 50 my ($class) = @_;
25 20         101 my $self = $class->SUPER::new(@_);
26 20         94 $self->textstart();
27 20         49 return $self;
28             }
29              
30             =over
31              
32             =item $width = $content->text_left($text, %opts)
33              
34             Alias for C. Implemented for symmetry, for those who use a lot of
35             C and C, and desire a matching C.
36              
37             Adds text to the page (left justified), at the current position.
38             Note that there is no maximum width, and nothing to keep you from overflowing
39             the physical page on the right!
40             The width used (in points) is B.
41              
42             =back
43              
44             =cut
45              
46             sub text_left {
47 0     0 1 0 my ($self, $text, @opts) = @_;
48              
49 0         0 return $self->text($text, @opts);
50             }
51              
52             =over
53              
54             =item $width = $content->text_center($text, %opts)
55              
56             As C, but I on the current point.
57              
58             Adds text to the page (centered).
59             The width used (in points) is B.
60              
61             =back
62              
63             =cut
64              
65             sub text_center {
66 6     6 1 32 my ($self, $text, @opts) = @_;
67              
68 6         29 my $width = $self->advancewidth($text, @opts);
69 6         37 return $self->text($text, 'indent' => -($width/2), @opts);
70             }
71              
72             =over
73              
74             =item $width = $content->text_right($text, %opts)
75              
76             As C, but right-aligned to the current point.
77              
78             Adds text to the page (right justified).
79             Note that there is no maximum width, and nothing to keep you from overflowing
80             the physical page on the left!
81             The width used (in points) is B.
82              
83             =back
84              
85             =cut
86              
87             sub text_right {
88 3     3 1 15 my ($self, $text, @opts) = @_;
89              
90 3         12 my $width = $self->advancewidth($text, @opts);
91 3         12 return $self->text($text, 'indent' => -$width, @opts);
92             }
93              
94             =over
95              
96             =item $width = $content->text_justified($text, $width, %opts)
97            
98             As C, but stretches text using C, C, and (as a
99             last resort) C, to fill the desired
100             (available) C<$width>. Note that if the desired width is I than the
101             natural width taken by the text, it will be I to fit, using the
102             same three routines.
103              
104             The unchanged C<$width> is B, unless there was some reason to
105             change it (e.g., overflow).
106              
107             B
108              
109             =over
110              
111             =item 'nocs' => value
112              
113             If this option value is 1 (default 0), do B use any intercharacter
114             spacing. This is useful for connected characters, such as fonts for Arabic,
115             Devanagari, Latin cursive handwriting, etc. You don't want to add additional
116             space between characters during justification, which would disconnect them.
117              
118             I (interword) spacing values (explicit or default) are doubled if
119             nocs is 1. This is to make up for the lack of added/subtracted intercharacter
120             spacing.
121              
122             =item 'wordsp' => value
123              
124             The percentage of one space character (default 100) that is the maximum amount
125             to add to (each) interword spacing to expand the line.
126             If C is 1, double C.
127              
128             =item 'charsp' => value
129              
130             If adding interword space didn't do enough, the percentage of one em (default
131             100) that is the maximum amount to add to (each) intercharacter spacing to
132             further expand the line.
133             If C is 1, force C to 0.
134              
135             =item 'wordspa' => value
136              
137             If adding intercharacter space didn't do enough, the percentage of one space
138             character (default 100) that is the maximum I amount to add to
139             (each) interword spacing to further expand the line.
140             If C is 1, double C.
141              
142             =item 'charspa' => value
143              
144             If adding more interword space didn't do enough, the percentage of one em
145             (default 100) that is the maximum I amount to add to (each)
146             intercharacter spacing to further expand the line.
147             If C is 1, force C to 0.
148              
149             =item 'condw' => value
150              
151             The percentage of one space character (default 25) that is the maximum amount
152             to subtract from (each) interword spacing to condense the line.
153             If C is 1, double C.
154              
155             =item 'condc' => value
156              
157             If removing interword space didn't do enough, the percentage of one em
158             (default 10) that is the maximum amount to subtract from (each) intercharacter
159             spacing to further condense the line.
160             If C is 1, force C to 0.
161              
162             =back
163              
164             If expansion (or reduction) wordspace and charspace changes didn't do enough
165             to make the line fit the desired width, use C to finish expanding or
166             condensing the line to fit.
167              
168             =back
169              
170             =cut
171              
172             sub text_justified {
173 4     4 1 18 my ($self, $text, $width, %opts) = @_;
174             # copy dashed option names to the preferred undashed names
175 4 50 33     18 if (defined $opts{'-wordsp'} && !defined $opts{'wordsp'}) { $opts{'wordsp'} = delete($opts{'-wordsp'}); }
  0         0  
176 4 50 33     13 if (defined $opts{'-charsp'} && !defined $opts{'charsp'}) { $opts{'charsp'} = delete($opts{'-charsp'}); }
  0         0  
177 4 50 33     15 if (defined $opts{'-wordspa'} && !defined $opts{'wordspa'}) { $opts{'wordspa'} = delete($opts{'-wordspa'}); }
  0         0  
178 4 50 33     14 if (defined $opts{'-charspa'} && !defined $opts{'charspa'}) { $opts{'charspa'} = delete($opts{'-charspa'}); }
  0         0  
179 4 50 33     13 if (defined $opts{'-condw'} && !defined $opts{'condw'}) { $opts{'condw'} = delete($opts{'-condw'}); }
  0         0  
180 4 50 33     16 if (defined $opts{'-condc'} && !defined $opts{'condc'}) { $opts{'condc'} = delete($opts{'-condc'}); }
  0         0  
181 4 50 33     13 if (defined $opts{'-nocs'} && !defined $opts{'nocs'}) { $opts{'nocs'} = delete($opts{'-nocs'}); }
  0         0  
182              
183             # optional parameters to control how expansion or condensation are done
184             # 1. expand interword space up to 100% of 1 space
185 4 50       14 my $wordsp = defined($opts{'wordsp'})? $opts{'wordsp'}: 100;
186             # 2. expand intercharacter space up to 100% of 1em
187 4 50       9 my $charsp = defined($opts{'charsp'})? $opts{'charsp'}: 100;
188             # 3. expand interword space up to another 100% of 1 space
189 4 50       12 my $wordspa = defined($opts{'wordspa'})? $opts{'wordspa'}: 100;
190             # 4. expand intercharacter space up to another 100% of 1em
191 4 50       9 my $charspa = defined($opts{'charspa'})? $opts{'charspa'}: 100;
192             # 5. condense interword space up to 25% of 1 space
193 4 50       9 my $condw = defined($opts{'condw'})? $opts{'condw'}: 25;
194             # 6. condense intercharacter space up to 10% of 1em
195 4 50       9 my $condc = defined($opts{'condc'})? $opts{'condc'}: 10;
196             # 7. if still short or long, hscale()
197              
198 4 50       10 my $nocs = defined($opts{'nocs'})? $opts{'nocs'}: 0;
199 4 50       11 if ($nocs) {
200 0         0 $charsp = $charspa = $condc = 0;
201 0         0 $wordsp *= 2;
202 0         0 $wordspa *= 2;
203 0         0 $condw *= 2;
204             }
205              
206             # with original wordspace, charspace, and hscale settings
207             # note that we do NOT change any existing charspace here
208 4         14 my $length = $self->advancewidth($text, %opts);
209 4         10 my $overage = $length - $width; # > 0, raw text is too wide, < 0, narrow
210              
211 4         9 my ($i, @chars, $val, $limit);
212 4         14 my $hs = $self->hscale(); # save old settings and reset to 0
213 4         13 my $ws = $self->wordspace();
214 4         15 my $cs = $self->charspace();
215 4         14 $self->hscale(100); $self->wordspace(0); $self->charspace(0);
  4         13  
  4         12  
216              
217             # not near perfect fit? not within .1 pt of fitting
218 4 50       15 if (abs($overage) > 0.1) {
219              
220             # how many interword spaces can we change with wordspace?
221 4         6 my $num_spaces = 0;
222             # how many intercharacter spaces can be added to or removed?
223 4         9 my $num_chars = -1;
224 4         26 @chars = split //, $text;
225 4         16 for ($i=0; $i
226 78 100       105 if ($chars[$i] eq ' ') { $num_spaces++; } # TBD other whitespace?
  16         19  
227 78         111 $num_chars++; # count spaces as characters, too
228             }
229 4         14 my $em = $self->advancewidth('M');
230 4         12 my $sp = $self->advancewidth(' ');
231              
232 4 50       13 if ($overage > 0) {
233             # too wide: need to condense it
234             # 1. subtract from interword space, up to -$condw/100 $sp
235 0 0 0     0 if ($overage > 0 && $num_spaces > 0 && $condw > 0) {
      0        
236 0         0 $val = $overage/$num_spaces;
237 0         0 $limit = $condw/100*$sp;
238 0 0       0 if ($val > $limit) { $val = $limit; }
  0         0  
239 0         0 $self->wordspace(-$val);
240 0         0 $overage -= $val*$num_spaces;
241             }
242             # 2. subtract from intercharacter space, up to -$condc/100 $em
243 0 0 0     0 if ($overage > 0 && $num_chars > 0 && $condc > 0) {
      0        
244 0         0 $val = $overage/$num_chars;
245 0         0 $limit = $condc/100*$em;
246 0 0       0 if ($val > $limit) { $val = $limit; }
  0         0  
247 0         0 $self->charspace(-$val);
248 0         0 $overage -= $val*$num_chars;
249             }
250             # 3. nothing more to do than scale down with hscale()
251             } else {
252             # too narrow: need to expand it (usual case)
253 4         9 $overage = -$overage; # working with positive value is easier
254             # 1. add to interword space, up to $wordsp/100 $sp
255 4 50 33     26 if ($overage > 0 && $num_spaces > 0 && $wordsp > 0) {
      33        
256 4         8 $val = $overage/$num_spaces;
257 4         8 $limit = $wordsp/100*$sp;
258 4 100       9 if ($val > $limit) { $val = $limit; }
  1         2  
259 4         12 $self->wordspace($val);
260 4         11 $overage -= $val*$num_spaces;
261             }
262             # 2. add to intercharacter space, up to $charsp/100 $em
263 4 50 66     18 if ($overage > 0 && $num_chars > 0 && $charsp > 0) {
      66        
264 1         2 $val = $overage/$num_chars;
265 1         4 $limit = $charsp/100*$em;
266 1 50       3 if ($val > $limit) { $val = $limit; }
  0         0  
267 1         4 $self->charspace($val);
268 1         3 $overage -= $val*$num_chars;
269             }
270             # 3. add to interword space, up to $wordspa/100 $sp additional
271 4 0 33     13 if ($overage > 0 && $num_spaces > 0 && $wordspa > 0) {
      33        
272 0         0 $val = $overage/$num_spaces;
273 0         0 $limit = $wordspa/100*$sp;
274 0 0       0 if ($val > $limit) { $val = $limit; }
  0         0  
275 0         0 $self->wordspace($val+$self->wordspace());
276 0         0 $overage -= $val*$num_spaces;
277             }
278             # 4. add to intercharacter space, up to $charspa/100 $em additional
279 4 0 33     11 if ($overage > 0 && $num_chars > 0 && $charspa > 0) {
      33        
280 0         0 $val = $overage/$num_chars;
281 0         0 $limit = $charspa/100*$em;
282 0 0       0 if ($val > $limit) { $val = $limit; }
  0         0  
283 0         0 $self->charspace($val+$self->charspace());
284 0         0 $overage -= $val*$num_chars;
285             }
286             # 5. nothing more to do than scale up with hscale()
287             }
288              
289             # last ditch effort to fill the line: use hscale()
290             # temporarily resets hscale to expand width of line to match $width
291             # wordspace and charspace are already (temporarily) at max/min
292 4 50       11 if ($overage > 0.1) {
293 0         0 $self->hscale(100*($width/$self->advancewidth($text, %opts)));
294             }
295              
296             } # original $overage was not near 0
297             # do the output, with wordspace, charspace, and possiby hscale changed
298 4         23 $self->text($text, %opts);
299              
300             # restore settings
301 4         16 $self->hscale($hs); $self->wordspace($ws); $self->charspace($cs);
  4         13  
  4         13  
302              
303 4         19 return $width;
304             }
305              
306             =head2 Multiple Lines from a String
307              
308             The string is split at regular blanks (spaces), x20, to find the longest
309             substring that will fit the C<$width>.
310             If a single word is longer than C<$width>, it will overflow.
311             To stay strictly within the desired bounds, set the option
312             C=>0 to disallow spillover.
313              
314             =head3 Hyphenation
315              
316             If hyphenation is enabled, those methods which split up a string into multiple
317             lines (the "text fill", paragraph, and section methods) will attempt to split
318             up the word that overflows the line, in order to pack the text even more
319             tightly ("greedy" line splitting). There are a number of controls over where a
320             word may be split, but note that there is nothing language-specific (i.e.,
321             following a given language's rules for where a word may be split). This is left
322             to other packages.
323              
324             There are hard coded minimums of 2 letters before the split, and 2 letters after
325             the split. See C. Note that neither hyphenation nor simple
326             line splitting makes any attempt to prevent widows and orphans, prevent
327             splitting of the last word in a column or page, or otherwise engage in
328             I.
329              
330             =over
331              
332             =item 'hyphenate' => value
333              
334             0: no hyphenation (B), 1: do basic hyphenation. Always allows
335             splitting at a soft hyphen (\xAD). Unicode hyphen (U+2010) and non-splitting
336             hyphen (U+2011) are ignored as split points.
337              
338             =item 'spHH' => value
339              
340             0: do I split at a hard hyphen (x\2D), 1: I (B)
341              
342             =item 'spOP' => value
343              
344             0: do I split after most punctuation, 1: I (B)
345              
346             =item 'spDR' => value
347              
348             0: do I split after a run of one or more digits, 1: I (B)
349              
350             =item 'spLR' => value
351              
352             0: do I split after a run of one or more ASCII letters, 1: I (B)
353              
354             =item 'spCC' => value
355              
356             0: do I split in camelCase between a lowercase letter and an
357             uppercase letter, 1: I (B)
358              
359             =back
360              
361             =head3 Methods
362              
363             =cut
364              
365             # splits input text (on spaces) into words, glues them back together until
366             # have filled desired (available) width. return the new line and remaining
367             # text. runs of spaces should be preserved. if the first word of a line does
368             # not fit within the alloted space, and cannot be split short enough, just
369             # accept the overflow.
370             sub _text_fill_line {
371 20     20   56 my ($self, $text, $width, $over, %opts) = @_;
372             # copy dashed option names to the preferred undashed names
373 20 50 33     53 if (defined $opts{'-hyphenate'} && !defined $opts{'hyphenate'}) { $opts{'hyphenate'} = delete($opts{'-hyphenate'}); }
  0         0  
374 20 50 33     50 if (defined $opts{'-lang'} && !defined $opts{'lang'}) { $opts{'lang'} = delete($opts{'-lang'}); }
  0         0  
375 20 50 33     46 if (defined $opts{'-nosplit'} && !defined $opts{'nosplit'}) { $opts{'nosplit'} = delete($opts{'-nosplit'}); }
  0         0  
376              
377             # options of interest
378 20 50       241 my $hyphenate = defined($opts{'hyphenate'})? $opts{'hyphenate'}: 0; # default off
379             #my $lang = defined($opts{'lang'})? $opts{'lang'}: 'en'; # English rules by default
380 20         154 my $lang = 'basic';
381             #my $nosplit = defined($opts{'nosplit'})? $opts{'nosplit'}: ''; # indexes NOT to split at, given
382             # as string of integers
383             # my @noSplit = split /[,\s]+/, $nosplit; # normally empty array
384             # 1. indexes start at 0 (split after character N not permitted)
385             # 2. SHYs (soft hyphens) should be skipped
386             # 3. need to map entire string's indexes to each word under
387             # consideration for splitting (hyphenation)
388              
389             # TBD should we consider any non-ASCII spaces?
390             # don't split on non-breaking space (required blank).
391 20         101 my @txt = split(/\x20/, $text);
392 20         33 my @line = ();
393 20         29 local $"; # intent is that reset of separator ($") is local to block
394 20         39 $"=' '; ## no critic
395 20         25 my $lastWord = ''; # the one that didn't quite fit
396 20         28 my $overflowed = 0;
397              
398 20         47 while (@txt) {
399             # build up @line from @txt array until overfills line.
400             # need to remove SHYs (soft hyphens) at this point.
401 119         174 $lastWord = shift @txt; # preserve any SHYs in the word
402 119         186 push @line, (_removeSHY($lastWord));
403             # one space between each element of line, like join(' ', @line)
404 119         423 $overflowed = $self->advancewidth("@line", %opts) > $width;
405 119 100       309 last if $overflowed;
406             }
407             # if overflowed, and overflow not allowed, remove the last word added,
408             # unless single word in line and we're not going to attempt word splitting.
409 20 100 66     62 if ($overflowed && !$over) {
410 13 50 33     62 if ($hyphenate && @line == 1 || @line > 1) {
      33        
411 13         17 pop @line; # discard last (or only) word
412 13         34 unshift @txt,$lastWord; # restore with SHYs intact
413             }
414             # if not hyphenating (splitting words), just leave oversized
415             # single-word line. if hyphenating, could have empty @line.
416             }
417              
418 20         52 my $Txt = "@txt"; # remaining text to put on next line
419 20         42 my $Line = "@line"; # line that fits, but not yet with any split word
420             # may be empty if first word in line overflows
421              
422             # if we try to hyphenate, try splitting up that last word that
423             # broke the camel's back. otherwise, will return $Line and $Txt as is.
424 20 50 33     48 if ($hyphenate && $overflowed) {
425 0         0 my $space;
426             # @line is current whole word list of line, does NOT overflow because
427             # $lastWord was removed. it may be empty if the first word tried was
428             # too long. @txt is whole word list of the remaining words to be output
429             # (includes $lastWord as its first word).
430             #
431             # we want to try splitting $lastWord into short enough left fragment
432             # (with right fragment remainder as first word of next line). if we
433             # fail to do so, just leave whole word as first word of next line, IF
434             # @line was not empty. if @line was empty, accept the overflow and
435             # output $lastWord as @line and remove it from @txt.
436 0 0       0 if (@line) {
437             # line not empty. $space is width for word fragment, not
438             # including blank after previous last word of @line.
439 0         0 $space = $width - $self->advancewidth("@line ", %opts);
440             } else {
441             # line empty (first word too long, and we can try hyphenating).
442             # $space is entire $width available for left fragment.
443 0         0 $space = $width;
444             }
445              
446 0 0       0 if ($space > 0) {
447 0         0 my ($wordLeft, $wordRight);
448             # @line is word(s) (if any) currently fitting within $width.
449             # @txt is remaining words unused in this line. $lastWord is first
450             # word of @txt. $space is width remaining to fill in line.
451 0         0 $wordLeft = ''; $wordRight = $lastWord; # fallbacks
  0         0  
452              
453             # if there is an error in Hyphenate_$lang, the message may be
454             # that the splitWord() function can't be found. debug errors by
455             # hard coding the require and splitWord() calls.
456              
457             ## test that Hyphenate_$lang exists. if not, use Hyphenate_en
458             ## TBD: if Hyphenate_$lang is not found, should we fall back to
459             ## English (en) rules, or turn off hyphenation, or do limited
460             ## hyphenation (nothing language-specific)?
461             # only Hyphenate_basic. leave language support to other packages
462 0         0 require PDF::Builder::Content::Hyphenate_basic;
463             #eval "require PDF::Builder::Content::Hyphenate_$lang";
464             #if ($@) {
465             #print "something went wrong with require eval: $@\n";
466             #$lang = 'en'; # perlmonks 27443 fall back to English
467             #require PDF::Builder::Content::Hyphenate_en;
468             #}
469 0         0 ($wordLeft,$wordRight) = PDF::Builder::Content::Hyphenate_basic::splitWord($self, $lastWord, $space, %opts);
470             #eval '($wordLeft,$wordRight) = PDF::Builder::Content::Hyphenate_'.$lang.'::splitWord($self, "$lastWord", $space, %opts)';
471 0 0       0 if ($@) { print "something went wrong with eval: $@\n"; }
  0         0  
472              
473             # $wordLeft is left fragment of $lastWord that fits in $space.
474             # it might be empty '' if couldn't get a small enough piece. it
475             # includes a hyphen, but no leading space, and can be added to
476             # @line.
477             # $wordRight is the remainder of $lastWord (right fragment) that
478             # didn't fit. it might be the entire $lastWord. it shouldn't be
479             # empty, since the whole point of the exercise is that $lastWord
480             # didn't fit in the remaining space. it will replace the first
481             # element of @txt (there should be at least one).
482            
483             # see if have a small enough left fragment of $lastWord to append
484             # to @line. neither left nor right Word should have full $lastWord,
485             # and both cannot be empty. it is highly unlikely that $wordLeft
486             # will be the full $lastWord, but quite possible that it is empty
487             # and $wordRight is $lastWord.
488              
489 0 0       0 if (!@line) {
490             # special case of empty line. if $wordLeft is empty and
491             # $wordRight is presumably the entire $lastWord, use $wordRight
492             # for the line and remove it ($lastWord) from @txt.
493 0 0       0 if ($wordLeft eq '') {
494 0         0 @line = ($wordRight); # probably overflows $width.
495 0         0 shift @txt; # remove $lastWord from @txt.
496             } else {
497             # $wordLeft fragment fits $width.
498 0         0 @line = ($wordLeft); # should fit $width.
499 0         0 shift @txt; # replace first element of @txt ($lastWord)
500 0         0 unshift @txt, $wordRight;
501             }
502             } else {
503             # usual case of some words already in @line. if $wordLeft is
504             # empty and $wordRight is entire $lastWord, we're done here.
505             # if $wordLeft has something, append it to line and replace
506             # first element of @txt with $wordRight (unless empty, which
507             # shouldn't happen).
508 0 0       0 if ($wordLeft eq '') {
509             # was unable to split $lastWord into short enough fragment.
510             # leave @line (already has words) and @txt alone.
511             } else {
512 0         0 push @line, ($wordLeft); # should fit $space.
513 0         0 shift @txt; # replace first element of @txt (was $lastWord)
514 0 0       0 unshift @txt, $wordRight if $wordRight ne '';
515             }
516             }
517              
518             # rebuild $Line and $Txt, in case they were altered.
519 0         0 $Txt = "@txt";
520 0         0 $Line = "@line";
521             } # there was $space available to try to fit a word fragment
522             } # we had an overflow to clean up, and hyphenation (word splitting) OK
523 20         72 return ($Line, $Txt);
524             }
525              
526             # remove soft hyphens (SHYs) from a word. assume is always #173 (good for
527             # Latin-1, CP-1252, UTF-8; might not work for some encodings) TBD
528             sub _removeSHY {
529 119     119   171 my ($word) = @_;
530              
531 119         229 my @chars = split //, $word;
532 119         151 my $out = '';
533 119         174 foreach (@chars) {
534 357 50       477 next if ord($_) == 173;
535 357         434 $out .= $_;
536             }
537 119         230 return $out;
538             }
539              
540             =over
541              
542             =item ($width, $leftover) = $content->text_fill_left($string, $width, %opts)
543              
544             Fill a line of 'width' with as much text as will fit,
545             and outputs it left justified.
546             The width actually used, and the leftover text (that didn't fit),
547             are B.
548              
549             =item ($width, $leftover) = $content->text_fill($string, $width, %opts)
550              
551             Alias for text_fill_left().
552              
553             =back
554              
555             =cut
556              
557             sub text_fill_left {
558 10     10 1 30 my ($self, $text, $width, %opts) = @_;
559             # copy dashed option names to preferred undashed names
560 10 50 33     38 if (defined $opts{'-spillover'} && !defined $opts{'spillover'}) { $opts{'spillover'} = delete($opts{'-spillover'}); }
  10         18  
561              
562 10   33     32 my $over = (not(defined($opts{'spillover'}) and $opts{'spillover'} == 0));
563 10         30 my ($line, $ret) = $self->_text_fill_line($text, $width, $over, %opts);
564 10         34 $width = $self->text($line, %opts);
565 10         33 return ($width, $ret);
566             }
567              
568             sub text_fill {
569 0     0 1 0 my $self = shift;
570 0         0 return $self->text_fill_left(@_);
571             }
572              
573             =over
574              
575             =item ($width, $leftover) = $content->text_fill_center($string, $width, %opts)
576              
577             Fill a line of 'width' with as much text as will fit,
578             and outputs it centered.
579             The width actually used, and the leftover text (that didn't fit),
580             are B.
581              
582             =back
583              
584             =cut
585              
586             sub text_fill_center {
587 2     2 1 6 my ($self, $text, $width, %opts) = @_;
588             # copy dashed option names to preferred undashed names
589 2 50 33     11 if (defined $opts{'-spillover'} && !defined $opts{'spillover'}) { $opts{'spillover'} = delete($opts{'-spillover'}); }
  2         5  
590              
591 2   33     8 my $over = (not(defined($opts{'spillover'}) and $opts{'spillover'} == 0));
592 2         8 my ($line, $ret) = $self->_text_fill_line($text, $width, $over, %opts);
593 2         10 $width = $self->text_center($line, %opts);
594 2         7 return ($width, $ret);
595             }
596              
597             =over
598              
599             =item ($width, $leftover) = $content->text_fill_right($string, $width, %opts)
600              
601             Fill a line of 'width' with as much text as will fit,
602             and outputs it right justified.
603             The width actually used, and the leftover text (that didn't fit),
604             are B.
605              
606             =back
607              
608             =cut
609              
610             sub text_fill_right {
611 2     2 1 8 my ($self, $text, $width, %opts) = @_;
612             # copy dashed option names to preferred undashed names
613 2 50 33     8 if (defined $opts{'-spillover'} && !defined $opts{'spillover'}) { $opts{'spillover'} = delete($opts{'-spillover'}); }
  2         5  
614              
615 2   33     12 my $over = (not(defined($opts{'spillover'}) and $opts{'spillover'} == 0));
616 2         7 my ($line, $ret) = $self->_text_fill_line($text, $width, $over, %opts);
617 2         10 $width = $self->text_right($line, %opts);
618 2         7 return ($width, $ret);
619             }
620              
621             =over
622              
623             =item ($width, $leftover) = $content->text_fill_justified($string, $width, %opts)
624              
625             Fill a line of 'width' with as much text as will fit,
626             and outputs it fully justified (stretched or condensed).
627             The width actually used, and the leftover text (that didn't fit),
628             are B.
629              
630             Note that the entire line is fit to the available
631             width via a call to C.
632             See C for options to control stretch and condense.
633             The last line is unjustified (normal size) and left aligned by default,
634             although the option
635              
636             B
637              
638             =over
639              
640             =item 'last_align' => place
641              
642             where place is 'left' (default), 'center', or 'right' (may be shortened to
643             first letter) allows you to specify the alignment of the last line output.
644              
645             =back
646              
647             =back
648              
649             =cut
650              
651             sub text_fill_justified {
652 6     6 1 21 my ($self, $text, $width, %opts) = @_;
653             # copy dashed option names to preferred undashed names
654 6 100 66     24 if (defined $opts{'-last_align'} && !defined $opts{'last_align'}) { $opts{'last_align'} = delete($opts{'-last_align'}); }
  4         13  
655 6 50 33     26 if (defined $opts{'-spillover'} && !defined $opts{'spillover'}) { $opts{'spillover'} = delete($opts{'-spillover'}); }
  6         13  
656              
657 6         12 my $align = 'l'; # default left align last line
658 6 100       10 if (defined($opts{'last_align'})) {
659 4 50       23 if ($opts{'last_align'} =~ m/^l/i) { $align = 'l'; }
  0 100       0  
    50          
660 2         3 elsif ($opts{'last_align'} =~ m/^c/i) { $align = 'c'; }
661 2         5 elsif ($opts{'last_align'} =~ m/^r/i) { $align = 'r'; }
662 0         0 else { warn "Unknown last_align for justified fill, 'left' used\n"; }
663             }
664              
665 6   33     20 my $over = (not(defined($opts{'spillover'}) and $opts{'spillover'} == 0));
666 6         25 my ($line, $ret) = $self->_text_fill_line($text, $width, $over, %opts);
667             # if last line, use $align (don't justify)
668 6 100       21 if ($ret eq '') {
669 3         10 my $lw = $self->advancewidth($line, %opts);
670 3 100       14 if ($align eq 'l') {
    100          
671 1         4 $width = $self->text($line, %opts);
672             } elsif ($align eq 'c') {
673 1         6 $width = $self->text($line, 'indent' => ($width-$lw)/2, %opts);
674             } else { # 'r'
675 1         6 $width = $self->text($line, 'indent' => ($width-$lw), %opts);
676             }
677             } else {
678 3         12 $width = $self->text_justified($line, $width, %opts);
679             }
680 6         22 return ($width, $ret);
681             }
682              
683             =over
684              
685             =item ($overflow_text, $unused_height) = $txt->paragraph($text, $width,$height, $continue, %opts)
686              
687             =item $overflow_text = $txt->paragraph($text, $width,$height, $continue, %opts)
688              
689             Print a single string into a rectangular area on the page, of given width and
690             maximum height. The baseline of the first (top) line is at the current text
691             position.
692              
693             Apply the text within the rectangle and B any leftover text (if could
694             not fit all of it within the rectangle). If called in an array context, the
695             unused height is also B (may be 0 or negative if it just filled the
696             rectangle).
697              
698             If C<$continue> is 1, the first line does B get special treatment for
699             indenting or outdenting, because we're printing the continuation of the
700             paragraph that was interrupted earlier. If it's 0, the first line may be
701             indented or outdented.
702              
703             B
704              
705             =over
706              
707             =item 'pndnt' => $indent
708              
709             Give the amount of indent (positive) or outdent (negative, for "hanging")
710             for paragraph first lines). This setting is ignored for centered text.
711              
712             =item 'align' => $choice
713              
714             C<$choice> is 'justified', 'right', 'center', 'left'; the default is 'left'.
715             See C call for options to control how a line is expanded or
716             condensed if C<$choice> is 'justified'. C<$choice> may be shortened to the
717             first letter.
718              
719             =item 'last_align' => place
720              
721             where place is 'left' (default), 'center', or 'right' (may be shortened to
722             first letter) allows you to specify the alignment of the last line output,
723             but applies only when C is 'justified'.
724              
725             =item 'underline' => $distance
726              
727             =item 'underline' => [ $distance, $thickness, ... ]
728              
729             If a scalar, distance below baseline,
730             else array reference with pairs of distance and line thickness.
731              
732             =item 'spillover' => $over
733              
734             Controls if words in a line which exceed the given width should be
735             "spilled over" the bounds, or if a new line should be used for this word.
736              
737             C<$over> is 1 or 0, with the default 1 (spills over the width).
738              
739             =back
740              
741             B
742              
743             $txt->font($font,$fontsize);
744             $txt->leading($leading);
745             $txt->translate($x,$y);
746             $overflow = $txt->paragraph( 'long paragraph here ...',
747             $width,
748             $y+$leading-$bottom_margin );
749              
750             B if you need to change any text treatment I a paragraph
751             (B or I text, for instance), this can not handle it. Only
752             plain text (all the same font, size, etc.) can be typeset with C.
753             Also, there is currently very limited line splitting (hyphenation) to better
754             fit to a given width, and nothing is done for "widows and orphans".
755              
756             =back
757              
758             =cut
759              
760             # TBD for LTR languages, does indenting on left make sense for right justified?
761             # TBD for bidi/RTL languages, should indenting be on right?
762              
763             sub paragraph {
764 12     12 1 86 my ($self, $text, $width,$height, $continue, %opts) = @_;
765             # copy dashed option names to preferred undashed names
766 12 100 66     54 if (defined $opts{'-align'} && !defined $opts{'align'}) { $opts{'align'} = delete($opts{'-align'}); }
  5         14  
767 12 50 33     39 if (defined $opts{'-pndnt'} && !defined $opts{'pndnt'}) { $opts{'pndnt'} = delete($opts{'-pndnt'}); }
  0         0  
768              
769 12         19 my @line = ();
770 12         21 my $nwidth = 0;
771 12         26 my $leading = $self->leading();
772 12         21 my $align = 'l'; # default left
773 12 100       31 if (defined($opts{'align'})) {
774 5 50       42 if ($opts{'align'} =~ /^l/i) { $align = 'l'; }
  0 100       0  
    100          
    50          
775 1         2 elsif ($opts{'align'} =~ /^c/i) { $align = 'c'; }
776 1         3 elsif ($opts{'align'} =~ /^r/i) { $align = 'r'; }
777 3         7 elsif ($opts{'align'} =~ /^j/i) { $align = 'j'; }
778 0         0 else { warn "Unknown align value for paragraph(), 'left' used\n"; }
779             } # default stays at 'l'
780 12 50       29 my $indent = defined($opts{'pndnt'})? $opts{'pndnt'}: 0;
781 12 100       34 if ($align eq 'c') { $indent = 0; } # indent/outdent makes no sense centered
  1         2  
782 12         21 my $first_line = !$continue;
783 12         16 my $lw;
784 12         43 my $em = $self->advancewidth('M');
785              
786 12         34 while (length($text) > 0) { # more text to go...
787             # indent == 0 (flush) all lines normal width
788             # indent (>0) first line moved in on left, subsequent normal width
789             # outdent (<0) first line is normal width, subsequent moved in on left
790 20         28 $lw = $width;
791 20 50 33     63 if ($indent > 0 && $first_line) { $lw -= $indent*$em; }
  0         0  
792 20 50 33     46 if ($indent < 0 && !$first_line) { $lw += $indent*$em; }
  0         0  
793             # now, need to indent (move line start) right for 'l' and 'j'
794 20 0 0     48 if ($lw < $width && ($align eq 'l' || $align eq 'j')) {
      33        
795 0         0 $self->cr($leading); # go UP one line
796 0         0 $self->nl(88*abs($indent)); # come down to right line and move right
797             }
798              
799 20 100       53 if ($align eq 'j') {
    100          
    100          
800 6         26 ($nwidth,$text) = $self->text_fill_justified($text, $lw, %opts);
801             } elsif ($align eq 'r') {
802 2         9 ($nwidth,$text) = $self->text_fill_right($text, $lw, %opts);
803             } elsif ($align eq 'c') {
804 2         10 ($nwidth,$text) = $self->text_fill_center($text, $lw, %opts);
805             } else { # 'l'
806 10         28 ($nwidth,$text) = $self->text_fill_left($text, $lw, %opts);
807             }
808              
809 20         75 $self->nl();
810 20         27 $first_line = 0;
811              
812             # bail out and just return remaining $text if run out of vertical space
813 20 100       57 last if ($height -= $leading) < 0;
814             }
815              
816 12 100       28 if (wantarray) {
817             # paragraph() called in the context of returning an array
818 6         18 return ($text, $height);
819             }
820 6         21 return $text;
821             }
822              
823             =over
824              
825             =item ($overflow_text, $continue, $unused_height) = $txt->section($text, $width,$height, $continue, %opts)
826              
827             =item $overflow_text = $txt->section($text, $width,$height, $continue, %opts)
828              
829             The C<$text> contains a string with one or more paragraphs C<$width> wide,
830             starting at the current text position, with a newline \n between each
831             paragraph. Each paragraph is output (see C) until the C<$height>
832             limit is met (a partial paragraph may be at the bottom). Whatever wasn't
833             output, will be B.
834             If called in an array context, the
835             unused height and the paragraph "continue" flag are also B.
836              
837             C<$continue> is 0 for the first call of section(), and then use the value
838             returned from the previous call (1 if a paragraph was cut in the middle) to
839             prevent unwanted indenting or outdenting of the first line being printed.
840              
841             For compatibility with recent changes to PDF::API2, B is accepted
842             as an I for C
.
843              
844             B
845              
846             =over
847              
848             =item 'pvgap' => $vertical
849              
850             Additional vertical space (unit: pt) between paragraphs (default 0). Note that this space
851             will also be added after the last paragraph printed.
852              
853             =back
854              
855             See C for other C<%opts> you can use, such as C and C.
856              
857             =back
858              
859             =cut
860              
861             # alias for compatibility
862             sub paragraphs {
863 1     1 0 10 return section(@_);
864             }
865              
866             sub section {
867 2     2 1 13 my ($self, $text, $width,$height, $continue, %opts) = @_;
868             # copy dashed option names to preferred undashed names
869 2 50 33     10 if (defined $opts{'-pvgap'} && !defined $opts{'pvgap'}) { $opts{'pvgap'} = delete($opts{'-pvgap'}); }
  0         0  
870              
871 2         15 my $overflow = ''; # text to return if height fills up
872 2 50       7 my $pvgap = defined($opts{'pvgap'})? $opts{'pvgap'}: 0;
873             # $continue =0 if fresh paragraph, or =1 if continuing one cut in middle
874              
875 2         10 foreach my $para (split(/\n/, $text)) {
876             # regardless of whether we've run out of space vertically, we will
877             # loop through all the paragraphs requested
878            
879             # already seen inability to output more text?
880             # just put unused text back together into the string
881             # $continue should stay 1
882 6 50       15 if (length($overflow) > 0) {
883 0         0 $overflow .= "\n" . $para;
884 0         0 next;
885             }
886 6         18 ($para, $height) = $self->paragraph($para, $width,$height, $continue, %opts);
887 6         10 $continue = 0;
888 6 100       16 if (length($para) > 0) {
889             # we cut a paragraph in half. set flag that continuation doesn't
890             # get indented/outdented
891 2         5 $overflow .= $para;
892 2         3 $continue = 1;
893             }
894              
895             # inter-paragraph vertical space?
896             # note that the last paragraph will also get the extra space after it
897 6 50 66     18 if (length($para) == 0 && $pvgap != 0) {
898 0         0 $self->cr(-$pvgap);
899 0         0 $height -= $pvgap;
900             }
901             }
902              
903 2 50       8 if (wantarray) {
904             # section() called in the context of returning an array
905 0         0 return ($overflow, $continue, $height);
906             }
907 2         8 return $overflow;
908             }
909              
910             =over
911              
912             =item $width = $txt->textlabel($x,$y, $font, $size, $text, %opts)
913              
914             Place a line of text at an arbitrary C<[$x,$y]> on the page, with various text
915             settings (treatments) specified in the call.
916              
917             =over
918              
919             =item $font
920              
921             A previously created font.
922              
923             =item $size
924              
925             The font size (points).
926              
927             =item $text
928              
929             The text to be printed (a single line).
930              
931             =back
932              
933             B
934              
935             =over
936              
937             =item 'rotate' => $deg
938              
939             Rotate C<$deg> degrees counterclockwise from due East.
940              
941             =item 'color' => $cspec
942              
943             A color name or permitted spec, such as C<#CCE840>, for the character I.
944              
945             =item 'strokecolor' => $cspec
946              
947             A color name or permitted spec, such as C<#CCE840>, for the character I.
948              
949             =item 'charspace' => $cdist
950              
951             Additional distance between characters.
952              
953             =item 'wordspace' => $wdist
954              
955             Additional distance between words.
956              
957             =item 'hscale' => $hfactor
958              
959             Horizontal scaling mode (percentage of normal, default is 100).
960              
961             =item 'render' => $mode
962              
963             Character rendering mode (outline only, fill only, etc.). See C call.
964              
965             =item 'left' => 1
966              
967             Left align on the given point. This is the default.
968              
969             =item 'center' => 1
970              
971             Center the text on the given point.
972              
973             =item 'right' => 1
974              
975             Right align on the given point.
976              
977             =item 'align' => $placement
978              
979             Alternate to left, center, and right. C<$placement> is 'left' (default),
980             'center', or 'right'.
981              
982             =back
983              
984             Other options available to C, such as underlining, can be used here.
985              
986             The width used (in points) is B.
987              
988             =back
989              
990             B that C was not designed to interoperate with other
991             text operations. It is a standalone operation, and does I leave a "next
992             write" position (or any other setting) for another C mode operation. A
993             following write will likely be at C<(0,0)>, and not at the expected location.
994              
995             C is intended as an "all in one" convenience function for single
996             lines of text, such as a label on some
997             graphics, and not as part of putting down multiple pieces of text. It I
998             possible to figure out the position of a following write (either C
999             or C) by adding the returned width to the original position's I value
1000             (assuming left-justified positioning).
1001              
1002             =cut
1003              
1004             sub textlabel {
1005 0     0 1   my ($self, $x,$y, $font, $size, $text, %opts) = @_;
1006             # copy dashed option names to preferred undashed names
1007 0 0 0       if (defined $opts{'-rotate'} && !defined $opts{'rotate'}) { $opts{'rotate'} = delete($opts{'-rotate'}); }
  0            
1008 0 0 0       if (defined $opts{'-color'} && !defined $opts{'color'}) { $opts{'color'} = delete($opts{'-color'}); }
  0            
1009 0 0 0       if (defined $opts{'-strokecolor'} && !defined $opts{'strokecolor'}) { $opts{'strokecolor'} = delete($opts{'-strokecolor'}); }
  0            
1010 0 0 0       if (defined $opts{'-charspace'} && !defined $opts{'charspace'}) { $opts{'charspace'} = delete($opts{'-charspace'}); }
  0            
1011 0 0 0       if (defined $opts{'-hscale'} && !defined $opts{'hscale'}) { $opts{'hscale'} = delete($opts{'-hscale'}); }
  0            
1012 0 0 0       if (defined $opts{'-wordspace'} && !defined $opts{'wordspace'}) { $opts{'wordspace'} = delete($opts{'-wordspace'}); }
  0            
1013 0 0 0       if (defined $opts{'-render'} && !defined $opts{'render'}) { $opts{'render'} = delete($opts{'-render'}); }
  0            
1014 0 0 0       if (defined $opts{'-right'} && !defined $opts{'right'}) { $opts{'right'} = delete($opts{'-right'}); }
  0            
1015 0 0 0       if (defined $opts{'-center'} && !defined $opts{'center'}) { $opts{'center'} = delete($opts{'-center'}); }
  0            
1016 0 0 0       if (defined $opts{'-left'} && !defined $opts{'left'}) { $opts{'left'} = delete($opts{'-left'}); }
  0            
1017 0 0 0       if (defined $opts{'-align'} && !defined $opts{'align'}) { $opts{'align'} = delete($opts{'-align'}); }
  0            
1018 0           my $wht;
1019              
1020 0           my %trans_opts = ( 'translate' => [$x,$y] );
1021 0           my %text_state = ();
1022 0 0         $trans_opts{'rotate'} = $opts{'rotate'} if defined($opts{'rotate'});
1023              
1024 0           my $wastext = $self->_in_text_object();
1025 0 0         if ($wastext) {
1026 0           %text_state = $self->textstate();
1027 0           $self->textend();
1028             }
1029 0           $self->save();
1030 0           $self->textstart();
1031              
1032 0           $self->transform(%trans_opts);
1033              
1034 0 0         $self->fillcolor(ref($opts{'color'}) ? @{$opts{'color'}} : $opts{'color'}) if defined($opts{'color'});
  0 0          
1035 0 0         $self->strokecolor(ref($opts{'strokecolor'}) ? @{$opts{'strokecolor'}} : $opts{'strokecolor'}) if defined($opts{'strokecolor'});
  0 0          
1036              
1037 0           $self->font($font, $size);
1038              
1039 0 0         $self->charspace($opts{'charspace'}) if defined($opts{'charspace'});
1040 0 0         $self->hscale($opts{'hscale'}) if defined($opts{'hscale'});
1041 0 0         $self->wordspace($opts{'wordspace'}) if defined($opts{'wordspace'});
1042 0 0         $self->render($opts{'render'}) if defined($opts{'render'});
1043              
1044 0 0 0       if (defined($opts{'right'}) && $opts{'right'} ||
    0 0        
    0 0        
      0        
      0        
      0        
      0        
      0        
      0        
1045             defined($opts{'align'}) && $opts{'align'} =~ /^r/i) {
1046 0           $wht = $self->text_right($text, %opts);
1047             } elsif (defined($opts{'center'}) && $opts{'center'} ||
1048             defined($opts{'align'}) && $opts{'align'} =~ /^c/i) {
1049 0           $wht = $self->text_center($text, %opts);
1050             } elsif (defined($opts{'left'}) && $opts{'left'} ||
1051             defined($opts{'align'}) && $opts{'align'} =~ /^l/i) {
1052 0           $wht = $self->text($text, %opts); # explicitly left aligned
1053             } else {
1054 0           $wht = $self->text($text, %opts); # left aligned by default
1055             }
1056              
1057 0           $self->textend();
1058 0           $self->restore();
1059              
1060 0 0         if ($wastext) {
1061 0           $self->textstart();
1062 0           $self->textstate(%text_state);
1063             }
1064 0           return $wht;
1065             }
1066              
1067             1;