Support for Caption in PerlMagick (or how to wrap text?)

[magick]

Here is one way to write captioned text:

Code: Select all

$image->Write("caption:'PerlMagick has support for a caption');

Use the Set() method to set the font and size (e.g. 100x).

[hermann2]

Echo the comments... great piece of code!

The only warning is that the call to QueryFontMetrics assumes that all the Annotate parameters have been previously set. If this is not the case, the code breaks because QueryFontMetrics does not know which font, pointsize, etc., to apply as it is calculating each character width.

This is easily fixed in one of two ways:
1. Make sure you $img->Set() the Annotate parameters immediately prior to calling this subroutine.
2. Include your Annotate parameters within each call to QueryFontMetrics.

On a slightly different note but related to this code, does anyone know how to control the vertical spacing between each line?

[anthony]

just a couple of comments...

First, yes you can word wrap using perl,
BUT It will not do it correctly unless you also use a constant width font like 'courier'. Proportional fonts could result in large spaces at the end of the lines. I never did find a nice constant width font.

Second, the line spacing is set by the point size. That is the meaning of pointsize, the amount of space between lines! Fonts however may use all or none of that spacing, How much of the line spacing it uses, and the position of the baseline in that line space, is completely up to the font designer.

I have seen some fonts that are tiny at even large pointsizes, and others that overflow the pointsize specified linespacing on purpose (generally fonts for hand written, signature like text). It is generally not directly controllable by users.

[hermann2]

First, yes you can word wrap using perl, BUT It will not do it correctly unless you also use a constant width font like 'courier'. Proportional fonts could result in large spaces at the end of the lines. I never did find a nice constant width font.

This has not been my experience. I'm using a proportional font, and Gabe's code correctly adds up the individual width of each character, and wraps at exactly the right place.

Second, the line spacing is set by the point size. That is the meaning of pointsize, the amount of space between lines! Fonts however may use all or none of that spacing, How much of the line spacing it uses, and the position of the baseline in that line space, is completely up to the font designer.

That's what I was afraid of. Luckily, I was able to find a font with adequate line spacing after I posted the above message. The alternative would have been to modify Gabe's code to issue several $image->Annotate() commands, one for each line, and control the Y positioning of each line manually.

[anthony]

First, yes you can word wrap using perl, BUT It will not do it correctly unless you also use a constant width font like 'courier'. Proportional fonts could result in large spaces at the end of the lines. I never did find a nice constant width font.

This has not been my experience. I'm using a proportional font, and Gabe's code correctly adds up the individual width of each character, and wraps at exactly the right place.

Applogies to Gabe, of course his program did the right thing.
Probably was the same code that was built into the magick core for use by caption.

Hmmm this code may be able to be used to implement Word Justified Text!

IM really needs a proper Text Justification setting, as separate to the gravity setting.


Another alturnative is that you know the point size, and thus the height of each line!

So caption the text, then crop the the image into individual rows, then crop or trim each row, as appropriate for the font, and append them all together again.

[anthony]

Code: Select all

#!/usr/bin/perl
# This function will wrap at a space or hyphen, and if a word is longer than a
# line it will just break it at the end of the first line. To figure out the
# height of the text, pass the returned string to QueryMultilineFontMetrics.
#
# pass in the string to wrap, the IM object with font and size set, and the
# width you want to wrap to; returns new string
#
# From: Gabe Schaffer,  IM Forum: f=7&t=3708       7 October 2004
#
sub Wrap
{
   my ($text, $img, $maxwidth) = @_;

   # figure out the width of every character in the string
   #
   my %widths = map(($_ => ($img->QueryFontMetrics(text=>$_))[4]),
      keys %{{map(($_ => 1), split //, $text)}});

   my (@newtext, $pos);
   for (split //, $text) {
      # check to see if we're about to go out of bounds
      if ($widths{$_} + $pos > $maxwidth) {
         $pos = 0;
         my @word;
         # if we aren't already at the end of the word,
         # loop until we hit the beginning
         if ( $newtext[-1] ne " "
              && $newtext[-1] ne "-"
              && $newtext[-1] ne "\n") {
            unshift @word, pop @newtext
               while ( @newtext && $newtext[-1] ne " "
                       && $newtext[-1] ne "-"
                       && $newtext[-1] ne "\n")
         }

         # if we hit the beginning of a line,
         # we need to split a word in the middle
         if ($newtext[-1] eq "\n" || @newtext == 0) {
            push @newtext, @word, "\n";
         } else {
            push @newtext, "\n", @word;
            $pos += $widths{$_} for (@word);
         }
      }
      push @newtext, $_;
      $pos += $widths{$_};
      $pos = 0 if $newtext[-1] eq "\n";
   }

   return join "", @newtext;
}