Added preliminary support for adding image based fonts.
[imager.git] / lib / Imager / Font.pm
1 package Imager::Font;
2
3 use Imager::Color;
4 use strict;
5
6 # the aim here is that we can:
7 #  - add file based types in one place: here
8 #  - make sure we only attempt to create types that exist
9 #  - give reasonable defaults
10 #  - give the user some control over which types get used
11 my %drivers =
12   (
13    tt=>{
14         class=>'Imager::Font::Truetype',
15         module=>'Imager/Font/Truetype.pm',
16         files=>'.*\.ttf$',
17        },
18    t1=>{
19         class=>'Imager::Font::Type1',
20         module=>'Imager/Font/Type1.pm',
21         files=>'.*\.pfb$',
22        },
23    ft2=>{
24          class=>'Imager::Font::FreeType2',
25          module=>'Imager/Font/FreeType2.pm',
26          files=>'.*\.(pfa|pfb|otf|ttf|fon|fnt)$',
27         },
28    ifs=>{
29          class=>'Imager::Font::Image',
30          module=>'Imager/Font/Image.pm',
31          files=>'.*\.ifs$',
32         },
33    w32=>{
34          class=>'Imager::Font::Win32',
35          module=>'Imager/Font/Win32.pm',
36         },
37   );
38
39 # this currently should only contain file based types, don't add w32
40 my @priority = qw(t1 tt ft2 ifs);
41
42 # when Imager::Font is loaded, Imager.xs has not been bootstrapped yet
43 # this function is called from Imager.pm to finish initialization
44 sub __init {
45   @priority = grep Imager::i_has_format($_), @priority;
46   delete @drivers{grep !Imager::i_has_format($_), keys %drivers};
47 }
48
49 # search method
50 # 1. start by checking if file is the parameter
51 # 1a. if so qualify path and compare to the cache.
52 # 2a. if in cache - take it's id from there and increment count.
53 #
54
55 sub new {
56   my $class = shift;
57   my $self = {};
58   my ($file, $type, $id);
59   my %hsh=(color => Imager::Color->new(255,0,0,0),
60            size => 15,
61            @_);
62
63   bless $self,$class;
64
65   if ($hsh{'file'}) {
66     $file = $hsh{'file'};
67     if ( $file !~ m/^\// ) {
68       $file = './'.$file;
69       if (! -e $file) {
70         $Imager::ERRSTR = "Font $file not found";
71         return();
72       }
73     }
74
75     $type = $hsh{'type'};
76     if (!defined($type) or !$drivers{$type}) {
77       for my $drv (@priority) {
78         undef $type;
79         my $re = $drivers{$drv}{files} or next;
80         if ($file =~ /$re/i) {
81           $type = $drv;
82           last;
83         }
84       }
85     }
86     if (!defined($type)) {
87       $Imager::ERRSTR = "Font type not found";
88       return;
89     }
90   } elsif ($hsh{face}) {
91     $type = "w32";
92   } else {
93     $Imager::ERRSTR="No font file specified";
94     return;
95   }
96
97   if (!$Imager::formats{$type}) {
98     $Imager::ERRSTR = "`$type' not enabled";
99     return;
100   }
101
102   # here we should have the font type or be dead already.
103
104   require $drivers{$type}{module};
105   return $drivers{$type}{class}->new(%hsh);
106 }
107
108 # returns first defined parameter
109 sub _first {
110   for (@_) {
111     return $_ if defined $_;
112   }
113   return undef;
114 }
115
116 sub draw {
117   my $self = shift;
118   my %input = ('x' => 0, 'y' => 0, @_);
119   unless ($input{image}) {
120     $Imager::ERRSTR = 'No image supplied to $font->draw()';
121     return;
122   }
123   $input{string} = _first($input{string}, $input{text});
124   unless (defined $input{string}) {
125     $Imager::ERRSTR = "Missing required parameter 'string'";
126     return;
127   }
128   $input{aa} = _first($input{aa}, $input{antialias}, $self->{aa}, 1);
129   # the original draw code worked this out but didn't use it
130   $input{align} = _first($input{align}, $self->{align});
131   $input{color} = _first($input{color}, $self->{color});
132   $input{color} = Imager::_color($input{'color'});
133
134   $input{size} = _first($input{size}, $self->{size});
135   unless (defined $input{size}) {
136     $input{image}{ERRSTR} = "No font size provided";
137     return undef;
138   }
139   $input{align} = _first($input{align}, 1);
140   $input{utf8} = _first($input{utf8}, $self->{utf8}, 0);
141   $input{vlayout} = _first($input{vlayout}, $self->{vlayout}, 0);
142
143   $self->_draw(%input);
144 }
145
146 sub align {
147   my $self = shift;
148   my %input = ( halign => 'left', valign => 'baseline', 
149                 'x' => 0, 'y' => 0, @_ );
150
151   my $text = _first($input{string}, $input{text});
152   unless (defined $text) {
153     Imager->_set_error("Missing required parameter 'string'");
154     return;
155   }
156
157   # image needs to be supplied, but can be supplied as undef
158   unless (exists $input{image}) {
159     Imager->_set_error("Missing required parameter 'image'");
160     return;
161   }
162   my $size = _first($input{size}, $self->{size});
163   my $utf8 = _first($input{utf8}, 0);
164
165   my $bbox = $self->bounding_box(string=>$text, size=>$size, utf8=>$utf8);
166   my $valign = $input{valign};
167   $valign = 'baseline'
168     unless $valign && $valign =~ /^(?:top|center|bottom|baseline)$/;
169
170   my $halign = $input{halign};
171   $halign = 'start' 
172     unless $halign && $halign =~ /^(?:left|start|center|end|right)$/;
173
174   my $x = $input{'x'};
175   my $y = $input{'y'};
176
177   if ($valign eq 'top') {
178     $y += $bbox->ascent;
179   }
180   elsif ($valign eq 'center') {
181     $y += $bbox->ascent - $bbox->text_height / 2;
182   }
183   elsif ($valign eq 'bottom') {
184     $y += $bbox->descent;
185   }
186   # else baseline is the default
187
188   if ($halign eq 'left') {
189     $x -= $bbox->start_offset;
190   }
191   elsif ($halign eq 'start') {
192     # nothing to do
193   }
194   elsif ($halign eq 'center') {
195     $x -= $bbox->start_offset + $bbox->total_width / 2;
196   }
197   elsif ($halign eq 'end' || $halign eq 'right') {
198     $x -= $bbox->start_offset + $bbox->total_width - 1;
199   }
200   $x = int($x);
201   $y = int($y);
202
203   if ($input{image}) {
204     delete @input{qw/x y/};
205     $self->draw(%input, 'x' => $x, 'y' => $y, align=>1)
206       or return;
207 #      for my $i (1 .. length $text) {
208 #        my $work = substr($text, 0, $i);
209 #        my $bbox = $self->bounding_box(string=>$work, size=>$size, utf8=>$utf8);
210 #        my $nx = $x + $bbox->end_offset;
211 #        $input{image}->setpixel(x=>[ ($nx) x 5 ],
212 #                                'y'=>[ $y-2, $y-1, $y, $y+1, $y+2 ],
213 #                                color=>'FF0000');
214 #      }
215   }
216
217   return ($x+$bbox->start_offset, $y-$bbox->ascent, 
218           $x+$bbox->end_offset, $y-$bbox->descent+1);
219 }
220
221 sub bounding_box {
222   my $self=shift;
223   my %input=@_;
224
225   if (!exists $input{'string'}) { 
226     $Imager::ERRSTR='string parameter missing'; 
227     return;
228   }
229   $input{size} ||= $self->{size};
230   $input{sizew} = _first($input{sizew}, $self->{sizew}, 0);
231   $input{utf8} = _first($input{utf8}, $self->{utf8}, 0);
232
233   my @box = $self->_bounding_box(%input);
234
235   if (wantarray) {
236     if(@box && exists $input{'x'} and exists $input{'y'}) {
237       my($gdescent, $gascent)=@box[1,3];
238       $box[1]=$input{'y'}-$gascent;      # top = base - ascent (Y is down)
239       $box[3]=$input{'y'}-$gdescent;     # bottom = base - descent (Y is down, descent is negative)
240       $box[0]+=$input{'x'};
241       $box[2]+=$input{'x'};
242     } elsif (@box && $input{'canon'}) {
243       $box[3]-=$box[1];    # make it cannoical (ie (0,0) - (width, height))
244       $box[2]-=$box[0];
245     }
246     return @box;
247   }
248   else {
249     require Imager::Font::BBox;
250
251     return Imager::Font::BBox->new(@box);
252   }
253 }
254
255 sub dpi {
256   my $self = shift;
257
258   # I'm assuming a default of 72 dpi
259   my @old = (72, 72);
260   if (@_) {
261     $Imager::ERRSTR = "Setting dpi not implemented for this font type";
262     return;
263   }
264
265   return @old;
266 }
267
268 sub transform {
269   my $self = shift;
270
271   my %hsh = @_;
272
273   # this is split into transform() and _transform() so we can 
274   # implement other tags like: degrees=>12, which would build a
275   # 12 degree rotation matrix
276   # but I'll do that later
277   unless ($hsh{matrix}) {
278     $Imager::ERRSTR = "You need to supply a matrix";
279     return;
280   }
281
282   return $self->_transform(%hsh);
283 }
284
285 sub _transform {
286   $Imager::ERRSTR = "This type of font cannot be transformed";
287   return;
288 }
289
290 sub utf8 {
291   return 0;
292 }
293
294 sub priorities {
295   my $self = shift;
296   my @old = @priority;
297
298   if (@_) {
299     @priority = grep Imager::i_has_format($_), @_;
300   }
301   return @old;
302 }
303
304 1;
305
306 __END__
307
308 =head1 NAME
309
310 Imager::Font - Font handling for Imager.
311
312 =head1 SYNOPSIS
313
314   $t1font = Imager::Font->new(file => 'pathtofont.pfb');
315   $ttfont = Imager::Font->new(file => 'pathtofont.ttf');
316   $w32font = Imager::Font->new(face => 'Times New Roman');
317
318   $blue = Imager::Color->new("#0000FF");
319   $font = Imager::Font->new(file  => 'pathtofont.ttf',
320                             color => $blue,
321                             size  => 30);
322
323   ($neg_width,
324    $global_descent,
325    $pos_width,
326    $global_ascent,
327    $descent,
328    $ascent) = $font->bounding_box(string=>"Foo");
329
330   $logo = $font->logo(text   => "Slartibartfast Enterprises",
331                       size   => 40,
332                       border => 5,
333                       color  => $green);
334   # logo is proposed - doesn't exist yet
335
336
337   $img->string(font  => $font,
338              text  => "Model-XYZ",
339              x     => 15,
340              y     => 40,
341              size  => 40,
342              color => $red,
343              aa    => 1);
344
345   # Documentation in Imager.pm
346
347 =head1 DESCRIPTION
348
349 This module handles creating Font objects used by imager.  The module
350 also handles querying fonts for sizes and such.  If both T1lib and
351 freetype were avaliable at the time of compilation then Imager should
352 be able to work with both truetype fonts and t1 postscript fonts.  To
353 check if Imager is t1 or truetype capable you can use something like
354 this:
355
356   use Imager;
357   print "Has truetype"      if $Imager::formats{tt};
358   print "Has t1 postscript" if $Imager::formats{t1};
359   print "Has Win32 fonts"   if $Imager::formats{w32};
360   print "Has Freetype2"     if $Imager::formats{ft2};
361
362 =over 4
363
364 =item new
365
366 This creates a font object to pass to functions that take a font argument.
367
368   $font = Imager::Font->new(file  => 'denmark.ttf',
369                             color => $blue,
370                             size  => 30,
371                             aa    => 1);
372
373 This creates a font which is the truetype font denmark.ttf.  It's
374 default color is $blue, default size is 30 pixels and it's rendered
375 antialised by default.  Imager can see which type of font a file is by
376 looking at the suffix of the filename for the font.  A suffix of 'ttf'
377 is taken to mean a truetype font while a suffix of 'pfb' is taken to
378 mean a t1 postscript font.  If Imager cannot tell which type a font is
379 you can tell it explicitly by using the C<type> parameter:
380
381   $t1font = Imager::Font->new(file => 'fruitcase', type => 't1');
382   $ttfont = Imager::Font->new(file => 'arglebarf', type => 'tt');
383
384 If any of the C<color>, C<size> or C<aa> parameters are omitted when
385 calling C<Imager::Font->new()> the they take the following values:
386
387
388   color => Imager::Color->new(255, 0, 0, 0);  # this default should be changed
389   size  => 15
390   aa    => 0
391
392 To use Win32 fonts supply the facename of the font:
393
394   $font = Imager::Font->new(face=>'Arial Bold Italic');
395
396 There isn't any access to other logical font attributes, but this
397 typically isn't necessary for Win32 TrueType fonts, since you can
398 contruct the full name of the font as above.
399
400 Other logical font attributes may be added if there is sufficient demand.
401
402 =item bounding_box
403
404 Returns the bounding box for the specified string.  Example:
405
406   my ($neg_width,
407       $global_descent,
408       $pos_width,
409       $global_ascent,
410       $descent,
411       $ascent,
412       $advance_width) = $font->bounding_box(string => "A Fool");
413
414   my $bbox_object = $font->bounding_box(string => "A Fool");
415
416 =over
417
418 =item C<$neg_width>
419
420 the relative start of a the string.  In some
421 cases this can be a negative number, in that case the first letter
422 stretches to the left of the starting position that is specified in
423 the string method of the Imager class
424
425 =item C<$global_descent> 
426
427 how far down the lowest letter of the entire font reaches below the
428 baseline (this is often j).
429
430 =item C<$pos_width>
431
432 how wide the string from
433 the starting position is.  The total width of the string is
434 C<$pos_width-$neg_width>.
435
436 =item C<$descent> 
437
438 =item C<$ascent> 
439
440 the same as <$global_descent> and <$global_ascent> except that they
441 are only for the characters that appear in the string.
442
443 =item C<$advance_width>
444
445 the distance from the start point that the next string output should
446 start at, this is often the same as C<$pos_width>, but can be
447 different if the final character overlaps the right side of its
448 character cell.
449
450 =back
451
452 Obviously we can stuff all the results into an array just as well:
453
454   @metrics = $font->bounding_box(string => "testing 123");
455
456 Note that extra values may be added, so $metrics[-1] isn't supported.
457 It's possible to translate the output by a passing coordinate to the
458 bounding box method:
459
460   @metrics = $font->bounding_box(string => "testing 123", x=>45, y=>34);
461
462 This gives the bounding box as if the string had been put down at C<(x,y)>
463 By giving bounding_box 'canon' as a true value it's possible to measure
464 the space needed for the string:
465
466   @metrics = $font->bounding_box(string=>"testing",size=>15,canon=>1);
467
468 This returns tha same values in $metrics[0] and $metrics[1],
469 but:
470
471  $bbox[2] - horizontal space taken by glyphs
472  $bbox[3] - vertical space taken by glyphs
473
474 Returns an L<Imager::Font::BBox> object in scalar context, so you can
475 avoid all those confusing indices.  This has methods as named above,
476 with some extra convenience methods.
477
478 =item string
479
480 This is a method of the Imager class but because it's described in
481 here since it belongs to the font routines.  Example:
482
483   $img=Imager->new();
484   $img->read(file=>"test.jpg");
485   $img->string(font=>$t1font,
486                text=>"Model-XYZ",
487                x=>0,
488                y=>40,
489                size=>40,
490                color=>$red);
491   $img->write(file=>"testout.jpg");
492
493 This would put a 40 pixel high text in the top left corner of an
494 image.  If you measure the actuall pixels it varies since the fonts
495 usually do not use their full height.  It seems that the color and
496 size can be specified twice.  When a font is created only the actual
497 font specified matters.  It his however convenient to store default
498 values in a font, such as color and size.  If parameters are passed to
499 the string function they are used instead of the defaults stored in
500 the font.
501
502 The following parameters can be supplied to the string() method:
503
504 =over
505
506 =item string
507
508 The text to be rendered.  If this isn't present the 'text' parameter
509 is used.  If neither is present the call will fail.
510
511 =item aa
512
513 If non-zero the output will be anti-aliased.
514
515 =item x
516
517 =item y
518
519 The start point for rendering the text.  See the align parameter.
520
521 =item align
522
523 If non-zero the point supplied in (x,y) will be on the base-line, if
524 zero then (x,y) will be at the top-left of the first character.
525
526 =item channel
527
528 If present, the text will be written to the specified channel of the
529 image and the color parameter will be ignore.
530
531 =item color
532
533 The color to draw the text in.
534
535 =item size
536
537 The point-size to draw the text at.
538
539 =item sizew
540
541 For drivers that support it, the width to draw the text at.  Defaults
542 to be value of the 'size' parameter.
543
544 =item utf8
545
546 For drivers that support it, treat the string as UTF8 encoded.  For
547 versions of perl that support Unicode (5.6 and later), this will be
548 enabled automatically if the 'string' parameter is already a UTF8
549 string. See L<UTF8> for more information.
550
551 =item vlayout
552
553 For drivers that support it, draw the text vertically.  Note: I
554 haven't found a font that has the appropriate metrics yet.
555
556 =back
557
558 If string() is called with the C<channel> parameter then the color
559 isn't used and the font is drawn in only one channel of the image.
560 This can be quite handy to create overlays.  See the examples for tips
561 about this.
562
563 Sometimes it is necessary to know how much space a string takes before
564 rendering it.  The bounding_box() method described earlier can be used
565 for that.
566
567 =item align(string=>$text, size=>$size, x=>..., y=>..., valign => ..., halign=>...)
568
569 Higher level text output - outputs the text aligned as specified
570 around the given point (x,y).
571
572   # "Hello" centered at 100, 100 in the image.
573   my ($left, $top, $bottom, $right) = 
574     $font->align(string=>"Hello",
575                  x=>100, y=>100, 
576                  halign=>'center', valign=>'center', 
577                  image=>$image);
578
579 Takes the same parameters as $font->draw(), and the following extra
580 parameters:
581
582 =over
583
584 =item valign
585
586 Possible values are:
587
588 =over
589
590 =item top
591
592 Point is at the top of the text.
593
594 =item bottom
595
596 Point is at the bottom of the text.
597
598 =item baseline
599
600 Point is on the baseline of the text (default.)
601
602 =item center
603
604 Point is vertically centered within the text.
605
606 =back
607
608 =item halign
609
610 =over
611
612 =item left
613
614 The point is at the left of the text.
615
616 =item start
617
618 The point is at the start point of the text.
619
620 =item center
621
622 The point is horizontally centered within the text.
623
624 =item right
625
626 The point is at the right end of the text.
627
628 =item end
629
630 The point is at the right end of the text.  This will change to the
631 end point of the text (once the proper bounding box interfaces are
632 available).
633
634 =back
635
636 =item image
637
638 The image to draw to.  Set to C<undef> to avoid drawing but still
639 calculate the bounding box.
640
641 =back
642
643 Returns a list specifying the bounds of the drawn text.
644
645 =item dpi()
646
647 =item dpi(xdpi=>$xdpi, ydpi=>$ydpi)
648
649 =item dpi(dpi=>$dpi)
650
651 Set retrieve the spatial resolution of the image in dots per inch.
652 The default is 72 dpi.
653
654 This isn't implemented for all font types yet.
655
656 =item transform(matrix=>$matrix)
657
658 Applies a transformation to the font, where matrix is an array ref of
659 numbers representing a 2 x 3 matrix:
660
661   [  $matrix->[0],  $matrix->[1],  $matrix->[2],
662      $matrix->[3],  $matrix->[4],  $matrix->[5]   ]
663
664 Not all font types support transformations, these will return false.
665
666 It's possible that a driver will disable hinting if you use a
667 transformation, to prevent discontinuities in the transformations.
668 See the end of the test script t/t38ft2font.t for an example.
669
670 Currently only the ft2 (Freetype 2.x) driver supports the transform()
671 method.
672
673 =item has_chars(string=>$text)
674
675 Checks if the characters in $text are defined by the font.
676
677 In a list context returns a list of true or false value corresponding
678 to the characters in $text, true if the character is defined, false if
679 not.  In scalar context returns a string of NUL or non-NUL
680 characters.  Supports UTF8 where the font driver supports UTF8.
681
682 Not all fonts support this method (use $font->can("has_chars") to
683 check.)
684
685 =item logo
686
687 This method doesn't exist yet but is under consideration.  It would mostly
688 be helpful for generating small tests and such.  Its proposed interface is:
689
690   $img = $font->logo(string=>"Plan XYZ", color=>$blue, border=>7);
691
692 This would be nice for writing (admittedly multiline) one liners like:
693
694 Imager::Font->new(file=>"arial.ttf", color=>$blue, aa=>1)
695             ->string(text=>"Plan XYZ", border=>5)
696             ->write(file=>"xyz.png");
697
698 =item face_name()
699
700 Returns the internal name of the face.  Not all font types support
701 this method yet.
702
703 =item glyph_names(string=>$string [, utf8=>$utf8 ] );
704
705 Returns a list of glyph names for each of the characters in the
706 string.  If the character has no name then C<undef> is returned for
707 the character.
708
709 Some font files do not include glyph names, in this case Freetype 2
710 will not return any names.  Freetype 1 can return standard names even
711 if there are no glyph names in the font.
712
713 Both Freetype 1.x and 2.x allow support for glyph names to not be
714 included.
715
716 =back
717
718 =head1 UTF8
719
720 There are 2 ways of rendering Unicode characters with Imager:
721
722 =over
723
724 =item *
725
726 For versions of perl that support it, use perl's native UTF8 strings.
727 This is the simplest method.
728
729 =item *
730
731 Hand build your own UTF8 encoded strings.  Only recommended if your
732 version of perl has no UTF8 support.
733
734 =back
735
736 Imager won't construct characters for you, so if want to output
737 unicode character 00C3 "LATIN CAPITAL LETTER A WITH DIAERESIS", and
738 your font doesn't support it, Imager will I<not> build it from 0041
739 "LATIN CAPITAL LETTER A" and 0308 "COMBINING DIAERESIS".
740
741 =head2 Native UTF8 Support
742
743 If your version of perl supports UTF8 and the driver supports UTF8,
744 just use the $im->string() method, and it should do the right thing.
745
746 =head2 Build your own
747
748 In this case you need to build your own UTF8 encoded characters.
749
750 For example:
751
752  $x = pack("C*", 0xE2, 0x80, 0x90); # character code 0x2010 HYPHEN
753
754 You need to be be careful with versions of perl that have UTF8
755 support, since your string may end up doubly UTF8 encoded.
756
757 For example:
758
759  $x = "A\xE2\x80\x90\x41\x{2010}";
760  substr($x, -1, 0) = ""; 
761  # at this point $x is has the UTF8 flag set, but has 5 characters,
762  # none, of which is the constructed UTF8 character
763
764 The test script t/t38ft2font.t has a small example of this after the 
765 comment:
766
767   # an attempt using emulation of UTF8
768
769 =head1 DRIVER CONTROL
770
771 If you don't supply a 'type' parameter to Imager::Font->new(), but you
772 do supply a 'file' parameter, Imager will attempt to guess which font
773 driver to used based on the extension of the font file.
774
775 Since some formats can be handled by more than one driver, a priority
776 list is used to choose which one should be used, if a given format can
777 be handled by more than one driver.
778
779 The current priority can be retrieved with:
780
781   @drivers = Imager::Font->priorities();
782
783 You can set new priorities and save the old priorities with:
784
785   @old = Imager::Font->priorities(@drivers);
786
787 If you supply driver names that are not currently supported, they will
788 be ignored.
789
790 Imager supports both T1Lib and Freetype2 for working with Type 1
791 fonts, but currently only T1Lib does any caching, so by default T1Lib
792 is given a higher priority.  Since Imager's Freetype2 support can also
793 do font transformations, you may want to give that a higher priority:
794
795   my @old = Imager::Font->priorities(qw(tt ft2 t1));
796
797 =head1 AUTHOR
798
799 Arnar M. Hrafnkelsson, addi@umich.edu
800 And a great deal of help from others - see the README for a complete
801 list.
802
803 =head1 BUGS
804
805 You need to modify this class to add new font types.
806
807 =head1 SEE ALSO
808
809 Imager(3), Imager::Font::FreeType2(3), Imager::Font::Type1(3),
810 Imager::Font::Win32(3), Imager::Font::Truetype(3), Imager::Font::BBox(3)
811
812
813 http://www.eecs.umich.edu/~addi/perl/Imager/
814
815 =cut
816
817