fix error handling for invalid utf8 for T1
[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 use Scalar::Util ();
7
8 BEGIN {
9   $VERSION = "1.020";
10
11   require XSLoader;
12   XSLoader::load('Imager::Font::T1', $VERSION);
13 }
14
15
16 *_first = \&Imager::Font::_first;
17
18 my $t1aa = 2;
19
20 sub new {
21   my $class = shift;
22   my %hsh=(color=>Imager::Color->new(255,0,0,255),
23            size=>15,
24            @_);
25
26   unless ($hsh{file}) {
27     $Imager::ERRSTR = "No font file specified";
28     return;
29   }
30   unless (-e $hsh{file}) {
31     $Imager::ERRSTR = "Font file $hsh{file} not found";
32     return;
33   }
34   unless ($Imager::formats{t1}) {
35     $Imager::ERRSTR = "Type 1 fonts not supported in this build";
36     return;
37   }
38   # we want to avoid T1Lib's file search mechanism
39   unless ($hsh{file} =~ m!^/!
40           || $hsh{file} =~ m!^\.\/?/!
41           || $^O =~ /^(MSWin32|cygwin)$/ && $hsh{file} =~ /^[a-z]:/i) {
42     $hsh{file} = './' . $hsh{file};
43   }
44
45   if($hsh{afm}) {
46           unless (-e $hsh{afm}) {
47             $Imager::ERRSTR = "Afm file $hsh{afm} not found";
48             return;
49           }
50           unless ($hsh{afm} =~ m!^/!
51                   || $hsh{afm} =~ m!^\./!
52                   || $^O =~ /^(MSWin32|cygwin)$/ && $hsh{file} =~ /^[a-z]:/i) {
53             $hsh{file} = './' . $hsh{file};
54           }
55   } else {
56           $hsh{afm} = 0;
57   }
58
59   my $font = Imager::Font::T1xs->new($hsh{file},$hsh{afm});
60   unless ($font) { # the low-level code may miss some error handling
61     Imager->_set_error(Imager->_error_as_msg);
62     return;
63   }
64   return bless {
65                 t1font    => $font,
66                 aa    => $hsh{aa} || 0,
67                 file  => $hsh{file},
68                 type  => 't1',
69                 size  => $hsh{size},
70                 color => $hsh{color},
71                 t1aa  => $t1aa,
72                }, $class;
73 }
74
75 sub _draw {
76   my $self = shift;
77
78   $self->_valid
79     or return;
80
81   my %input = @_;
82   my $flags = '';
83   $flags .= 'u' if $input{underline};
84   $flags .= 's' if $input{strikethrough};
85   $flags .= 'o' if $input{overline};
86   my $aa = $input{aa} ? $self->{t1aa} : 0;
87   if (exists $input{channel}) {
88     $self->{t1font}->cp($input{image}{IMG}, $input{'x'}, $input{'y'},
89                     $input{channel}, $input{size},
90                     $input{string}, $input{align},
91                     $input{utf8}, $flags, $aa)
92       or return;
93   } else {
94     $self->{t1font}->text($input{image}{IMG}, $input{'x'}, $input{'y'}, 
95                       $input{color}, $input{size}, 
96                       $input{string}, $input{align}, $input{utf8}, $flags, $aa)
97       or return;
98   }
99
100   return $self;
101 }
102
103 sub _bounding_box {
104   my $self = shift;
105
106   $self->_valid
107     or return;
108
109   my %input = @_;
110   my $flags = '';
111   $flags .= 'u' if $input{underline};
112   $flags .= 's' if $input{strikethrough};
113   $flags .= 'o' if $input{overline};
114   my @bbox =  $self->{t1font}->bbox($input{size}, $input{string},
115                                     $input{utf8}, $flags);
116   unless (@bbox) {
117     Imager->_set_error(Imager->_error_as_msg);
118     return;
119   }
120
121   return @bbox;
122 }
123
124 # check if the font has the characters in the given string
125 sub has_chars {
126   my ($self, %hsh) = @_;
127
128   $self->_valid
129     or return;
130
131   unless (defined $hsh{string}) {
132     $Imager::ERRSTR = "No string supplied to \$font->has_chars()";
133     return;
134   }
135   if (wantarray) {
136     my @result = $self->{t1font}
137       ->has_chars($hsh{string}, _first($hsh{'utf8'}, $self->{utf8}, 0));
138     unless (@result) {
139       Imager->_set_error(Imager->_error_as_msg);
140       return;
141     }
142
143     return @result;
144   }
145   else {
146     my $result = $self->{t1font}
147       ->has_chars($hsh{string}, _first($hsh{'utf8'}, $self->{utf8}, 0));
148     unless (defined $result) {
149       Imager->_set_error(Imager->_error_as_msg);
150       return;
151     }
152     return $result;
153   }
154 }
155
156 sub utf8 {
157   1;
158 }
159
160 sub face_name {
161   my ($self) = @_;
162
163   $self->_valid
164     or return;
165
166   return $self->{t1font}->face_name();
167 }
168
169 sub glyph_names {
170   my ($self, %input) = @_;
171
172   $self->_valid
173     or return;
174
175   my $string = $input{string};
176   defined $string
177     or return Imager->_set_error("no string parameter passed to glyph_names");
178   my $utf8 = _first($input{utf8} || 0);
179
180   my @result = $self->{t1font}->glyph_names($string, $utf8);
181   unless (@result) {
182     Imager->_set_error(Imager->_error_as_msg);
183     return;
184   }
185
186   return @result;
187 }
188
189 sub set_aa_level {
190   my ($self, $new_t1aa) = @_;
191
192   if (!defined $new_t1aa ||
193       ($new_t1aa != 1 && $new_t1aa != 2)) {
194     Imager->_set_error("set_aa_level: parameter must be 1 or 2");
195     return;
196   }
197
198   if (ref $self) {
199     $self->_valid
200       or return;
201
202     $self->{t1aa} = $new_t1aa;
203   }
204   else {
205     $t1aa = $new_t1aa;
206   }
207
208   return 1;
209 }
210
211 sub _valid {
212   my $self = shift;
213
214   unless ($self->{t1font} && Scalar::Util::blessed($self->{t1font})) {
215     Imager->_set_error("font object was created in another thread");
216     return;
217   }
218
219   return 1;
220 }
221
222 1;
223
224 __END__
225
226 =head1 NAME
227
228   Imager::Font::Type1 - low-level functions for Type1 fonts
229
230 =head1 DESCRIPTION
231
232 Imager::Font creates a Imager::Font::Type1 object when asked to create
233 a font object based on a C<.pfb> file.
234
235 See Imager::Font to see how to use this type.
236
237 This class provides low-level functions that require the caller to
238 perform data validation
239
240 By default Imager no longer creates the F<t1lib.log> log file.  You
241 can re-enable that by calling Imager::init() with the C<t1log> option:
242
243   Imager::init(t1log=>1);
244
245 This must be called before creating any fonts.
246
247 Currently specific to Imager::Font::Type1, you can use the following
248 flags when drawing text or calculating a bounding box:
249
250 =for stopwords overline strikethrough
251
252 =over
253
254 =item *
255
256 C<underline> - Draw the text with an underline.
257
258 =item *
259
260 C<overline> - Draw the text with an overline.
261
262 =item *
263
264 C<strikethrough> - Draw the text with a strikethrough.
265
266 =back
267
268 Obviously, if you're calculating the bounding box the size of the line
269 is included in the box, and the line isn't drawn :)
270
271 =head2 Anti-aliasing
272
273 T1Lib supports multiple levels of anti-aliasing, by default, if you
274 request anti-aliased output, Imager::Font::T1 will use the maximum
275 level.
276
277 You can override this with the set_t1_aa() method:
278
279 =over
280
281 =item set_aa_level()
282
283 Usage:
284
285   $font->set_aa_level(1);
286   Imager::Font::T1->set_aa_level(2);
287
288 Sets the T1Lib anti-aliasing level either for the specified font, or
289 for new font objects.
290
291 The only parameter must be 1 or 2.
292
293 Returns true on success.
294
295 =back
296
297 =head1 AUTHOR
298
299 Addi, Tony
300
301 =cut