lib/Imager/Font/Type1.pm

   1 package Imager::Font::Type1;
   2 use strict;
   3 use Imager::Color;
   4 use vars qw(@ISA);
   5 @ISA = qw(Imager::Font);
   6
   7 *_first = \&Imager::Font::_first;
   8
   9 my $t1aa;
  10
  11 # $T1AA is in there because for some reason (probably cache related) antialiasing
  12 # is a system wide setting in t1 lib.
  13
  14 sub t1_set_aa_level {
  15   if (!defined $t1aa or $_[0] != $t1aa) {
  16     Imager::i_t1_set_aa($_[0]);
  17     $t1aa=$_[0];
  18   }
  19 }
  20
  21 sub new {
  22   my $class = shift;
  23   my %hsh=(color=>Imager::Color->new(255,0,0,0),
  24            size=>15,
  25            @_);
  26
  27   unless ($hsh{file}) {
  28     $Imager::ERRSTR = "No font file specified";
  29     return;
  30   }
  31   unless (-e $hsh{file}) {
  32     $Imager::ERRSTR = "Font file $hsh{file} not found";
  33     return;
  34   }
  35   unless ($Imager::formats{t1}) {
  36     $Imager::ERRSTR = "Type 1 fonts not supported in this build";
  37     return;
  38   }
  39   unless ($hsh{file} =~ m!^/! || $hsh{file} =~ m!^\./!) {
  40     $hsh{file} = './' . $hsh{file};
  41   }
  42
  43   if($hsh{afm}) {
  44           unless (-e $hsh{afm}) {
  45             $Imager::ERRSTR = "Afm file $hsh{afm} not found";
  46             return;
  47           }
  48           unless ($hsh{afm} =~ m!^/! || $hsh{afm} =~ m!^\./!) {
  49             $hsh{file} = './' . $hsh{file};
  50           }
  51   } else {
  52           $hsh{afm} = 0;
  53   }
  54
  55   my $id = Imager::i_t1_new($hsh{file},$hsh{afm});
  56   unless ($id >= 0) { # the low-level code may miss some error handling
  57     $Imager::ERRSTR = "Could not load font ($id)";
  58     return;
  59   }
  60   return bless {
  61                 id    => $id,
  62                 aa    => $hsh{aa} || 0,
  63                 file  => $hsh{file},
  64                 type  => 't1',
  65                 size  => $hsh{size},
  66                 color => $hsh{color},
  67                }, $class;
  68 }
  69
  70 sub _draw {
  71   my $self = shift;
  72   my %input = @_;
  73   t1_set_aa_level($input{aa});
  74   my $flags = '';
  75   $flags .= 'u' if $input{underline};
  76   $flags .= 's' if $input{strikethrough};
  77   $flags .= 'o' if $input{overline};
  78   if (exists $input{channel}) {
  79     Imager::i_t1_cp($input{image}{IMG}, $input{'x'}, $input{'y'},
  80                     $input{channel}, $self->{id}, $input{size},
  81                     $input{string}, length($input{string}), $input{align},
  82                     $input{utf8}, $flags);
  83   } else {
  84     Imager::i_t1_text($input{image}{IMG}, $input{'x'}, $input{'y'},
  85                       $input{color}, $self->{id}, $input{size},
  86                       $input{string}, length($input{string}),
  87                       $input{align}, $input{utf8}, $flags);
  88   }
  89
  90   return $self;
  91 }
  92
  93 sub _bounding_box {
  94   my $self = shift;
  95   my %input = @_;
  96   my $flags = '';
  97   $flags .= 'u' if $input{underline};
  98   $flags .= 's' if $input{strikethrough};
  99   $flags .= 'o' if $input{overline};
 100   return Imager::i_t1_bbox($self->{id}, $input{size}, $input{string},
 101                            length($input{string}), $input{utf8}, $flags);
 102 }
 103
 104 # check if the font has the characters in the given string
 105 sub has_chars {
 106   my ($self, %hsh) = @_;
 107
 108   unless (defined $hsh{string} && length $hsh{string}) {
 109     $Imager::ERRSTR = "No string supplied to \$font->has_chars()";
 110     return;
 111   }
 112   return Imager::i_t1_has_chars($self->{id}, $hsh{string}, $hsh{'utf8'} || 0);
 113 }
 114
 115 sub utf8 {
 116   1;
 117 }
 118
 119 sub face_name {
 120   my ($self) = @_;
 121
 122   Imager::i_t1_face_name($self->{id});
 123 }
 124
 125 sub glyph_names {
 126   my ($self, %input) = @_;
 127
 128   my $string = $input{string};
 129   defined $string
 130     or return Imager->_seterror("no string parameter passed to glyph_names");
 131   my $utf8 = _first($input{utf8} || 0);
 132
 133   Imager::i_t1_glyph_name($self->{id}, $string, $utf8);
 134 }
 135
 136
 137 1;
 138
 139 __END__
 140
 141 =head1 NAME
 142
 143   Imager::Font::Type1 - low-level functions for Type1 fonts
 144
 145 =head1 DESCRIPTION
 146
 147 Imager::Font creates a Imager::Font::Type1 object when asked to create
 148 a font object based on a .pfb file.
 149
 150 See Imager::Font to see how to use this type.
 151
 152 This class provides low-level functions that require the caller to
 153 perform data validation
 154
 155 By default Imager no longer creates the F<t1lib.log> log file.  You
 156 can re-enable that by calling Imager::init() with the C<t1log> option:
 157
 158   Imager::init(t1log=>1);
 159
 160 Currently specific to Imager::Font::Type1, you can use the following
 161 flags when drawing text or calculating a bounding box:
 162
 163 =over
 164
 165 =item underline
 166
 167 Draw the text with an underline.
 168
 169 =item overline
 170
 171 Draw the text with an overline.
 172
 173 =item strikethrough
 174
 175 Draw the text with a strikethrough.
 176
 177 =back
 178
 179 Obviously, if you're calculating the bounding box the size of the line
 180 is included in the box, and the line isn't drawn :)
 181
 182 =head1 AUTHOR
 183
 184 Addi, Tony
 185
 186 =cut