thread-safe T1lib interface
[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;
19
20 # $T1AA is in there because for some reason (probably cache related) antialiasing
21 # is a system wide setting in t1 lib.
22
23 sub new {
24   my $class = shift;
25   my %hsh=(color=>Imager::Color->new(255,0,0,255),
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!^\.\/?/!
44           || $^O =~ /^(MSWin32|cygwin)$/ && $hsh{file} =~ /^[a-z]:/i) {
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!^\./!
55                   || $^O =~ /^(MSWin32|cygwin)$/ && $hsh{file} =~ /^[a-z]:/i) {
56             $hsh{file} = './' . $hsh{file};
57           }
58   } else {
59           $hsh{afm} = 0;
60   }
61
62   my $font = Imager::Font::T1xs->new($hsh{file},$hsh{afm});
63   unless ($font) { # the low-level code may miss some error handling
64     Imager->_set_error(Imager->_error_as_msg);
65     return;
66   }
67   return bless {
68                 t1font    => $font,
69                 aa    => $hsh{aa} || 0,
70                 file  => $hsh{file},
71                 type  => 't1',
72                 size  => $hsh{size},
73                 color => $hsh{color},
74                }, $class;
75 }
76
77 sub _draw {
78   my $self = shift;
79
80   $self->_valid
81     or return;
82
83   my %input = @_;
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}) {
89     $self->{t1font}->cp($input{image}{IMG}, $input{'x'}, $input{'y'},
90                     $input{channel}, $input{size},
91                     $input{string}, length($input{string}), $input{align},
92                     $input{utf8}, $flags, $input{aa});
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, $input{aa});
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   return $self->{t1font}->bbox($input{size}, $input{string},
115                            length($input{string}), $input{utf8}, $flags);
116 }
117
118 # check if the font has the characters in the given string
119 sub has_chars {
120   my ($self, %hsh) = @_;
121
122   $self->_valid
123     or return;
124
125   unless (defined $hsh{string} && length $hsh{string}) {
126     $Imager::ERRSTR = "No string supplied to \$font->has_chars()";
127     return;
128   }
129   return $self->{t1font}->has_chars($hsh{string}, 
130                                     _first($hsh{'utf8'}, $self->{utf8}, 0));
131 }
132
133 sub utf8 {
134   1;
135 }
136
137 sub face_name {
138   my ($self) = @_;
139
140   $self->_valid
141     or return;
142
143   return $self->{t1font}->face_name();
144 }
145
146 sub glyph_names {
147   my ($self, %input) = @_;
148
149   $self->_valid
150     or return;
151
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
157   return $self->{t1font}->glyph_name($string, $utf8);
158 }
159
160
161 sub _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
172 1;
173
174 __END__
175
176 =head1 NAME
177
178   Imager::Font::Type1 - low-level functions for Type1 fonts
179
180 =head1 DESCRIPTION
181
182 Imager::Font creates a Imager::Font::Type1 object when asked to create
183 a font object based on a C<.pfb> file.
184
185 See Imager::Font to see how to use this type.
186
187 This class provides low-level functions that require the caller to
188 perform data validation
189
190 By default Imager no longer creates the F<t1lib.log> log file.  You
191 can re-enable that by calling Imager::init() with the C<t1log> option:
192
193   Imager::init(t1log=>1);
194
195 This must be called before creating any fonts.
196
197 Currently specific to Imager::Font::Type1, you can use the following
198 flags when drawing text or calculating a bounding box:
199
200 =for stopwords overline strikethrough
201
202 =over
203
204 =item *
205
206 C<underline> - Draw the text with an underline.
207
208 =item *
209
210 C<overline> - Draw the text with an overline.
211
212 =item *
213
214 C<strikethrough> - Draw the text with a strikethrough.
215
216 =back
217
218 Obviously, if you're calculating the bounding box the size of the line
219 is included in the box, and the line isn't drawn :)
220
221 =head1 AUTHOR
222
223 Addi, Tony
224
225 =cut