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