lib/Imager/Font/Wrap.pm

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