lib/Imager/Font/Type1.pm

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