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