summaryrefslogtreecommitdiff
path: root/Master/tlpkg/tlperl0/lib/Imager/Font
diff options
context:
space:
mode:
Diffstat (limited to 'Master/tlpkg/tlperl0/lib/Imager/Font')
-rwxr-xr-xMaster/tlpkg/tlperl0/lib/Imager/Font/BBox.pm282
-rwxr-xr-xMaster/tlpkg/tlperl0/lib/Imager/Font/FreeType2.pm233
-rwxr-xr-xMaster/tlpkg/tlperl0/lib/Imager/Font/Image.pm167
-rwxr-xr-xMaster/tlpkg/tlperl0/lib/Imager/Font/Truetype.pm127
-rwxr-xr-xMaster/tlpkg/tlperl0/lib/Imager/Font/Type1.pm191
-rwxr-xr-xMaster/tlpkg/tlperl0/lib/Imager/Font/Win32.pm61
-rwxr-xr-xMaster/tlpkg/tlperl0/lib/Imager/Font/Wrap.pm387
7 files changed, 1448 insertions, 0 deletions
diff --git a/Master/tlpkg/tlperl0/lib/Imager/Font/BBox.pm b/Master/tlpkg/tlperl0/lib/Imager/Font/BBox.pm
new file mode 100755
index 00000000000..3af88568f89
--- /dev/null
+++ b/Master/tlpkg/tlperl0/lib/Imager/Font/BBox.pm
@@ -0,0 +1,282 @@
+package Imager::Font::BBox;
+use strict;
+use vars qw($VERSION);
+
+$VERSION = "1.005";
+
+=head1 NAME
+
+Imager::Font::BBox - objects representing the bounding box of a string.
+
+=head1 SYNOPSIS
+
+ use Imager::Font;
+
+ # get the object
+ my $font = Imager::Font->new(...);
+ my $bbox = $font->bounding_box(string=>$text, size=>$size);
+
+ # methods
+ my $start = $bbox->start_offset;
+ my $left_bearing = $bbox->left_bearing;
+ my $right_bearing = $bbox->right_bearing;
+ my $end = $bbox->end_offset;
+ my $gdescent = $box->global_descent;
+ my $gascent = $bbox->global_ascent;
+ my $ascent = $bbox->ascent;
+ my $decent = $bbox->descent;
+ my $total_width = $bbox->total_width;
+ my $fheight = $bbox->font_height;
+ my $theight = $bbox->text_height;
+ my $display_width = $bbox->display_width;
+
+=head1 DESCRIPTION
+
+Objects of this class are returned by the Imager::Font bounding_box()
+method when it is called in scalar context.
+
+This will hopefully make the information from this method more
+accessible.
+
+=head1 METHODS
+
+=over
+
+=item start_offset()
+
+=item neg_width
+
+=item left_bearing
+
+Returns the horizonatal offset from the selected drawing location to
+the left edge of the first character drawn. If this is positive, the
+first glyph is to the right of the drawing location.
+
+The alias neg_width() is present to match the bounding_box()
+documentation for list context.
+
+The alias left_bearing() is present to match font terminology.
+
+=cut
+
+sub start_offset {
+ return $_[0][0];
+}
+
+sub neg_width {
+ return $_[0][0];
+}
+
+sub left_bearing {
+ return $_[0][0];
+}
+
+=item advance_width()
+
+The advance width of the string, if the driver supports that,
+otherwise the same as end_offset.
+
+=cut
+
+sub advance_width {
+ my $self = shift;
+
+ @$self > 6 ? $self->[6] : $self->[2];
+}
+
+=item right_bearing
+
+The distance from the right of the last glyph to the end of the advance
+point.
+
+If the glyph overflows the right side of the advance width this value
+is negative.
+
+=cut
+
+sub right_bearing {
+ my $self = shift;
+
+ @$self >= 8 && return $self->[7]; # driver gives it to us
+
+ # otherwise the closest we have is the difference between the
+ # end_pos and advance_width
+ return $self->advance_width - $self->pos_width;
+}
+
+=item display_width
+
+The distance from the left-most pixel of the left-most glyph to the
+right-most pixel of the right-most glyph.
+
+Equals advance_width - left_bearing - right_bearing (and implemented
+that way.)
+
+=cut
+
+sub display_width {
+ my ($self) = @_;
+
+ $self->advance_width - $self->left_bearing - $self->right_bearing;
+}
+
+=item global_descent()
+
+The lowest position relative to the font baseline that any character
+in the font reaches in the character cell. Normally negative.
+
+At least one font we've seen has reported a positive number for this.
+
+=cut
+
+sub global_descent {
+ return $_[0][1];
+}
+
+=item global_ascent()
+
+The highest position relative to the font baseline that any character
+in the font reaches in the character cell. Normally positive.
+
+=cut
+
+sub global_ascent {
+ return $_[0][3];
+}
+
+=item descent()
+
+The lowest position relative to the font baseline that any character
+in the supplied string reaches. Negative when any character's glyph
+reaches below the baseline.
+
+=cut
+
+sub descent {
+ return $_[0][4];
+}
+
+=item ascent()
+
+The highest position relative to the font baseline that any character
+in the supplied string reaches. Positive if any character's glyph
+reaches above the baseline.
+
+=cut
+
+sub ascent {
+ return $_[0][5];
+}
+
+=item font_height()
+
+The maximum displayed height of any string using this font.
+
+=cut
+
+sub font_height {
+ my $self = shift;
+ $self->global_ascent - $self->global_descent;
+}
+
+=item text_height()
+
+The displayed height of the supplied string.
+
+=cut
+
+sub text_height {
+ my $self = shift;
+
+ $self->ascent - $self->descent;
+}
+
+=back
+
+=head1 OBSOLETE METHODS
+
+These methods include bugs kept for backwards compatibility and
+shouldn't be used in new code.
+
+=over
+
+=item total_width()
+
+The total displayed width of the string.
+
+New code should use display_width().
+
+This depends on end_offset(), and is limited by it's backward
+compatibility.
+
+=cut
+
+sub total_width {
+ my $self = shift;
+
+ $self->end_offset - $self->start_offset;
+}
+
+=item end_offset
+
+=item pos_width
+
+The offset from the selected drawing location to the right edge of the
+last character drawn. Should always be positive.
+
+You can use the alias pos_width() if you are used to the
+bounding_box() documentation for list context.
+
+For backwards compatibility this method returns the maximum of the
+advance width and the offset of the right edge of the last glyph.
+
+=cut
+
+sub end_offset {
+ return $_[0][2];
+}
+
+sub pos_width {
+ return $_[0][2];
+}
+
+=back
+
+=head1 INTERNAL FUNCTIONS
+
+=over
+
+=item new(...)
+
+Called by Imager::Font->bounding_box() to create the object.
+
+=cut
+
+sub new {
+ my $class = shift;
+ return bless [ @_ ], $class;
+}
+
+=back
+
+=head1 BUGS
+
+Doesn't reproduce the functionality that you get using the x and y
+parameters to Imager::Font->bounding_box(). I considered:
+
+ my ($left, $top, $right, $bottom) = $box->offset(x=>$x, y=>$y)
+
+but this is about as clumsy as the original.
+
+=head1 AUTHOR
+
+Tony Cook <tony@develop-help.com>
+
+=head1 SEE ALSO
+
+Imager(3), Imager::Font(3)
+
+=cut
+
+1;
+
diff --git a/Master/tlpkg/tlperl0/lib/Imager/Font/FreeType2.pm b/Master/tlpkg/tlperl0/lib/Imager/Font/FreeType2.pm
new file mode 100755
index 00000000000..4f0ac2e4358
--- /dev/null
+++ b/Master/tlpkg/tlperl0/lib/Imager/Font/FreeType2.pm
@@ -0,0 +1,233 @@
+package Imager::Font::FreeType2;
+use strict;
+use Imager::Color;
+use vars qw(@ISA $VERSION);
+@ISA = qw(Imager::Font);
+
+$VERSION = "1.013";
+
+*_first = \&Imager::Font::_first;
+
+sub new {
+ my $class = shift;
+ my %hsh=(color=>Imager::Color->new(255,0,0,0),
+ size=>15,
+ @_);
+
+ unless ($hsh{file}) {
+ $Imager::ERRSTR = "No font file specified";
+ return;
+ }
+ unless (-e $hsh{file}) {
+ $Imager::ERRSTR = "Font file $hsh{file} not found";
+ return;
+ }
+ unless ($Imager::formats{ft2}) {
+ $Imager::ERRSTR = "Freetype2 not supported in this build";
+ return;
+ }
+ my $id = i_ft2_new($hsh{file}, $hsh{'index'} || 0);
+ unless ($id) { # the low-level code may miss some error handling
+ $Imager::ERRSTR = Imager::_error_as_msg();
+ return;
+ }
+ return bless {
+ id => $id,
+ aa => $hsh{aa} || 0,
+ file => $hsh{file},
+ type => 't1',
+ size => $hsh{size},
+ color => $hsh{color},
+ utf8 => $hsh{utf8},
+ vlayout => $hsh{vlayout},
+ }, $class;
+}
+
+sub _draw {
+ my $self = shift;
+ my %input = @_;
+ if (exists $input{channel}) {
+ i_ft2_cp($self->{id}, $input{image}{IMG}, $input{'x'}, $input{'y'},
+ $input{channel}, $input{size}, $input{sizew} || 0,
+ $input{string}, , $input{align}, $input{aa}, $input{vlayout},
+ $input{utf8});
+ } else {
+ i_ft2_text($self->{id}, $input{image}{IMG},
+ $input{'x'}, $input{'y'},
+ $input{color}, $input{size}, $input{sizew} || 0,
+ $input{string}, $input{align}, $input{aa}, $input{vlayout},
+ $input{utf8});
+ }
+}
+
+sub _bounding_box {
+ my $self = shift;
+ my %input = @_;
+
+ return i_ft2_bbox($self->{id}, $input{size}, $input{sizew}, $input{string},
+ $input{utf8});
+}
+
+sub dpi {
+ my $self = shift;
+ my @old = i_ft2_getdpi($self->{id});
+ if (@_) {
+ my %hsh = @_;
+ my $result;
+ unless ($hsh{xdpi} && $hsh{ydpi}) {
+ if ($hsh{dpi}) {
+ $hsh{xdpi} = $hsh{ydpi} = $hsh{dpi};
+ }
+ else {
+ $Imager::ERRSTR = "dpi method requires xdpi and ydpi or just dpi";
+ return;
+ }
+ i_ft2_setdpi($self->{id}, $hsh{xdpi}, $hsh{ydpi}) or return;
+ }
+ }
+
+ return @old;
+}
+
+sub hinting {
+ my ($self, %opts) = @_;
+
+ i_ft2_sethinting($self->{id}, $opts{hinting} || 0);
+}
+
+sub _transform {
+ my $self = shift;
+
+ my %hsh = @_;
+ my $matrix = $hsh{matrix} or return undef;
+
+ return i_ft2_settransform($self->{id}, $matrix)
+}
+
+sub utf8 {
+ return 1;
+}
+
+# check if the font has the characters in the given string
+sub has_chars {
+ my ($self, %hsh) = @_;
+
+ unless (defined $hsh{string} && length $hsh{string}) {
+ $Imager::ERRSTR = "No string supplied to \$font->has_chars()";
+ return;
+ }
+ return i_ft2_has_chars($self->{id}, $hsh{string},
+ _first($hsh{'utf8'}, $self->{utf8}, 0));
+}
+
+sub face_name {
+ my ($self) = @_;
+
+ i_ft2_face_name($self->{id});
+}
+
+sub can_glyph_names {
+ i_ft2_can_do_glyph_names();
+}
+
+sub glyph_names {
+ my ($self, %input) = @_;
+
+ my $string = $input{string};
+ defined $string
+ or return Imager->_set_error("no string parameter passed to glyph_names");
+ my $utf8 = _first($input{utf8}, 0);
+ my $reliable_only = _first($input{reliable_only}, 1);
+
+ my @names = i_ft2_glyph_name($self->{id}, $string, $utf8, $reliable_only);
+ @names or return Imager->_set_error(Imager->_error_as_msg);
+
+ return @names if wantarray;
+ return pop @names;
+}
+
+sub is_mm {
+ my ($self) = @_;
+
+ i_ft2_is_multiple_master($self->{id});
+}
+
+sub mm_axes {
+ my ($self) = @_;
+
+ my ($num_axis, $num_design, @axes) =
+ i_ft2_get_multiple_masters($self->{id})
+ or return Imager->_set_error(Imager->_error_as_msg);
+
+ return @axes;
+}
+
+sub set_mm_coords {
+ my ($self, %opts) = @_;
+
+ $opts{coords}
+ or return Imager->_set_error("Missing coords parameter");
+ ref($opts{coords}) && $opts{coords} =~ /ARRAY\(0x[\da-f]+\)$/
+ or return Imager->_set_error("coords parameter must be an ARRAY ref");
+
+ i_ft2_set_mm_coords($self->{id}, @{$opts{coords}})
+ or return Imager->_set_error(Imager->_error_as_msg);
+
+ return 1;
+}
+
+1;
+
+__END__
+
+=head1 NAME
+
+ Imager::Font::FreeType2 - low-level functions for FreeType2 text output
+
+=head1 DESCRIPTION
+
+Imager::Font creates a Imager::Font::FreeType2 object when asked to.
+
+See Imager::Font to see how to use this type.
+
+This class provides low-level functions that require the caller to
+perform data validation.
+
+This driver supports:
+
+=over
+
+=item transform()
+
+=item dpi()
+
+=item draw()
+
+The following parameters:
+
+=over
+
+=item utf8
+
+=item vlayour
+
+=item sizew
+
+=back
+
+=back
+
+=head2 Special behaviors
+
+If you call transform() to set a transformation matrix, hinting will
+be switched off. This prevents sudden jumps in the size of the text
+caused by the hinting when the transformation is the identity matrix.
+If for some reason you want hinting enabled, use
+$font->hinting(hinting=>1) to re-enable hinting. This will need to be
+called after I<each> call to transform().
+
+=head1 AUTHOR
+
+Addi, Tony
+
+=cut
diff --git a/Master/tlpkg/tlperl0/lib/Imager/Font/Image.pm b/Master/tlpkg/tlperl0/lib/Imager/Font/Image.pm
new file mode 100755
index 00000000000..19f3920ffe4
--- /dev/null
+++ b/Master/tlpkg/tlperl0/lib/Imager/Font/Image.pm
@@ -0,0 +1,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];
+ }
+}
diff --git a/Master/tlpkg/tlperl0/lib/Imager/Font/Truetype.pm b/Master/tlpkg/tlperl0/lib/Imager/Font/Truetype.pm
new file mode 100755
index 00000000000..24ffd098340
--- /dev/null
+++ b/Master/tlpkg/tlperl0/lib/Imager/Font/Truetype.pm
@@ -0,0 +1,127 @@
+package Imager::Font::Truetype;
+use strict;
+use vars qw(@ISA $VERSION);
+@ISA = qw(Imager::Font);
+
+$VERSION = "1.010";
+
+*_first = \&Imager::Font::_first;
+
+sub new {
+ my $class = shift;
+ my %hsh=(color=>Imager::Color->new(255,0,0,0),
+ size=>15,
+ @_);
+
+ unless ($hsh{file}) {
+ $Imager::ERRSTR = "No font file specified";
+ return;
+ }
+ unless (-e $hsh{file}) {
+ $Imager::ERRSTR = "Font file $hsh{file} not found";
+ return;
+ }
+ unless ($Imager::formats{tt}) {
+ $Imager::ERRSTR = "Type 1 fonts not supported in this build";
+ return;
+ }
+ my $id = Imager::i_tt_new($hsh{file});
+ unless ($id) { # the low-level code may miss some error handling
+ $Imager::ERRSTR = Imager::_error_as_msg();
+ return;
+ }
+ return bless {
+ id => $id,
+ aa => $hsh{aa} || 0,
+ file => $hsh{file},
+ type => 'tt',
+ size => $hsh{size},
+ color => $hsh{color},
+ }, $class;
+}
+
+sub _draw {
+ my $self = shift;
+ my %input = @_;
+
+ # note that the string length parameter is ignored and calculated in
+ # XS with SvPV(), since we want the number of bytes rather than the
+ # number of characters, which is what we'd get in perl for a UTF8
+ # encoded string in 5.6 and later
+
+ if ( exists $input{channel} ) {
+ Imager::i_tt_cp($self->{id},$input{image}{IMG},
+ $input{'x'}, $input{'y'}, $input{channel}, $input{size},
+ $input{string}, length($input{string}),$input{aa},
+ $input{utf8}, $input{align});
+ } else {
+ Imager::i_tt_text($self->{id}, $input{image}{IMG},
+ $input{'x'}, $input{'y'}, $input{color},
+ $input{size}, $input{string},
+ length($input{string}), $input{aa}, $input{utf8},
+ $input{align});
+ }
+}
+
+sub _bounding_box {
+ my $self = shift;
+ my %input = @_;
+ return Imager::i_tt_bbox($self->{id}, $input{size},
+ $input{string}, length($input{string}),
+ $input{utf8});
+}
+
+sub utf8 { 1 }
+
+# check if the font has the characters in the given string
+sub has_chars {
+ my ($self, %hsh) = @_;
+
+ unless (defined $hsh{string} && length $hsh{string}) {
+ $Imager::ERRSTR = "No string supplied to \$font->has_chars()";
+ return;
+ }
+ return Imager::i_tt_has_chars($self->{id}, $hsh{string},
+ _first($hsh{'utf8'}, $self->{utf8}, 0));
+}
+
+sub face_name {
+ my ($self) = @_;
+
+ Imager::i_tt_face_name($self->{id});
+}
+
+sub glyph_names {
+ my ($self, %input) = @_;
+
+ my $string = $input{string};
+ defined $string
+ or return Imager->_set_error("no string parameter passed to glyph_names");
+ my $utf8 = _first($input{utf8} || 0);
+
+ Imager::i_tt_glyph_name($self->{id}, $string, $utf8);
+}
+
+1;
+
+__END__
+
+=head1 NAME
+
+ Imager::Font::Truetype - low-level functions for Truetype fonts
+
+=head1 DESCRIPTION
+
+Imager::Font creates a Imager::Font::Truetype object when asked to create
+a font object based on a .ttf file.
+
+See Imager::Font to see how to use this type.
+
+This class provides low-level functions that require the caller to
+perform data validation.
+
+=head1 AUTHOR
+
+Addi, Tony
+
+=cut
diff --git a/Master/tlpkg/tlperl0/lib/Imager/Font/Type1.pm b/Master/tlpkg/tlperl0/lib/Imager/Font/Type1.pm
new file mode 100755
index 00000000000..d9e15e7daaf
--- /dev/null
+++ b/Master/tlpkg/tlperl0/lib/Imager/Font/Type1.pm
@@ -0,0 +1,191 @@
+package Imager::Font::Type1;
+use strict;
+use Imager::Color;
+use vars qw(@ISA $VERSION);
+@ISA = qw(Imager::Font);
+
+$VERSION = "1.010";
+
+*_first = \&Imager::Font::_first;
+
+my $t1aa;
+
+# $T1AA is in there because for some reason (probably cache related) antialiasing
+# is a system wide setting in t1 lib.
+
+sub t1_set_aa_level {
+ if (!defined $t1aa or $_[0] != $t1aa) {
+ Imager::i_t1_set_aa($_[0]);
+ $t1aa=$_[0];
+ }
+}
+
+sub new {
+ my $class = shift;
+ my %hsh=(color=>Imager::Color->new(255,0,0,0),
+ size=>15,
+ @_);
+
+ unless ($hsh{file}) {
+ $Imager::ERRSTR = "No font file specified";
+ return;
+ }
+ unless (-e $hsh{file}) {
+ $Imager::ERRSTR = "Font file $hsh{file} not found";
+ return;
+ }
+ unless ($Imager::formats{t1}) {
+ $Imager::ERRSTR = "Type 1 fonts not supported in this build";
+ return;
+ }
+ unless ($hsh{file} =~ m!^/! || $hsh{file} =~ m!^\./!) {
+ $hsh{file} = './' . $hsh{file};
+ }
+
+ if($hsh{afm}) {
+ unless (-e $hsh{afm}) {
+ $Imager::ERRSTR = "Afm file $hsh{afm} not found";
+ return;
+ }
+ unless ($hsh{afm} =~ m!^/! || $hsh{afm} =~ m!^\./!) {
+ $hsh{file} = './' . $hsh{file};
+ }
+ } else {
+ $hsh{afm} = 0;
+ }
+
+ my $id = Imager::i_t1_new($hsh{file},$hsh{afm});
+ unless ($id >= 0) { # the low-level code may miss some error handling
+ $Imager::ERRSTR = "Could not load font ($id)";
+ return;
+ }
+ return bless {
+ id => $id,
+ aa => $hsh{aa} || 0,
+ file => $hsh{file},
+ type => 't1',
+ size => $hsh{size},
+ color => $hsh{color},
+ }, $class;
+}
+
+sub _draw {
+ my $self = shift;
+ my %input = @_;
+ t1_set_aa_level($input{aa});
+ my $flags = '';
+ $flags .= 'u' if $input{underline};
+ $flags .= 's' if $input{strikethrough};
+ $flags .= 'o' if $input{overline};
+ if (exists $input{channel}) {
+ Imager::i_t1_cp($input{image}{IMG}, $input{'x'}, $input{'y'},
+ $input{channel}, $self->{id}, $input{size},
+ $input{string}, length($input{string}), $input{align},
+ $input{utf8}, $flags);
+ } else {
+ Imager::i_t1_text($input{image}{IMG}, $input{'x'}, $input{'y'},
+ $input{color}, $self->{id}, $input{size},
+ $input{string}, length($input{string}),
+ $input{align}, $input{utf8}, $flags);
+ }
+
+ return $self;
+}
+
+sub _bounding_box {
+ my $self = shift;
+ my %input = @_;
+ my $flags = '';
+ $flags .= 'u' if $input{underline};
+ $flags .= 's' if $input{strikethrough};
+ $flags .= 'o' if $input{overline};
+ return Imager::i_t1_bbox($self->{id}, $input{size}, $input{string},
+ length($input{string}), $input{utf8}, $flags);
+}
+
+# check if the font has the characters in the given string
+sub has_chars {
+ my ($self, %hsh) = @_;
+
+ unless (defined $hsh{string} && length $hsh{string}) {
+ $Imager::ERRSTR = "No string supplied to \$font->has_chars()";
+ return;
+ }
+ return Imager::i_t1_has_chars($self->{id}, $hsh{string},
+ _first($hsh{'utf8'}, $self->{utf8}, 0));
+}
+
+sub utf8 {
+ 1;
+}
+
+sub face_name {
+ my ($self) = @_;
+
+ Imager::i_t1_face_name($self->{id});
+}
+
+sub glyph_names {
+ my ($self, %input) = @_;
+
+ my $string = $input{string};
+ defined $string
+ or return Imager->_set_error("no string parameter passed to glyph_names");
+ my $utf8 = _first($input{utf8} || 0);
+
+ Imager::i_t1_glyph_name($self->{id}, $string, $utf8);
+}
+
+
+1;
+
+__END__
+
+=head1 NAME
+
+ Imager::Font::Type1 - low-level functions for Type1 fonts
+
+=head1 DESCRIPTION
+
+Imager::Font creates a Imager::Font::Type1 object when asked to create
+a font object based on a .pfb file.
+
+See Imager::Font to see how to use this type.
+
+This class provides low-level functions that require the caller to
+perform data validation
+
+By default Imager no longer creates the F<t1lib.log> log file. You
+can re-enable that by calling Imager::init() with the C<t1log> option:
+
+ Imager::init(t1log=>1);
+
+This must be called before creating any fonts.
+
+Currently specific to Imager::Font::Type1, you can use the following
+flags when drawing text or calculating a bounding box:
+
+=over
+
+=item underline
+
+Draw the text with an underline.
+
+=item overline
+
+Draw the text with an overline.
+
+=item strikethrough
+
+Draw the text with a strikethrough.
+
+=back
+
+Obviously, if you're calculating the bounding box the size of the line
+is included in the box, and the line isn't drawn :)
+
+=head1 AUTHOR
+
+Addi, Tony
+
+=cut
diff --git a/Master/tlpkg/tlperl0/lib/Imager/Font/Win32.pm b/Master/tlpkg/tlperl0/lib/Imager/Font/Win32.pm
new file mode 100755
index 00000000000..790d9ae8b09
--- /dev/null
+++ b/Master/tlpkg/tlperl0/lib/Imager/Font/Win32.pm
@@ -0,0 +1,61 @@
+package Imager::Font::Win32;
+use strict;
+use vars qw(@ISA $VERSION);
+@ISA = qw(Imager::Font);
+
+$VERSION = "1.005";
+
+# called by Imager::Font::new()
+# since Win32's HFONTs include the size information this
+# is just a stub
+sub new {
+ my ($class, %opts) = @_;
+
+ return bless \%opts, $class;
+}
+
+sub _bounding_box {
+ my ($self, %opts) = @_;
+
+ my @bbox = Imager::i_wf_bbox($self->{face}, $opts{size}, $opts{string}, $opts{utf8});
+}
+
+sub _draw {
+ my $self = shift;
+
+ my %input = @_;
+ if (exists $input{channel}) {
+ Imager::i_wf_cp($self->{face}, $input{image}{IMG}, $input{x}, $input{'y'},
+ $input{channel}, $input{size},
+ $input{string}, $input{align}, $input{aa}, $input{utf8});
+ }
+ else {
+ Imager::i_wf_text($self->{face}, $input{image}{IMG}, $input{x},
+ $input{'y'}, $input{color}, $input{size},
+ $input{string}, $input{align}, $input{aa}, $input{utf8});
+ }
+}
+
+
+sub utf8 {
+ return 1;
+}
+
+1;
+
+__END__
+
+=head1 NAME
+
+Imager::Font::Win32 - uses Win32 GDI services for text output
+
+=head1 SYNOPSIS
+
+ my $font = Imager::Font->new(face=>"Arial");
+
+=head1 DESCRIPTION
+
+Implements font support using Win32 GDI calls. See Imager::Font for
+usage information.
+
+=cut
diff --git a/Master/tlpkg/tlperl0/lib/Imager/Font/Wrap.pm b/Master/tlpkg/tlperl0/lib/Imager/Font/Wrap.pm
new file mode 100755
index 00000000000..5e061d76eab
--- /dev/null
+++ b/Master/tlpkg/tlperl0/lib/Imager/Font/Wrap.pm
@@ -0,0 +1,387 @@
+package Imager::Font::Wrap;
+use strict;
+use Imager;
+use Imager::Font;
+use vars qw($VERSION);
+
+$VERSION = "1.002";
+
+*_first = \&Imager::Font::_first;
+
+# we can't accept the utf8 parameter, too hard at this level
+
+# the %state contains:
+# font - the font
+# im - the image
+# x - the left position
+# w - the width
+# justify - fill, left, right or center
+
+sub _format_line {
+ my ($state, $spaces, $text, $fill) = @_;
+
+ $text =~ s/ +$//;
+ my $box = $state->{font}->bounding_box(string=>$text,
+ size=>$state->{size});
+
+ my $y = $state->{linepos} + $box->global_ascent;
+
+ if ($state->{bottom}
+ && $state->{linepos} + $box->font_height > $state->{bottom}) {
+ $state->{full} = 1;
+ return 0;
+ }
+
+ if ($text =~ /\S/ && $state->{im}) {
+ my $justify = $fill ? $state->{justify} :
+ $state->{justify} eq 'fill' ? 'left' : $state->{justify};
+ if ($justify ne 'fill') {
+ my $x = $state->{x};
+ if ($justify eq 'right') {
+ $x += $state->{w} - $box->advance_width;
+ }
+ elsif ($justify eq 'center') {
+ $x += ($state->{w} - $box->advance_width) / 2;
+ }
+ $state->{font}->draw(image=>$state->{im}, string=>$text,
+ x=>$x, 'y'=>$y,
+ size=>$state->{size}, %{$state->{input}});
+ }
+ else {
+ (my $nospaces = $text) =~ tr/ //d;
+ my $nospace_bbox = $state->{font}->bounding_box(string=>$nospaces,
+ size=>$state->{size});
+ my $gap = $state->{w} - $nospace_bbox->advance_width;
+ my $x = $state->{x};
+ $spaces = $text =~ tr/ / /;
+ while (length $text) {
+ if ($text =~ s/^(\S+)//) {
+ my $word = $1;
+ my $bbox = $state->{font}->bounding_box(string=>$word,
+ size=>$state->{size});
+ $state->{font}->draw(image=>$state->{im}, string=>$1,
+ x=>$x, 'y'=>$y,
+ size=>$state->{size}, %{$state->{input}});
+ $x += $bbox->advance_width;
+ }
+ elsif ($text =~ s/^( +)//) {
+ my $sep = $1;
+ my $advance = int($gap * length($sep) / $spaces);
+ $spaces -= length $sep;
+ $gap -= $advance;
+ $x += $advance;
+ }
+ else {
+ die "This shouldn't happen\n";
+ }
+ }
+ }
+ }
+ $state->{linepos} += $box->font_height + $state->{linegap};
+
+ 1;
+}
+
+sub wrap_text {
+ my $class = shift;
+ my %input = @_;
+
+ # try to get something useful
+ my $x = _first(delete $input{'x'}, 0);
+ my $y = _first(delete $input{'y'}, 0);
+ exists $input{image}
+ or return Imager->_set_error('No image parameter supplied');
+ my $im = delete $input{image};
+ my $imerr = $im || 'Imager';
+ my $width = delete $input{width};
+ if (!defined $width) {
+ defined $im && $im->getwidth > $x
+ or return $imerr->_set_error("No width supplied and can't guess");
+ $width = $im->getwidth - $x;
+ }
+ my $font = delete $input{font}
+ or return $imerr->_set_error("No font parameter supplied");
+ my $size = _first(delete $input{size}, $font->{size});
+ defined $size
+ or return $imerr->_set_error("No font size supplied");
+
+ 2 * $size < $width
+ or return $imerr->_set_error("Width too small for font size");
+
+ my $text = delete $input{string};
+ defined $text
+ or return $imerr->_set_error("No string parameter supplied");
+
+ my $justify = _first($input{justify}, "left");
+
+ my %state =
+ (
+ font => $font,
+ im => $im,
+ x => $x,
+ w => $width,
+ justify => $justify,
+ 'y' => $y,
+ linepos=>$y,
+ size=>$size,
+ input => \%input,
+ linegap => delete $input{linegap} || 0,
+ );
+ $state{height} = delete $input{height};
+ if ($state{height}) {
+ $state{bottom} = $y + $state{height};
+ }
+ my $line = '';
+ my $spaces = 0;
+ my $charpos = 0;
+ my $linepos = 0;
+ pos($text) = 0; # avoid a warning
+ while (pos($text) < length($text)) {
+ #print pos($text), "\n";
+ if ($text =~ /\G( +)/gc) {
+ #print "spaces\n";
+ $line .= $1;
+ $spaces += length($1);
+ }
+ elsif ($text =~ /\G(?:\x0D\x0A?|\x0A\x0D?)/gc) {
+ #print "newline\n";
+ _format_line(\%state, $spaces, $line, 0)
+ or last;
+ $line = '';
+ $spaces = 0;
+ $linepos = pos($text);
+ }
+ elsif ($text =~ /\G(\S+)/gc) {
+ #print "word\n";
+ my $word = $1;
+ my $bbox = $font->bounding_box(string=>$line . $word, size=>$size);
+ if ($bbox->advance_width > $width) {
+ _format_line(\%state, $spaces, $line, 1)
+ or last;
+ $line = '';
+ $spaces = 0;
+ $linepos = pos($text) - length($word);
+ }
+ $line .= $word;
+ # check for long words
+ $bbox = $font->bounding_box(string=>$line, size=>$size);
+ while ($bbox->advance_width > $width) {
+ my $len = length($line) - 1;
+ $bbox = $font->bounding_box(string=>substr($line, 0, $len),
+ size=>$size);
+ while ($bbox->advance_width > $width) {
+ --$len;
+ $bbox = $font->bounding_box(string=>substr($line, 0, $len),
+ size=>$size);
+ }
+ _format_line(\%state, 0, substr($line, 0, $len), 0)
+ or last;
+ $line = substr($line, $len);
+ $bbox = $font->bounding_box(string=>$line, size=>$size);
+ $linepos = pos($text) - length($line);
+ }
+ }
+ elsif ($text =~ /\G\s/gc) {
+ # skip a single unrecognized whitespace char
+ #print "skip\n";
+ $linepos = pos($text);
+ }
+ }
+
+ if (length $line && !$state{full}) {
+ $linepos += length $line
+ if _format_line(\%state, 0, $line, 0);
+ }
+
+ if ($input{savepos}) {
+ ${$input{savepos}} = $linepos;
+ }
+
+ return ($x, $y, $x+$width, $state{linepos});
+}
+
+1;
+
+__END__
+
+=head1 NAME
+
+ Imager::Font::Wrap - simple wrapped text output
+
+=head1 SYNOPSIS
+
+ use Imager::Font::Wrap;
+
+ my $img = Imager->new(xsize=>$xsize, ysize=>$ysize);
+
+ my $font = Imager::Font->new(file=>$fontfile);
+
+ my $string = "..."; # text with or without newlines
+
+ Imager::Font::Wrap->wrap_text( image => $img,
+ font => $font,
+ string => $string,
+ x => $left,
+ y => $top,
+ width => $width,
+ .... );
+
+=head1 DESCRIPTION
+
+This is a simple text wrapper with options to control the layout of
+text within the line.
+
+You can control the position, width and height of the text with the
+C<image>, C<x>, C<y>, C<width> and C<height> options.
+
+You can simply calculate space usage by setting C<image> to C<undef>,
+or set C<savepos> to see how much text can fit within the given
+C<height>.
+
+=over
+
+=item wrap_text
+
+Draw word-wrapped text.
+
+=over
+
+=item x
+
+=item y
+
+The top-left corner of the rectangle the text is formatted into.
+Defaults to (0, 0).
+
+=item width
+
+The width of the formatted text in pixels. Defaults to the horizontal
+gap between the top-left corner and the right edge of the image. If
+no image is supplied then this is required.
+
+=item height
+
+The maximum height of the formated text in pixels. Not required.
+
+=item savepos
+
+The amount of text consumed (as a count of characters) will be stored
+into the scalar this refers to.
+
+ my $pagenum = 1;
+ my $string = "...";
+ my $font = ...;
+ my $savepos;
+
+ while (length $string) {
+ my $img = Imager->new(xsize=>$xsize, ysize=>$ysize);
+ Imager::Font::Wrap->wrap_text(string=>$string, font=>$font,
+ image=>$img, savepos => \$savepos)
+ or die $img->errstr;
+ $savepos > 0
+ or die "Could not fit any text on page\n";
+ $string = substr($string, $savepos);
+ $img->write(file=>"page$pagenum.ppm");
+ }
+
+=item image
+
+The image to render the text to. Can be supplied as C<undef> to
+simply calculate the bounding box.
+
+=item font
+
+The font used to render the text. Required.
+
+=item size
+
+The size to render the font in. Defaults to the size stored in the
+font object. Required if it isn't stored in the font object.
+
+=item string
+
+The text to render. This can contain non-whitespace, blanks (ASCII
+0x20), and newlines.
+
+Newlines must match /(?:\x0A\x0D?|\x0D\x0A?)/. Whitespace other than
+blanks and newlines are completely ignored.
+
+=item justify
+
+The way text is formatted within each line. Possible values include:
+
+=over
+
+=item left
+
+Left aligned against the left edge of the text box.
+
+=item right
+
+Right aligned against the right edge of the text box.
+
+=item center
+
+Centered horizontally in the text box.
+
+=item fill
+
+All but the final line of the paragraph has spaces expanded so that
+the line fills from the left to the right edge of the text box.
+
+=back
+
+=item linegap
+
+Gap between lines of text in pixels. This is in addition to the size
+from $font->font_height. Can be positive or negative. Default 0.
+
+=back
+
+Any other parameters are passed onto Imager::Font->draw().
+
+Returns a list:
+
+ ($left, $top, $right, $bottom)
+
+which are the bounds of the space used to layout the text.
+
+If C<height> is set then this is the space used within that height.
+
+You can use this to calculate the space required to format the text
+before doing it:
+
+ my ($left, $top, $right, $bottom) =
+ Imager::Font::Wrap->wrap_text(string => $string,
+ font => $font,
+ width => $xsize);
+ my $img = Imager->new(xsize=>$xsize, ysize=>$bottom);
+ Imager::Font::Wrap->wrap_text(string => $string,
+ font => $font,
+ width => $xsize,
+ image => $image);
+
+=back
+
+=head1 BUGS
+
+Imager::Font can handle UTF8 encoded text itself, but this module
+doesn't support that (and probably won't). This could probably be
+done with regex magic.
+
+Currently ignores the C<sizew> parameter, if you supply one it will be
+supplied to the draw() function and the text will be too short or too
+long for the C<width>.
+
+Uses a simplistic text model, which is why there's no hyphenation, and
+no tabs.
+
+=head1 AUTHOR
+
+Tony Cook <tony@develop-help.com>
+
+=head1 SEE ALSO
+
+Imager(3), Imager::Font(3)
+
+=cut