eliminate use vars
[imager.git] / lib / Imager / Font / Wrap.pm
1 package Imager::Font::Wrap;
2 use 5.006;
3 use strict;
4 use Imager;
5 use Imager::Font;
6
7 our $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
20 sub _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
85 sub 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
201 1;
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
229 This is a simple text wrapper with options to control the layout of
230 text within the line.
231
232 You can control the position, width and height of the text with the
233 C<image>, C<x>, C<y>, C<width> and C<height> options.
234
235 You can simply calculate space usage by setting C<image> to C<undef>,
236 or set C<savepos> to see how much text can fit within the given
237 C<height>.
238
239 =over
240
241 =item wrap_text()
242
243 Draw word-wrapped text.
244
245 =over
246
247 =item *
248
249 C<x>, C<y> - The top-left corner of the rectangle the text is
250 formatted into.  Defaults to (0, 0).
251
252 =item *
253
254 C<width> - The width of the formatted text in pixels.  Defaults to the
255 horizontal gap between the top-left corner and the right edge of the
256 image.  If no image is supplied then this is required.
257
258 =item *
259
260 C<height> - The maximum height of the formatted text in pixels.  Not
261 required.
262
263 =item *
264
265 C<savepos> - The amount of text consumed (as a count of characters)
266 will 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
286 C<image> - The image to render the text to.  Can be supplied as
287 C<undef> or not provided to simply calculate the bounding box.
288
289 =item *
290
291 C<font> - The font used to render the text.  Required.
292
293 =item *
294
295 C<size> - The size to render the font in.  Defaults to the size stored
296 in the font object.  Required if it isn't stored in the font object.
297
298 =item *
299
300 C<string> - The text to render.  This can contain non-white-space,
301 blanks (ASCII 0x20), and newlines.
302
303 Newlines must match /(?:\x0A\x0D?|\x0D\x0A?)/.  White-space other than
304 blanks and newlines are completely ignored.
305
306 =item *
307
308 C<justify>
309
310 The way text is formatted within each line.  Possible values include:
311
312 =over
313
314 =item *
315
316 C<left> - left aligned against the left edge of the text box.
317
318 =item *
319
320 C<right> - right aligned against the right edge of the text box.
321
322 =item *
323
324 C<center> - centered horizontally in the text box.
325
326 =item *
327
328 fill - all but the final line of the paragraph has spaces expanded so
329 that the line fills from the left to the right edge of the text box.
330
331 =back
332
333 =item *
334
335 C<linegap> - Gap between lines of text in pixels.  This is in addition
336 to the size from C<< $font->font_height >>.  Can be positive or
337 negative.  Default 0.
338
339 =back
340
341 Any other parameters are passed onto Imager::Font->draw().
342
343 Returns a list:
344
345   ($left, $top, $right, $bottom)
346
347 which are the bounds of the space used to layout the text.
348
349 If C<height> is set then this is the space used within that height.
350
351 You can use this to calculate the space required to format the text
352 before 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
368 Imager::Font can handle UTF-8 encoded text itself, but this module
369 doesn't support that (and probably won't).  This could probably be
370 done with regex magic.
371
372 Currently ignores the C<sizew> parameter, if you supply one it will be
373 supplied to the draw() function and the text will be too short or too
374 long for the C<width>.
375
376 Uses a simplistic text model, which is why there's no hyphenation, and
377 no tabs.
378
379 =head1 AUTHOR
380
381 Tony Cook <tony@develop-help.com>
382
383 =head1 SEE ALSO
384
385 Imager(3), Imager::Font(3)
386
387 =cut