File Coverage

blib/lib/Imager/Font/Wrap.pm

Criterion	Covered	Total	%
statement	11	107	10.2
branch	0	54	0.0
condition	0	16	0.0
subroutine	4	6	66.6
pod	1	1	100.0
total	16	184	8.7

package Imager::Font::Wrap;
use 5.006;
use strict;
use Imager;
use Imager::Font;

our $VERSION = "1.005";

*_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);
  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__