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