diff options
Diffstat (limited to 'Master/tlpkg/tlperl/lib/Imager/Font/Wrap.pm')
| -rwxr-xr-x | Master/tlpkg/tlperl/lib/Imager/Font/Wrap.pm | 387 |
1 files changed, 387 insertions, 0 deletions
diff --git a/Master/tlpkg/tlperl/lib/Imager/Font/Wrap.pm b/Master/tlpkg/tlperl/lib/Imager/Font/Wrap.pm new file mode 100755 index 00000000000..5e061d76eab --- /dev/null +++ b/Master/tlpkg/tlperl/lib/Imager/Font/Wrap.pm @@ -0,0 +1,387 @@ +package Imager::Font::Wrap; +use strict; +use Imager; +use Imager::Font; +use vars qw($VERSION); + +$VERSION = "1.002"; + +*_first = \&Imager::Font::_first; + +# we can't accept the utf8 parameter, too hard at this level + +# the %state contains: +# font - the font +# im - the image +# x - the left position +# w - the width +# justify - fill, left, right or center + +sub _format_line { + my ($state, $spaces, $text, $fill) = @_; + + $text =~ s/ +$//; + my $box = $state->{font}->bounding_box(string=>$text, + size=>$state->{size}); + + my $y = $state->{linepos} + $box->global_ascent; + + if ($state->{bottom} + && $state->{linepos} + $box->font_height > $state->{bottom}) { + $state->{full} = 1; + return 0; + } + + if ($text =~ /\S/ && $state->{im}) { + my $justify = $fill ? $state->{justify} : + $state->{justify} eq 'fill' ? 'left' : $state->{justify}; + if ($justify ne 'fill') { + my $x = $state->{x}; + if ($justify eq 'right') { + $x += $state->{w} - $box->advance_width; + } + elsif ($justify eq 'center') { + $x += ($state->{w} - $box->advance_width) / 2; + } + $state->{font}->draw(image=>$state->{im}, string=>$text, + x=>$x, 'y'=>$y, + size=>$state->{size}, %{$state->{input}}); + } + else { + (my $nospaces = $text) =~ tr/ //d; + my $nospace_bbox = $state->{font}->bounding_box(string=>$nospaces, + size=>$state->{size}); + my $gap = $state->{w} - $nospace_bbox->advance_width; + my $x = $state->{x}; + $spaces = $text =~ tr/ / /; + while (length $text) { + if ($text =~ s/^(\S+)//) { + my $word = $1; + my $bbox = $state->{font}->bounding_box(string=>$word, + size=>$state->{size}); + $state->{font}->draw(image=>$state->{im}, string=>$1, + x=>$x, 'y'=>$y, + size=>$state->{size}, %{$state->{input}}); + $x += $bbox->advance_width; + } + elsif ($text =~ s/^( +)//) { + my $sep = $1; + my $advance = int($gap * length($sep) / $spaces); + $spaces -= length $sep; + $gap -= $advance; + $x += $advance; + } + else { + die "This shouldn't happen\n"; + } + } + } + } + $state->{linepos} += $box->font_height + $state->{linegap}; + + 1; +} + +sub wrap_text { + my $class = shift; + my %input = @_; + + # try to get something useful + my $x = _first(delete $input{'x'}, 0); + my $y = _first(delete $input{'y'}, 0); + exists $input{image} + or return Imager->_set_error('No image parameter supplied'); + my $im = delete $input{image}; + my $imerr = $im || 'Imager'; + my $width = delete $input{width}; + if (!defined $width) { + defined $im && $im->getwidth > $x + or return $imerr->_set_error("No width supplied and can't guess"); + $width = $im->getwidth - $x; + } + my $font = delete $input{font} + or return $imerr->_set_error("No font parameter supplied"); + my $size = _first(delete $input{size}, $font->{size}); + defined $size + or return $imerr->_set_error("No font size supplied"); + + 2 * $size < $width + or return $imerr->_set_error("Width too small for font size"); + + my $text = delete $input{string}; + defined $text + or return $imerr->_set_error("No string parameter supplied"); + + my $justify = _first($input{justify}, "left"); + + my %state = + ( + font => $font, + im => $im, + x => $x, + w => $width, + justify => $justify, + 'y' => $y, + linepos=>$y, + size=>$size, + input => \%input, + linegap => delete $input{linegap} || 0, + ); + $state{height} = delete $input{height}; + if ($state{height}) { + $state{bottom} = $y + $state{height}; + } + my $line = ''; + my $spaces = 0; + my $charpos = 0; + my $linepos = 0; + pos($text) = 0; # avoid a warning + while (pos($text) < length($text)) { + #print pos($text), "\n"; + if ($text =~ /\G( +)/gc) { + #print "spaces\n"; + $line .= $1; + $spaces += length($1); + } + elsif ($text =~ /\G(?:\x0D\x0A?|\x0A\x0D?)/gc) { + #print "newline\n"; + _format_line(\%state, $spaces, $line, 0) + or last; + $line = ''; + $spaces = 0; + $linepos = pos($text); + } + elsif ($text =~ /\G(\S+)/gc) { + #print "word\n"; + my $word = $1; + my $bbox = $font->bounding_box(string=>$line . $word, size=>$size); + if ($bbox->advance_width > $width) { + _format_line(\%state, $spaces, $line, 1) + or last; + $line = ''; + $spaces = 0; + $linepos = pos($text) - length($word); + } + $line .= $word; + # check for long words + $bbox = $font->bounding_box(string=>$line, size=>$size); + while ($bbox->advance_width > $width) { + my $len = length($line) - 1; + $bbox = $font->bounding_box(string=>substr($line, 0, $len), + size=>$size); + while ($bbox->advance_width > $width) { + --$len; + $bbox = $font->bounding_box(string=>substr($line, 0, $len), + size=>$size); + } + _format_line(\%state, 0, substr($line, 0, $len), 0) + or last; + $line = substr($line, $len); + $bbox = $font->bounding_box(string=>$line, size=>$size); + $linepos = pos($text) - length($line); + } + } + elsif ($text =~ /\G\s/gc) { + # skip a single unrecognized whitespace char + #print "skip\n"; + $linepos = pos($text); + } + } + + if (length $line && !$state{full}) { + $linepos += length $line + if _format_line(\%state, 0, $line, 0); + } + + if ($input{savepos}) { + ${$input{savepos}} = $linepos; + } + + return ($x, $y, $x+$width, $state{linepos}); +} + +1; + +__END__ + +=head1 NAME + + Imager::Font::Wrap - simple wrapped text output + +=head1 SYNOPSIS + + use Imager::Font::Wrap; + + my $img = Imager->new(xsize=>$xsize, ysize=>$ysize); + + my $font = Imager::Font->new(file=>$fontfile); + + my $string = "..."; # text with or without newlines + + Imager::Font::Wrap->wrap_text( image => $img, + font => $font, + string => $string, + x => $left, + y => $top, + width => $width, + .... ); + +=head1 DESCRIPTION + +This is a simple text wrapper with options to control the layout of +text within the line. + +You can control the position, width and height of the text with the +C<image>, C<x>, C<y>, C<width> and C<height> options. + +You can simply calculate space usage by setting C<image> to C<undef>, +or set C<savepos> to see how much text can fit within the given +C<height>. + +=over + +=item wrap_text + +Draw word-wrapped text. + +=over + +=item x + +=item y + +The top-left corner of the rectangle the text is formatted into. +Defaults to (0, 0). + +=item width + +The width of the formatted text in pixels. Defaults to the horizontal +gap between the top-left corner and the right edge of the image. If +no image is supplied then this is required. + +=item height + +The maximum height of the formated text in pixels. Not required. + +=item savepos + +The amount of text consumed (as a count of characters) will be stored +into the scalar this refers to. + + my $pagenum = 1; + my $string = "..."; + my $font = ...; + my $savepos; + + while (length $string) { + my $img = Imager->new(xsize=>$xsize, ysize=>$ysize); + Imager::Font::Wrap->wrap_text(string=>$string, font=>$font, + image=>$img, savepos => \$savepos) + or die $img->errstr; + $savepos > 0 + or die "Could not fit any text on page\n"; + $string = substr($string, $savepos); + $img->write(file=>"page$pagenum.ppm"); + } + +=item image + +The image to render the text to. Can be supplied as C<undef> to +simply calculate the bounding box. + +=item font + +The font used to render the text. Required. + +=item size + +The size to render the font in. Defaults to the size stored in the +font object. Required if it isn't stored in the font object. + +=item string + +The text to render. This can contain non-whitespace, blanks (ASCII +0x20), and newlines. + +Newlines must match /(?:\x0A\x0D?|\x0D\x0A?)/. Whitespace other than +blanks and newlines are completely ignored. + +=item justify + +The way text is formatted within each line. Possible values include: + +=over + +=item left + +Left aligned against the left edge of the text box. + +=item right + +Right aligned against the right edge of the text box. + +=item center + +Centered horizontally in the text box. + +=item fill + +All but the final line of the paragraph has spaces expanded so that +the line fills from the left to the right edge of the text box. + +=back + +=item linegap + +Gap between lines of text in pixels. This is in addition to the size +from $font->font_height. Can be positive or negative. Default 0. + +=back + +Any other parameters are passed onto Imager::Font->draw(). + +Returns a list: + + ($left, $top, $right, $bottom) + +which are the bounds of the space used to layout the text. + +If C<height> is set then this is the space used within that height. + +You can use this to calculate the space required to format the text +before doing it: + + my ($left, $top, $right, $bottom) = + Imager::Font::Wrap->wrap_text(string => $string, + font => $font, + width => $xsize); + my $img = Imager->new(xsize=>$xsize, ysize=>$bottom); + Imager::Font::Wrap->wrap_text(string => $string, + font => $font, + width => $xsize, + image => $image); + +=back + +=head1 BUGS + +Imager::Font can handle UTF8 encoded text itself, but this module +doesn't support that (and probably won't). This could probably be +done with regex magic. + +Currently ignores the C<sizew> parameter, if you supply one it will be +supplied to the draw() function and the text will be too short or too +long for the C<width>. + +Uses a simplistic text model, which is why there's no hyphenation, and +no tabs. + +=head1 AUTHOR + +Tony Cook <tony@develop-help.com> + +=head1 SEE ALSO + +Imager(3), Imager::Font(3) + +=cut |