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