1package Imager::Font::Wrap;
2use 5.006;
3use strict;
4use Imager;
5use Imager::Font;
6
7our $VERSION = "1.005";
8
9*_first = \&Imager::Font::_first;
10
11# we can't accept the utf8 parameter, too hard at this level
12
13# the %state contains:
14#  font - the font
15#  im - the image
16#  x - the left position
17#  w - the width
18#  justify - fill, left, right or center
19
20sub _format_line {
21  my ($state, $spaces, $text, $fill) = @_;
22
23  $text =~ s/ +$//;
24  my $box = $state->{font}->bounding_box(string=>$text,
25                                         size=>$state->{size});
26
27  my $y = $state->{linepos} + $box->global_ascent;
28
29  if ($state->{bottom}
30      && $state->{linepos} + $box->font_height > $state->{bottom}) {
31    $state->{full} = 1;
32    return 0;
33  }
34
35  if ($text =~ /\S/ && $state->{im}) {
36    my $justify = $fill ? $state->{justify} :
37      $state->{justify} eq 'fill' ? 'left' : $state->{justify};
38    if ($justify ne 'fill') {
39      my $x = $state->{x};
40      if ($justify eq 'right') {
41        $x += $state->{w} - $box->advance_width;
42      }
43      elsif ($justify eq 'center') {
44        $x += ($state->{w} - $box->advance_width) / 2;
45      }
46      $state->{font}->draw(image=>$state->{im}, string=>$text,
47                           x=>$x, 'y'=>$y,
48                           size=>$state->{size}, %{$state->{input}});
49    }
50    else {
51      (my $nospaces = $text) =~ tr/ //d;
52      my $nospace_bbox = $state->{font}->bounding_box(string=>$nospaces,
53                                                      size=>$state->{size});
54      my $gap = $state->{w} - $nospace_bbox->advance_width;
55      my $x = $state->{x};
56      $spaces = $text =~ tr/ / /;
57      while (length $text) {
58        if ($text =~ s/^(\S+)//) {
59          my $word = $1;
60          my $bbox = $state->{font}->bounding_box(string=>$word,
61                                                  size=>$state->{size});
62          $state->{font}->draw(image=>$state->{im}, string=>$1,
63                               x=>$x, 'y'=>$y,
64                               size=>$state->{size}, %{$state->{input}});
65          $x += $bbox->advance_width;
66        }
67        elsif ($text =~ s/^( +)//) {
68          my $sep = $1;
69          my $advance = int($gap * length($sep) / $spaces);
70          $spaces -= length $sep;
71          $gap -= $advance;
72          $x += $advance;
73        }
74        else {
75          die "This shouldn't happen\n";
76        }
77      }
78    }
79  }
80  $state->{linepos} += $box->font_height + $state->{linegap};
81
82  1;
83}
84
85sub wrap_text {
86  my $class = shift;
87  my %input = @_;
88
89  # try to get something useful
90  my $x = _first(delete $input{'x'}, 0);
91  my $y = _first(delete $input{'y'}, 0);
92  my $im = delete $input{image};
93  my $imerr = $im || 'Imager';
94  my $width = delete $input{width};
95  if (!defined $width) {
96    defined $im && $im->getwidth > $x
97      or return $imerr->_set_error("No width supplied and can't guess");
98    $width = $im->getwidth - $x;
99  }
100  my $font = delete $input{font}
101    or return $imerr->_set_error("No font parameter supplied");
102  my $size = _first(delete $input{size}, $font->{size});
103  defined $size
104    or return $imerr->_set_error("No font size supplied");
105
106  2 * $size < $width
107    or return $imerr->_set_error("Width too small for font size");
108
109  my $text = delete $input{string};
110  defined $text
111    or return $imerr->_set_error("No string parameter supplied");
112
113  my $justify = _first($input{justify}, "left");
114
115  my %state =
116    (
117     font => $font,
118     im => $im,
119     x => $x,
120     w => $width,
121     justify => $justify,
122     'y' => $y,
123     linepos=>$y,
124     size=>$size,
125     input => \%input,
126     linegap => delete $input{linegap} || 0,
127    );
128  $state{height} = delete $input{height};
129  if ($state{height}) {
130    $state{bottom} = $y + $state{height};
131  }
132  my $line = '';
133  my $spaces = 0;
134  my $charpos = 0;
135  my $linepos = 0;
136  pos($text) = 0; # avoid a warning
137  while (pos($text) < length($text)) {
138    #print pos($text), "\n";
139    if ($text =~ /\G( +)/gc) {
140      #print "spaces\n";
141      $line .= $1;
142      $spaces += length($1);
143    }
144    elsif ($text =~ /\G(?:\x0D\x0A?|\x0A\x0D?)/gc) {
145      #print "newline\n";
146      _format_line(\%state, $spaces, $line, 0)
147        or last;
148      $line = '';
149      $spaces = 0;
150      $linepos = pos($text);
151    }
152    elsif ($text =~ /\G(\S+)/gc) {
153      #print "word\n";
154      my $word = $1;
155      my $bbox = $font->bounding_box(string=>$line . $word, size=>$size);
156      if ($bbox->advance_width > $width) {
157        _format_line(\%state, $spaces, $line, 1)
158          or last;
159        $line = '';
160        $spaces = 0;
161        $linepos = pos($text) - length($word);
162      }
163      $line .= $word;
164      # check for long words
165      $bbox = $font->bounding_box(string=>$line, size=>$size);
166      while ($bbox->advance_width > $width) {
167        my $len = length($line) - 1;
168        $bbox = $font->bounding_box(string=>substr($line, 0, $len),
169                                    size=>$size);
170        while ($bbox->advance_width > $width) {
171          --$len;
172          $bbox = $font->bounding_box(string=>substr($line, 0, $len),
173                                      size=>$size);
174        }
175        _format_line(\%state, 0, substr($line, 0, $len), 0)
176          or last;
177        $line = substr($line, $len);
178        $bbox = $font->bounding_box(string=>$line, size=>$size);
179        $linepos = pos($text) - length($line);
180      }
181    }
182    elsif ($text =~ /\G\s/gc) {
183      # skip a single unrecognized whitespace char
184      #print "skip\n";
185      $linepos = pos($text);
186    }
187  }
188
189  if (length $line && !$state{full}) {
190    $linepos += length $line
191      if _format_line(\%state, 0, $line, 0);
192  }
193
194  if ($input{savepos}) {
195    ${$input{savepos}} = $linepos;
196  }
197
198  return ($x, $y, $x+$width, $state{linepos});
199}
200
2011;
202
203__END__
204
205=head1 NAME
206
207  Imager::Font::Wrap - simple wrapped text output
208
209=head1 SYNOPSIS
210
211  use Imager::Font::Wrap;
212
213  my $img = Imager->new(xsize=>$xsize, ysize=>$ysize);
214
215  my $font = Imager::Font->new(file=>$fontfile);
216
217  my $string = "..."; # text with or without newlines
218
219  Imager::Font::Wrap->wrap_text( image  => $img,
220                                 font   => $font,
221                                 string => $string,
222                                 x      => $left,
223                                 y      => $top,
224                                 width  => $width,
225                                 .... );
226
227=head1 DESCRIPTION
228
229This is a simple text wrapper with options to control the layout of
230text within the line.
231
232You can control the position, width and height of the text with the
233C<image>, C<x>, C<y>, C<width> and C<height> options.
234
235You can simply calculate space usage by setting C<image> to C<undef>,
236or set C<savepos> to see how much text can fit within the given
237C<height>.
238
239=over
240
241=item wrap_text()
242
243Draw word-wrapped text.
244
245=over
246
247=item *
248
249C<x>, C<y> - The top-left corner of the rectangle the text is
250formatted into.  Defaults to (0, 0).
251
252=item *
253
254C<width> - The width of the formatted text in pixels.  Defaults to the
255horizontal gap between the top-left corner and the right edge of the
256image.  If no image is supplied then this is required.
257
258=item *
259
260C<height> - The maximum height of the formatted text in pixels.  Not
261required.
262
263=item *
264
265C<savepos> - The amount of text consumed (as a count of characters)
266will be stored into the scalar this refers to.
267
268  my $pagenum = 1;
269  my $string = "...";
270  my $font = ...;
271  my $savepos;
272
273  while (length $string) {
274    my $img = Imager->new(xsize=>$xsize, ysize=>$ysize);
275    Imager::Font::Wrap->wrap_text(string=>$string, font=>$font,
276                                  image=>$img, savepos => \$savepos)
277      or die $img->errstr;
278    $savepos > 0
279      or die "Could not fit any text on page\n";
280    $string = substr($string, $savepos);
281    $img->write(file=>"page$pagenum.ppm");
282  }
283
284=item *
285
286C<image> - The image to render the text to.  Can be supplied as
287C<undef> or not provided to simply calculate the bounding box.
288
289=item *
290
291C<font> - The font used to render the text.  Required.
292
293=item *
294
295C<size> - The size to render the font in.  Defaults to the size stored
296in the font object.  Required if it isn't stored in the font object.
297
298=item *
299
300C<string> - The text to render.  This can contain non-white-space,
301blanks (ASCII 0x20), and newlines.
302
303Newlines must match /(?:\x0A\x0D?|\x0D\x0A?)/.  White-space other than
304blanks and newlines are completely ignored.
305
306=item *
307
308C<justify>
309
310The way text is formatted within each line.  Possible values include:
311
312=over
313
314=item *
315
316C<left> - left aligned against the left edge of the text box.
317
318=item *
319
320C<right> - right aligned against the right edge of the text box.
321
322=item *
323
324C<center> - centered horizontally in the text box.
325
326=item *
327
328fill - all but the final line of the paragraph has spaces expanded so
329that the line fills from the left to the right edge of the text box.
330
331=back
332
333=item *
334
335C<linegap> - Gap between lines of text in pixels.  This is in addition
336to the size from C<< $font->font_height >>.  Can be positive or
337negative.  Default 0.
338
339=back
340
341Any other parameters are passed onto Imager::Font->draw().
342
343Returns a list:
344
345  ($left, $top, $right, $bottom)
346
347which are the bounds of the space used to layout the text.
348
349If C<height> is set then this is the space used within that height.
350
351You can use this to calculate the space required to format the text
352before doing it:
353
354  my ($left, $top, $right, $bottom) =
355    Imager::Font::Wrap->wrap_text(string => $string,
356                                  font   => $font,
357                                  width  => $xsize);
358  my $img = Imager->new(xsize=>$xsize, ysize=>$bottom);
359  Imager::Font::Wrap->wrap_text(string => $string,
360                                font   => $font,
361                                width  => $xsize,
362                                image  => $image);
363
364=back
365
366=head1 BUGS
367
368Imager::Font can handle UTF-8 encoded text itself, but this module
369doesn't support that (and probably won't).  This could probably be
370done with regex magic.
371
372Currently ignores the C<sizew> parameter, if you supply one it will be
373supplied to the draw() function and the text will be too short or too
374long for the C<width>.
375
376Uses a simplistic text model, which is why there's no hyphenation, and
377no tabs.
378
379=head1 AUTHOR
380
381Tony Cook <tony@develop-help.com>
382
383=head1 SEE ALSO
384
385Imager(3), Imager::Font(3)
386
387=cut
388