T1/T1.pm

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