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