thread-safe T1lib interface
[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 {
9d8379a4 9 $VERSION = "1.019";
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
d03fd5a4
TC
18my $t1aa;
19
20# $T1AA is in there because for some reason (probably cache related) antialiasing
21# is a system wide setting in t1 lib.
22
a556912d
TC
23sub new {
24 my $class = shift;
61e5a61a 25 my %hsh=(color=>Imager::Color->new(255,0,0,255),
a556912d
TC
26 size=>15,
27 @_);
28
29 unless ($hsh{file}) {
30 $Imager::ERRSTR = "No font file specified";
31 return;
32 }
33 unless (-e $hsh{file}) {
34 $Imager::ERRSTR = "Font file $hsh{file} not found";
35 return;
36 }
37 unless ($Imager::formats{t1}) {
38 $Imager::ERRSTR = "Type 1 fonts not supported in this build";
39 return;
40 }
41 # we want to avoid T1Lib's file search mechanism
42 unless ($hsh{file} =~ m!^/!
43 || $hsh{file} =~ m!^\.\/?/!
43233e13 44 || $^O =~ /^(MSWin32|cygwin)$/ && $hsh{file} =~ /^[a-z]:/i) {
a556912d
TC
45 $hsh{file} = './' . $hsh{file};
46 }
47
48 if($hsh{afm}) {
49 unless (-e $hsh{afm}) {
50 $Imager::ERRSTR = "Afm file $hsh{afm} not found";
51 return;
52 }
53 unless ($hsh{afm} =~ m!^/!
54 || $hsh{afm} =~ m!^\./!
43233e13 55 || $^O =~ /^(MSWin32|cygwin)$/ && $hsh{file} =~ /^[a-z]:/i) {
a556912d
TC
56 $hsh{file} = './' . $hsh{file};
57 }
58 } else {
59 $hsh{afm} = 0;
60 }
61
1aaae40f
TC
62 my $font = Imager::Font::T1xs->new($hsh{file},$hsh{afm});
63 unless ($font) { # the low-level code may miss some error handling
73e3ff55 64 Imager->_set_error(Imager->_error_as_msg);
a556912d
TC
65 return;
66 }
67 return bless {
1aaae40f 68 t1font => $font,
a556912d
TC
69 aa => $hsh{aa} || 0,
70 file => $hsh{file},
71 type => 't1',
72 size => $hsh{size},
73 color => $hsh{color},
74 }, $class;
75}
76
77sub _draw {
78 my $self = shift;
1aaae40f
TC
79
80 $self->_valid
81 or return;
82
a556912d 83 my %input = @_;
a556912d
TC
84 my $flags = '';
85 $flags .= 'u' if $input{underline};
86 $flags .= 's' if $input{strikethrough};
87 $flags .= 'o' if $input{overline};
88 if (exists $input{channel}) {
1aaae40f
TC
89 $self->{t1font}->cp($input{image}{IMG}, $input{'x'}, $input{'y'},
90 $input{channel}, $input{size},
a556912d 91 $input{string}, length($input{string}), $input{align},
1aaae40f 92 $input{utf8}, $flags, $input{aa});
a556912d 93 } else {
1aaae40f
TC
94 $self->{t1font}->text($input{image}{IMG}, $input{'x'}, $input{'y'},
95 $input{color}, $input{size},
a556912d 96 $input{string}, length($input{string}),
1aaae40f 97 $input{align}, $input{utf8}, $flags, $input{aa});
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},
a556912d
TC
115 length($input{string}), $input{utf8}, $flags);
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
a556912d
TC
125 unless (defined $hsh{string} && length $hsh{string}) {
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
1aaae40f 157 return $self->{t1font}->glyph_name($string, $utf8);
a556912d
TC
158}
159
160
1aaae40f
TC
161sub _valid {
162 my $self = shift;
163
164 unless ($self->{t1font} && Scalar::Util::blessed($self->{t1font})) {
165 Imager->_set_error("font object was created in another thread");
166 return;
167 }
168
169 return 1;
170}
171
a556912d
TC
1721;
173
174__END__
175
176=head1 NAME
177
178 Imager::Font::Type1 - low-level functions for Type1 fonts
179
180=head1 DESCRIPTION
181
182Imager::Font creates a Imager::Font::Type1 object when asked to create
183a font object based on a C<.pfb> file.
184
185See Imager::Font to see how to use this type.
186
187This class provides low-level functions that require the caller to
188perform data validation
189
190By default Imager no longer creates the F<t1lib.log> log file. You
191can re-enable that by calling Imager::init() with the C<t1log> option:
192
193 Imager::init(t1log=>1);
194
195This must be called before creating any fonts.
196
197Currently specific to Imager::Font::Type1, you can use the following
198flags when drawing text or calculating a bounding box:
199
200=for stopwords overline strikethrough
201
202=over
203
204=item *
205
206C<underline> - Draw the text with an underline.
207
208=item *
209
210C<overline> - Draw the text with an overline.
211
212=item *
213
214C<strikethrough> - Draw the text with a strikethrough.
215
216=back
217
218Obviously, if you're calculating the bounding box the size of the line
219is included in the box, and the line isn't drawn :)
220
221=head1 AUTHOR
222
223Addi, Tony
224
225=cut