samples/slant_text.pl

   1 #!perl -w
   2 use strict;
   3 use Imager;
   4 use Imager::Matrix2d;
   5 use Getopt::Long;
   6 use constant PI => 4 * atan2(1,1);
   7
   8 # this sample requires Freetype 2.x
   9 $Imager::formats{"ft2"}
  10   or die "This sample require Freetype 2.x to be configured in Imager\n";
  11
  12 Getopt::Long::Configure("bundling");
  13
  14 my $angle = 30;
  15 my $fg = 'white';
  16 my $bg = 'black';
  17 my $size = 20;
  18 my $rotate;
  19 GetOptions('angle|a=f' => \$angle,
  20            'size|s=i' => \$size,
  21            'foreground|fg|f=s' => \$fg,
  22            'background|bg|b=s' => \$bg,
  23            'rotate|r' => \$rotate)
  24   or usage();
  25
  26 # check for sanity
  27 if ($angle < -45 or $angle > 45) {
  28   # while values outside this range are valid, the text would be hard
  29   # to read
  30   die "--angle is limited to the range -45 through +45\n";
  31 }
  32 elsif ($size < 10) {
  33   die "--size must be 10 or greater\n";
  34 }
  35
  36 my $fontfile = shift;
  37 my $outfile = shift;
  38 @ARGV
  39   or usage();
  40 my $text = "@ARGV";
  41
  42 my $angle_rads = $angle * (PI / 180);
  43 my $trans;
  44
  45 # this is the only difference between rotation and shearing: the
  46 # transformation matrix
  47 if ($rotate) {
  48   $trans = Imager::Matrix2d->rotate(radians => $angle_rads);
  49 }
  50 else {
  51   $trans = Imager::Matrix2d->shear(x=>sin($angle_rads)/cos($angle_rads));
  52 }
  53
  54 # only the Freetype 2.x driver supports transformations for now
  55 my $font = Imager::Font->new(file=>$fontfile, type=>'ft2')
  56   or die "Cannot load font $fontfile: ", Imager->errstr, "\n";
  57
  58 $font->transform(matrix=>$trans);
  59
  60 my $bbox = $font->bounding_box(string=>$text, size=>$size);
  61
  62 # these are in font co-ordinates, so y is flipped
  63 my ($left, $miny, $right, $maxy) =
  64   transformed_bounds($bbox, $trans);
  65
  66 # convert to image relative co-ordinates
  67 my ($top, $bottom) = (-$maxy, -$miny);
  68
  69 my ($width, $height) = ($right - $left, $bottom - $top);
  70
  71 my $img = Imager->new(xsize=>$width, ysize=>$height);
  72
  73 # fill with the background
  74 $img->box(filled=>1, color=>$bg);
  75
  76 # and draw our string in the right place
  77 $img->string(text => $text,
  78              color => Imager::Color->new('white'),
  79              x => -$left,
  80              y => -$top,
  81              color => $fg,
  82              font => $font,
  83              size => $size);
  84
  85 $img->write(file=>$outfile)
  86   or die "Cannot save $outfile: ",$img->errstr,"\n";
  87
  88 sub transformed_bounds {
  89   my ($bbox, $matrix) = @_;
  90
  91   my $bounds;
  92   for my $point ([ $bbox->start_offset, $bbox->ascent  ],
  93                  [ $bbox->start_offset, $bbox->descent ],
  94                  [ $bbox->end_offset,   $bbox->ascent  ],
  95                  [ $bbox->end_offset,   $bbox->descent ]) {
  96     $bounds = add_bound($bounds, transform_point(@$point, $matrix));
  97   }
  98
  99   @$bounds;
 100 }
 101
 102 sub transform_point {
 103   my ($x, $y, $matrix) = @_;
 104
 105   return
 106     (
 107      $x * $matrix->[0] + $y * $matrix->[1] + $matrix->[2],
 108      $x * $matrix->[3] + $y * $matrix->[4] + $matrix->[5]
 109     );
 110 }
 111
 112 sub add_bound {
 113   my ($bounds, $x, $y) = @_;
 114
 115   $bounds or return [ $x, $y, $x, $y ];
 116
 117   $x < $bounds->[0] and $bounds->[0] = $x;
 118   $y < $bounds->[1] and $bounds->[1] = $y;
 119   $x > $bounds->[2] and $bounds->[2] = $x;
 120   $y > $bounds->[3] and $bounds->[3] = $y;
 121
 122   $bounds;
 123 }
 124
 125 sub usage {
 126   print <<EOS;
 127 Usage: $0 [options] fontfile outfile text...
 128 Options:
 129   --angle <angle> | -a <angle>
 130     Set the slant angle in degrees, limited to -45 to +45.  Default 30.
 131   --size <pixels> | -s <angle>
 132     Set the text size in pixels.  Must be 10 or greater. Default: 20.
 133   --foreground <color> | --fg <color> | -f <color>
 134     Set the text foreground color.  Default: white.
 135   --background <color> | --bg <color> | -b <color>
 136     Set the image background color.  Default: black
 137   --rotate | -r
 138     Rotate instead of shearing.  Default: shear
 139
 140 eg.
 141   # shear
 142   $0 -a 45 fontfiles/ImUgly.ttf output.ppm "something to say"
 143   # rotate at 100 pixel font size, blue foregroune, white background
 144   $0 -rs 100 -b white -f blue fontfiles/ImUgly.ttf output.ppm Imager
 145 EOS
 146   exit 1;
 147 }
 148
 149 =head1 NAME
 150
 151 slant_text.pl - sample for drawing transformed text
 152
 153 =head1 SYNOPSIS
 154
 155   perl slant_text.pl [options] fontfile output text
 156
 157   Run without arguments for option details.
 158
 159 =head1 DESCRIPTION
 160
 161 This is a sample for drawing transformed text.
 162
 163 It's complicated by the need to create an image to put the text into,
 164 if you have text, a font, and a good idea where it belongs, it's
 165 simple to create the transformation matrix:
 166
 167   use Imager::Matrix2d;
 168   # or call another method for shearing, etc
 169   my $matrix = Imager::Matrix2d->rotate(radians=>$some_angle);
 170
 171 Feed the transformation matrix to the font:
 172
 173   $font->transform(matrix=>$font);
 174
 175 then draw the text as normal:
 176
 177   $image->string(string=>$some_text,
 178                  x => $where_x,
 179                  y => $where_y,
 180                  font => $font,
 181                  size => $size);
 182
 183 But if you do need the bounds, the code above does show you how to do
 184 it.
 185
 186 =head1 FUNCTIONS
 187
 188 =over
 189
 190 =item transformed_bounds
 191
 192 Returns a list of bounds:
 193   (minx, miny, maxx, maxy)
 194
 195 These are offsets from the text's starting point in font co-ordinates
 196 - so positive y is I<up>.
 197
 198 Note: this returns the bounds of the transformed bounding box, in most
 199 cases the actual text will not be touching these boundaries.
 200
 201 =cut
 202
 203 =back
 204
 205 =head1 AUTHOR
 206
 207 Tony Cook <tony@imager.perl.org>
 208
 209 =head1 REVISION
 210
 211 $Revision$
 212
 213 =head1 SEE ALSO
 214
 215 Imager(1), Imager::Cookbook, Imager::Matrix2d
 216
 217 =cut