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