File Coverage

blib/lib/PDF/Builder/Content/Text.pm
Criterion Covered Total %
statement 176 282 62.4
branch 67 156 42.9
condition 24 102 23.5
subroutine 16 19 84.2
pod 13 14 92.8
total 296 573 51.6


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