1package Imager::Font::Image; 2use 5.006; 3use strict; 4use Imager::Color; 5use File::Basename; 6use File::Spec; 7 8our @ISA = qw(Imager::Font); 9our $VERSION = "1.000"; 10 11sub NWIDTH () { 0 } 12sub PWIDTH () { 2 } 13sub GDESCENT () { 1 } 14sub GASCENT () { 3 } 15sub DESCENT () { 4 } 16sub ASCENT () { 5 } 17 18 19our %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 71sub 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 100sub 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 128sub 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 139sub 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 153sub _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} 169