[rt #75878] pass --verbose through to Imager::Probe in sub-modules
[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;
18
19 # $T1AA is in there because for some reason (probably cache related) antialiasing
20 # is a system wide setting in t1 lib.
21
22 sub t1_set_aa_level {
23   if (!defined $t1aa or $_[0] != $t1aa) {
24     i_t1_set_aa($_[0]);
25     $t1aa=$_[0];
26   }
27 }
28
29 sub new {
30   my $class = shift;
31   my %hsh=(color=>Imager::Color->new(255,0,0,255),
32            size=>15,
33            @_);
34
35   unless ($hsh{file}) {
36     $Imager::ERRSTR = "No font file specified";
37     return;
38   }
39   unless (-e $hsh{file}) {
40     $Imager::ERRSTR = "Font file $hsh{file} not found";
41     return;
42   }
43   unless ($Imager::formats{t1}) {
44     $Imager::ERRSTR = "Type 1 fonts not supported in this build";
45     return;
46   }
47   # we want to avoid T1Lib's file search mechanism
48   unless ($hsh{file} =~ m!^/!
49           || $hsh{file} =~ m!^\.\/?/!
50           || $^O =~ /^(MSWin32|cygwin)$/ && $hsh{file} =~ /^[a-z]:/i) {
51     $hsh{file} = './' . $hsh{file};
52   }
53
54   if($hsh{afm}) {
55           unless (-e $hsh{afm}) {
56             $Imager::ERRSTR = "Afm file $hsh{afm} not found";
57             return;
58           }
59           unless ($hsh{afm} =~ m!^/!
60                   || $hsh{afm} =~ m!^\./!
61                   || $^O =~ /^(MSWin32|cygwin)$/ && $hsh{file} =~ /^[a-z]:/i) {
62             $hsh{file} = './' . $hsh{file};
63           }
64   } else {
65           $hsh{afm} = 0;
66   }
67
68   my $id = i_t1_new($hsh{file},$hsh{afm});
69   unless ($id >= 0) { # the low-level code may miss some error handling
70     Imager->_set_error(Imager->_error_as_msg);
71     return;
72   }
73   return bless {
74                 id    => $id,
75                 aa    => $hsh{aa} || 0,
76                 file  => $hsh{file},
77                 type  => 't1',
78                 size  => $hsh{size},
79                 color => $hsh{color},
80                }, $class;
81 }
82
83 sub _draw {
84   my $self = shift;
85   my %input = @_;
86   t1_set_aa_level($input{aa});
87   my $flags = '';
88   $flags .= 'u' if $input{underline};
89   $flags .= 's' if $input{strikethrough};
90   $flags .= 'o' if $input{overline};
91   if (exists $input{channel}) {
92     i_t1_cp($input{image}{IMG}, $input{'x'}, $input{'y'},
93                     $input{channel}, $self->{id}, $input{size},
94                     $input{string}, length($input{string}), $input{align},
95                     $input{utf8}, $flags);
96   } else {
97     i_t1_text($input{image}{IMG}, $input{'x'}, $input{'y'}, 
98                       $input{color}, $self->{id}, $input{size}, 
99                       $input{string}, length($input{string}), 
100                       $input{align}, $input{utf8}, $flags);
101   }
102
103   return $self;
104 }
105
106 sub _bounding_box {
107   my $self = shift;
108   my %input = @_;
109   my $flags = '';
110   $flags .= 'u' if $input{underline};
111   $flags .= 's' if $input{strikethrough};
112   $flags .= 'o' if $input{overline};
113   return i_t1_bbox($self->{id}, $input{size}, $input{string},
114                            length($input{string}), $input{utf8}, $flags);
115 }
116
117 # check if the font has the characters in the given string
118 sub has_chars {
119   my ($self, %hsh) = @_;
120
121   unless (defined $hsh{string} && length $hsh{string}) {
122     $Imager::ERRSTR = "No string supplied to \$font->has_chars()";
123     return;
124   }
125   return i_t1_has_chars($self->{id}, $hsh{string}, 
126                                 _first($hsh{'utf8'}, $self->{utf8}, 0));
127 }
128
129 sub utf8 {
130   1;
131 }
132
133 sub face_name {
134   my ($self) = @_;
135
136   i_t1_face_name($self->{id});
137 }
138
139 sub glyph_names {
140   my ($self, %input) = @_;
141
142   my $string = $input{string};
143   defined $string
144     or return Imager->_set_error("no string parameter passed to glyph_names");
145   my $utf8 = _first($input{utf8} || 0);
146
147   i_t1_glyph_name($self->{id}, $string, $utf8);
148 }
149
150
151 1;
152
153 __END__
154
155 =head1 NAME
156
157   Imager::Font::Type1 - low-level functions for Type1 fonts
158
159 =head1 DESCRIPTION
160
161 Imager::Font creates a Imager::Font::Type1 object when asked to create
162 a font object based on a C<.pfb> file.
163
164 See Imager::Font to see how to use this type.
165
166 This class provides low-level functions that require the caller to
167 perform data validation
168
169 By default Imager no longer creates the F<t1lib.log> log file.  You
170 can re-enable that by calling Imager::init() with the C<t1log> option:
171
172   Imager::init(t1log=>1);
173
174 This must be called before creating any fonts.
175
176 Currently specific to Imager::Font::Type1, you can use the following
177 flags when drawing text or calculating a bounding box:
178
179 =for stopwords overline strikethrough
180
181 =over
182
183 =item *
184
185 C<underline> - Draw the text with an underline.
186
187 =item *
188
189 C<overline> - Draw the text with an overline.
190
191 =item *
192
193 C<strikethrough> - Draw the text with a strikethrough.
194
195 =back
196
197 Obviously, if you're calculating the bounding box the size of the line
198 is included in the box, and the line isn't drawn :)
199
200 =head1 AUTHOR
201
202 Addi, Tony
203
204 =cut