r9527 - in /trunk/libfont-ttf-perl: ./ debian/ lib/Font/ lib/Font/TTF/
gregoa-guest at users.alioth.debian.org
gregoa-guest at users.alioth.debian.org
Sat Nov 17 20:28:29 UTC 2007
Author: gregoa-guest
Date: Sat Nov 17 20:28:29 2007
New Revision: 9527
URL: http://svn.debian.org/wsvn/?sc=1&rev=9527
Log:
New upstream release.
Added:
trunk/libfont-ttf-perl/TODO
- copied unchanged from r9526, branches/upstream/libfont-ttf-perl/current/TODO
trunk/libfont-ttf-perl/lib/Font/TTF/Tags.pm
- copied unchanged from r9526, branches/upstream/libfont-ttf-perl/current/lib/Font/TTF/Tags.pm
Modified:
trunk/libfont-ttf-perl/MANIFEST
trunk/libfont-ttf-perl/MANIFEST.SKIP
trunk/libfont-ttf-perl/META.yml
trunk/libfont-ttf-perl/Makefile.PL
trunk/libfont-ttf-perl/debian/changelog
trunk/libfont-ttf-perl/lib/Font/TTF.pm
trunk/libfont-ttf-perl/lib/Font/TTF/Anchor.pm
trunk/libfont-ttf-perl/lib/Font/TTF/Coverage.pm
trunk/libfont-ttf-perl/lib/Font/TTF/Font.pm
trunk/libfont-ttf-perl/lib/Font/TTF/GPOS.pm
trunk/libfont-ttf-perl/lib/Font/TTF/GSUB.pm
trunk/libfont-ttf-perl/lib/Font/TTF/Glyph.pm
trunk/libfont-ttf-perl/lib/Font/TTF/Maxp.pm
trunk/libfont-ttf-perl/lib/Font/TTF/Name.pm
trunk/libfont-ttf-perl/lib/Font/TTF/Table.pm
trunk/libfont-ttf-perl/lib/Font/TTF/Ttopen.pm
Modified: trunk/libfont-ttf-perl/MANIFEST
URL: http://svn.debian.org/wsvn/trunk/libfont-ttf-perl/MANIFEST?rev=9527&op=diff
==============================================================================
--- trunk/libfont-ttf-perl/MANIFEST (original)
+++ trunk/libfont-ttf-perl/MANIFEST Sat Nov 17 20:28:29 2007
@@ -54,6 +54,7 @@
lib/Font/TTF/PSNames.pm
lib/Font/TTF/Segarr.pm
lib/Font/TTF/Table.pm
+lib/Font/TTF/Tags.pm
lib/Font/TTF/Ttc.pm
lib/Font/TTF/Ttopen.pm
lib/Font/TTF/Useall.pm
@@ -68,3 +69,4 @@
MANIFEST.SKIP
META.yml
README.TXT
+TODO
Modified: trunk/libfont-ttf-perl/MANIFEST.SKIP
URL: http://svn.debian.org/wsvn/trunk/libfont-ttf-perl/MANIFEST.SKIP?rev=9527&op=diff
==============================================================================
--- trunk/libfont-ttf-perl/MANIFEST.SKIP (original)
+++ trunk/libfont-ttf-perl/MANIFEST.SKIP Sat Nov 17 20:28:29 2007
@@ -4,6 +4,8 @@
\.bak
CVS/
\.tar
+\.tgz
+\.old
misc/
Build/
exes/
@@ -17,3 +19,8 @@
pm_to_blib
\~$
dev/
+build/
+dists/
+^libfont-
+description-pak
+^doc
Modified: trunk/libfont-ttf-perl/META.yml
URL: http://svn.debian.org/wsvn/trunk/libfont-ttf-perl/META.yml?rev=9527&op=diff
==============================================================================
--- trunk/libfont-ttf-perl/META.yml (original)
+++ trunk/libfont-ttf-perl/META.yml Sat Nov 17 20:28:29 2007
@@ -1,7 +1,7 @@
# http://module-build.sourceforge.net/META-spec.html
#XXXXXXX This is a prototype!!! It will change in the future!!! XXXXX#
name: Font-TTF
-version: 0.41
+version: 0.42
version_from: lib/Font/TTF.pm
installdirs: site
requires:
Modified: trunk/libfont-ttf-perl/Makefile.PL
URL: http://svn.debian.org/wsvn/trunk/libfont-ttf-perl/Makefile.PL?rev=9527&op=diff
==============================================================================
--- trunk/libfont-ttf-perl/Makefile.PL (original)
+++ trunk/libfont-ttf-perl/Makefile.PL Sat Nov 17 20:28:29 2007
@@ -1,4 +1,19 @@
use ExtUtils::MakeMaker;
+use Getopt::Std;
+
+getopts('d:rv:');
+
+%pbuilderopts = (
+ 'gutsy' => '--bindmounts /media/hosk_1'
+ );
+
+$opt_v ||= 1;
+
+if ($^O eq 'linux' && !defined $opt_d)
+{
+ $opt_d = `lsb_release -c`;
+ $opt_d =~ s/^.*?(\w+)\s*$/$1/o;
+}
@theselibs = (grep {-f } glob("lib/Font/TTF/*"), "lib/Font/TTF.pm");
@@ -9,8 +24,8 @@
@extras = ('dist' => { 'TO_UNIX' => 'perl -Mtounix -e "tounix(\"$(DISTVNAME)\")"' });
}
-WriteMakefile (
- NAME => "Font::TTF",
+%makeinfo = (
+ NAME => 'Font::TTF',
VERSION_FROM => 'lib/Font/TTF.pm',
# VERSION => "0.38",
# HTMLLIBPODS => {map {my $t = $_; $t=~s/\..*?$/.html/o; $t='blib/Html/'.$t; $_ => $t;} @theselibs},
@@ -19,6 +34,8 @@
ABSTRACT => "TTF font support for Perl",
@extras
);
+
+WriteMakefile(%makeinfo);
if ($^O eq 'MSWin32') {
# incantation to solve the problem of everyone's $Config{make} being 'nmake'
@@ -41,4 +58,51 @@
}
}
+elsif ($^O eq 'linux')
+{
+sub MY::postamble
+{
+ my ($self) = @_;
+ my ($res);
+ my ($package) = lc($self->{'NAME'});
+ my ($pversion) = $self->{'VERSION'};
+ my ($svn) = `svnversion`;
+ my ($sign) = '--auto-debsign' if ($opt_r);
+ my ($fpackage);
+
+ $svn =~ s/[0-9]*://og;
+ $svn =~ s/\s+$//o;
+ $package =~ s/::/-/;
+ $package = "lib${package}-perl";
+ $pversion .= "+$svn" unless ($opt_r);
+ $fpackage = "$package-$pversion";
+
+ $res = <<"EOT";
+deb-base: dist
+ rm -fr $self->{'DISTVNAME'}
+ rm -fr $fpackage
+ tar xvzf $self->{'DISTVNAME'}.tar.gz
+ mv $self->{'DISTVNAME'} $fpackage
+ tar cfz "${package}_$pversion.orig.tar.gz" $fpackage
+ cp -a debian $fpackage
+ cd $fpackage && find . -name .svn | xargs rm -rf
+
+# make deb builds an interim deb from svn source for release
+deb: deb-base
+EOT
+
+ foreach $d (split(' ', $opt_d))
+ {
+ $res .= <<"EOT";
+ mkdir -p dists/$d
+ dch -D $d -v $pversion-$opt_v -m -b -c $fpackage/debian/changelog "Auto build from perl for $d"
+ cd $fpackage && pdebuild --buildresult ../dists/$d -- --basetgz /var/cache/pbuilder/base-$d.tgz $pbuilderopts{$d}
+EOT
+ }
+
+ return $res;
+}
+
+}
+
Modified: trunk/libfont-ttf-perl/debian/changelog
URL: http://svn.debian.org/wsvn/trunk/libfont-ttf-perl/debian/changelog?rev=9527&op=diff
==============================================================================
--- trunk/libfont-ttf-perl/debian/changelog (original)
+++ trunk/libfont-ttf-perl/debian/changelog Sat Nov 17 20:28:29 2007
@@ -1,5 +1,6 @@
-libfont-ttf-perl (0.41-2) UNRELEASED; urgency=low
+libfont-ttf-perl (0.42-1) UNRELEASED; urgency=low
+ * New upstream release.
* debian/control: Added: Vcs-Svn field (source stanza); Vcs-Browser
field (source stanza); Homepage field (source stanza). Removed: XS-
Vcs-Svn fields.
Modified: trunk/libfont-ttf-perl/lib/Font/TTF.pm
URL: http://svn.debian.org/wsvn/trunk/libfont-ttf-perl/lib/Font/TTF.pm?rev=9527&op=diff
==============================================================================
--- trunk/libfont-ttf-perl/lib/Font/TTF.pm (original)
+++ trunk/libfont-ttf-perl/lib/Font/TTF.pm Sat Nov 17 20:28:29 2007
@@ -1,6 +1,7 @@
package Font::TTF;
-$VERSION = '0.41'; # MJPH 27-MAR-2007 Remove warnings from font copy
+$VERSION = '0.42'; # MJPH 11-OCT-2007 Add Volt2ttf support
+# $VERSION = '0.41'; # MJPH 27-MAR-2007 Remove warnings from font copy
# Bug fixes in Ttopen, GDEF
# Remove redundant head and maxp ->reads
# $VERSION = '0.40'; # MJPH 31-JUL-2006 Add EBDT, EBLC tables
Modified: trunk/libfont-ttf-perl/lib/Font/TTF/Anchor.pm
URL: http://svn.debian.org/wsvn/trunk/libfont-ttf-perl/lib/Font/TTF/Anchor.pm?rev=9527&op=diff
==============================================================================
--- trunk/libfont-ttf-perl/lib/Font/TTF/Anchor.pm (original)
+++ trunk/libfont-ttf-perl/lib/Font/TTF/Anchor.pm Sat Nov 17 20:28:29 2007
@@ -49,6 +49,7 @@
=cut
use strict;
+use Font::TTF::Utils;
=head2 new
@@ -76,14 +77,14 @@
sub read
{
my ($self, $fh) = @_;
- my ($dat, $loc, $fmt, $x, $y, $p, $xoff, $yoff);
+ my ($dat, $loc, $fmt, $p, $xoff, $yoff);
$fh->read($dat, 6);
- ($fmt, $x, $y) = unpack('n*', $dat);
+ $fmt = unpack('n', $dat);
if ($fmt == 4)
- { ($self->{'xid'}, $self->{'yid'}) = ($x, $y); }
+ { ($self->{'xid'}, $self->{'yid'}) = TTF_Unpack('S2', substr($dat,2)); }
else
- { ($self->{'x'}, $self->{'y'}) = ($x, $y); }
+ { ($self->{'x'}, $self->{'y'}) = TTF_Unpack('s2', substr($dat,2)); }
if ($fmt == 2)
{
@@ -112,7 +113,7 @@
=head2 out($fh, $style)
Outputs the Anchor to the given file handle at this point also addressing issues
-of deltas. If $style is set, then no output is set to the file handle. The return
+of deltas. If $style is set, then no output is sent to the file handle. The return
value is the output string.
=cut
@@ -123,12 +124,12 @@
my ($xoff, $yoff, $fmt, $out);
if (defined $self->{'xid'} || defined $self->{'yid'})
- { $out = pack('n*', 4, $self->{'xid'}, $self->{'yid'}); }
+ { $out = TTF_Pack('SSS', 4, $self->{'xid'}, $self->{'yid'}); }
elsif (defined $self->{'p'})
- { $out = pack('n*', 2, @{$self}{'x', 'y', 'p'}); }
+ { $out = TTF_Pack('Ssss', 2, @{$self}{'x', 'y', 'p'}); }
elsif (defined $self->{'xdev'} || defined $self->{'ydev'})
{
- $out = pack('n*', 3, @{$self}{'x', 'y'});
+ $out = TTF_Pack('Sss', 3, @{$self}{'x', 'y'});
if (defined $self->{'xdev'})
{
$out .= pack('n2', 10, 0);
@@ -144,9 +145,16 @@
$out .= $self->{'ydev'}->out($fh, 1);
}
} else
- { $out = pack('n3', 1, @{$self}{'x', 'y'}); }
+ { $out = TTF_Pack('Sss', 1, @{$self}{'x', 'y'}); }
$fh->print($out) unless $style;
$out;
+}
+
+
+sub signature
+{
+ my ($self) = @_;
+ return join (",", map {"${_}=$self->{$_}"} qw(x y p xdev ydev xid yid));
}
Modified: trunk/libfont-ttf-perl/lib/Font/TTF/Coverage.pm
URL: http://svn.debian.org/wsvn/trunk/libfont-ttf-perl/lib/Font/TTF/Coverage.pm?rev=9527&op=diff
==============================================================================
--- trunk/libfont-ttf-perl/lib/Font/TTF/Coverage.pm (original)
+++ trunk/libfont-ttf-perl/lib/Font/TTF/Coverage.pm Sat Nov 17 20:28:29 2007
@@ -134,15 +134,18 @@
{
$fmt = 2;
last;
- } elsif ($gids[$i] == $gids[$i-1] + 1)
+ } elsif ($gids[$i] == $gids[$i-1] + 1 && ($self->{'cover'} || $self->{'val'}{$gids[$i]} == $self->{'val'}{$gids[$i-1]}))
{ $eff++; }
else
- { $grp++; }
- }
- if ($self->{'cover'})
- { $fmt = 2 if ($eff / $grp > 4); }
- else
- { $fmt = 2 if ($grp > 1); }
+ {
+ $grp++;
+ $eff += $gids[$i] - $gids[$i-1] if (!$self->{'cover'});
+ }
+ }
+# if ($self->{'cover'})
+ { $fmt = 2 if ($eff / $grp > 3); }
+# else
+# { $fmt = 2 if ($grp > 1); }
if ($fmt == 1 && $self->{'cover'})
{
@@ -156,7 +159,7 @@
foreach $g (@gids)
{
if ($g > $last + 1)
- { &$shipout(pack('n*', 0 x ($g - $last - 1))); }
+ { &$shipout(pack('n*', (0) x ($g - $last - 1))); }
&$shipout(pack('n', $self->{'val'}{$g}));
$last = $g;
}
@@ -201,7 +204,7 @@
}
-=head2 $c->add($glyphid)
+=head2 $c->add($glyphid[, $class])
Adds a glyph id to the coverage table incrementing the count so that each subsequent addition
has the next sequential number. Returns the index number of the glyphid added
@@ -210,13 +213,75 @@
sub add
{
- my ($self, $gid) = @_;
+ my ($self, $gid, $class) = @_;
return $self->{'val'}{$gid} if (defined $self->{'val'}{$gid});
- $self->{'val'}{$gid} = $self->{'count'};
- return $self->{'count'}++;
-}
-
+ if ($self->{'cover'})
+ {
+ $self->{'val'}{$gid} = $self->{'count'};
+ return $self->{'count'}++;
+ }
+ else
+ {
+ $self->{'val'}{$gid} = $class || '0';
+ $self->{'max'} = $class if ($class > $self->{'max'});
+ return $class;
+ }
+}
+
+
+=head2 $c->signtaure
+
+Returns a vector of all the glyph ids covered by this coverage table or class
+
+=cut
+
+sub signature
+{
+ my ($self) = @_;
+ my ($vec, $range, $size);
+
+if (0)
+{
+ if ($self->{'cover'})
+ { $range = 1; $size = 1; }
+ else
+ {
+ $range = $self->{'max'};
+ $size = 1;
+ while ($range > 1)
+ {
+ $size = $size << 1;
+ $range = $range >> 1;
+ }
+ $range = $self->{'max'} + 1;
+ }
+ foreach (keys %{$self->{'val'}})
+ { vec($vec, $_, $size) = $self->{'val'}{$_} > $range ? $range : $self->{'val'}{$_}; }
+ length($vec) . ":" . $vec;
+}
+ $vec = join(";", map{"$_,$self->{'val'}{$_}"} keys %{$self->{'val'}});
+}
+
+=head2 @map=$c->sort
+
+Sorts the coverage table so that indexes are in ascending order of glyphid.
+Returns a map such that $map[$new_index]=$old_index.
+
+=cut
+
+sub sort
+{
+ my ($self) = @_;
+ my (@res, $i);
+
+ foreach (sort {$a <=> $b} keys %{$self->{'val'}})
+ {
+ push(@res, $self->{'val'}{$_});
+ $self->{'val'}{$_} = $i++;
+ }
+ @res;
+}
=head2 $c->out_xml($context)
Modified: trunk/libfont-ttf-perl/lib/Font/TTF/Font.pm
URL: http://svn.debian.org/wsvn/trunk/libfont-ttf-perl/lib/Font/TTF/Font.pm?rev=9527&op=diff
==============================================================================
--- trunk/libfont-ttf-perl/lib/Font/TTF/Font.pm (original)
+++ trunk/libfont-ttf-perl/lib/Font/TTF/Font.pm Sat Nov 17 20:28:29 2007
@@ -250,7 +250,7 @@
my ($class) = @_;
my ($t);
- foreach $t (keys %tables)
+ foreach $t (values %tables)
{
$t =~ s|::|/|oig;
require "$t.pm";
Modified: trunk/libfont-ttf-perl/lib/Font/TTF/GPOS.pm
URL: http://svn.debian.org/wsvn/trunk/libfont-ttf-perl/lib/Font/TTF/GPOS.pm?rev=9527&op=diff
==============================================================================
--- trunk/libfont-ttf-perl/lib/Font/TTF/GPOS.pm (original)
+++ trunk/libfont-ttf-perl/lib/Font/TTF/GPOS.pm Sat Nov 17 20:28:29 2007
@@ -257,7 +257,7 @@
for ($i = 0; $i < $mcount; $i++)
{ push (@{$lookup->{'RULES'}}, [{'ACTION' =>
[$self->read_value($count, $loc, $lookup, $fh)]}]); }
- $self->{'ACTION_TYPE'} = 'v';
+ $lookup->{'ACTION_TYPE'} = 'v';
} elsif ($type == 2 && $fmt == 1)
{
$lookup->{'VFMT'} = $count;
@@ -389,30 +389,29 @@
sub out_sub
{
- my ($self, $fh, $main_lookup, $index) = @_;
+ my ($self, $fh, $main_lookup, $index, $ctables, $base) = @_;
my ($type) = $main_lookup->{'TYPE'};
my ($lookup) = $main_lookup->{'SUB'}[$index];
my ($fmt) = $lookup->{'FORMAT'};
my ($out, $r, $s, $t, $i, $j, $vfmt, $vfmt2, $loc1);
my ($num) = $#{$lookup->{'RULES'}} + 1;
- my ($ctables) = {};
my ($mtables) = {};
my (@reftables);
if ($type == 1 && $fmt == 1)
{
- $out = pack('n2', $fmt, Font::TTF::Ttopen::ref_cache($lookup->{'COVERAGE'}, $ctables, 2));
+ $out = pack('n2', $fmt, Font::TTF::Ttopen::ref_cache($lookup->{'COVERAGE'}, $ctables, 2 + $base));
$vfmt = $self->fmt_value($lookup->{'ADJUST'});
- $out .= pack('n', $vfmt) . $self->out_value($lookup->{'ADJUST'}, $vfmt, $ctables, 6);
+ $out .= pack('n', $vfmt) . $self->out_value($lookup->{'ADJUST'}, $vfmt, $ctables, 6 + $base);
} elsif ($type == 1 && $fmt == 2)
{
$vfmt = 0;
foreach $r (@{$lookup->{'RULES'}})
{ $vfmt |= $self->fmt_value($r->[0]{'ACTION'}[0]); }
- $out = pack('n4', $fmt, Font::TTF::Ttopen::ref_cache($lookup->{'COVERAGE'}, $ctables, 2),
+ $out = pack('n4', $fmt, Font::TTF::Ttopen::ref_cache($lookup->{'COVERAGE'}, $ctables, 2 + $base),
$vfmt, $#{$lookup->{'RULES'}} + 1);
foreach $r (@{$lookup->{'RULES'}})
- { $out .= $self->out_value($r->[0]{'ACTION'}[0], $vfmt, $ctables, length($out)); }
+ { $out .= $self->out_value($r->[0]{'ACTION'}[0], $vfmt, $ctables, length($out) + $base); }
} elsif ($type == 2 && $fmt < 3)
{
$vfmt = 0;
@@ -430,7 +429,7 @@
# start PairPosFormat1 subtable
$out = pack('n5',
$fmt,
- Font::TTF::Ttopen::ref_cache($lookup->{'COVERAGE'}, $ctables, 2),
+ Font::TTF::Ttopen::ref_cache($lookup->{'COVERAGE'}, $ctables, 2 + $base),
$vfmt,
$vfmt2,
$#{$lookup->{'RULES'}} + 1); # PairSetCount
@@ -438,58 +437,65 @@
$off += length($out);
$off += 2 * ($#{$lookup->{'RULES'}} + 1); # there will be PairSetCount offsets here
my $pairsets = '';
+ my (%cache);
foreach $r (@{$lookup->{'RULES'}}) # foreach PairSet table
{
# write offset to this PairSet at end of PairPosFormat1 table
- $out .= pack('n', $off);
-
- # generate PairSet itself (using $off as eventual offset within PairPos subtable)
- my $pairset = pack('n', $#{$r} + 1); # PairValueCount
- foreach $t (@$r) # foreach PairValueRecord
+ if (defined $cache{"$r"})
+ { $out .= pack('n', $cache{"$r"}); }
+ else
{
- $pairset .= pack('n', $t->{'MATCH'}[0]); # SecondGlyph - MATCH has only one entry
- $pairset .=
- $self->out_value($t->{'ACTION'}[0], $vfmt, $ctables, $off + length($pairset));
- $pairset .=
- $self->out_value($t->{'ACTION'}[1], $vfmt2, $ctables, $off + length($pairset));
+ $out .= pack('n', $off);
+ $cache{"$r"} = $off;
+
+ # generate PairSet itself (using $off as eventual offset within PairPos subtable)
+ my $pairset = pack('n', $#{$r} + 1); # PairValueCount
+ foreach $t (@$r) # foreach PairValueRecord
+ {
+ $pairset .= pack('n', $t->{'MATCH'}[0]); # SecondGlyph - MATCH has only one entry
+ $pairset .=
+ $self->out_value($t->{'ACTION'}[0], $vfmt, $ctables, $off + length($pairset) + $base);
+ $pairset .=
+ $self->out_value($t->{'ACTION'}[1], $vfmt2, $ctables, $off + length($pairset) + $base);
+ }
+ $off += length($pairset);
+ $pairsets .= $pairset;
}
- $off += length($pairset);
- $pairsets .= $pairset;
}
$out .= $pairsets;
die "internal error: PairPos size not as calculated" if (length($out) != $off);
} else
{
- $out = pack('n8', $fmt, Font::TTF::Ttopen::ref_cache($lookup->{'COVERAGE'}, $ctables, 2),
+ $out = pack('n8', $fmt, Font::TTF::Ttopen::ref_cache($lookup->{'COVERAGE'}, $ctables, 2 + $base),
$vfmt, $vfmt2,
- Font::TTF::Ttopen::ref_cache($lookup->{'CLASS'}, $ctables, 1),
- Font::TTF::Ttopen::ref_cache($lookup->{'MATCH'}[0], $ctables, 1),
- $#{$lookup->{'RULES'}} + 1, $#{$lookup->{'RULES'}[0]} + 1);
-
- foreach $r (@{$lookup->{'RULES'}})
- {
- foreach $t (@$r)
+ Font::TTF::Ttopen::ref_cache($lookup->{'CLASS'}, $ctables, 8 + $base),
+ Font::TTF::Ttopen::ref_cache($lookup->{'MATCH'}[0], $ctables, 10 + $base),
+ $lookup->{'CLASS'}{'max'} + 1, $lookup->{'MATCH'}[0]{'max'} + 1);
+
+ for ($i = 0; $i <= $lookup->{'CLASS'}{'max'}; $i++)
+ {
+ for ($j = 0; $j <= $lookup->{'MATCH'}[0]{'max'}; $j++)
{
- $out .= $self->out_value($t->{'ACTION'}[0], $vfmt, $ctables, length($out));
- $out .= $self->out_value($t->{'ACTION'}[1], $vfmt2, $ctables, length($out));
+ $out .= $self->out_value($lookup->{'RULES'}[$i][$j]{'ACTION'}[0], $vfmt, $ctables, length($out) + $base);
+ $out .= $self->out_value($lookup->{'RULES'}[$i][$j]{'ACTION'}[1], $vfmt2, $ctables, length($out) + $base);
}
}
}
} elsif ($type == 3 && $fmt == 1)
{
- $out = pack('n3', $fmt, Font::TTF::Ttopen::ref_cache($lookup->{'COVERAGE'}, $ctables, 2),
+ $out = pack('n3', $fmt, Font::TTF::Ttopen::ref_cache($lookup->{'COVERAGE'}, $ctables, 2 + $base),
$#{$lookup->{'RULES'}} + 1);
foreach $r (@{$lookup->{'RULES'}})
{
- $out .= pack('n2', Font::TTF::Ttopen::ref_cache($r->[0]{'ACTION'}[0], $ctables, length($out)),
- Font::TTF::Ttopen::ref_cache($r->[0]{'ACTION'}[1], $ctables, length($out) + 2));
+ $out .= pack('n2', Font::TTF::Ttopen::ref_cache($r->[0]{'ACTION'}[0], $ctables, length($out) + $base),
+ Font::TTF::Ttopen::ref_cache($r->[0]{'ACTION'}[1], $ctables, length($out) + 2 + $base));
}
} elsif ($type == 4 || $type == 5 || $type == 6)
{
my ($loc_off, $loc_t, $ltables);
- $out = pack('n7', $fmt, Font::TTF::Ttopen::ref_cache($lookup->{'MATCH'}[0], $ctables, 2),
- Font::TTF::Ttopen::ref_cache($lookup->{'COVERAGE'}, $ctables, 4),
+ $out = pack('n7', $fmt, Font::TTF::Ttopen::ref_cache($lookup->{'MATCH'}[0], $ctables, 2 + $base),
+ Font::TTF::Ttopen::ref_cache($lookup->{'COVERAGE'}, $ctables, 4 + $base),
$#{$lookup->{'RULES'}[0][0]{'ACTION'}} + 1, 12, ($#{$lookup->{'MARKS'}} + 4) << 2,
$#{$lookup->{'MARKS'}} + 1);
foreach $r (@{$lookup->{'MARKS'}})
@@ -524,11 +530,11 @@
push (@reftables, [$ltables, $loc_t]) if ($type == 5);
}
push (@reftables, [$ltables, $loc_t]) unless ($type == 5);
+ $out = Font::TTF::Ttopen::out_final($fh, $out, \@reftables, 1);
} elsif ($type == 7 || $type == 8)
- { $out = $self->out_context($lookup, $fh, $type - 2, $fmt, $ctables, $out, $num); }
- push (@reftables, [$ctables, 0]);
- Font::TTF::Ttopen::out_final($fh, $out, \@reftables);
- $lookup;
+ { $out = $self->out_context($lookup, $fh, $type - 2, $fmt, $ctables, $out, $num, $base); }
+# push (@reftables, [$ctables, 0]);
+ $out;
}
Modified: trunk/libfont-ttf-perl/lib/Font/TTF/GSUB.pm
URL: http://svn.debian.org/wsvn/trunk/libfont-ttf-perl/lib/Font/TTF/GSUB.pm?rev=9527&op=diff
==============================================================================
--- trunk/libfont-ttf-perl/lib/Font/TTF/GSUB.pm (original)
+++ trunk/libfont-ttf-perl/lib/Font/TTF/GSUB.pm Sat Nov 17 20:28:29 2007
@@ -197,17 +197,16 @@
sub out_sub
{
- my ($self, $fh, $main_lookup, $index) = @_;
+ my ($self, $fh, $main_lookup, $index, $ctables, $base) = @_;
my ($type) = $main_lookup->{'TYPE'};
my ($lookup) = $main_lookup->{'SUB'}[$index];
my ($fmt) = $lookup->{'FORMAT'};
my ($out, $r, $t, $i, $j, $offc, $offd, $numd);
my ($num) = $#{$lookup->{'RULES'}} + 1;
- my ($ctables) = {};
if ($type == 1)
{
- $out = pack("nn", $fmt, Font::TTF::Ttopen::ref_cache($lookup->{'COVERAGE'}, $ctables, 2));
+ $out = pack("nn", $fmt, Font::TTF::Ttopen::ref_cache($lookup->{'COVERAGE'}, $ctables, 2 + $base));
if ($fmt == 1)
{ $out .= pack("n", $lookup->{'ADJUST'}); }
else
@@ -218,7 +217,7 @@
}
} elsif ($type == 2 || $type == 3)
{
- $out = pack("nnn", $fmt, Font::TTF::Ttopen::ref_cache($lookup->{'COVERAGE'}, $ctables, 2),
+ $out = pack("nnn", $fmt, Font::TTF::Ttopen::ref_cache($lookup->{'COVERAGE'}, $ctables, 2 + $base),
$num);
$out .= pack('n*', (0) x $num);
$offc = length($out);
@@ -230,9 +229,9 @@
$offc = length($out);
}
} elsif ($type == 4 || $type == 5 || $type == 6)
- { $out = $self->out_context($lookup, $fh, $type, $fmt, $ctables, $out, $num); }
- Font::TTF::Ttopen::out_final($fh, $out, [[$ctables, 0]]);
- $lookup;
+ { $out = $self->out_context($lookup, $fh, $type, $fmt, $ctables, $out, $num, $base); }
+# Font::TTF::Ttopen::out_final($fh, $out, [[$ctables, 0]]);
+ $out;
}
=head1 AUTHOR
Modified: trunk/libfont-ttf-perl/lib/Font/TTF/Glyph.pm
URL: http://svn.debian.org/wsvn/trunk/libfont-ttf-perl/lib/Font/TTF/Glyph.pm?rev=9527&op=diff
==============================================================================
--- trunk/libfont-ttf-perl/lib/Font/TTF/Glyph.pm (original)
+++ trunk/libfont-ttf-perl/lib/Font/TTF/Glyph.pm Sat Nov 17 20:28:29 2007
@@ -604,7 +604,8 @@
$self->{' DAT'} .= pack("a" . $len, substr($self->{'hints'}, 0, $len));
}
}
- $self->{' DAT'} .= "\000" if (length($self->{' DAT'}) & 1);
+ my ($olen) = length($self->{' DAT'});
+ $self->{' DAT'} .= ("\000") x (4 - ($olen & 3)) if ($olen & 3);
$self->{' OUTLEN'} = length($self->{' DAT'});
$self->{' read'} = 2; # changed from 1 to 2 so we don't read_dat() again
# we leave numPoints and instLen since maxp stats use this
@@ -775,6 +776,7 @@
{ ($x, $y) = ($x + $comp->{'args'}[0], $y + $comp->{'args'}[1]); }
push (@{$self->{'x'}}, $x);
push (@{$self->{'y'}}, $y);
+ push (@{$self->{'flags'}}, $compg->{'flags'}[$i]);
}
foreach $e (@{$compg->{'endPoints'}})
{ push (@{$self->{'endPoints'}}, $e + $nump); }
Modified: trunk/libfont-ttf-perl/lib/Font/TTF/Maxp.pm
URL: http://svn.debian.org/wsvn/trunk/libfont-ttf-perl/lib/Font/TTF/Maxp.pm?rev=9527&op=diff
==============================================================================
--- trunk/libfont-ttf-perl/lib/Font/TTF/Maxp.pm (original)
+++ trunk/libfont-ttf-perl/lib/Font/TTF/Maxp.pm Sat Nov 17 20:28:29 2007
@@ -146,7 +146,7 @@
{
my ($g) = $self->{' PARENT'}{'loca'}{'glyphs'}[$i] || next;
- @n = $g->maxInfo($self->{' PARENT'}{'loca'}{'glyphs'});
+ @n = $g->maxInfo;
for ($j = 0; $j <= $#n; $j++)
{ $m[$j] = $n[$j] if $n[$j] > $m[$j]; }
Modified: trunk/libfont-ttf-perl/lib/Font/TTF/Name.pm
URL: http://svn.debian.org/wsvn/trunk/libfont-ttf-perl/lib/Font/TTF/Name.pm?rev=9527&op=diff
==============================================================================
--- trunk/libfont-ttf-perl/lib/Font/TTF/Name.pm (original)
+++ trunk/libfont-ttf-perl/lib/Font/TTF/Name.pm Sat Nov 17 20:28:29 2007
@@ -106,7 +106,7 @@
else
{ $win_langs{$i + 0x400} = $ms_langids[$i][0]; }
}
- %langs_win = map {$win_langs{$_} => $_} keys %win_langs;
+ %langs_win = map {my ($t) = $win_langs{$_}; my (@res) = ($t => $_); push (@res, $t => $_) if ($t =~ s/-.*$//o && ($_ & 0xFC00) == 0x400); @res} keys %win_langs;
$i = 0;
%langs_mac = map {$_ => $i++} @mac_langs;
}
@@ -333,32 +333,53 @@
}
-=head2 set_name($nid, $str, $lang)
+=head2 set_name($nid, $str[, $lang[, @cover]])
Sets the given name id string to $str for all platforms and encodings that
this module can handle. If $lang is set, it is interpretted as a language
tag and if the particular language of a string is found to match, then
that string is changed, otherwise no change occurs.
-Notice that this function does not add any names to the table.
+If supplied, @cover should be a list of references to two-element arrays
+containing pid,eid pairs that should added to the name table if not already present.
+
+This function does not add any names to the table unless @cover is supplied.
=cut
sub set_name
{
- my ($self, $nid, $str, $lang) = @_;
- my ($pid, $eid, $lid);
+ my ($self, $nid, $str, $lang, @cover) = @_;
+ my ($pid, $eid, $lid, $c);
foreach $pid (0 .. $#{$self->{'strings'}[$nid]})
{
+ my $strNL = $str;
+ $strNL =~ s/\n/\r\n/og if $pid == 3;
+ $strNL =~ s/\n/\r/og if $pid == 1;
foreach $eid (0 .. $#{$self->{'strings'}[$nid][$pid]})
{
foreach $lid (keys %{$self->{'strings'}[$nid][$pid][$eid]})
{
next unless (!defined $lang || $self->match_lang($pid, $lid, $lang));
- $self->{'strings'}[$nid][$pid][$eid]{$lid} = $str;
+ $self->{'strings'}[$nid][$pid][$eid]{$lid} = $strNL;
+ foreach $c (0 .. scalar @cover)
+ {
+ next unless ($cover[$c][0] == $pid && $cover[$c][1] == $eid);
+ delete $cover[$c];
+ last;
+ }
}
}
+ }
+ foreach $c (@cover)
+ {
+ my ($pid, $eid) = @{$c};
+ my ($lid) = $self->find_lang($pid, $lang);
+ my $strNL = $str;
+ $strNL =~ s/\n/\r\n/og if $pid == 3;
+ $strNL =~ s/\n/\r/og if $pid == 1;
+ $self->{'strings'}[$nid][$pid][$eid]{$lid} = $strNL;
}
return $self;
}
@@ -558,7 +579,7 @@
);
#'
- at ms_langids = ( [],
+ at ms_langids = ( [""],
['ar', ["-SA", "-IQ", "-EG", "-LY", "-DZ", "-MA", "-TN",
"-OM", "-YE", "-SY", "-JO", "-LB", "-KW", "-AE",
"-BH", "-QA"]],
Modified: trunk/libfont-ttf-perl/lib/Font/TTF/Table.pm
URL: http://svn.debian.org/wsvn/trunk/libfont-ttf-perl/lib/Font/TTF/Table.pm?rev=9527&op=diff
==============================================================================
--- trunk/libfont-ttf-perl/lib/Font/TTF/Table.pm (original)
+++ trunk/libfont-ttf-perl/lib/Font/TTF/Table.pm Sat Nov 17 20:28:29 2007
@@ -317,7 +317,7 @@
Releases ALL of the memory used by this table, and all of its component/child
objects. This method is called automatically by
-'C<Font::TTF::Font-E<gt>release>' (so you don't have to call it yourself).
+'Font::TTF::Font-E<gt>release' (so you don't have to call it yourself).
B<NOTE>, that it is important that this method get called at some point prior
to the actual destruction of the object. Internally, we track things in a
Modified: trunk/libfont-ttf-perl/lib/Font/TTF/Ttopen.pm
URL: http://svn.debian.org/wsvn/trunk/libfont-ttf-perl/lib/Font/TTF/Ttopen.pm?rev=9527&op=diff
==============================================================================
--- trunk/libfont-ttf-perl/lib/Font/TTF/Ttopen.pm (original)
+++ trunk/libfont-ttf-perl/lib/Font/TTF/Ttopen.pm Sat Nov 17 20:28:29 2007
@@ -413,10 +413,19 @@
$fh->read($dat, $nSub * 2);
$j = 0;
my @offsets = unpack("n*", $dat);
+ my $isExtension = ($l->{'TYPE'} == $self->extension());
for ($j = 0; $j < $nSub; $j++)
{
- $l->{'SUB'}[$j]{' OFFSET'} = $offsets[$j];
- $fh->seek($moff + $oLook + $l->{' OFFSET'} + $l->{'SUB'}[$j]{' OFFSET'}, 0);
+ $l->{'SUB'}[$j]{' OFFSET'} = $offsets[$j];
+ $fh->seek($moff + $oLook + $l->{' OFFSET'} + $l->{'SUB'}[$j]{' OFFSET'}, 0);
+ if ($isExtension)
+ {
+ $fh->read($dat, 8);
+ my $longOff;
+ (undef, $l->{'TYPE'}, $longOff) = unpack("nnN", $dat);
+ $l->{'SUB'}[$j]{' OFFSET'} += $longOff;
+ $fh->seek($moff + $oLook + $l->{' OFFSET'} + $l->{'SUB'}[$j]{' OFFSET'}, 0);
+ }
$self->read_sub($fh, $l, $j);
}
}
@@ -460,7 +469,7 @@
{
my ($self, $fh) = @_;
my ($i, $j, $base, $off, $tag, $t, $l, $lTag, $oScript, @script, @tags);
- my ($end, $nTags, @offs, $oFeat, $oLook, $nSub, $nSubs, $big);
+ my ($end, $nTags, @offs, $oFeat, $oLook, $nSub, $nSubs, $big, $out);
return $self->SUPER::out($fh) unless $self->{' read'};
@@ -600,12 +609,16 @@
}
else
{ $end = $tag->{' EXT_OFFSET'}; }
- @offs = ();
+ my (@offs, $out, @refs);
for ($j = 0; $j < $nSub; $j++)
{
- push(@offs, tell($fh) - $end);
- $self->out_sub($fh, $tag, $j);
- }
+ my ($ctables) = {};
+ my ($base) = length($out);
+ push(@offs, tell($fh) - $end + $base);
+ $out .= $self->out_sub($fh, $tag, $j, $ctables, $base);
+ push (@refs, [$ctables, $base]);
+ }
+ out_final($fh, $out, \@refs);
$end = $fh->tell();
if (!defined $big)
{
@@ -747,7 +760,7 @@
my ($fh, $out, $cache_list, $state) = @_;
my ($len) = length($out || '');
my ($base_loc) = $state ? 0 : $fh->tell();
- my ($loc, $t, $r, $s, $master_cache, $offs, $str);
+ my ($loc, $t, $r, $s, $master_cache, $offs, $str, %vecs);
$fh->print($out || '') unless $state; # first output the current attempt
foreach $r (@$cache_list)
@@ -758,12 +771,19 @@
$str = "$t";
if (!defined $master_cache->{$str})
{
- $master_cache->{$str} = ($state ? length($out) : $fh->tell())
- - $base_loc;
- if ($state)
- { $out .= $r->[0]{$str}[0]->out($fh, 1); }
+ my ($vec) = $r->[0]{$str}[0]->signature();
+ if ($vecs{$vec})
+ { $master_cache->{$str} = $master_cache->{$vecs{$vec}}; }
else
- { $r->[0]{$str}[0]->out($fh, 0); }
+ {
+ $vecs{$vec} = $str;
+ $master_cache->{$str} = ($state ? length($out) : $fh->tell())
+ - $base_loc;
+ if ($state)
+ { $out .= $r->[0]{$str}[0]->out($fh, 1); }
+ else
+ { $r->[0]{$str}[0]->out($fh, 0); }
+ }
}
foreach $s (@{$r->[0]{$str}[1]})
{ substr($out, $s, 2) = pack('n', $master_cache->{$str} - $offs); }
@@ -964,7 +984,7 @@
sub out_context
{
- my ($self, $lookup, $fh, $type, $fmt, $ctables, $out, $num) = @_;
+ my ($self, $lookup, $fh, $type, $fmt, $ctables, $out, $num, $base) = @_;
my ($offc, $offd, $i, $j, $r, $t, $numd);
$out ||= '';
@@ -974,20 +994,20 @@
if ($fmt == 1)
{
- $out = pack("nnn", $fmt, Font::TTF::Ttopen::ref_cache($lookup->{'COVERAGE'}, $ctables, 2),
+ $out = pack("nnn", $fmt, Font::TTF::Ttopen::ref_cache($lookup->{'COVERAGE'}, $ctables, 2 + $base),
$num);
$base_off = 6;
} elsif ($type == 5)
{
- $out = pack("nnnn", $fmt, Font::TTF::Ttopen::ref_cache($lookup->{'COVERAGE'}, $ctables, 2),
- Font::TTF::Ttopen::ref_cache($lookup->{'CLASS'}, $ctables, 4), $num);
+ $out = pack("nnnn", $fmt, Font::TTF::Ttopen::ref_cache($lookup->{'COVERAGE'}, $ctables, 2 + $base),
+ Font::TTF::Ttopen::ref_cache($lookup->{'CLASS'}, $ctables, 4 + $base), $num);
$base_off = 8;
} elsif ($type == 6)
{
- $out = pack("n6", $fmt, Font::TTF::Ttopen::ref_cache($lookup->{'COVERAGE'}, $ctables, 2),
- Font::TTF::Ttopen::ref_cache($lookup->{'PRE_CLASS'}, $ctables, 4),
- Font::TTF::Ttopen::ref_cache($lookup->{'CLASS'}, $ctables, 6),
- Font::TTF::Ttopen::ref_cache($lookup->{'POST_CLASS'}, $ctables, 8),
+ $out = pack("n6", $fmt, Font::TTF::Ttopen::ref_cache($lookup->{'COVERAGE'}, $ctables, 2 + $base),
+ Font::TTF::Ttopen::ref_cache($lookup->{'PRE_CLASS'}, $ctables, 4 + $base),
+ Font::TTF::Ttopen::ref_cache($lookup->{'CLASS'}, $ctables, 6 + $base),
+ Font::TTF::Ttopen::ref_cache($lookup->{'POST_CLASS'}, $ctables, 8 + $base),
$num);
$base_off = 12;
}
@@ -1034,7 +1054,7 @@
$out .= pack('n3', $fmt, $#{$lookup->{'RULES'}[0][0]{'MATCH'}} + 1,
$#{$lookup->{'RULES'}[0][0]{'ACTION'}} + 1);
foreach $t (@{$lookup->{'RULES'}[0][0]{'MATCH'}})
- { $out .= pack('n', Font::TTF::Ttopen::ref_cache($t, $ctables, length($out))); }
+ { $out .= pack('n', Font::TTF::Ttopen::ref_cache($t, $ctables, length($out) + $base)); }
foreach $t (@{$lookup->{'RULES'}[0][0]{'ACTION'}})
{ $out .= pack('n2', @$t); }
} elsif ($type == 6 && $fmt == 3)
@@ -1043,13 +1063,13 @@
no strict 'refs'; # temp fix - more code needed (probably "if" statements in the event 'PRE' or 'POST' are empty)
$out .= pack('n2', $fmt, defined $r->{'PRE'} ? scalar @{$r->{'PRE'}} : 0);
foreach $t (@{$r->{'PRE'}})
- { $out .= pack('n', Font::TTF::Ttopen::ref_cache($t, $ctables, length($out))); }
+ { $out .= pack('n', Font::TTF::Ttopen::ref_cache($t, $ctables, length($out) + $base)); }
$out .= pack('n', defined $r->{'MATCH'} ? scalar @{$r->{'MATCH'}} : 0);
foreach $t (@{$r->{'MATCH'}})
- { $out .= pack('n', Font::TTF::Ttopen::ref_cache($t, $ctables, length($out))); }
+ { $out .= pack('n', Font::TTF::Ttopen::ref_cache($t, $ctables, length($out) + $base)); }
$out .= pack('n', defined $r->{'POST'} ? scalar @{$r->{'POST'}} : 0);
foreach $t (@{$r->{'POST'}})
- { $out .= pack('n', Font::TTF::Ttopen::ref_cache($t, $ctables, length($out))); }
+ { $out .= pack('n', Font::TTF::Ttopen::ref_cache($t, $ctables, length($out) + $base)); }
$out .= pack('n', defined $r->{'ACTION'} ? scalar @{$r->{'ACTION'}} : 0);
foreach $t (@{$r->{'ACTION'}})
{ $out .= pack('n2', @$t); }
More information about the Pkg-perl-cvs-commits
mailing list