Added preliminary support for adding image based fonts.
[imager.git] / lib / Imager / Font / Image.pm
1 package Imager::Font::Image;
2 use strict;
3 use Imager::Color;
4 use File::Basename;
5 use File::Spec;
6
7 use vars qw(@ISA %REQUIRED_FIELDS);
8 @ISA = qw(Imager::Font);
9
10 sub NWIDTH   () { 0 }
11 sub PWIDTH   () { 2 }
12 sub GDESCENT () { 1 }
13 sub GASCENT  () { 3 }
14 sub DESCENT  () { 4 }
15 sub ASCENT   () { 5 }
16
17
18 %REQUIRED_FIELDS = (
19         Image_spec     => 1,
20         Font_size      => 1,
21         Global_ascent  => 1,
22         Global_descent => 1,);
23
24 # Required fields
25 # Fontmetrics:
26 # Font global data:
27 #   image name
28 #   font size
29 #   max glyph height
30 #   max glyph width
31 #
32 # The per character data is:
33 #   left edge   (inclusive)
34 #   right edge  (exclusive)
35 #   top edge    (inclusive)
36 #   bottom edge (exclusive)
37 #   left adjustment
38 #   forward shift
39 #   baseline adjustment (from top)
40 #
41 # The left adjustment is the starting
42 # offset into the glyph, the forward shift
43 # is the actual forward movement of the
44 # imaginary cursor.
45
46 # To calculate the size of a string use:
47 #  sum (forward_shift_i) + left_adjustment_0 + width_last - left_adjustment_last - forward_shift_last
48
49 # example font spec file:
50
51 # IAGRFONT
52 # # This is an imager font definition file.  This is a comment
53 # Image_spec = foo.png
54 # Font_size  = 12
55 # Global_ascent = 10
56 # Global_descent = -2
57 # # Per character data
58 # FM_65 = 20 40 30 50 3 15
59 # # Code for 'A' left edge = 20, right = 40, top = 30, bottom 50, leading = 3, forward = 15.
60 # The left adjustment is the starting
61 # offset into the glyph, the forward shift
62 # is the actual forward movement of the
63 # imaginary cursor.
64
65 # To calculate the size of a string use:
66 #  sum (forward_shift_i) + left_adjustment_0 + width_last - left_adjustment_last - forward_shift_last
67
68
69
70 sub parse_fontspec_file {
71   my ($self, $file) = @_;
72   local *FH;
73   return unless open(FH, "<$file");
74
75   my %req = %REQUIRED_FIELDS;
76
77   while(<FH>) {
78     next if m/^\#/;
79     if (m/^\s*?(\S+?)\s*=\s*(.+?)\s*$/) {
80       # Check for a required field:
81       my $char = $1;
82       my $metric = $2;
83       if ($req{$char}) {
84         $self->{$char} = $metric;
85         delete $req{$1};
86       } else {
87         next unless $char =~ s/^FM_(\d+)$/$1/;
88         next unless $metric =~ m/(\d+)\s+(\d+)\s+(\d+)\s+(\d+)\s+(\d+)\s+(\d+)$/;
89         $self->{fm}->{$char} = [$1, $2, $3, $4, $5, $6];
90       }
91     }
92   }
93   close(FH);
94   return $self;
95 }
96
97
98
99 sub new {
100   my $self = bless {}, shift;
101   my %opts = (color=>Imager::Color->new(255, 0, 0, 0), @_);
102
103   unless ($opts{file}) {
104     $Imager::ERRSTR = "No font file specified";
105     return;
106   }
107   unless ($self->parse_fontspec_file($opts{file})) {
108     $Imager::ERRSTR = "Font file $opts{file} not found or bad";
109     return;
110   }
111
112   my $img = Imager->new();
113   my $img_filename = File::Spec->catfile( dirname($opts{'file'}),
114                                           $self->{Image_spec} );
115
116   unless ($img->open(%opts, file=>$img_filename)) {
117     $Imager::ERRSTR = "Font IMAGE file $img_filename not found or bad: ".
118       $img->errstr();
119     return;
120   }
121
122   $self->{image} = $img;
123   $self->{size} = $self->{Font_size};
124   return $self;
125 }
126
127 sub get_glyph_data {
128   my ($self, $glyph_code) = @_;
129   return unless exists $self->{fm}->{$glyph_code};
130   return @{$self->{fm}->{$glyph_code}};
131 }
132
133 # copy_glyph
134 #
135 # $x, $y is left, baseline for glyphs.
136 #
137
138 sub copy_glyph {
139   my ($self, $glyph_code, $target_img, $x, $y) = @_;
140
141   my @gdata = $self->get_glyph_data($glyph_code) or return;
142
143   $target_img->rubthrough(src=>$self->{image},
144                           tx => $x + $gdata[4],
145                           ty => $y -  $self->{Global_ascent},,
146                           src_minx => $gdata[0],
147                           src_maxx => $gdata[1],
148                           src_miny => $gdata[2],
149                           src_maxy => $gdata[3]);
150 }
151
152 sub _draw {
153   my ($self, %opts) = @_;
154
155   my $x = $opts{'x'};
156   my $y = $opts{'y'};
157
158   my @glyphs = unpack("C*", $opts{string});
159   my $img = $opts{image};
160
161   my $glyph;
162   for $glyph (@glyphs) {
163     my @gmetrics = $self->get_glyph_data($glyph) or next;
164     $self->copy_glyph($glyph, $img, $x, $y);
165     $x += $gmetrics[5];
166   }
167 }