update from the separate T1 distribution
[imager.git] / 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