diff options
Diffstat (limited to 'Master/tlpkg/tlperl0/lib/Imager/Font')
-rwxr-xr-x | Master/tlpkg/tlperl0/lib/Imager/Font/BBox.pm | 282 | ||||
-rwxr-xr-x | Master/tlpkg/tlperl0/lib/Imager/Font/FreeType2.pm | 233 | ||||
-rwxr-xr-x | Master/tlpkg/tlperl0/lib/Imager/Font/Image.pm | 167 | ||||
-rwxr-xr-x | Master/tlpkg/tlperl0/lib/Imager/Font/Truetype.pm | 127 | ||||
-rwxr-xr-x | Master/tlpkg/tlperl0/lib/Imager/Font/Type1.pm | 191 | ||||
-rwxr-xr-x | Master/tlpkg/tlperl0/lib/Imager/Font/Win32.pm | 61 | ||||
-rwxr-xr-x | Master/tlpkg/tlperl0/lib/Imager/Font/Wrap.pm | 387 |
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 |