eliminate use vars
[imager.git] / lib / Imager / Font / Wrap.pm
CommitLineData
3799c4d1 1package Imager::Font::Wrap;
ee64a81f 2use 5.006;
3799c4d1
TC
3use strict;
4use Imager;
5use Imager::Font;
f17b46d8 6
ee64a81f 7our $VERSION = "1.005";
3799c4d1
TC
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);
3799c4d1
TC
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}) {
7febff1d
TC
190 $linepos += length $line
191 if _format_line(\%state, 0, $line, 0);
3799c4d1
TC
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
d5556805
TC
239=over
240
5715f7c3 241=item wrap_text()
d5556805
TC
242
243Draw word-wrapped text.
3799c4d1
TC
244
245=over
246
5715f7c3 247=item *
3799c4d1 248
5715f7c3
TC
249C<x>, C<y> - The top-left corner of the rectangle the text is
250formatted into. Defaults to (0, 0).
3799c4d1 251
5715f7c3 252=item *
3799c4d1 253
5715f7c3
TC
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.
3799c4d1 257
5715f7c3 258=item *
3799c4d1 259
5715f7c3
TC
260C<height> - The maximum height of the formatted text in pixels. Not
261required.
3799c4d1 262
5715f7c3 263=item *
3799c4d1 264
5715f7c3
TC
265C<savepos> - The amount of text consumed (as a count of characters)
266will be stored into the scalar this refers to.
3799c4d1
TC
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
5715f7c3 284=item *
3799c4d1 285
5715f7c3 286C<image> - The image to render the text to. Can be supplied as
d6f4e964 287C<undef> or not provided to simply calculate the bounding box.
3799c4d1 288
5715f7c3 289=item *
3799c4d1 290
5715f7c3 291C<font> - The font used to render the text. Required.
3799c4d1 292
5715f7c3 293=item *
3799c4d1 294
5715f7c3
TC
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.
3799c4d1 297
5715f7c3 298=item *
3799c4d1 299
5715f7c3
TC
300C<string> - The text to render. This can contain non-white-space,
301blanks (ASCII 0x20), and newlines.
3799c4d1 302
5715f7c3 303Newlines must match /(?:\x0A\x0D?|\x0D\x0A?)/. White-space other than
3799c4d1
TC
304blanks and newlines are completely ignored.
305
5715f7c3
TC
306=item *
307
308C<justify>
3799c4d1
TC
309
310The way text is formatted within each line. Possible values include:
311
312=over
313
5715f7c3 314=item *
3799c4d1 315
5715f7c3 316C<left> - left aligned against the left edge of the text box.
3799c4d1 317
5715f7c3 318=item *
3799c4d1 319
5715f7c3 320C<right> - right aligned against the right edge of the text box.
3799c4d1 321
5715f7c3 322=item *
3799c4d1 323
5715f7c3 324C<center> - centered horizontally in the text box.
3799c4d1 325
5715f7c3 326=item *
3799c4d1 327
5715f7c3
TC
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.
3799c4d1
TC
330
331=back
332
5715f7c3 333=item *
3799c4d1 334
5715f7c3
TC
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.
3799c4d1
TC
338
339=back
340
341Any other parameters are passed onto Imager::Font->draw().
342
3799c4d1
TC
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
d5556805
TC
364=back
365
3799c4d1
TC
366=head1 BUGS
367
5715f7c3 368Imager::Font can handle UTF-8 encoded text itself, but this module
3799c4d1
TC
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