provide better control over AA, and improve error handling
[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.019";
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}, length($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}, length($input{string}), 
97                       $input{align}, $input{utf8}, $flags, $aa)
98       or return;
99   }
100
101   return $self;
102 }
103
104 sub _bounding_box {
105   my $self = shift;
106
107   $self->_valid
108     or return;
109
110   my %input = @_;
111   my $flags = '';
112   $flags .= 'u' if $input{underline};
113   $flags .= 's' if $input{strikethrough};
114   $flags .= 'o' if $input{overline};
115   return $self->{t1font}->bbox($input{size}, $input{string},
116                            length($input{string}), $input{utf8}, $flags);
117 }
118
119 # check if the font has the characters in the given string
120 sub has_chars {
121   my ($self, %hsh) = @_;
122
123   $self->_valid
124     or return;
125
126   unless (defined $hsh{string} && length $hsh{string}) {
127     $Imager::ERRSTR = "No string supplied to \$font->has_chars()";
128     return;
129   }
130   return $self->{t1font}->has_chars($hsh{string}, 
131                                     _first($hsh{'utf8'}, $self->{utf8}, 0));
132 }
133
134 sub utf8 {
135   1;
136 }
137
138 sub face_name {
139   my ($self) = @_;
140
141   $self->_valid
142     or return;
143
144   return $self->{t1font}->face_name();
145 }
146
147 sub glyph_names {
148   my ($self, %input) = @_;
149
150   $self->_valid
151     or return;
152
153   my $string = $input{string};
154   defined $string
155     or return Imager->_set_error("no string parameter passed to glyph_names");
156   my $utf8 = _first($input{utf8} || 0);
157
158   return $self->{t1font}->glyph_name($string, $utf8);
159 }
160
161 sub set_aa_level {
162   my ($self, $new_t1aa) = @_;
163
164   if (!defined $new_t1aa ||
165       ($new_t1aa != 1 && $new_t1aa != 2)) {
166     Imager->_set_error("set_aa_level: parameter must be 1 or 2");
167     return;
168   }
169
170   if (ref $self) {
171     $self->_valid
172       or return;
173
174     $self->{t1aa} = $new_t1aa;
175   }
176   else {
177     $t1aa = $new_t1aa;
178   }
179
180   return 1;
181 }
182
183 sub _valid {
184   my $self = shift;
185
186   unless ($self->{t1font} && Scalar::Util::blessed($self->{t1font})) {
187     Imager->_set_error("font object was created in another thread");
188     return;
189   }
190
191   return 1;
192 }
193
194 1;
195
196 __END__
197
198 =head1 NAME
199
200   Imager::Font::Type1 - low-level functions for Type1 fonts
201
202 =head1 DESCRIPTION
203
204 Imager::Font creates a Imager::Font::Type1 object when asked to create
205 a font object based on a C<.pfb> file.
206
207 See Imager::Font to see how to use this type.
208
209 This class provides low-level functions that require the caller to
210 perform data validation
211
212 By default Imager no longer creates the F<t1lib.log> log file.  You
213 can re-enable that by calling Imager::init() with the C<t1log> option:
214
215   Imager::init(t1log=>1);
216
217 This must be called before creating any fonts.
218
219 Currently specific to Imager::Font::Type1, you can use the following
220 flags when drawing text or calculating a bounding box:
221
222 =for stopwords overline strikethrough
223
224 =over
225
226 =item *
227
228 C<underline> - Draw the text with an underline.
229
230 =item *
231
232 C<overline> - Draw the text with an overline.
233
234 =item *
235
236 C<strikethrough> - Draw the text with a strikethrough.
237
238 =back
239
240 Obviously, if you're calculating the bounding box the size of the line
241 is included in the box, and the line isn't drawn :)
242
243 =head2 Anti-aliasing
244
245 T1Lib supports multiple levels of anti-aliasing, by default, if you
246 request anti-aliased output, Imager::Font::T1 will use the maximum
247 level.
248
249 You can override this with the set_t1_aa() method:
250
251 =over
252
253 =item set_aa_level()
254
255 Usage:
256
257   $font->set_aa_level(1);
258   Imager::Font::T1->set_aa_level(2);
259
260 Sets the T1Lib anti-aliasing level either for the specified font, or
261 for new font objects.
262
263 The only parameter must be 1 or 2.
264
265 Returns true on success.
266
267 =back
268
269 =head1 AUTHOR
270
271 Addi, Tony
272
273 =cut